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:
parent
4666ad3439
commit
066d1ced7c
|
@ -18,7 +18,7 @@ import Data.Binary (Binary (..))
|
|||
import Data.Char (isSpace)
|
||||
import Data.List.Split (splitOn)
|
||||
import Data.List (intercalate)
|
||||
import Data.Map (empty)
|
||||
import qualified Data.Map as M (empty)
|
||||
import Data.Typeable (Typeable)
|
||||
import Hakyll
|
||||
import qualified Bibtex as B
|
||||
|
@ -26,32 +26,36 @@ import qualified Text.Pandoc as Pandoc
|
|||
import qualified Text.Parsec as Parsec
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
newtype BibEntry = BibEntry B.Item
|
||||
newtype BibEntry = BE B.Item
|
||||
deriving (Typeable)
|
||||
|
||||
unwrapBE :: BibEntry -> B.Item
|
||||
unwrapBE (BE it) = it
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance Binary BibEntry where
|
||||
put (BibEntry t) = do
|
||||
put (BE t) = do
|
||||
put $ B.entryType t
|
||||
put $ B.identifier 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 $ \key _ item ->
|
||||
let BibEntry t = itemBody item
|
||||
let BE 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
|
||||
"url" -> return $ StringField $ val
|
||||
_ -> return $ StringField $ latexToHtml val
|
||||
Just val -> return $ StringField $ case key of
|
||||
k
|
||||
| k == "author" -> formatAuthors val
|
||||
| k == "month" -> expandMonth val
|
||||
| k `elem` [ "title", "booktitle", "journal", "note" ] -> latexToHtml val
|
||||
| otherwise -> val
|
||||
Nothing -> empty
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
newtype BibFile = BibFile [BibEntry]
|
||||
|
@ -60,25 +64,25 @@ newtype BibFile = BibFile [BibEntry]
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
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 = 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)
|
||||
Right xs -> BibFile $ map BE (B.resolveCrossRefs True xs)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
lookupBibEntry :: String -> BibFile -> BibEntry
|
||||
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"
|
||||
(x : _) -> x
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
formatAuthors :: String -> String
|
||||
formatAuthors auth =
|
||||
|
@ -130,5 +134,5 @@ latexToHtml tex =
|
|||
Right (Pandoc.Pandoc meta [Pandoc.Para para]) ->
|
||||
Pandoc.Pandoc meta [Pandoc.Plain para]
|
||||
Left _ ->
|
||||
Pandoc.Pandoc (Pandoc.Meta Data.Map.empty) []
|
||||
Pandoc.Pandoc (Pandoc.Meta M.empty) []
|
||||
in Pandoc.writeHtmlString Pandoc.def p
|
||||
|
|
Loading…
Reference in New Issue