{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{- |
   Module      : Text.Pandoc.Error
   Copyright   : Copyright (C) 2006-2020 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

This module provides a standard way to deal with possible errors encounted
during parsing.

-}
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

-- | Handle PandocError by exiting with an error message.
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 error comes from a chunk or included file,
                     -- then we won't get the right text this way:
                     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