summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Alias.hs8
-rw-r--r--src/Hakyll/Paper.hs47
-rw-r--r--src/Hakyll/TeX/BibTeX.hs3
3 files changed, 35 insertions, 23 deletions
diff --git a/src/Hakyll/Alias.hs b/src/Hakyll/Alias.hs
index 33ed5c1..73beb86 100644
--- a/src/Hakyll/Alias.hs
+++ b/src/Hakyll/Alias.hs
@@ -20,7 +20,7 @@ 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 :: forall a x c . (Binary a, Binary x, Typeable a, Typeable x, 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
@@ -28,15 +28,15 @@ aliasCtxtFrom name toa fromx ident = functionField1 name $ \s -> do
-- 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)
+personCtxt = aliasCtxtFrom @Name_ @Person_ "personA" (parseName . toSL) (pure . toSL . personHtml)
-- 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)
+licenseCtxt = aliasCtxtFrom @StrictText @License_ "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)
+journalCtxt = aliasCtxtFrom @StrictText @Journal_ "journalA" (pure . toSL) (pure . toSL . journalHtml)
diff --git a/src/Hakyll/Paper.hs b/src/Hakyll/Paper.hs
index 0c997eb..609f74d 100644
--- a/src/Hakyll/Paper.hs
+++ b/src/Hakyll/Paper.hs
@@ -8,25 +8,36 @@ import Data.Time.Format
import Hakyll.Util (transformContext_)
import Hakyll.Core.Identifier.Pattorn
import System.FilePath
+import Witherable
+import Network.URI (parseRelativeReference)
+import Data.String.Slugger (toSlug)
+import Hakyll.TeX.BibTeX (compileBibtex)
+data FieldContext a = FieldContext
+ { _authorCtxt :: Context (Name a)
+ , _journalCtxt :: Context (Status a)
+ }
+
+
authorCtxt :: StringConv a String => Context (Name a)
authorCtxt = fold $
- [ field "name" $ pure . renderNameFML . fmap toSL . getItemBody
+ [ field "name" $ pure . renderNameFML . fmap toSL . itemBody
]
-paperCtxt :: StringConv a String => Context (Paper a)
-paperCtxt = fold $
- [ listFieldWith "authors" authorCtxt $ pure . authors . itemBody
+paperCtxt :: StringConv a String => FieldContext a -> Context (Paper a)
+paperCtxt fctxt = fold $
+ [ listFieldWith "authors" (_authorCtxt fctxt <> authorCtxt) $ pure . traverse authors
+ -- fmap pure . authors . itemBody
, field "abstract" $ liftMaybe . fmap toSL . abstract . itemBody
, field "title" $ pure . toSL . title . itemBody
, field "key" $ pure . sluggedKey . itemBody
- , status >$< statusCtxt
- , listFieldWith "eprints" eprintCtxt $ pure . eprints . itemBody
+ , status >$< (statusCtxt <> _journalCtxt fctxt)
+ , listFieldWith "eprints" eprintCtxt $ pure . traverse eprints
-- , eprint >$< maybeContext eprintCtxt
- , field "extra" $ \i -> case extraLink $ getItemBody i of
+ , field "extra" $ \i -> case extraLink $ itemBody i of
Just l -> pure $ show l
Nothing -> do
let k = sluggedKey $ itemBody i
@@ -36,19 +47,19 @@ paperCtxt = fold $
_ -> fail $ "No extra for " <> k
]
-mkPaperContext :: StringConv a String => [Paper a] -> Context b
-mkPaperContext papers = listField "papers" paperCtxt $ do
+mkPaperContext :: (StringConv a String, StringConv String a) => FieldContext a -> [Paper a] -> Context b
+mkPaperContext fctxt papers = listField "papers" (paperCtxt fctxt) $ do
fp <- getResourceFilePath
forM papers $ \p -> do
let itm = Item (fromFilePath $ replaceFileName fp (sluggedKey p)) p
e <- findLocal itm
- pure $ (\x -> x { eprint = eprint x <> e }) <$> itm
+ pure $ (\x -> x { eprints = eprints x <> e }) <$> itm
statusCtxt :: StringConv a String => Context (Status a)
statusCtxt = fold $
- [ field "date" $ formatTime defaultTimeLocale "%b %Y" . date . itemBody
+ [ field "date" $ pure . formatTime defaultTimeLocale "%b %Y" . date . itemBody
, field "journal" $ \i -> case itemBody i of
Published _ j _ -> pure $ toSL j
Accepted _ j -> pure $ toSL j
@@ -57,7 +68,7 @@ statusCtxt = fold $
Published _ _ d -> pure $ show (doiLink d)
_ -> fail "No DOI"
, boolField "published" $ \case
- Item _ (Published {..}) -> True
+ Item _ (Published {}) -> True
_ -> False
-- \i -> case itemBody i of
-- Published _ _ _ -> True
@@ -76,13 +87,13 @@ statusCtxt = fold $
eprintCtxt :: StringConv a String => Context (Eprint a)
eprintCtxt = fold $
[ field "eprint" $ \i -> pure $ case itemBody i of
- ArXivEprint a _ -> show $ arXivLink ArXivAbs a
- OtherEprint _ l -> show $ l
+ 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
+ ArXivEprint (ArXiv _ c) -> "arXiv[" <> toSL c <> "]"
+ OtherEprint n _ -> toSL n
, field "arXivClass" $ \i -> case itemBody i of
- ArXivEprint _ c -> pure $ toSL c
+ ArXivEprint (ArXiv _ c) -> pure $ toSL c
_ -> fail "No arXiv"
, functionField "arXivLink" $ \args i -> case itemBody i of
ArXivEprint a ->
@@ -91,7 +102,7 @@ eprintCtxt = fold $
["pdf"] -> pure $ show $ arXivLink ArXivPdf a
["src"] -> pure $ show $ arXivLink ArXivSrc a
xs -> fail $ "Invalid argument to arXivLink: " <> show xs
- _ -> fail "No ArXiv"
+ _ -> fail "No ArXiv"
]
findLocal :: (StringConv a String, StringConv String a) => Item (Paper a) -> Compiler [Eprint a]
diff --git a/src/Hakyll/TeX/BibTeX.hs b/src/Hakyll/TeX/BibTeX.hs
index eb87c4e..a78f254 100644
--- a/src/Hakyll/TeX/BibTeX.hs
+++ b/src/Hakyll/TeX/BibTeX.hs
@@ -33,7 +33,8 @@ instance Writable [B.T] where
compileBibtex :: (StringConv s String) => Item s -> Compiler (Item BibTeX)
compileBibtex = fmap (B.lowerCaseFieldNames <<$>>) . compileParsec_ p . fmap toSL
where
- p = B.skippingLeadingSpace $ B.file <* P.space <* P.eof
+ p = B.skippingSpace B.file
+ -- p = B.skippingLeadingSpace $ B.file <* P.space <* P.eof
bibtexCompiler :: Compiler (Item BibTeX)
bibtexCompiler = getResourceBody >>= compileBibtex
generated by cgit v1.2.3 (git 2.25.1) at 2026-07-09 20:02:18 +0000