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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Citeproc
import Citeproc.CslJson
import Control.Monad (when, unless, foldM)
import Control.Applicative ((<|>))
import Data.Bifunctor (second)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.ByteString.Lazy as BL
import qualified Data.Aeson as Aeson
import Data.Aeson.Encode.Pretty as AesonPretty
import Data.Ord (comparing)
import System.IO
import System.Exit
import System.Environment
import System.Console.GetOpt
main :: IO ()
main = do
rawargs <- getArgs
let (opts, args, errs) = getOpt Permute options rawargs
unless (null errs) $ do
mapM_ err errs
exitWith $ ExitFailure 1
opt <- foldM (flip ($)) defaultOpt opts
when (optHelp opt) $ do
putStr $ usageInfo "citeproc [OPTIONS] [FILE]" options
exitSuccess
when (optVersion opt) $ do
putStrLn $ "citeproc version " ++ VERSION_citeproc
exitSuccess
format <- case optFormat opt of
Just "html" -> return Html
Just "json" -> return Json
Just _ -> err "--format must be html or json"
Nothing -> return Html
bs <- case args of
[] -> BL.getContents
(f:_) -> BL.readFile f
case Aeson.eitherDecode bs of
Left e -> err e
Right (inp :: Inputs (CslJson Text)) -> do
stylesheet <- case optStyle opt of
Just fp -> T.dropWhile (=='\xFEFF') <$> -- drop BOM
TIO.readFile fp
Nothing ->
case inputsStyle inp of
Just s -> return s
Nothing -> err "No style specified"
references <- case optReferences opt of
Just fp -> do
raw <- BL.readFile fp
case Aeson.eitherDecode raw of
Left e -> err e
Right rs -> return rs
Nothing ->
case inputsReferences inp of
Just rs -> return rs
Nothing -> err "No references specified"
abbreviations <- case optAbbreviations opt of
Just fp -> do
raw <- BL.readFile fp
case Aeson.eitherDecode raw of
Left e -> err e
Right ab -> return $ Just ab
Nothing -> return $ inputsAbbreviations inp
let lang = optLang opt <|> inputsLang inp
parseResult <-
parseStyle (\_ -> return mempty) stylesheet
case parseResult of
Left e -> err (T.unpack $ prettyCiteprocError e)
Right parsedStyle -> do
let style = parsedStyle{ styleAbbreviations = abbreviations }
let result= citeproc defaultCiteprocOptions
style
lang
references
(fromMaybe [] (inputsCitations inp))
let jsonResult :: Aeson.Value
jsonResult =
case format of
Json -> Aeson.object
[ ("citations", Aeson.toJSON $
map cslJsonToJson
(resultCitations result))
, ("bibliography", Aeson.toJSON $
map (second cslJsonToJson)
(resultBibliography result))
, ("warnings", Aeson.toJSON $ resultWarnings result)
]
Html -> Aeson.toJSON result
BL.putStr $ AesonPretty.encodePretty'
AesonPretty.defConfig
{ confIndent = AesonPretty.Spaces 2
, confCompare = AesonPretty.keyOrder
["citations","bibliography","warnings"]
`mappend` comparing T.length
, confTrailingNewline = True }
jsonResult
data Format = Json | Html deriving (Show, Ord, Eq)
data Opt =
Opt{ optStyle :: Maybe String
, optReferences :: Maybe String
, optAbbreviations :: Maybe String
, optFormat :: Maybe String
, optLang :: Maybe Lang
, optHelp :: Bool
, optVersion :: Bool
} deriving Show
defaultOpt :: Opt
defaultOpt =
Opt { optStyle = Nothing
, optReferences = Nothing
, optAbbreviations = Nothing
, optFormat = Nothing
, optLang = Nothing
, optHelp = False
, optVersion = False
}
options :: [OptDescr (Opt -> IO Opt)]
options =
[ Option ['s'] ["style"]
(ReqArg (\fp opt -> return opt{ optStyle = Just fp }) "FILE")
"CSL style file"
, Option ['r'] ["references"]
(ReqArg (\fp opt -> return opt{ optReferences = Just fp }) "FILE")
"CSL JSON bibliography"
, Option ['a'] ["abbreviations"]
(ReqArg (\fp opt -> return opt{ optAbbreviations = Just fp }) "FILE")
"CSL abbreviations table"
, Option ['l'] ["lang"]
(ReqArg (\lang opt ->
case parseLang (T.pack lang) of
Right l -> return opt{ optLang = Just l }
Left msg -> err $ "Could not parse language tag:\n" ++ msg)
"BCP 47 language tag")
"Override locale"
, Option ['f'] ["format"]
(ReqArg (\format opt -> return opt{ optFormat = Just format }) "html|json")
"Controls formatting of entries in result"
, Option ['h'] ["help"]
(NoArg (\opt -> return opt{ optHelp = True }))
"Print usage information"
, Option ['V'] ["version"]
(NoArg (\opt -> return opt{ optVersion = True }))
"Print version number"
]
err :: String -> IO a
err s = do
hPutStrLn stderr s
exitWith $ ExitFailure 1
|
