Small tweaks.

Seems tricky to use the Text.CSL bib parser, since that drops the
non-standard fields. Using the context monoid seems not to be worth it.
This commit is contained in:
Justin Hsu 2017-09-23 20:37:50 +01:00
parent 4666ad3439
commit 066d1ced7c
1 changed files with 21 additions and 17 deletions

View File

@ -18,7 +18,7 @@ import Data.Binary (Binary (..))
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Map (empty) import qualified Data.Map as M (empty)
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Hakyll import Hakyll
import qualified Bibtex as B import qualified Bibtex as B
@ -26,32 +26,36 @@ import qualified Text.Pandoc as Pandoc
import qualified Text.Parsec as Parsec import qualified Text.Parsec as Parsec
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
newtype BibEntry = BibEntry B.Item newtype BibEntry = BE B.Item
deriving (Typeable) deriving (Typeable)
unwrapBE :: BibEntry -> B.Item
unwrapBE (BE it) = it
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
instance Binary BibEntry where instance Binary BibEntry where
put (BibEntry t) = do put (BE t) = do
put $ B.entryType t put $ B.entryType t
put $ B.identifier t put $ B.identifier t
put $ B.fields t put $ B.fields t
get = BibEntry <$> (B.Item <$> get <*> get <*> get) get = BE <$> (B.Item <$> get <*> get <*> get)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- XXX refactor to use Context monoid XXX -- XXX refactor to use Context monoid ? XXX
bibEntryContext :: Context BibEntry bibEntryContext :: Context BibEntry
bibEntryContext = Context $ \key _ item -> bibEntryContext = Context $ \key _ item ->
let BibEntry t = itemBody item let BE t = itemBody item
in case key of in case key of
"identifier" -> return $ StringField $ B.identifier t "identifier" -> return $ StringField $ B.identifier t
_ -> case lookup key (B.fields t) of _ -> case lookup key (B.fields t) of
Nothing -> Control.Applicative.empty Just val -> return $ StringField $ case key of
Just val -> case key of k
"author" -> return $ StringField $ formatAuthors val | k == "author" -> formatAuthors val
"month" -> return $ StringField $ expandMonth val | k == "month" -> expandMonth val
"url" -> return $ StringField $ val | k `elem` [ "title", "booktitle", "journal", "note" ] -> latexToHtml val
_ -> return $ StringField $ latexToHtml val | otherwise -> val
Nothing -> empty
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
newtype BibFile = BibFile [BibEntry] newtype BibFile = BibFile [BibEntry]
@ -60,25 +64,25 @@ newtype BibFile = BibFile [BibEntry]
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
bibFileEntryNames :: BibFile -> [String] bibFileEntryNames :: BibFile -> [String]
bibFileEntryNames (BibFile es) = [B.identifier t | BibEntry t <- es] bibFileEntryNames (BibFile es) = [B.identifier t | BE t <- es]
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- XXX refactor to use Text.CSL.readBiblioFile XXX
parseBibFile :: String -> BibFile parseBibFile :: String -> BibFile
parseBibFile string = case Parsec.runParser (B.bibEntries <* Parsec.eof) parseBibFile string = case Parsec.runParser (B.bibEntries <* Parsec.eof)
[] "<bib file>" string of [] "<bib file>" string of
Left err -> error $ show err Left err -> error $ show err
Right xs -> BibFile $ map BibEntry (B.resolveCrossRefs True xs) Right xs -> BibFile $ map BE (B.resolveCrossRefs True xs)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
lookupBibEntry :: String -> BibFile -> BibEntry lookupBibEntry :: String -> BibFile -> BibEntry
lookupBibEntry name (BibFile es) = lookupBibEntry name (BibFile es) =
case [BibEntry t | BibEntry t <- es, B.identifier t == name] of case [BE t | BE t <- es, B.identifier t == name] of
[] -> error $ name ++ " not found in BibFile" [] -> error $ name ++ " not found in BibFile"
(x : _) -> x (x : _) -> x
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
formatAuthors :: String -> String formatAuthors :: String -> String
formatAuthors auth = formatAuthors auth =
@ -130,5 +134,5 @@ latexToHtml tex =
Right (Pandoc.Pandoc meta [Pandoc.Para para]) -> Right (Pandoc.Pandoc meta [Pandoc.Para para]) ->
Pandoc.Pandoc meta [Pandoc.Plain para] Pandoc.Pandoc meta [Pandoc.Plain para]
Left _ -> Left _ ->
Pandoc.Pandoc (Pandoc.Meta Data.Map.empty) [] Pandoc.Pandoc (Pandoc.Meta M.empty) []
in Pandoc.writeHtmlString Pandoc.def p in Pandoc.writeHtmlString Pandoc.def p