justin-site/HakyllBibTex.hs

135 lines
4.9 KiB
Haskell
Raw Normal View History

-- JH: From hakyll-bibtex by jaspervdj, using the Pandoc parser.
--------------------------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module HakyllBibTex
( BibEntry (..)
, bibEntryContext
, BibFile (..)
, bibFileEntryNames
, parseBibFile
, lookupBibEntry
) where
--------------------------------------------------------------------------------
import Control.Applicative
import Data.Binary (Binary (..))
import Data.Char (isSpace)
import Data.List.Split (splitOn)
import Data.List (intercalate)
import Data.Map (empty)
import Data.Typeable (Typeable)
import Hakyll
2015-01-05 04:43:45 +00:00
import qualified Bibtex as B
import qualified Text.Pandoc as Pandoc
import qualified Text.Parsec as Parsec
--------------------------------------------------------------------------------
newtype BibEntry = BibEntry B.Item
deriving (Typeable)
--------------------------------------------------------------------------------
instance Binary BibEntry where
put (BibEntry t) = do
put $ B.entryType t
put $ B.identifier t
put $ B.fields t
get = BibEntry <$> (B.Item <$> get <*> get <*> get)
--------------------------------------------------------------------------------
-- XXX refactor to use Context monoid XXX
bibEntryContext :: Context BibEntry
bibEntryContext = Context $ \key _ item ->
let BibEntry t = itemBody item
in case key of
"identifier" -> return $ StringField $ B.identifier t
_ -> case lookup key (B.fields t) of
Nothing -> Control.Applicative.empty
Just val -> case key of
"author" -> return $ StringField $ formatAuthors val
"month" -> return $ StringField $ expandMonth val
2016-02-19 04:47:40 +00:00
"url" -> return $ StringField $ val
_ -> return $ StringField $ latexToHtml val
--------------------------------------------------------------------------------
newtype BibFile = BibFile [BibEntry]
deriving (Binary, Typeable)
--------------------------------------------------------------------------------
bibFileEntryNames :: BibFile -> [String]
bibFileEntryNames (BibFile es) = [B.identifier t | BibEntry t <- es]
--------------------------------------------------------------------------------
-- XXX refactor to use Text.CSL.readBiblioFile XXX
parseBibFile :: String -> BibFile
parseBibFile string = case Parsec.runParser (B.bibEntries <* Parsec.eof)
[] "<bib file>" string of
Left err -> error $ show err
Right xs -> BibFile $ map BibEntry (B.resolveCrossRefs True xs)
--------------------------------------------------------------------------------
lookupBibEntry :: String -> BibFile -> BibEntry
lookupBibEntry name (BibFile es) =
case [BibEntry t | BibEntry t <- es, B.identifier t == name] of
[] -> error $ name ++ " not found in BibFile"
(x : _) -> x
--------------------------------------------------------------------------------
formatAuthors :: String -> String
formatAuthors auth =
let auths = splitOn "and" auth
swapped = fmap formatAuthor auths
finalSep = case (length auths) of
1 -> ""
2 -> " and&nbsp;"
_ -> ", and&nbsp;"
in
(intercalate ", " (init swapped)) ++ finalSep ++ last swapped
--------------------------------------------------------------------------------
formatAuthor :: String -> String
formatAuthor = intercalate "&nbsp;"
. (splitOn " ")
. latexToHtml
. trimSpace
. (intercalate " ")
. reverse
. (splitOn ",")
--------------------------------------------------------------------------------
expandMonth :: String -> String
expandMonth mon = case mon of
"jan" -> "January"
"feb" -> "February"
"mar" -> "March"
"apr" -> "April"
"may" -> "May"
"jun" -> "June"
"jul" -> "July"
"aug" -> "August"
"sep" -> "September"
"oct" -> "October"
"nov" -> "November"
"dec" -> "December"
2016-10-14 02:43:11 +00:00
x -> x
--------------------------------------------------------------------------------
-- Inefficient...
trimSpace :: String -> String
trimSpace = f . f
2016-02-19 04:43:24 +00:00
where f = reverse . dropWhile isSpace
--------------------------------------------------------------------------------
latexToHtml tex =
let p = case Pandoc.readLaTeX Pandoc.def tex of
Right (Pandoc.Pandoc meta [Pandoc.Para para]) ->
Pandoc.Pandoc meta [Pandoc.Plain para]
Left _ ->
Pandoc.Pandoc (Pandoc.Meta Data.Map.empty) []
in Pandoc.writeHtmlString Pandoc.def p