1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric      #-}
3{-# LANGUAGE OverloadedStrings  #-}
4{- |
5   Module      : Text.Pandoc.Error
6   Copyright   : Copyright (C) 2006-2021 John MacFarlane
7   License     : GNU GPL, version 2 or above
8
9   Maintainer  : John MacFarlane <jgm@berkeley.edu>
10   Stability   : alpha
11   Portability : portable
12
13This module provides a standard way to deal with possible errors
14encountered during parsing.
15
16-}
17module Text.Pandoc.Error (
18  PandocError(..),
19  renderError,
20  handleError) where
21
22import Control.Exception (Exception, displayException)
23import Data.Typeable (Typeable)
24import Data.Word (Word8)
25import Data.Text (Text)
26import Data.List (sortOn)
27import qualified Data.Text as T
28import Data.Ord (Down(..))
29import GHC.Generics (Generic)
30import Network.HTTP.Client (HttpException)
31import System.Exit (ExitCode (..), exitWith)
32import System.IO (stderr)
33import qualified Text.Pandoc.UTF8 as UTF8
34import Text.Pandoc.Sources (Sources(..))
35import Text.Printf (printf)
36import Text.Parsec.Error
37import Text.Parsec.Pos hiding (Line)
38import Text.Pandoc.Shared (tshow)
39import Citeproc (CiteprocError, prettyCiteprocError)
40
41data PandocError = PandocIOError Text IOError
42                 | PandocHttpError Text HttpException
43                 | PandocShouldNeverHappenError Text
44                 | PandocSomeError Text
45                 | PandocParseError Text
46                 | PandocParsecError Sources ParseError
47                 | PandocMakePDFError Text
48                 | PandocOptionError Text
49                 | PandocSyntaxMapError Text
50                 | PandocFailOnWarningError
51                 | PandocPDFProgramNotFoundError Text
52                 | PandocPDFError Text
53                 | PandocXMLError Text Text
54                 | PandocFilterError Text Text
55                 | PandocLuaError Text
56                 | PandocCouldNotFindDataFileError Text
57                 | PandocResourceNotFound Text
58                 | PandocTemplateError Text
59                 | PandocAppError Text
60                 | PandocEpubSubdirectoryError Text
61                 | PandocMacroLoop Text
62                 | PandocUTF8DecodingError Text Int Word8
63                 | PandocIpynbDecodingError Text
64                 | PandocUnsupportedCharsetError Text
65                 | PandocUnknownReaderError Text
66                 | PandocUnknownWriterError Text
67                 | PandocUnsupportedExtensionError Text Text
68                 | PandocCiteprocError CiteprocError
69                 | PandocBibliographyError Text Text
70                 deriving (Show, Typeable, Generic)
71
72instance Exception PandocError
73
74renderError :: PandocError -> Text
75renderError e =
76  case e of
77    PandocIOError _ err' -> T.pack $ displayException err'
78    PandocHttpError u err' ->
79      "Could not fetch " <> u <> "\n" <> tshow err'
80    PandocShouldNeverHappenError s ->
81      "Something we thought was impossible happened!\n" <>
82      "Please report this to pandoc's developers: " <> s
83    PandocSomeError s -> s
84    PandocParseError s -> s
85    PandocParsecError (Sources inputs) err' ->
86        let errPos = errorPos err'
87            errLine = sourceLine errPos
88            errColumn = sourceColumn errPos
89            errFile = sourceName errPos
90            errorInFile =
91              case sortOn (Down . sourceLine . fst)
92                      [ (pos,t)
93                        | (pos,t) <- inputs
94                        , sourceName pos == errFile
95                        , sourceLine pos <= errLine
96                      ] of
97                []  -> ""
98                ((pos,txt):_) ->
99                  let ls = T.lines txt <> [""]
100                      ln = (errLine - sourceLine pos) + 1
101                   in if length ls > ln && ln >= 1
102                         then T.concat ["\n", ls !! (ln - 1)
103                                       ,"\n", T.replicate (errColumn - 1) " "
104                                       ,"^"]
105                         else ""
106        in  "Error at " <> tshow  err' <> errorInFile
107    PandocMakePDFError s -> s
108    PandocOptionError s -> s
109    PandocSyntaxMapError s -> s
110    PandocFailOnWarningError -> "Failing because there were warnings."
111    PandocPDFProgramNotFoundError pdfprog ->
112        pdfprog <> " not found. Please select a different --pdf-engine or install " <> pdfprog
113    PandocPDFError logmsg -> "Error producing PDF.\n" <> logmsg
114    PandocXMLError fp logmsg -> "Invalid XML" <>
115        (if T.null fp then "" else " in " <> fp) <> ":\n" <> logmsg
116    PandocFilterError filtername msg -> "Error running filter " <>
117        filtername <> ":\n" <> msg
118    PandocLuaError msg -> "Error running Lua:\n" <> msg
119    PandocCouldNotFindDataFileError fn ->
120        "Could not find data file " <> fn
121    PandocResourceNotFound fn ->
122        "File " <> fn <> " not found in resource path"
123    PandocTemplateError s -> "Error compiling template " <> s
124    PandocAppError s -> s
125    PandocEpubSubdirectoryError s ->
126      "EPUB subdirectory name '" <> s <> "' contains illegal characters"
127    PandocMacroLoop s ->
128      "Loop encountered in expanding macro " <> s
129    PandocUTF8DecodingError f offset w ->
130      "UTF-8 decoding error in " <> f <> " at byte offset " <> tshow offset <>
131      " (" <> T.pack (printf "%2x" w) <> ").\n" <>
132      "The input must be a UTF-8 encoded text."
133    PandocIpynbDecodingError w ->
134      "ipynb decoding error: " <> w
135    PandocUnsupportedCharsetError charset ->
136      "Unsupported charset " <> charset
137    PandocUnknownReaderError r ->
138      "Unknown input format " <> r <>
139      case r of
140        "doc" -> "\nPandoc can convert from DOCX, but not from DOC." <>
141                 "\nTry using Word to save your DOC file as DOCX," <>
142                 " and convert that with pandoc."
143        "pdf" -> "\nPandoc can convert to PDF, but not from PDF."
144        _     -> ""
145    PandocUnknownWriterError w ->
146       "Unknown output format " <> w <>
147       case w of
148         "pdf" -> "To create a pdf using pandoc, use" <>
149                  " -t latex|beamer|context|ms|html5" <>
150                 "\nand specify an output file with " <>
151                 ".pdf extension (-o filename.pdf)."
152         "doc" -> "\nPandoc can convert to DOCX, but not to DOC."
153         _     -> ""
154    PandocUnsupportedExtensionError ext f ->
155      "The extension " <> ext <> " is not supported " <>
156      "for " <> f
157    PandocCiteprocError e' ->
158      prettyCiteprocError e'
159    PandocBibliographyError fp msg ->
160      "Error reading bibliography file " <> fp <> ":\n" <> msg
161
162
163-- | Handle PandocError by exiting with an error message.
164handleError :: Either PandocError a -> IO a
165handleError (Right r) = return r
166handleError (Left e) =
167  case e of
168    PandocIOError _ err' -> ioError err'
169    _ -> err exitCode (renderError e)
170 where
171  exitCode =
172    case e of
173      PandocIOError{} -> 1
174      PandocHttpError{} -> 61
175      PandocShouldNeverHappenError{} -> 62
176      PandocSomeError{} -> 63
177      PandocParseError{} -> 64
178      PandocParsecError{} -> 65
179      PandocMakePDFError{} -> 66
180      PandocOptionError{} -> 6
181      PandocSyntaxMapError{} -> 67
182      PandocFailOnWarningError{} -> 3
183      PandocPDFProgramNotFoundError{} -> 47
184      PandocPDFError{} -> 43
185      PandocXMLError{} -> 44
186      PandocFilterError{} -> 83
187      PandocLuaError{} -> 84
188      PandocCouldNotFindDataFileError{} -> 97
189      PandocResourceNotFound{} -> 99
190      PandocTemplateError{} -> 5
191      PandocAppError{} -> 4
192      PandocEpubSubdirectoryError{} -> 31
193      PandocMacroLoop{} -> 91
194      PandocUTF8DecodingError{} -> 92
195      PandocIpynbDecodingError{} -> 93
196      PandocUnsupportedCharsetError{} -> 94
197      PandocUnknownReaderError{} -> 21
198      PandocUnknownWriterError{} -> 22
199      PandocUnsupportedExtensionError{} -> 23
200      PandocCiteprocError{} -> 24
201      PandocBibliographyError{} -> 25
202
203err :: Int -> Text -> IO a
204err exitCode msg = do
205  UTF8.hPutStrLn stderr msg
206  exitWith $ ExitFailure exitCode
207  return undefined
208