summaryrefslogtreecommitdiff
path: root/src/Data/Paper.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Paper.hs')
-rw-r--r--src/Data/Paper.hs24
1 files changed, 18 insertions, 6 deletions
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