{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Prelude
import Control.Applicative (many, (<|>))
import Control.Exception as E
import Control.Monad
import Data.Aeson.Encode.Pretty (Config (..), Indent (Spaces),
NumberFormat (Generic),
defConfig, encodePretty')
import Data.Attoparsec.ByteString.Char8 as Attoparsec
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as BL
import Data.Char (chr, toLower)
import Data.List (group, sort)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Version (showVersion)
import Data.Yaml.Builder (toByteStringWith, setWidth)
import Text.Libyaml (defaultFormatOptions)
import Paths_pandoc_citeproc (version)
import System.Console.GetOpt
import System.Environment (getArgs)
import System.Exit
import System.FilePath (takeExtension)
import System.IO
import Text.CSL.Data (getLicense, getManPage)
import Text.CSL.Exception
import Text.CSL.Input.Bibutils (BibFormat (..),
readBiblioString)
import Text.CSL.Pandoc (processCites')
import Safe (readMay)
import Text.CSL.Reference (Literal (..),
Reference (refId))
import Text.Pandoc.JSON hiding (Format)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Walk
main :: IO ()
main = do
argv <- getArgs
let (flags, args, errs) = getOpt Permute options argv
let header = "Usage: pandoc-citeproc [options] [file..]"
unless (null errs) $ do
UTF8.hPutStrLn stderr $ usageInfo (unlines $ errs ++ [header]) options
exitWith $ ExitFailure 1
when (Version `elem` flags) $ do
UTF8.putStrLn $ "pandoc-citeproc " ++ showVersion version
exitSuccess
when (Help `elem` flags) $ do
UTF8.putStrLn $ usageInfo header options
exitSuccess
when (Man `elem` flags) $ do
getManPage >>= BL.putStr
exitSuccess
when (License `elem` flags) $ do
getLicense >>= BL.putStr
exitSuccess
E.handle
(\(e :: CiteprocException) -> do
UTF8.hPutStrLn stderr $ renderError e
exitWith (ExitFailure 1)) $
if Bib2YAML `elem` flags || Bib2JSON `elem` flags
then do
colwidth <- case Prelude.take 1 $
reverse [readMay n | Columns n <- flags] of
[] -> return $ Just 80
[Just 0] -> return $ Nothing
[Just x] -> return $ Just x
_ -> do
UTF8.hPutStrLn stderr $
"--columns must be followed by a number"
exitWith $ ExitFailure 7
let fmtOpts = setWidth colwidth defaultFormatOptions
let mbformat = case [f | Format f <- flags] of
[x] -> readFormat x
_ -> Nothing
bibformat <- case mbformat <|>
msum (map formatFromExtension args) of
Just f -> return f
Nothing -> do
UTF8.hPutStrLn stderr $ usageInfo
("Unknown format\n" ++ header) options
exitWith $ ExitFailure 4
bibstring <- case args of
[] -> B.getContents
xs -> mconcat <$> mapM B.readFile xs
readBiblioString (const True) bibformat (decodeUtf8 bibstring) >>=
(if Quiet `elem` flags then return else warnDuplicateKeys) >>=
if Bib2YAML `elem` flags
then outputYamlBlock .
B8.intercalate (B.singleton 10) .
map (unescapeTags . toByteStringWith fmtOpts . (:[]))
else B8.putStrLn . unescapeUnicode . B.concat . BL.toChunks .
encodePretty' defConfig{ confIndent = Spaces 2
, confCompare = compare
, confNumFormat = Generic }
else toJSONFilter (doCites (Quiet `elem` flags))
formatFromExtension :: FilePath -> Maybe BibFormat
formatFromExtension = readFormat . dropWhile (=='.') . takeExtension
readFormat :: String -> Maybe BibFormat
readFormat = go . map toLower
where go "biblatex" = Just BibLatex
go "bib" = Just BibLatex
go "bibtex" = Just Bibtex
go "json" = Just Json
go "yaml" = Just Yaml
#ifdef USE_BIBUTILS
go "ris" = Just Ris
go "endnote" = Just Endnote
go "enl" = Just Endnote
go "endnotexml" = Just EndnotXml
go "xml" = Just EndnotXml
go "wos" = Just Isi
go "isi" = Just Isi
go "medline" = Just Medline
go "copac" = Just Copac
go "mods" = Just Mods
go "nbib" = Just Nbib
#endif
go _ = Nothing
doCites :: Bool -> Pandoc -> IO Pandoc
doCites beQuiet doc = do
doc' <- processCites' doc
let warnings = query findWarnings doc'
unless beQuiet $ mapM_ (UTF8.hPutStrLn stderr) warnings
return doc'
findWarnings :: Inline -> [String]
findWarnings (Span (_,["citeproc-not-found"],[("data-reference-id",ref)]) _) =
["pandoc-citeproc: reference " ++ T.unpack ref ++ " not found" | ref /= "*"]
findWarnings (Span (_,["citeproc-no-output"],_) _) =
["pandoc-citeproc: reference with no printed form"]
findWarnings _ = []
data Option =
Help
| Man
| License
| Version
| Convert
| Format String
| Columns String
| Bib2YAML
| Bib2JSON
| Quiet
deriving (Ord, Eq, Show)
options :: [OptDescr Option]
options =
[ Option ['h'] ["help"] (NoArg Help) "show usage information"
, Option [] ["man"] (NoArg Man) "print man page to stdout"
, Option [] ["license"] (NoArg License) "print license to stdout"
, Option ['V'] ["version"] (NoArg Version) "show program version"
, Option ['y'] ["bib2yaml"] (NoArg Bib2YAML) "convert bibliography to YAML"
, Option ['j'] ["bib2json"] (NoArg Bib2JSON) "convert bibliography to JSON"
, Option ['q'] ["quiet"] (NoArg Quiet) "silence all warnings"
, Option ['f'] ["format"] (ReqArg Format "FORMAT") "bibliography format"
, Option ['c'] ["columns"] (ReqArg Columns "NUMBER") "column width (or 0)"
]
warnDuplicateKeys :: [Reference] -> IO [Reference]
warnDuplicateKeys refs = mapM_ warnDup dupKeys >> return refs
where warnDup k = UTF8.hPutStrLn stderr $
"biblio2yaml: duplicate key " ++ T.unpack k
allKeys = map (unLiteral . refId) refs
dupKeys = [x | (x:_:_) <- group (sort allKeys)]
outputYamlBlock :: B.ByteString -> IO ()
outputYamlBlock contents = do
UTF8.putStrLn "---\nreferences:"
B.putStr contents
UTF8.putStrLn "..."
-- turn
-- id: ! "\u043F\u0443\u043D\u043A\u04423"
-- into
-- id: пункт3
unescapeTags :: B.ByteString -> B.ByteString
unescapeTags bs = case parseOnly (many $ tag <|> other) bs of
Left e -> error e
Right r -> B.concat r
unescapeUnicode :: B.ByteString -> B.ByteString
unescapeUnicode bs = case parseOnly (many other) bs of
Left e -> error e
Right r -> B.concat r
tag :: Attoparsec.Parser B.ByteString
tag = do
_ <- string $ B8.pack ": ! "
c <- char '\'' <|> char '"'
cs <- manyTill (escaped c <|> other) (char c)
return $ B8.pack ": " <> B8.singleton c <> B.concat cs <> B8.singleton c
escaped :: Char -> Attoparsec.Parser B.ByteString
escaped c = string $ B8.pack ['\\',c]
other :: Attoparsec.Parser B.ByteString
other = uchar <|> Attoparsec.takeWhile1 notspecial <|> regchar
where notspecial = not . inClass ":!\\\"'"
uchar :: Attoparsec.Parser B.ByteString
uchar = do
_ <- char '\\'
num <- (2 <$ char 'x') <|> (4 <$ char 'u') <|> (8 <$ char 'U')
cs <- count num $ satisfy $ inClass "0-9a-fA-F"
let n = read ('0':'x':cs)
return $ encodeUtf8 $ T.pack [chr n]
regchar :: Attoparsec.Parser B.ByteString
regchar = B8.singleton <$> anyChar