diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Data/Paper.hs | 40 | ||||
| -rw-r--r-- | src/Hakyll/Alias.hs | 23 | ||||
| -rw-r--r-- | src/Hakyll/Paper.hs | 88 | ||||
| -rw-r--r-- | src/Hakyll/Util.hs | 2 |
4 files changed, 97 insertions, 56 deletions
diff --git a/src/Data/Paper.hs b/src/Data/Paper.hs index f8b691d..34c6fad 100644 --- a/src/Data/Paper.hs +++ b/src/Data/Paper.hs @@ -27,7 +27,7 @@ data Paper a = Paper , authors :: ![Name a] , abstract :: !(Maybe a) , extraLink :: !(Maybe URI) - , eprint :: !(Maybe (Eprint a)) + , eprints :: ![Eprint a] } deriving (Eq, Foldable, Functor, Ord, Generic, Show, Traversable) instance Binary a => Binary (Paper a) @@ -102,26 +102,38 @@ mkPaper bib = do -- extraLink = M.lookup "extralink" fields title <- find' "title" authors <- find' "authors" >>= traverse (ffmap toSL . parseName . toSL) . B.splitAuthorList - status <- toLower <<$>> find' "pubstate" >>= \case - "submitted" -> Submitted <$> getDate - "unpublished" -> Unpublished <$> getDate - "accepted" -> Accepted <$> getDate <*> find' "journal" - _ -> do - journal <- find' "journal" - doi <- find' "doi" >>= fmap DOI . puri - date <- getDate - pure $ Published {..} + status <- do + date <- getDate + traverse puri (M.lookup "doi" fields) >>= \case + Just u -> do + let doi = DOI u + journal <- findit "journal" + pure $ Published {..} + Nothing -> pure $ case M.lookup "journal" fields of + Just journal -> Accepted {..} + Nothing -> case toLower <<$>> M.lookup "pubstate" fields of + Just "unpublished" -> Unpublished {..} + _ -> Submitted {..} + -- case toLower <<$>> M.lookup "pubstate" of + -- Just "submitted" -> Submitted <$> getDate + -- Just "unpublished" -> Unpublished <$> getDate + -- Just "accepted" -> Accepted <$> getDate <*> find' "journal" + -- _ -> do + -- journal <- find' "journal" + -- doi <- find' "doi" >>= fmap DOI . puri + -- date <- getDate + -- pure $ Published {..} extraLink <- traverse puri $ M.lookup "extralink" fields - eprint <- case toLower <$> M.lookup "eprinttype" fields of + eprint <- case toLower <<$>> M.lookup "eprinttype" fields of Just "arxiv" -> do _identifier <- find' "eprint" >>= puri _class <- find' "eprintclass" - pure $ Just $ ArXivEprint $ ArXiv {..} + pure $ pure $ ArXivEprint $ ArXiv {..} Just s -> do let eprintName = s eprintLink <- find' "eprint" >>= puri - pure $ Just $ OtherEprint {..} - Nothing -> pure Nothing + pure $ pure $ OtherEprint {..} + Nothing -> pure [] pure $ Paper {..} where fields = M.fromList $ B.fields bib 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 |