diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,12 +1,8 @@ {-# LANGUAGE CPP #-} import Distribution.Simple -import Distribution.Simple.PreProcess import Distribution.PackageDescription (PackageDescription(..)) -import Distribution.Simple.Program (simpleProgram, Program(..)) -import Distribution.Simple.Utils ( rawSystemExitCode, findProgramVersion ) -import System.Exit -import Distribution.Simple.Utils (info, notice, installOrdinaryFiles) +import Distribution.Simple.Utils (notice, installOrdinaryFiles) import Distribution.Simple.Setup import Distribution.Simple.LocalBuildInfo @@ -14,12 +10,7 @@ main :: IO () main = defaultMainWithHooks $ simpleUserHooks { - -- enable hsb2hs preprocessor for .hsb files - hookedPreProcessors = [ppBlobSuffixHandler] - , hookedPrograms = [(simpleProgram "hsb2hs"){ - programFindVersion = \verbosity fp -> - findProgramVersion "--version" id verbosity fp }] - , postCopy = installManPage + postCopy = installManPage } installManPage :: Args -> CopyFlags @@ -33,14 +24,3 @@ installOrdinaryFiles verbosity mandest [("man/man1", "pandoc-citeproc.1")] -ppBlobSuffixHandler :: PPSuffixHandler -ppBlobSuffixHandler = ("hsb", \_ _ -> - PreProcessor { - platformIndependent = True, - runPreProcessor = mkSimplePreProcessor $ \infile outfile verbosity -> - do info verbosity $ "Preprocessing " ++ infile ++ " to " ++ outfile - ec <- rawSystemExitCode verbosity "hsb2hs" [infile, infile, outfile] - case ec of - ExitSuccess -> return () - ExitFailure _ -> error "hsb2hs is needed to build this program" - }) diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,16 @@ +pandoc-citeproc (0.11) + + * Add Text.CSL.Exception module exporting CiteprocException [API change]. + * Throw CiteprocExceptions instead of crashing with 'error'. This + should lead to better error messages in pandoc when pandoc-citeproc fails. + * Compat.Pandoc: support for pandoc 2.0 API with Text instead of String. + * Text.CSL.Input.Bibtex - revise item parser for better error messages. + This should give us better messages when someone uses a bad character + in a citation key. + * Use defConfig from aeson-pretty. Otherwise we get an error with newer + versions, which added a field to the Config record. + * Removed old hsb2hs-specific stuff from Setup.hs. + pandoc-citeproc (0.10.5.1) * Minor tweaks for clean CI builds. diff --git a/compat/Text/CSL/Compat/Pandoc.hs b/compat/Text/CSL/Compat/Pandoc.hs --- a/compat/Text/CSL/Compat/Pandoc.hs +++ b/compat/Text/CSL/Compat/Pandoc.hs @@ -22,6 +22,7 @@ import qualified Text.Pandoc as Pandoc import qualified Text.Pandoc.Process #if MIN_VERSION_pandoc(2,0,0) +import qualified Data.Text as T import Text.Pandoc.MIME (MimeType) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Class (runPure, runIO) @@ -42,25 +43,28 @@ #if MIN_VERSION_pandoc(2,0,0) readHtml = either mempty id . runPure . Pandoc.readHtml def{ readerExtensions = extensionsFromList [Ext_native_divs, - Ext_native_spans, Ext_raw_html, Ext_smart] } + Ext_native_spans, Ext_raw_html, Ext_smart] } . + T.pack readMarkdown = either mempty id . runPure . Pandoc.readMarkdown - def{ readerExtensions = pandocExtensions, readerStandalone = True } + def{ readerExtensions = pandocExtensions, readerStandalone = True } . + T.pack readLaTeX = either mempty id . runPure . Pandoc.readLaTeX - def{ readerExtensions = extensionsFromList [Ext_raw_tex, Ext_smart] } + def{ readerExtensions = extensionsFromList [Ext_raw_tex, Ext_smart] } . + T.pack -readNative = either mempty id . runPure . Pandoc.readNative def +readNative = either mempty id . runPure . Pandoc.readNative def . T.pack -writeMarkdown = either mempty id . runPure . Pandoc.writeMarkdown +writeMarkdown = either mempty T.unpack . runPure . Pandoc.writeMarkdown def{ writerExtensions = disableExtension Ext_smart pandocExtensions, writerWrapText = WrapNone } -writePlain = either mempty id . runPure . Pandoc.writePlain def +writePlain = either mempty T.unpack . runPure . Pandoc.writePlain def -writeNative = either mempty id . runPure . Pandoc.writeNative def +writeNative = either mempty T.unpack . runPure . Pandoc.writeNative def -writeHtmlString = either mempty id . runPure . Pandoc.writeHtml4String +writeHtmlString = either mempty T.unpack . runPure . Pandoc.writeHtml4String def{ writerExtensions = extensionsFromList [Ext_native_divs, Ext_native_spans, Ext_raw_html] } diff --git a/pandoc-citeproc.cabal b/pandoc-citeproc.cabal --- a/pandoc-citeproc.cabal +++ b/pandoc-citeproc.cabal @@ -1,5 +1,5 @@ name: pandoc-citeproc -version: 0.10.5.1 +version: 0.11 cabal-version: >= 1.12 synopsis: Supports using pandoc with citeproc @@ -76,6 +76,7 @@ exposed-modules: Text.CSL.Pandoc Text.CSL Text.CSL.Reference + Text.CSL.Exception Text.CSL.Style Text.CSL.Eval Text.CSL.Eval.Common diff --git a/pandoc-citeproc.hs b/pandoc-citeproc.hs --- a/pandoc-citeproc.hs +++ b/pandoc-citeproc.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, ScopedTypeVariables #-} module Main where import Text.CSL.Input.Bibutils (readBiblioString, BibFormat(..)) import Text.CSL.Reference (Reference(refId), Literal(..)) @@ -12,8 +12,10 @@ import Data.Attoparsec.ByteString.Char8 as Attoparsec import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) -import Data.Aeson.Encode.Pretty (encodePretty', Config(..), Indent(Spaces), NumberFormat(Generic)) +import Data.Aeson.Encode.Pretty (encodePretty', defConfig, Config(..), + Indent(Spaces), NumberFormat(Generic)) import System.Console.GetOpt +import Control.Exception as E import Control.Monad import System.IO import System.FilePath (takeExtension) @@ -69,10 +71,14 @@ B8.intercalate (B.singleton 10) . map (unescapeTags . toByteString . (:[])) else B8.putStrLn . unescapeUnicode . B.concat . BL.toChunks . - encodePretty' Config{ confIndent = Spaces 2 - , confCompare = compare - , confNumFormat = Generic } - else toJSONFilter doCites + encodePretty' defConfig{ confIndent = Spaces 2 + , confCompare = compare + , confNumFormat = Generic } + else E.catch (toJSONFilter doCites) + (\(e :: SomeException) -> do + UTF8.hPutStrLn stderr $ + "pandoc-citeproc: error running filter.\n" ++ show e + exitWith (ExitFailure 1)) formatFromExtension :: FilePath -> Maybe BibFormat formatFromExtension = readFormat . dropWhile (=='.') . takeExtension diff --git a/src/Text/CSL/Data/Embedded.hs b/src/Text/CSL/Data/Embedded.hs --- a/src/Text/CSL/Data/Embedded.hs +++ b/src/Text/CSL/Data/Embedded.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} --- to be processed using hsb2hs -module Text.CSL.Data.Embedded (localeFiles, defaultCSL, manpage, license) where +module Text.CSL.Data.Embedded (localeFiles, defaultCSL, manpage, license) +where import Data.FileEmbed import qualified Data.ByteString.Char8 as S diff --git a/src/Text/CSL/Eval.hs b/src/Text/CSL/Eval.hs --- a/src/Text/CSL/Eval.hs +++ b/src/Text/CSL/Eval.hs @@ -22,6 +22,7 @@ import Control.Arrow import Control.Monad.State +import qualified Control.Exception as E import Data.Monoid (Any(..)) import Data.Char ( toLower, isDigit, isLetter ) import Data.Maybe @@ -31,6 +32,7 @@ import Text.Pandoc.Shared (stringify) import qualified Data.Text as T +import Text.CSL.Exception import Text.CSL.Eval.Common import Text.CSL.Eval.Output import Text.CSL.Eval.Date @@ -136,7 +138,7 @@ | Macro s fm <- el = do ms <- gets (macros . env) case lookup s ms of - Nothing -> error $ "Macro " ++ show s ++ " not found!" + Nothing -> E.throw $ MacroNotFound (show s) Just els -> do res <- concat <$> mapM evalElement els if null res diff --git a/src/Text/CSL/Eval/Date.hs b/src/Text/CSL/Eval/Date.hs --- a/src/Text/CSL/Eval/Date.hs +++ b/src/Text/CSL/Eval/Date.hs @@ -16,11 +16,14 @@ module Text.CSL.Eval.Date where import Control.Monad.State +import qualified Control.Exception as E + import Data.Char import Data.List import Data.List.Split import Data.Maybe +import Text.CSL.Exception import Text.CSL.Eval.Common import Text.CSL.Eval.Output import Text.CSL.Style @@ -84,7 +87,7 @@ addODate xs = [ODate xs] splitDate a b = case split (onSublist $ diff a b dp) dp of [x,y,z] -> (x,y,z) - _ -> error "error in splitting date ranges" + _ -> E.throw ErrorSplittingDate doRange a b = let (x,y,z) = splitDate a b in map (formatDatePart False a) x ++ map (formatDatePart False a) (init' y) ++ diff --git a/src/Text/CSL/Eval/Output.hs b/src/Text/CSL/Eval/Output.hs --- a/src/Text/CSL/Eval/Output.hs +++ b/src/Text/CSL/Eval/Output.hs @@ -38,9 +38,9 @@ pRaw :: Parsec String () Inline pRaw = try $ do - string "{{" + _ <- string "{{" format <- many1 letter - string "}}" + _ <- string "}}" contents <- manyTill anyChar (try (string ("{{/" ++ format ++ "}}"))) return $ RawInline (Format format) contents diff --git a/src/Text/CSL/Exception.hs b/src/Text/CSL/Exception.hs new file mode 100644 --- /dev/null +++ b/src/Text/CSL/Exception.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE StandaloneDeriving #-} +module Text.CSL.Exception (CiteprocException(..)) where +import Control.Exception (Exception) + +data CiteprocException = + ErrorParsingReferences String + | CouldNotFindAbbrevFile String + | CouldNotFindBibFile String + | ErrorReadingBibFile String String + | ErrorReadingBib String + | ErrorSplittingDate + | MacroNotFound String + | DependentStyleHasItselfAsParent String + deriving Show + +instance Exception CiteprocException + diff --git a/src/Text/CSL/Input/Bibtex.hs b/src/Text/CSL/Input/Bibtex.hs --- a/src/Text/CSL/Input/Bibtex.hs +++ b/src/Text/CSL/Input/Bibtex.hs @@ -125,8 +125,11 @@ type BibParser = Parsec [Char] [(String, String)] bibEntries :: BibParser [Item] -bibEntries = many (try (skipMany nonEntry >> bibItem)) <* skipMany nonEntry - where nonEntry = bibSkip <|> bibComment <|> bibPreamble <|> bibString +bibEntries = do + skipMany nonEntry + items <- many (bibItem <* skipMany nonEntry) + return items + where nonEntry = bibSkip <|> bibComment <|> bibPreamble <|> bibString bibSkip :: BibParser () bibSkip = skipMany1 (satisfy (/='@')) @@ -194,7 +197,7 @@ spaces char '{' spaces - entid <- many (satisfy isBibtexKeyChar) + entid <- many1 (satisfy isBibtexKeyChar) spaces char ',' spaces diff --git a/src/Text/CSL/Input/Bibutils.hs b/src/Text/CSL/Input/Bibutils.hs --- a/src/Text/CSL/Input/Bibutils.hs +++ b/src/Text/CSL/Input/Bibutils.hs @@ -23,14 +23,15 @@ import Text.CSL.Compat.Pandoc (readMarkdown) import Data.Char import System.FilePath ( takeExtension ) +import Text.CSL.Exception import Text.CSL.Reference hiding ( Value ) import Text.CSL.Input.Bibtex import qualified Data.ByteString.Lazy as BL import qualified Data.Map as M import Data.Aeson +import qualified Control.Exception as E #ifdef USE_BIBUTILS -import qualified Control.Exception as E import Control.Exception ( bracket, catch ) import Control.Monad.Trans ( liftIO ) import System.FilePath ( (), (<.>) ) @@ -47,8 +48,10 @@ readBiblioFile :: FilePath -> IO [Reference] readBiblioFile f = case getExt f of - ".json" -> BL.readFile f >>= either error return . eitherDecode - ".yaml" -> UTF8.readFile f >>= either error return . readYamlBib + ".json" -> BL.readFile f >>= either + (E.throwIO . ErrorReadingBibFile f) return . eitherDecode + ".yaml" -> UTF8.readFile f >>= either + (E.throwIO . ErrorReadingBibFile f) return . readYamlBib ".bib" -> readBibtex False True f ".bibtex" -> readBibtex True True f ".biblatex" -> readBibtex False True f @@ -60,10 +63,9 @@ ".wos" -> readBiblioFile' f isi_in ".medline" -> readBiblioFile' f medline_in ".copac" -> readBiblioFile' f copac_in - _ -> error $ "citeproc: the format of the bibliographic database could not be recognized\n" ++ - "using the file extension." + _ -> E.throwIO $ ErrorReadingBibFile f "the format of the bibliographic database could not be recognized from the file extension" #else - _ -> error $ "citeproc: Bibliography format not supported.\n" + _ -> E.throwIO $ ErrorReadingBibFile f "bibliography format not supported" #endif data BibFormat @@ -80,11 +82,14 @@ | Copac | Mods #endif + deriving Show readBiblioString :: BibFormat -> String -> IO [Reference] readBiblioString b s - | Json <- b = either error return $ eitherDecode $ UTF8.fromStringLazy s - | Yaml <- b = either error return $ readYamlBib s + | Json <- b = either (E.throwIO . ErrorReadingBib) + return $ eitherDecode $ UTF8.fromStringLazy s + | Yaml <- b = either (E.throwIO . ErrorReadingBib) + return $ readYamlBib s | Bibtex <- b = readBibtexString True True s | BibLatex <- b = readBibtexString False True s #ifdef USE_BIBUTILS @@ -96,7 +101,8 @@ | Copac <- b = go copac_in | Mods <- b = go mods_in #endif - | otherwise = error "in readBiblioString" + | otherwise = E.throwIO $ ErrorReadingBib $ + "unsupported format " ++ show b #ifdef USE_BIBUTILS where go f = withTempDir "citeproc" $ \tdir -> do @@ -125,7 +131,7 @@ refs <- readBibtex True False tfile return $! refs where handleBibfileError :: E.SomeException -> IO [Reference] - handleBibfileError e = error $ "Error reading " ++ fin ++ "\n" ++ show e + handleBibfileError e = E.throwIO $ ErrorReadingBibFile fin (show e) -- | Perform a function in a temporary directory and clean up. withTempDir :: FilePath -> (FilePath -> IO a) -> IO a diff --git a/src/Text/CSL/Pandoc.hs b/src/Text/CSL/Pandoc.hs --- a/src/Text/CSL/Pandoc.hs +++ b/src/Text/CSL/Pandoc.hs @@ -1,6 +1,7 @@ {-# LANGUAGE PatternGuards, OverloadedStrings, FlexibleInstances, ScopedTypeVariables, CPP #-} -module Text.CSL.Pandoc (processCites, processCites') where +module Text.CSL.Pandoc (processCites, processCites') +where import Text.Pandoc import Text.Pandoc.Walk @@ -31,6 +32,7 @@ import System.FilePath import System.Directory (getAppUserDataDirectory) import Text.CSL.Util (findFile, splitStrWhen, tr', parseRomanNumeral, trim) +import Text.CSL.Exception import System.IO.Error (isDoesNotExistError) import Data.Maybe (fromMaybe) @@ -151,7 +153,7 @@ if isDoesNotExistError e then return Nothing else E.throwIO e - let inlineRefError s = error $ "Error parsing references: " ++ s + let inlineRefError s = E.throw $ ErrorParsingReferences s let inlineRefs = either inlineRefError id $ convertRefs $ lookupMeta "references" meta let cslfile = (lookupMeta "csl" meta <|> lookupMeta "citation-style" meta) @@ -189,7 +191,7 @@ let skipLeadingSpace = L.dropWhile (\s -> s == 32 || (s >= 9 && s <= 13)) abbrevs <- maybe (return (Abbreviations M.empty)) (\f -> findFile (maybe ["."] (\g -> [".", g]) mbcsldir) f >>= - maybe (error $ "Could not find " ++ f) return >>= + maybe (E.throwIO $ CouldNotFindAbbrevFile f) return >>= L.readFile >>= either error return . eitherDecode . skipLeadingSpace) cslAbbrevFile @@ -209,7 +211,7 @@ getBibRefs (MetaList xs) = concat `fmap` mapM getBibRefs xs getBibRefs (MetaInlines xs) = getBibRefs (MetaString $ stringify xs) getBibRefs (MetaString s) = do - path <- findFile ["."] s >>= maybe (error $ "Could not find " ++ s) return + path <- findFile ["."] s >>= maybe (E.throwIO $ CouldNotFindBibFile s) return map unescapeRefId `fmap` readBiblioFile path getBibRefs _ = return [] diff --git a/src/Text/CSL/Parser.hs b/src/Text/CSL/Parser.hs --- a/src/Text/CSL/Parser.hs +++ b/src/Text/CSL/Parser.hs @@ -33,6 +33,7 @@ import Text.Pandoc.UTF8 (fromStringLazy) import Text.CSL.Compat.Pandoc (fetchItem) import Text.CSL.Data (getLocale) +import Text.CSL.Exception -- | Parse a 'String' into a 'Style' (with default locale). parseCSL :: String -> Style @@ -65,7 +66,7 @@ let parentCur = cur $/ get "info" &/ pickParentCur let parent' = concatMap (stringAttr "href") parentCur when (parent' == src) $ do - error $ "Dependent CSL style " ++ src ++ " specifies itself as parent." + E.throwIO $ DependentStyleHasItselfAsParent src case parent' of "" -> localizeCSL mbLocale $ parseCSLCursor cur y -> do diff --git a/src/Text/CSL/Reference.hs b/src/Text/CSL/Reference.hs --- a/src/Text/CSL/Reference.hs +++ b/src/Text/CSL/Reference.hs @@ -509,8 +509,8 @@ noteField :: P.Parser (Text, Aeson.Value) noteField = P.try $ do P.spaces - P.char '{' - P.char ':' + _ <- P.char '{' + _ <- P.char ':' k <- P.manyTill (P.letter <|> P.char '-') (P.char ':') v <- P.manyTill P.anyChar (P.char '}') return (T.pack k, Aeson.String (T.pack v)) diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -9,9 +9,13 @@ - '.' - location: git: https://github.com/jgm/pandoc.git - commit: 55d679e382954dd458acd6233609851748522d99 + commit: ae61d5f57dc8094eb40a9e83427db7fb02afcefb extra-dep: true extra-deps: -- xml-conduit-1.5.0 +- hslua-0.8.0 - skylighting-0.3.3 -resolver: lts-8.16 +- cmark-gfm-0.1.1 +- QuickCheck-2.10.0.1 +- tasty-quickcheck-0.9.1 +- haddock-library-1.4.3 +resolver: lts-9.0 diff --git a/tests/jats.csl b/tests/jats.csl deleted file mode 100644 --- a/tests/jats.csl +++ /dev/null @@ -1,208 +0,0 @@ - - - diff --git a/tests/test-pandoc-citeproc.hs b/tests/test-pandoc-citeproc.hs --- a/tests/test-pandoc-citeproc.hs +++ b/tests/test-pandoc-citeproc.hs @@ -96,7 +96,7 @@ UTF8.writeFile actualf result oldDir <- getCurrentDirectory setCurrentDirectory fp - rawSystem "diff" ["-U1","expected","actual"] + _ <- rawSystem "diff" ["-U1","expected","actual"] setCurrentDirectory oldDir biblio2yamlTest :: String -> IO TestResult