Technically working, but I need a cleaner way to pass personA and

journalA into a list context...

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