More work on papers

2 files changed, 38 insertions, 8 deletions

diff --git a/src/Hakyll/Paper.hs b/src/Hakyll/Paper.hs
index e131d43..5d59532 100644
--- a/src/Hakyll/Paper.hs
+++ b/src/Hakyll/Paper.hs
@@ -7,6 +7,8 @@ import Data.Name
 import Data.Time.Format
 import Hakyll.Core.Compiler.Internal
 import Hakyll.Core.Provider (resourceList)
+import Hakyll.Util (transformContext_)
+import System.FilePath
 
 
 findIdentifiers :: Pattern -> Compiler [Identifier]
@@ -25,14 +27,25 @@ paperCtxt = fold $
     , field "abstract" $ liftMaybe . fmap toSL . abstract . itemBody
     , field "title" $ pure . toSL . title . getItemBody
     , status >$< statusCtxt
-    -- , eprint >$< eprintCtxt
+    , eprint >$< maybeContext 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
+                              Just l -> pure $ show l
+                              Nothing -> do
+                                  let k = key $ itemBody i
+                                      ident = toFilePath $ itemIdentifier i
+                                  findItentifiers (fromString $ ident <> "/index.**") >>= witherM (fmap (>>= parseRelativeReference) . getRoute) >>= \case
+                                    (x:_) -> pure $ show x
+                                    _ -> fail $ "No extra for " <> toSL k
     ]
 
+mkPaperContext :: StringConv a String => [Paper a] -> Context b
+mkPaperContext papers = listField "papers" paperCtxt $ do
+    fp <- getResourceFilePath
+    forM papers $ \p -> do
+        let itm = Item (fromFilePath $ replaceFileName fp (toSL $ key p)) p
+        eprnt <- findLocal itm
+        pure $ (\x -> x { eprint = eprnt }) <$> itm
+
 
 
 statusCtxt :: StringConv a String => Context (Status a)
@@ -67,12 +80,16 @@ eprintCtxt = fold $
                                                 _ -> fail "No ArXiv"
     ]
 
+maybeContext :: Context a -> Context (Maybe a)
+maybeContext = transformContext_ $ maybe (fail "Got Nothing") pure
+
 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
+              ident = toFilePath $ itemIdentifier paper
+          findIdentifiers (fromString (ident <> ".pdf") .||. fromString (ident <> "/" <> toSL k <> ".pdf")) >>= witherM (fmap (>>= parseRelativeReference) . getRoute) >>= pure . \case
+            (x:_) -> Just $ OtherEprint (toSL "eprint") x
             _ -> Nothing
diff --git a/src/Hakyll/Util.hs b/src/Hakyll/Util.hs
index edbdb16..35169fa 100644
--- a/src/Hakyll/Util.hs
+++ b/src/Hakyll/Util.hs
@@ -1,7 +1,12 @@
 module Hakyll.Util
-    ( dropParentRoute
+    (
+    -- * Route utils
+      dropParentRoute
     , modifyDirRoute
     , modifyDirRoute_
+    -- * Context utils
+    , transformContext
+    , transformContext_
     ) where
 
 import Prolog
@@ -17,3 +22,11 @@ modifyDirRoute f = customRoute $ f . splitDirectories . toFilePath
 
 modifyDirRoute_ :: ([FilePath] -> [FilePath]) -> Routes
 modifyDirRoute_ f = modifyDirRoute $ joinPath . f
+
+-- | General contramap
+transformContext :: (Item b -> Compiler (Item a)) -> Context a -> Context b
+transformContext f (Context c) = Context $ \n args itm -> c n args =<< f itm
+
+-- | Slightly more general contramap
+transformContext_ :: (b -> Compiler a) -> Context a -> Context b
+transformContext_ = transformContext . traverse