{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{- |
   Module      : Text.Pandoc.Error
   Copyright   : Copyright (C) 2006-2022 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
encountered during parsing.

-}
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 Data.List (sortOn)
import qualified Data.Text as T
import Data.Ord (Down(..))
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.Pandoc.Sources (Sources(..))
import Text.Printf (printf)
import Text.Parsec.Error
import Text.Parsec.Pos hiding (Line)
import Text.Pandoc.Shared (tshow)
import Citeproc (CiteprocError, prettyCiteprocError)

data PandocError = PandocIOError Text IOError
                 | PandocHttpError Text HttpException
                 | PandocShouldNeverHappenError Text
                 | PandocSomeError Text
                 | PandocParseError Text
                 | PandocParsecError Sources ParseError
                 | PandocMakePDFError Text
                 | PandocOptionError Text
                 | PandocSyntaxMapError Text
                 | PandocFailOnWarningError
                 | PandocPDFProgramNotFoundError Text
                 | PandocPDFError Text
                 | PandocXMLError Text Text
                 | PandocFilterError Text Text
                 | PandocLuaError Text
                 | PandocCouldNotFindDataFileError Text
                 | PandocCouldNotFindMetadataFileError Text
                 | PandocResourceNotFound Text
                 | PandocTemplateError Text
                 | PandocAppError Text
                 | PandocEpubSubdirectoryError Text
                 | PandocMacroLoop Text
                 | PandocUTF8DecodingError Text Int Word8
                 | PandocIpynbDecodingError Text
                 | PandocUnsupportedCharsetError Text
                 | PandocUnknownReaderError Text
                 | PandocUnknownWriterError Text
                 | PandocUnsupportedExtensionError Text Text
                 | PandocCiteprocError CiteprocError
                 | PandocBibliographyError Text Text
                 deriving (Int -> PandocError -> ShowS
[PandocError] -> ShowS
PandocError -> String
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. 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

renderError :: PandocError -> Text
renderError :: PandocError -> Text
renderError PandocError
e =
  case PandocError
e of
    PandocIOError Text
_ IOError
err' -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> String
displayException IOError
err'
    PandocHttpError Text
u HttpException
err' ->
      Text
"Could not fetch " forall a. Semigroup a => a -> a -> a
<> Text
u forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow HttpException
err'
    PandocShouldNeverHappenError Text
s ->
      Text
"Something we thought was impossible happened!\n" forall a. Semigroup a => a -> a -> a
<>
      Text
"Please report this to pandoc's developers: " forall a. Semigroup a => a -> a -> a
<> Text
s
    PandocSomeError Text
s -> Text
s
    PandocParseError Text
s -> Text
s
    PandocParsecError (Sources [(SourcePos, Text)]
inputs) 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
            errFile :: String
errFile = SourcePos -> String
sourceName SourcePos
errPos
            errorInFile :: Text
errorInFile =
              case forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Int
sourceLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
                      [ (SourcePos
pos,Text
t)
                        | (SourcePos
pos,Text
t) <- [(SourcePos, Text)]
inputs
                        , SourcePos -> String
sourceName SourcePos
pos forall a. Eq a => a -> a -> Bool
== String
errFile
                        , SourcePos -> Int
sourceLine SourcePos
pos forall a. Ord a => a -> a -> Bool
<= Int
errLine
                      ] of
                []  -> Text
""
                ((SourcePos
pos,Text
txt):[(SourcePos, Text)]
_) ->
                  let ls :: [Text]
ls = Text -> [Text]
T.lines Text
txt forall a. Semigroup a => a -> a -> a
<> [Text
""]
                      ln :: Int
ln = (Int
errLine forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceLine SourcePos
pos) forall a. Num a => a -> a -> a
+ Int
1
                   in if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls forall a. Ord a => a -> a -> Bool
> Int
ln Bool -> Bool -> Bool
&& Int
ln forall a. Ord a => a -> a -> Bool
>= Int
1
                         then [Text] -> Text
T.concat [Text
"\n", [Text]
ls forall a. [a] -> Int -> a
!! (Int
ln forall a. Num a => a -> a -> a
- Int
1)
                                       ,Text
"\n", Int -> Text -> Text
T.replicate (Int
errColumn forall a. Num a => a -> a -> a
- Int
1) Text
" "
                                       ,Text
"^"]
                         else Text
""
        in  Text
"Error at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow  ParseError
err' forall a. Semigroup a => a -> a -> a
<> Text
errorInFile
    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 forall a. Semigroup a => a -> a -> a
<> Text
" not found. Please select a different --pdf-engine or install " forall a. Semigroup a => a -> a -> a
<> Text
pdfprog
    PandocPDFError Text
logmsg -> Text
"Error producing PDF.\n" forall a. Semigroup a => a -> a -> a
<> Text
logmsg
    PandocXMLError Text
fp Text
logmsg -> Text
"Invalid XML" forall a. Semigroup a => a -> a -> a
<>
        (if Text -> Bool
T.null Text
fp then Text
"" else Text
" in " forall a. Semigroup a => a -> a -> a
<> Text
fp) forall a. Semigroup a => a -> a -> a
<> Text
":\n" forall a. Semigroup a => a -> a -> a
<> Text
logmsg
    PandocFilterError Text
filtername Text
msg -> Text
"Error running filter " forall a. Semigroup a => a -> a -> a
<>
        Text
filtername forall a. Semigroup a => a -> a -> a
<> Text
":\n" forall a. Semigroup a => a -> a -> a
<> Text
msg
    PandocLuaError Text
msg -> Text
"Error running Lua:\n" forall a. Semigroup a => a -> a -> a
<> Text
msg
    PandocCouldNotFindDataFileError Text
fn ->
        Text
"Could not find data file " forall a. Semigroup a => a -> a -> a
<> Text
fn
    PandocCouldNotFindMetadataFileError Text
fn ->
        Text
"Could not find metadata file " forall a. Semigroup a => a -> a -> a
<> Text
fn
    PandocResourceNotFound Text
fn ->
        Text
"File " forall a. Semigroup a => a -> a -> a
<> Text
fn forall a. Semigroup a => a -> a -> a
<> Text
" not found in resource path"
    PandocTemplateError Text
s -> Text
"Error compiling template " forall a. Semigroup a => a -> a -> a
<> Text
s
    PandocAppError Text
s -> Text
s
    PandocEpubSubdirectoryError Text
s ->
      Text
"EPUB subdirectory name '" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"' contains illegal characters"
    PandocMacroLoop Text
s ->
      Text
"Loop encountered in expanding macro " forall a. Semigroup a => a -> a -> a
<> Text
s
    PandocUTF8DecodingError Text
f Int
offset Word8
w ->
      Text
"UTF-8 decoding error in " forall a. Semigroup a => a -> a -> a
<> Text
f forall a. Semigroup a => a -> a -> a
<> Text
" at byte offset " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
offset forall a. Semigroup a => a -> a -> a
<>
      Text
" (" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%2x" Word8
w) forall a. Semigroup a => a -> a -> a
<> Text
").\n" forall a. Semigroup a => a -> a -> a
<>
      Text
"The input must be a UTF-8 encoded text."
    PandocIpynbDecodingError Text
w ->
      Text
"ipynb decoding error: " forall a. Semigroup a => a -> a -> a
<> Text
w
    PandocUnsupportedCharsetError Text
charset ->
      Text
"Unsupported charset " forall a. Semigroup a => a -> a -> a
<> Text
charset
    PandocUnknownReaderError Text
r ->
      Text
"Unknown input format " forall a. Semigroup a => a -> a -> a
<> Text
r forall a. Semigroup a => a -> a -> a
<>
      case Text
r of
        Text
"doc" -> Text
"\nPandoc can convert from DOCX, but not from DOC." forall a. Semigroup a => a -> a -> a
<>
                 Text
"\nTry using Word to save your DOC file as DOCX," 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 " forall a. Semigroup a => a -> a -> a
<> Text
w forall a. Semigroup a => a -> a -> a
<>
       case Text
w of
         Text
"pdf" -> Text
"To create a pdf using pandoc, use" forall a. Semigroup a => a -> a -> a
<>
                  Text
" -t latex|beamer|context|ms|html5" forall a. Semigroup a => a -> a -> a
<>
                 Text
"\nand specify an output file with " 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 " forall a. Semigroup a => a -> a -> a
<> Text
ext forall a. Semigroup a => a -> a -> a
<> Text
" is not supported " forall a. Semigroup a => a -> a -> a
<>
      Text
"for " forall a. Semigroup a => a -> a -> a
<> Text
f
    PandocCiteprocError CiteprocError
e' ->
      CiteprocError -> Text
prettyCiteprocError CiteprocError
e'
    PandocBibliographyError Text
fp Text
msg ->
      Text
"Error reading bibliography file " forall a. Semigroup a => a -> a -> a
<> Text
fp forall a. Semigroup a => a -> a -> a
<> Text
":\n" forall a. Semigroup a => a -> a -> a
<> Text
msg


-- | Handle PandocError by exiting with an error message.
handleError :: Either PandocError a -> IO a
handleError :: forall a. Either PandocError a -> IO a
handleError (Right a
r) = forall (m :: * -> *) a. Monad m => a -> m a
return a
r
handleError (Left PandocError
e) =
  case PandocError
e of
    PandocIOError Text
_ IOError
err' -> forall a. IOError -> IO a
ioError IOError
err'
    PandocError
_ -> 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
      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
      PandocParsecError{} -> Int
65
      PandocMakePDFError{} -> Int
66
      PandocSyntaxMapError{} -> Int
67
      PandocFilterError{} -> Int
83
      PandocLuaError{} -> Int
84
      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
  forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
exitCode
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. HasCallStack => a
undefined