justin-site/HakyllBibTex.hs

115 lines
4.1 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.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)
--------------------------------------------------------------------------------
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 -> empty
Just val -> case key of
"author" -> return $ StringField $ formatAuthors val
_ -> return $ StringField $ latexToHtml val
--------------------------------------------------------------------------------
newtype BibFile = BibFile [BibEntry]
deriving (Binary, Typeable)
--------------------------------------------------------------------------------
bibFileEntryNames :: BibFile -> [String]
bibFileEntryNames (BibFile es) = [B.identifier t | BibEntry t <- es]
--------------------------------------------------------------------------------
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 ",")
--------------------------------------------------------------------------------
-- Inefficient...
trimSpace :: String -> String
trimSpace = f . f
where f = reverse . dropWhile isSpace
--------------------------------------------------------------------------------
latexToHtml tex =
let p = case Pandoc.readLaTeX Pandoc.def tex of
Pandoc.Pandoc meta [Pandoc.Para para] ->
Pandoc.Pandoc meta [Pandoc.Plain para]
x -> x
in Pandoc.writeHtmlString Pandoc.def p