From f902be4f4641262787c623deac267c02d89fec7c Mon Sep 17 00:00:00 2001 From: Chris Wells Date: Tue, 25 Mar 2025 17:31:18 -0500 Subject: Working more on my publication list --- src/Hakyll/Paper.hs | 88 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 52 insertions(+), 36 deletions(-) (limited to 'src/Hakyll/Paper.hs') diff --git a/src/Hakyll/Paper.hs b/src/Hakyll/Paper.hs index 5d59532..8db50cd 100644 --- a/src/Hakyll/Paper.hs +++ b/src/Hakyll/Paper.hs @@ -5,15 +5,10 @@ import Hakyll import Data.Paper 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] -findIdentifiers pat = filterMatches pat . resourceList . compilerProvider <$> compilerAsk - authorCtxt :: StringConv a String => Context (Name a) @@ -25,53 +20,68 @@ 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 + , field "title" $ pure . toSL . title . itemBody + , field "key" $ pure . sluggedKey . itemBody , status >$< statusCtxt - , eprint >$< maybeContext eprintCtxt + , listFieldWith "eprints" eprintCtxt $ pure . eprints . itemBody + -- , eprint >$< maybeContext eprintCtxt , field "extra" $ \i -> case extraLink $ getItemBody i of Just l -> pure $ show l Nothing -> do - let k = key $ itemBody i + let k = sluggedKey $ itemBody i ident = toFilePath $ itemIdentifier i - findItentifiers (fromString $ ident <> "/index.**") >>= witherM (fmap (>>= parseRelativeReference) . getRoute) >>= \case + getMatches (fromString $ ident <> "/index.*") >>= witherM (fmap (>>= parseRelativeReference) . getRoute) >>= \case (x:_) -> pure $ show x - _ -> fail $ "No extra for " <> toSL k + _ -> fail $ "No extra for " <> 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 + let itm = Item (fromFilePath $ replaceFileName fp (sluggedKey p)) p + e <- findLocal itm + pure $ (\x -> x { eprint = eprint x <> e }) <$> itm statusCtxt :: StringConv a String => Context (Status a) statusCtxt = fold $ - [ field "date" $ formatTime defaultTimeLocale "%b %Y" . date . getItemBody - , field "journal" $ \i -> case getItemBody i of + [ field "date" $ formatTime defaultTimeLocale "%b %Y" . date . itemBody + , field "journal" $ \i -> case itemBody i of Published _ j _ -> pure $ toSL j Accepted _ j -> pure $ toSL j _ -> fail "No journal" - , field "doi" $ \i -> case getItemBody i of + , field "doi" $ \i -> case itemBody i of Published _ _ d -> pure $ show (doiLink d) + _ -> fail "No DOI" + , boolField "published" $ \i -> case itemBody i of + Published _ _ _ -> True + _ -> False + , boolField "accepted" $ \i -> case itemBody i of + Accepted _ _ -> True + _ -> False + , boolField "submitted" $ \i -> case itemBody i of + Submitted _ -> True + _ -> False + , boolField "unpublished" $ \i -> case itemBody i of + Unpublished _ -> True + _ -> False ] 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 "eprint" $ \i -> pure $ case itemBody i of + ArXivEprint a _ -> show $ arXivLink ArXivAbs a + OtherEprint _ l -> show $ l + , field "eprintName" $ \i -> pure $ case itemBody i of + ArXivEprint _ c -> "arXiv[" <> toSL c <> "]" + 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 _ -> + ArXivEprint a -> case args of ["abs"] -> pure $ show $ arXivLink ArXivAbs a ["pdf"] -> pure $ show $ arXivLink ArXivPdf a @@ -80,16 +90,22 @@ 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 - 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 +findLocal :: (StringConv a String, StringConv String a) => Item (Paper a) -> Compiler [Eprint a] +findLocal paper = do + let k = sluggedKey $ itemBody paper + ident = toFilePath $ itemIdentifier paper + getMatches (fromString (ident <> ".pdf") .||. fromString (ident <> "/" <> k <> ".pdf")) >>= witherM (fmap (>>= parseRelativeReference) . getRoute) >>= pure . fmap (OtherEprint (toSL ".pdf")) + + +sluggedKey :: StringConv a String => Paper a -> String +sluggedKey = toSlug . toSL . key + + +compilePapers :: StringConv s String => Item s -> Compiler (Item [Paper String]) +compilePapers = compileBibtex >=> traverse (mapM mkPaper) + +papersCompiler :: Compiler (Item [Paper String]) +papersCompiler = getResourceBody >>= compilerPapers + +-- paperListCompiler :: Compiler [Paper String] +-- paperListCompiler = bibtexCompiler -- cgit v1.2.3