Writing utils for parsing and formatting my papers

1 files changed, 77 insertions, 11 deletions

diff --git a/src/Data/Paper.hs b/src/Data/Paper.hs
index c2d4b3e..f8b691d 100644
--- a/src/Data/Paper.hs
+++ b/src/Data/Paper.hs
@@ -2,36 +2,53 @@
 module Data.Paper
     ( Paper (..)
     , Status (..)
+    , ArXiv (..)
+    , DOI (..)
+    , Eprint (..)
+    , mkPaper
     ) where
 
 import Prolog
-import Data.Journal
-import Data.Person
+import Data.Char (toLower)
+import Data.Map.Strict qualified as M
+import Data.Name
 import Data.Time
 import Network.URI
 import Network.URI.Static
 
+import Text.BibTeX.Entry qualified as B
+import Text.BibTeX.Parse qualified as B
+
 
 data Paper a = Paper
-    { title :: !a
+    { status :: !(Status a)
+    , key :: !a
+    , title :: !a
     , authors :: ![Name a]
-    , status :: !(Status a)
-    } deriving (Eq, Generic, Ord, Show)
+    , abstract :: !(Maybe a)
+    , extraLink :: !(Maybe URI)
+    , eprint :: !(Maybe (Eprint a))
+    } deriving (Eq, Foldable, Functor, Ord, Generic, Show, Traversable)
+
+instance Binary a => Binary (Paper a)
 
 -- instance (Binary a, Binary (Status f a), Binary (f (Person a))) => Binary (Paper f a)
 
 data Status a
-    = Submitted
-    | Accepted
-        { journal :: !a
-        }
+    = Unpublished { date :: !Day }
     | Published
         { date :: !Day
         , journal :: !a
         , doi :: !DOI
         }
-    | Unpublished
-    deriving (Eq, Generic, Ord, Show)
+    | Accepted
+        { date :: !Day
+        , journal :: !a
+        }
+    | Submitted { date :: !Day }
+    deriving (Eq, Foldable, Functor, Generic, Ord, Show, Traversable)
+
+instance Binary a => Binary (Status a)
 
 -- instance (Binary a, Binary (f (Journal a))) => Binary (Status f a)
 
@@ -39,6 +56,15 @@ newtype DOI = DOI URI
     deriving (Eq, Generic, Ord, Show)
     deriving newtype Binary
 
+data Eprint a
+    = ArXivEprint (ArXiv a)
+    | OtherEprint { eprintName :: !a
+                  , eprintLink :: !URI
+                  }
+    deriving (Eq, Foldable, Functor, Generic, Ord, Show, Traversable)
+
+instance Binary a => Binary (Eprint a)
+
 data ArXiv a = ArXiv
     { _identifier :: !URI
     , _class :: !a
@@ -67,3 +93,43 @@ doiURI = [uri|https://doi.org/|]
 
 doiLink :: DOI -> URI
 doiLink (DOI u) = u `relativeTo` doiURI
+
+
+mkPaper :: (MonadFail m, Alternative m) => B.T -> m (Paper String)
+mkPaper bib = do
+    let key = B.identifier bib
+        abstract = M.lookup "abstract" fields
+        -- 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 {..}
+    extraLink <- traverse puri $ M.lookup "extralink" fields
+    eprint <- case toLower <$> M.lookup "eprinttype" fields of
+                Just "arxiv" -> do
+                    _identifier <- find' "eprint" >>= puri
+                    _class <- find' "eprintclass"
+                    pure $ Just $ ArXivEprint $ ArXiv {..}
+                Just s -> do
+                    let eprintName = s
+                    eprintLink <- find' "eprint" >>= puri
+                    pure $ Just $ OtherEprint {..}
+                Nothing -> pure Nothing
+    pure $ Paper {..}
+    where
+        fields = M.fromList $ B.fields bib
+        find' k = findit k fields
+        getDate = mapM findit [ "month", "year" ] >>= parseTimeM True defaultTimeLocale "%b %Y" . unwords
+
+puri :: MonadFail m => String -> m URI
+puri u = undefined
+
+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