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/Alias.hs | 23 ++++++++++---- src/Hakyll/Paper.hs | 88 +++++++++++++++++++++++++++++++---------------------- src/Hakyll/Util.hs | 2 ++ 3 files changed, 71 insertions(+), 42 deletions(-) (limited to 'src/Hakyll') diff --git a/src/Hakyll/Alias.hs b/src/Hakyll/Alias.hs index 063ea2b..33ed5c1 100644 --- a/src/Hakyll/Alias.hs +++ b/src/Hakyll/Alias.hs @@ -20,12 +20,23 @@ import Hakyll.Web.Template.Util (functionField1) aliasCtxt :: (Ord a, FromAlias a x) => String -> (String -> Compiler a) -> (x -> Compiler String) -> AliasMap a x -> Context c aliasCtxt name toa fromx amap = functionField1 name $ toa >=> flip resolveAlias amap >=> fromx +aliasCtxtFrom :: (Ord a, FromAlias a x) => String -> (String -> Compiler a) -> (x -> Compiler String) -> Identifier -> Context c +aliasCtxtFrom name toa fromx ident = functionField1 name $ \s -> do + amap <- loadBody ident + toa s >>= flip resolveAlias amap >>= fromx -personCtxt :: (StringConv StrictText s, Ord (Name s), ToMarkup s) => AliasMap (Name s) (Person s) -> Context a -personCtxt = aliasCtxt "personA" (ffmap toSL . parseName . toSL) (pure . toSL . personHtml) -licenseCtxt :: (StringConv String s, Ord s, ToMarkup s) => AliasMap s (License s) -> Context a -licenseCtxt = aliasCtxt "licenseA" (pure . toSL) (pure . toSL . licenseHtml) +-- personCtxt :: (StringConv StrictText s, Ord (Name s), ToMarkup s) => AliasMap (Name s) (Person s) -> Context a +personCtxt :: Identifier -> Context a +personCtxt = aliasCtxtFrom @StrictText "personA" (ffmap toSL . parseName . toSL) (pure . toSL . personHtml) -journalCtxt :: (StringConv String s, Ord s, ToMarkup s) => AliasMap s (Journal s) -> Context a -journalCtxt = aliasCtxt "journalA" (pure . toSL) (pure . toSL . journalHtml) +-- personCtxtFrom :: Identifier -> Context a +-- personCtxtFrom = functionField1 + +-- licenseCtxt :: (StringConv String s, Ord s, ToMarkup s) => AliasMap s (License s) -> Context a +licenseCtxt :: Identifier -> Context a +licenseCtxt = aliasCtxtFrom @StrictText "licenseA" (pure . toSL) (pure . toSL . licenseHtml) + +-- journalCtxt :: (StringConv String s, Ord s, ToMarkup s) => AliasMap s (Journal s) -> Context a +journalCtxt :: Identifier -> Context a +journalCtxt = aliasCtxtFrom @StrictText "journalA" (pure . toSL) (pure . toSL . journalHtml) 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 diff --git a/src/Hakyll/Util.hs b/src/Hakyll/Util.hs index 35169fa..57d37be 100644 --- a/src/Hakyll/Util.hs +++ b/src/Hakyll/Util.hs @@ -11,6 +11,8 @@ module Hakyll.Util import Prolog import Hakyll +import Hakyll.Core.Provider (resourceList) +import Hakyll.Core.Compiler.Internal import System.FilePath -- | Drop some number of parent directories -- cgit v1.2.3