summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Paper.hs78
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