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
|