-- 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.Typeable            (Typeable)
import           Hakyll
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 -> return $ StringField $ latexToHtml val
  where
    -- Renders latex to HTML, but don't wrap everything in a <p>...
    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


--------------------------------------------------------------------------------
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