summaryrefslogtreecommitdiff
path: root/src/Hakyll/Paper.hs
blob: 8db50cdd90d5a4a717b8543c244e020b1a6d632d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
module Hakyll.Paper where

import Prolog
import Hakyll
import Data.Paper
import Data.Name
import Data.Time.Format
import Hakyll.Util (transformContext_)
import System.FilePath




authorCtxt :: StringConv a String => Context (Name a)
authorCtxt = fold $
    [ field "name" $ pure . renderNameFML . fmap toSL . getItemBody
    ]

paperCtxt :: StringConv a String => Context (Paper a)
paperCtxt = fold $
    [ listFieldWith "authors" authorCtxt $ pure . authors . itemBody
    , field "abstract" $ liftMaybe . fmap toSL . abstract . itemBody
    , field "title" $ pure . toSL . title . itemBody
    , field "key" $ pure . sluggedKey . itemBody
    , status >$< statusCtxt
    , listFieldWith "eprints" eprintCtxt $ pure . eprints . itemBody
    -- , eprint >$< maybeContext eprintCtxt
    , field "extra" $ \i -> case extraLink $ getItemBody 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 => [Paper a] -> Context b
mkPaperContext papers = listField "papers" paperCtxt $ do
    fp <- getResourceFilePath
    forM papers $ \p -> do
        let itm = Item (fromFilePath $ replaceFileName fp (sluggedKey p)) p
        e <- findLocal itm
        pure $ (\x -> x { eprint = eprint x <> e }) <$> itm



statusCtxt :: StringConv a String => Context (Status a)
statusCtxt = fold $
    [ field "date" $ 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" $ \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 _ c -> "arXiv[" <> toSL c <> "]"
                                          OtherEprint n _ -> show n
    , field "arXivClass" $ \i -> case itemBody i of
                                   ArXivEprint _ 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 paper = do
    let k = sluggedKey $ itemBody paper
        ident = toFilePath $ itemIdentifier paper
    getMatches (fromString (ident <> ".pdf") .||. fromString (ident <> "/" <> k <> ".pdf")) >>= witherM (fmap (>>= parseRelativeReference) . getRoute) >>= pure . fmap (OtherEprint (toSL ".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 >>= compilerPapers

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