Working on formatting papers

1 files changed, 78 insertions, 0 deletions

diff --git a/src/Hakyll/Paper.hs b/src/Hakyll/Paper.hs
index e69de29..e131d43 100644
--- a/src/Hakyll/Paper.hs
+++ b/src/Hakyll/Paper.hs
@@ -0,0 +1,78 @@
+module Hakyll.Paper where
+
+import Prolog
+import Hakyll
+import Data.Paper
+import Data.Name
+import Data.Time.Format
+import Hakyll.Core.Compiler.Internal
+import Hakyll.Core.Provider (resourceList)
+
+
+findIdentifiers :: Pattern -> Compiler [Identifier]
+findIdentifiers pat = filterMatches pat . resourceList . compilerProvider <$> compilerAsk
+
+
+
+authorCtxt :: StringConv a String => Context (Name a)
+authorCtxt = fold $
+    [ field "name" $ pure . renderNameFML . fmap toSL . getItemBody
+    ]
+
+paperCtxt :: StringConv a String => Context (Paper a)
+paperCtxt = fold $
+    [ listFieldWith "authors" authorCtxt $ pure . authors . itemBody
+    , field "abstract" $ liftMaybe . fmap toSL . abstract . itemBody
+    , field "title" $ pure . toSL . title . getItemBody
+    , status >$< statusCtxt
+    -- , eprint >$< eprintCtxt
+    , field "extra" $ \i -> case extraLink $ getItemBody i of
+                              Just l -> pure $ "<a href=\"" <> show l <> "\">extra</a>"
+                              Nothing ->
+                                  let k = key $ getItemBody i
+                                   in undefined
+    ]
+
+
+
+statusCtxt :: StringConv a String => Context (Status a)
+statusCtxt = fold $
+    [ field "date" $ formatTime defaultTimeLocale "%b %Y" . date . getItemBody
+    , field "journal" $ \i -> case getItemBody i of
+                                Published _ j _ -> pure $ toSL j
+                                Accepted _ j -> pure $ toSL j
+                                _ -> fail "No journal"
+    , field "doi" $ \i -> case getItemBody i of
+                            Published _ _ d -> pure $ show (doiLink d)
+    ]
+
+eprintCtxt :: StringConv a String => Context (Eprint a)
+eprintCtxt = fold $
+    [ field "eprint" $ \i -> case itemBody i of
+                               ArXivEprint a _ -> pure $ show $ arXivLink ArXivAbs a
+                               OtherEprint _ l -> pure $ show $ l
+    , field "eprintName" $ \i -> case itemBody i of
+                                   ArXivEprint {..} -> "arXiv"
+                                   OtherEprint n _ -> show n
+    , field "arXivClass" $ \i -> case itemBody i of
+                                   ArXivEprint _ c -> pure $ toSL c
+                                   _ -> fail "No arXiv"
+    , functionField "arXivLink" $ \args i -> case itemBody i of
+                                               ArXivEprint a _ ->
+                                                   case args of
+                                                     ["abs"] -> pure $ show $ arXivLink ArXivAbs a
+                                                     ["pdf"] -> pure $ show $ arXivLink ArXivPdf a
+                                                     ["src"] -> pure $ show $ arXivLink ArXivSrc a
+                                                     xs -> fail $ "Invalid argument to arXivLink: " <> show xs
+                                                _ -> fail "No ArXiv"
+    ]
+
+findLocal :: (StringConv a String, StringConv String a) => Item (Paper a) -> Compiler (Maybe (Eprint a))
+findLocal paper =
+    case eprint $ itemBody paper of
+      Just e -> pure $ Just e
+      Nothing -> do
+          let k = key $ itemBody paper
+          findIdentifiers ("**/" <> toSL k <> ".pdf") >>= witherM (fmap (>>= parseRelativeReference) . getRoute) >>= pure . \case
+            (x:_) -> OtherEprint (toSL "eprint") x
+            _ -> Nothing