module Hakyll.Paper where

import Prolog
import Hakyll
import Data.Paper
import Data.Name
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 . 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 <> _journalCtxt fctxt)
    , listFieldWith "eprints" eprintCtxt $ pure . traverse eprints
    -- , eprint >$< maybeContext eprintCtxt
    , field "extra" $ \i -> case extraLink $ itemBody i of
                              Just l -> pure $ show l
                              Nothing -> do
                                  let k = sluggedKey $ itemBody i
                                      ident = toFilePath $ itemIdentifier i
                                  getMatches (fromString $ ident <> "/index.*") >>= witherM (fmap (>>= parseRelativeReference) . getRoute) >>= \case
                                    (x:_) -> pure $ show x
                                    _ -> fail $ "No extra for " <> k
    ]

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 { eprints = eprints x <> e }) <$> itm



statusCtxt :: StringConv a String => Context (Status a)
statusCtxt = fold $
    [ 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
                                _ -> fail "No journal"
    , field "doi" $ \i -> case itemBody i of
                            Published _ _ d -> pure $ show (doiLink d)
                            _ -> fail "No DOI"
    , boolField "published" $ \case
        Item _ (Published {}) -> True
        _ -> False
        -- \i -> case itemBody i of
        --                               Published _ _ _ -> True
        --                               _ -> False
    , boolField "accepted" $ \i -> case itemBody i of
                                     Accepted _ _ -> True
                                     _ -> False
    , boolField "submitted" $ \i -> case itemBody i of
                                      Submitted _ -> True
                                      _ -> False
    , boolField "unpublished" $ \i -> case itemBody i of
                                        Unpublished _ -> True
                                        _ -> False
    ]

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
    , field "eprintName" $ \i -> pure $ case itemBody i of
                                          ArXivEprint (ArXiv _ c) -> "arXiv[" <> toSL c <> "]"
                                          OtherEprint n _ -> toSL n
    , field "arXivClass" $ \i -> case itemBody i of
                                   ArXivEprint (ArXiv _ c) -> pure $ toSL c
                                   _ -> fail "No arXiv"
    , functionField "arXivLink" $ \args i -> case itemBody i of
                                               ArXivEprint a ->
                                                   case args of
                                                     ["abs"] -> pure $ show $ arXivLink ArXivAbs a
                                                     ["pdf"] -> pure $ show $ arXivLink ArXivPdf a
                                                     ["src"] -> pure $ show $ arXivLink ArXivSrc a
                                                     xs -> fail $ "Invalid argument to arXivLink: " <> show xs
                                               _ -> fail "No ArXiv"
    ]

findLocal :: (StringConv a String, StringConv String a) => Item (Paper a) -> Compiler [Eprint a]
findLocal (Item ident paper) = getMatches (getPattern potentialPdfs) >>= witherM (fmap (>>= parseRelativeReference) . getRoute) >>= pure . fmap (OtherEprint (toSL ".pdf"))
    where
        fp :: FilePath
        fp = toFilePath ident
        potentialPdfs :: Pattorn
        potentialPdfs = foldMap (fromString . (fp <>)) $
            [ ".pdf"
            , "/" <> sluggedKey paper <> ".pdf"
            ]


sluggedKey :: StringConv a String => Paper a -> String
sluggedKey = toSlug . toSL . key


compilePapers :: StringConv s String => Item s -> Compiler (Item [Paper String])
compilePapers = compileBibtex >=> traverse (mapM mkPaper)

papersCompiler :: Compiler (Item [Paper String])
papersCompiler = getResourceBody >>= compilePapers

-- paperListCompiler :: Compiler [Paper String]
-- paperListCompiler = bibtexCompiler