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

journalA into a list context...

6 files changed, 26 insertions, 10 deletions

diff --git a/src/Data/Abbr.hs b/src/Data/Abbr.hs
index f42134f..8ee4bc0 100644
--- a/src/Data/Abbr.hs
+++ b/src/Data/Abbr.hs
@@ -27,7 +27,7 @@ type Abbr_ = Abbr StrictText
 abbrHtml :: ToMarkup a => Abbr a -> Html
 abbrHtml (Abbr n sn l) = linkedHtml $ Linked (fromMaybe n sn) l (n <$ sn)
 
-instance Ord a => ToAliases (Abbr a) where
+instance Ord a => ToAliases (Abbr a) a where
     toAliases (Abbr t st _) = S.fromList $ t : toList st
 
 instance FromAlias a (Abbr a) where
diff --git a/src/Data/Alias.hs b/src/Data/Alias.hs
index 357f901..9082c14 100644
--- a/src/Data/Alias.hs
+++ b/src/Data/Alias.hs
@@ -23,6 +23,7 @@ import Data.Aeson.KeyMap qualified as KM
 import Data.Map.Strict qualified as M
 import Data.Set qualified as S
 import Data.Typeable
+import Hakyll qualified as H
 
 
 data WithAliases a x = WithAliases (Set a) x
@@ -103,6 +104,9 @@ newtype AliasMap a x = AliasMap (Map a x)
     deriving newtype (Binary, Foldable, Functor, Semigroup, Monoid)
     deriving stock (Show, Traversable)
 
+instance H.Writable (AliasMap a x) where
+    write _ _ = pure ()
+
 buildAliasMap :: (Foldable t, ToAliases x a) => t x -> AliasMap a x
 buildAliasMap = fmap AliasMap $ foldMap $ (<$) <*> toMap . toAliases
 {-# INLINE buildAliasMap #-}
diff --git a/src/Data/Linked.hs b/src/Data/Linked.hs
index 8e78f86..de1dc77 100644
--- a/src/Data/Linked.hs
+++ b/src/Data/Linked.hs
@@ -38,7 +38,7 @@ instance ToMaybe Maybe where
     toMaybe = liftMaybe
 
 instance ToMaybe Identity where
-    toMaybe (Identity a) = pure a
+    toMaybe (Identity x) = pure x
 
 instance ToMaybe Proxy where
     toMaybe _ = empty
diff --git a/src/Data/Name.hs b/src/Data/Name.hs
index 647c285..faf8d8c 100644
--- a/src/Data/Name.hs
+++ b/src/Data/Name.hs
@@ -84,7 +84,7 @@ readNameFML t = T.map (\c -> if c == '~' then ' ' else c) <<$>>
       [] -> empty
       (f:xs) -> case unsnoc xs of
                   Nothing -> empty
-                  Just (m, l) -> pure $ Name f l $ case m of
+                  Just (m, l) -> pure $ Name l f $ case m of
                                                      [] -> Nothing
                                                      _ -> Just $ T.unwords m
 
diff --git a/src/Data/Paper.hs b/src/Data/Paper.hs
index 25b6d98..0dedc46 100644
--- a/src/Data/Paper.hs
+++ b/src/Data/Paper.hs
@@ -1,11 +1,16 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 module Data.Paper
     ( Paper (..)
     , Status (..)
     , ArXiv (..)
+    , ArXivType (..)
     , DOI (..)
     , Eprint (..)
     , mkPaper
+    -- * helpers
+    , doiLink
+    , arXivLink
     ) where
 
 import Prolog
@@ -15,9 +20,10 @@ import Data.Name
 import Data.Time
 import Network.URI
 import Network.URI.Static
+import Hakyll qualified as H
 
 import Text.BibTeX.Entry qualified as B
-import Text.BibTeX.Parse qualified as B
+import Text.BibTeX.Parse qualified as BP
 
 
 data Paper a = Paper
@@ -32,6 +38,12 @@ data Paper a = Paper
 
 instance Binary a => Binary (Paper a)
 
+instance H.Writable (Paper a) where
+  write _ _ = pure ()
+
+instance H.Writable (t (Paper a)) where
+  write _ _ = pure ()
+
 -- instance (Binary a, Binary (Status f a), Binary (f (Person a))) => Binary (Paper f a)
 
 data Status a
@@ -101,13 +113,13 @@ mkPaper bib = do
         abstract = M.lookup "abstract" fields
         -- extraLink = M.lookup "extralink" fields
     title <- find' "title"
-    authors <- find' "authors" >>= traverse (ffmap toSL . parseName . toSL) . B.splitAuthorList
+    authors <- find' "author" >>= traverse (ffmap toSL . parseName . toSL) . BP.splitAuthorList
     status <- do
         date <- getDate
         traverse puri (M.lookup "doi" fields) >>= \case
           Just u -> do
               let doi = DOI u
-              journal <- findit "journal"
+              journal <- findit "journal" fields
               pure $ Published {..}
           Nothing -> pure $ case M.lookup "journal" fields of
                               Just journal -> Accepted {..}
@@ -124,7 +136,7 @@ mkPaper bib = do
         --     date <- getDate
         --     pure $ Published {..}
     extraLink <- traverse puri $ M.lookup "extralink" fields
-    eprint <- case toLower <<$>> M.lookup "eprinttype" fields of
+    eprints <- case toLower <<$>> M.lookup "eprinttype" fields of
                 Just "arxiv" -> do
                     _identifier <- find' "eprint" >>= puri
                     _class <- find' "eprintclass"
@@ -138,10 +150,10 @@ mkPaper bib = do
     where
         fields = M.fromList $ B.fields bib
         find' k = findit k fields
-        getDate = mapM findit [ "month", "year" ] >>= parseTimeM True defaultTimeLocale "%b %Y" . unwords
+        getDate = mapM (`findit` fields) [ "month", "year" ] >>= parseTimeM True defaultTimeLocale "%b %Y" . unwords
 
 puri :: MonadFail m => String -> m URI
-puri u = maybe (fail $ show u <> " cannot be understood as a uri") pure $ parseURI u
+puri u = maybe (fail $ show u <> " cannot be understood as a uri") pure $ parseRelativeReference u
 
 findit :: (Show a, Ord a, MonadFail m) => a -> M.Map a x -> m x
 findit k = maybe (fail $ "Field " <> show k <> " does not exist") pure . M.lookup k
diff --git a/src/Data/Person.hs b/src/Data/Person.hs
index 853408e..389d1ed 100644
--- a/src/Data/Person.hs
+++ b/src/Data/Person.hs
@@ -28,7 +28,7 @@ instance Binary a => Binary (Person a)
 type Person_ = Person StrictText
 
 personHtml :: (ToMarkup a) => Person a -> Html
-personHtml (Person n w) = linkedHtml $ Linked (renderNameFML $ toMarkup <$> n) w Nothing
+personHtml (Person n w) = linkedHtml $ Linked (contents $ renderNameFML $ contents . toMarkup <$> n) w Nothing
 
 personFromName :: Name a -> Person a
 personFromName n = Person n Nothing