Switch to cabal builds.

No more stackage.
2021-01-03 18:31:52 +00:00
parent 2602bdd594
commit 525aa09f61
8 changed files with 157 additions and 63 deletions
@@ -0,0 +1,143 @@
+-- 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 qualified Data.Map                 as M (empty)
+import           Data.Text                (pack, unpack)
+import           Data.Typeable            (Typeable)
+import           Hakyll
+import qualified Bibtex                   as B
+import           Text.Pandoc
+import qualified Text.Parsec              as Parsec
+
+--------------------------------------------------------------------------------
+newtype BibEntry = BE B.Item
+    deriving (Typeable)
+
+unwrapBE :: BibEntry -> B.Item
+unwrapBE (BE it) = it
+
+--------------------------------------------------------------------------------
+instance Binary BibEntry where
+    put (BE t) = do
+        put $ B.entryType t
+        put $ B.identifier t
+        put $ B.fields t
+
+    get = BE <$> (B.Item <$> get <*> get <*> get)
+
+--------------------------------------------------------------------------------
+-- XXX refactor to use Context monoid ? XXX
+bibEntryContext :: Context BibEntry
+bibEntryContext = Context $ \key _ item ->
+    let BE t = itemBody item
+    in case key of
+        "identifier" -> return $ StringField $ B.identifier t
+        _            -> case lookup key (B.fields t) of
+            Just val -> return $ StringField $ case key of
+              k
+                | k == "author" -> formatAuthors val
+                | k == "month"  -> expandMonth   val
+                | otherwise     -> latexToHtml   val
+            Nothing  -> empty
+
+--------------------------------------------------------------------------------
+newtype BibFile = BibFile [BibEntry]
+    deriving (Binary, Typeable)
+
+
+--------------------------------------------------------------------------------
+bibFileEntryNames :: BibFile -> [String]
+bibFileEntryNames (BibFile es) = [B.identifier t | BE 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 BE (B.resolveCrossRefs True xs)
+
+
+--------------------------------------------------------------------------------
+lookupBibEntry :: String -> BibFile -> BibEntry
+lookupBibEntry name (BibFile es) =
+    case [BE t | BE 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"
+    x     -> x
+
+--------------------------------------------------------------------------------
+-- Inefficient...
+trimSpace :: String -> String
+trimSpace = f . f
+    where f = reverse . dropWhile isSpace
+
+-- Remove <p> and </p> tags...
+trimPara :: String -> String
+trimPara str = concat $ splitOn "</p>" $ drop 3 str
+
+--------------------------------------------------------------------------------
+latexToHtml :: String -> String
+latexToHtml tex =
+    let res = runPure $ readLaTeX def (pack tex)
+                        >>= writeHtml5String def 
+                        >>= return . trimPara . unpack
+    in case res of
+            Left   _    -> ""
+            Right  html -> html