{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Error (
PandocError(..),
handleError) where
import Control.Exception (Exception)
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.Parsec.Error
import Text.Parsec.Pos hiding (Line)
type Input = Text
data PandocError = PandocIOError Text IOError
| PandocHttpError Text HttpException
| PandocShouldNeverHappenError Text
| PandocSomeError Text
| PandocParseError Text
| PandocParsecError Input ParseError
| PandocMakePDFError Text
| PandocOptionError Text
| PandocSyntaxMapError Text
| PandocFailOnWarningError
| PandocPDFProgramNotFoundError Text
| PandocPDFError Text
| PandocFilterError Text Text
| PandocCouldNotFindDataFileError Text
| PandocResourceNotFound Text
| PandocTemplateError Text
| PandocAppError Text
| PandocEpubSubdirectoryError Text
| PandocMacroLoop Text
| PandocUTF8DecodingError Text Int Word8
| PandocIpynbDecodingError Text
| PandocUnknownReaderError Text
| PandocUnknownWriterError Text
| PandocUnsupportedExtensionError 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
showList :: [PandocError] -> ShowS
$cshowList :: [PandocError] -> ShowS
show :: PandocError -> String
$cshow :: PandocError -> String
showsPrec :: Int -> PandocError -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep PandocError x -> PandocError
$cfrom :: forall x. PandocError -> Rep PandocError x
Generic)
instance Exception PandocError
handleError :: Either PandocError a -> IO a
handleError :: Either PandocError a -> IO a
handleError (Right a
r) = 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'
PandocHttpError Text
u HttpException
err' -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
61 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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 -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
62 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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 -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
63 Text
s
PandocParseError Text
s -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
64 Text
s
PandocParsecError Text
input ParseError
err' ->
let errPos :: SourcePos
errPos = ParseError -> SourcePos
errorPos ParseError
err'
errLine :: Int
errLine = SourcePos -> Int
sourceLine SourcePos
errPos
errColumn :: Int
errColumn = SourcePos -> Int
sourceColumn SourcePos
errPos
ls :: [Text]
ls = Text -> [Text]
T.lines Text
input [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
""]
errorInFile :: Text
errorInFile = if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
errLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
then [Text] -> Text
T.concat [Text
"\n", [Text]
ls [Text] -> Int -> Text
forall a. [a] -> Int -> a
!! (Int
errLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
,Text
"\n", Int -> Text -> Text
T.replicate (Int
errColumn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
" "
,Text
"^"]
else Text
""
in Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
65 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$ Text
"\nError at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParseError -> Text
forall a. Show a => a -> Text
tshow ParseError
err' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
if SourcePos -> String
sourceName SourcePos
errPos String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"source"
then Text
errorInFile
else Text
""
PandocMakePDFError Text
s -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
66 Text
s
PandocOptionError Text
s -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
6 Text
s
PandocSyntaxMapError Text
s -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
67 Text
s
PandocError
PandocFailOnWarningError -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
3 Text
"Failing because there were warnings."
PandocPDFProgramNotFoundError Text
pdfprog -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
47 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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 -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
43 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$ Text
"Error producing PDF.\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
logmsg
PandocFilterError Text
filtername Text
msg -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
83 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$ 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
PandocCouldNotFindDataFileError Text
fn -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
97 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
Text
"Could not find data file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fn
PandocResourceNotFound Text
fn -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
99 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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 -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
5 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$ Text
"Error compiling template " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
PandocAppError Text
s -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
4 Text
s
PandocEpubSubdirectoryError Text
s -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
31 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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 -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
91 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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 -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
92 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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 -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
93 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
Text
"ipynb decoding error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w
PandocUnknownReaderError Text
r -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
21 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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 -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
22 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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 from DOC."
Text
_ -> Text
""
PandocUnsupportedExtensionError Text
ext Text
f -> Int -> Text -> IO a
forall a. Int -> Text -> IO a
err Int
23 (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
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
err :: Int -> Text -> IO a
err :: Int -> Text -> IO a
err Int
exitCode Text
msg = do
Handle -> String -> IO ()
UTF8.hPutStrLn Handle
stderr (Text -> String
T.unpack 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 (m :: * -> *) a. Monad m => a -> m a
return a
forall a. HasCallStack => a
undefined
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show