{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Error (
PandocError(..),
renderError,
handleError) where
import Control.Exception (Exception, displayException)
import Data.Typeable (Typeable)
import Data.Word (Word8)
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Network.HTTP.Client (HttpException)
import System.Exit (ExitCode (..), exitWith)
import System.IO (stderr)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Printf (printf)
import Text.Pandoc.Shared (tshow)
import Citeproc (CiteprocError, prettyCiteprocError)
data PandocError = PandocIOError Text IOError
| PandocHttpError Text HttpException
| PandocShouldNeverHappenError Text
| PandocSomeError Text
| PandocParseError Text
| PandocMakePDFError Text
| PandocOptionError Text
| PandocSyntaxMapError Text
| PandocFailOnWarningError
| PandocPDFProgramNotFoundError Text
| PandocPDFError Text
| PandocXMLError Text Text
| PandocFilterError Text Text
| PandocLuaError Text
| PandocNoScriptingEngine
| PandocCouldNotFindDataFileError Text
| PandocCouldNotFindMetadataFileError Text
| PandocResourceNotFound Text
| PandocTemplateError Text
| PandocNoTemplateError Text
| PandocAppError Text
| PandocEpubSubdirectoryError Text
| PandocMacroLoop Text
| PandocUTF8DecodingError Text Int Word8
| PandocIpynbDecodingError Text
| PandocUnsupportedCharsetError Text
| PandocFormatError Text Text
| PandocUnknownReaderError Text
| PandocUnknownWriterError Text
| PandocUnsupportedExtensionError Text Text
| PandocCiteprocError CiteprocError
| PandocBibliographyError Text Text
deriving (Int -> PandocError -> ShowS
[PandocError] -> ShowS
PandocError -> String
(Int -> PandocError -> ShowS)
-> (PandocError -> String)
-> ([PandocError] -> ShowS)
-> Show PandocError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PandocError -> ShowS
showsPrec :: Int -> PandocError -> ShowS
$cshow :: PandocError -> String
show :: PandocError -> String
$cshowList :: [PandocError] -> ShowS
showList :: [PandocError] -> ShowS
Show, Typeable, (forall x. PandocError -> Rep PandocError x)
-> (forall x. Rep PandocError x -> PandocError)
-> Generic PandocError
forall x. Rep PandocError x -> PandocError
forall x. PandocError -> Rep PandocError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PandocError -> Rep PandocError x
from :: forall x. PandocError -> Rep PandocError x
$cto :: forall x. Rep PandocError x -> PandocError
to :: forall x. Rep PandocError x -> PandocError
Generic)
instance Exception PandocError
renderError :: PandocError -> Text
renderError :: PandocError -> Text
renderError PandocError
e =
case PandocError
e of
PandocIOError Text
_ IOError
err' -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IOError -> String
forall e. Exception e => e -> String
displayException IOError
err'
PandocHttpError Text
u HttpException
err' ->
Text
"Could not fetch " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HttpException -> Text
forall a. Show a => a -> Text
tshow HttpException
err'
PandocShouldNeverHappenError Text
s ->
Text
"Something we thought was impossible happened!\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Please report this to pandoc's developers: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
PandocSomeError Text
s -> Text
s
PandocParseError Text
s -> Text
s
PandocMakePDFError Text
s -> Text
s
PandocOptionError Text
s -> Text
s
PandocSyntaxMapError Text
s -> Text
s
PandocError
PandocFailOnWarningError -> Text
"Failing because there were warnings."
PandocPDFProgramNotFoundError Text
pdfprog ->
Text
pdfprog Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found. Please select a different --pdf-engine or install " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pdfprog
PandocPDFError Text
logmsg -> Text
"Error producing PDF.\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
logmsg
PandocXMLError Text
fp Text
logmsg -> Text
"Invalid XML" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null Text
fp then Text
"" else Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fp) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
logmsg
PandocFilterError Text
filtername Text
msg -> Text
"Error running filter " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
filtername Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
PandocLuaError Text
msg -> Text
"Error running Lua:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
PandocError
PandocNoScriptingEngine -> Text
"This version of pandoc has been compiled " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"without Lua support."
PandocCouldNotFindDataFileError Text
fn ->
Text
"Could not find data file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fn
PandocCouldNotFindMetadataFileError Text
fn ->
Text
"Could not find metadata file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fn
PandocResourceNotFound Text
fn ->
Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found in resource path"
PandocTemplateError Text
s -> Text
"Error compiling template " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
PandocNoTemplateError Text
fp -> Text
"No template defined in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fp
PandocAppError Text
s -> Text
s
PandocEpubSubdirectoryError Text
s ->
Text
"EPUB subdirectory name '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' contains illegal characters"
PandocMacroLoop Text
s ->
Text
"Loop encountered in expanding macro " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
PandocUTF8DecodingError Text
f Int
offset Word8
w ->
Text
"UTF-8 decoding error in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at byte offset " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
offset Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%2x" Word8
w) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
").\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"The input must be a UTF-8 encoded text."
PandocIpynbDecodingError Text
w ->
Text
"ipynb decoding error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w
PandocUnsupportedCharsetError Text
charset ->
Text
"Unsupported charset " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
charset
PandocFormatError Text
format Text
s ->
Text
"Error parsing format " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
format Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
PandocUnknownReaderError Text
r ->
Text
"Unknown input format " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
case Text
r of
Text
"doc" -> Text
"\nPandoc can convert from DOCX, but not from DOC." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\nTry using Word to save your DOC file as DOCX," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" and convert that with pandoc."
Text
"pdf" -> Text
"\nPandoc can convert to PDF, but not from PDF."
Text
_ -> Text
""
PandocUnknownWriterError Text
w ->
Text
"Unknown output format " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
case Text
w of
Text
"pdf" -> Text
"To create a pdf using pandoc, use" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" -t latex|beamer|context|ms|html5" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\nand specify an output file with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
".pdf extension (-o filename.pdf)."
Text
"doc" -> Text
"\nPandoc can convert to DOCX, but not to DOC."
Text
_ -> Text
""
PandocUnsupportedExtensionError Text
ext Text
f ->
Text
"The extension " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ext Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not supported " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".\nUse --list-extensions=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"list supported extensions."
PandocCiteprocError CiteprocError
e' ->
CiteprocError -> Text
prettyCiteprocError CiteprocError
e'
PandocBibliographyError Text
fp Text
msg ->
Text
"Error reading bibliography file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
handleError :: Either PandocError a -> IO a
handleError :: forall a. Either PandocError a -> IO a
handleError (Right a
r) = a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
handleError (Left PandocError
e) =
case PandocError
e of
PandocIOError Text
_ IOError
err' -> IOError -> IO a
forall a. IOError -> IO a
ioError IOError
err'
PandocError
_ -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
exitCode (PandocError -> Text
renderError PandocError
e)
where
exitCode :: Int
exitCode =
case PandocError
e of
PandocIOError{} -> Int
1
PandocFailOnWarningError{} -> Int
3
PandocAppError{} -> Int
4
PandocTemplateError{} -> Int
5
PandocOptionError{} -> Int
6
PandocFormatError{} -> Int
20
PandocUnknownReaderError{} -> Int
21
PandocUnknownWriterError{} -> Int
22
PandocUnsupportedExtensionError{} -> Int
23
PandocCiteprocError{} -> Int
24
PandocBibliographyError{} -> Int
25
PandocEpubSubdirectoryError{} -> Int
31
PandocPDFError{} -> Int
43
PandocXMLError{} -> Int
44
PandocPDFProgramNotFoundError{} -> Int
47
PandocHttpError{} -> Int
61
PandocShouldNeverHappenError{} -> Int
62
PandocSomeError{} -> Int
63
PandocParseError{} -> Int
64
PandocMakePDFError{} -> Int
66
PandocSyntaxMapError{} -> Int
67
PandocFilterError{} -> Int
83
PandocLuaError{} -> Int
84
PandocNoTemplateError{} -> Int
87
PandocError
PandocNoScriptingEngine -> Int
89
PandocMacroLoop{} -> Int
91
PandocUTF8DecodingError{} -> Int
92
PandocIpynbDecodingError{} -> Int
93
PandocUnsupportedCharsetError{} -> Int
94
PandocCouldNotFindDataFileError{} -> Int
97
PandocCouldNotFindMetadataFileError{} -> Int
98
PandocResourceNotFound{} -> Int
99
err :: Int -> Text -> IO a
err :: forall a. Int -> Text -> IO a
err Int
exitCode Text
msg = do
Handle -> Text -> IO ()
UTF8.hPutStrLn Handle
stderr Text
msg
ExitCode -> IO Any
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO Any) -> ExitCode -> IO Any
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
exitCode
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. HasCallStack => a
undefined