diff options
| -rw-r--r-- | src/Hakyll/Paper.hs | 31 | ||||
| -rw-r--r-- | src/Hakyll/Util.hs | 15 |
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 |