{-# LANGUAGE QuasiQuotes #-}
module Data.Paper
    ( Paper (..)
    , Status (..)
    , ArXiv (..)
    , DOI (..)
    , Eprint (..)
    , mkPaper
    ) where

import Prolog
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
    { status :: !(Status a)
    , key :: !a
    , title :: !a
    , authors :: ![Name a]
    , 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
    = Unpublished { date :: !Day }
    | Published
        { date :: !Day
        , journal :: !a
        , doi :: !DOI
        }
    | 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)

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
    } deriving (Eq, Foldable, Functor, Generic, Ord, Show, Traversable)

instance Binary a => Binary (ArXiv a)

arXivURI :: URI
arXivURI = [uri|https://arxiv.org/|]

data ArXivType = ArXivAbs | ArXivPdf | ArXivSrc
    deriving (Bounded, Enum, Eq, Generic, Ord, Show)

arXivTypeRelative :: ArXivType -> URI
arXivTypeRelative = \case
    ArXivAbs -> [relativeReference|/abs|]
    ArXivPdf -> [relativeReference|/pdf|]
    ArXivSrc -> [relativeReference|/src|]

arXivLink :: ArXivType -> ArXiv a -> URI
arXivLink at a = _identifier a `relativeTo` arXivTypeRelative at `relativeTo` arXivURI


doiURI :: URI
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