6a3a04c · typeable/pandoc

benchmark/benchmark-pandoc.hs+6−4

@@ -22,20 +22,22 @@ import System.Environment (getArgs)

2222import Data.Monoid

2323import Data.Maybe (mapMaybe)

2424import Debug.Trace (trace)

25+import Text.Pandoc.Error

26+import Control.Applicative

2527

2628readerBench :: Pandoc

27− -> (String, ReaderOptions -> String -> IO Pandoc)

29+ -> (String, ReaderOptions -> String -> IO (Either PandocError Pandoc))

2830 -> Maybe Benchmark

2931readerBench doc (name, reader) =

3032 case lookup name writers of

3133 Just (PureStringWriter writer) ->

3234 let inp = writer def{ writerWrapText = True} doc

3335 in return $ bench (name ++ " reader") $ nfIO $

34− (reader def{ readerSmart = True }) inp

36+ (fmap handleError <$> reader def{ readerSmart = True }) inp

3537 _ | name == "commonmark" ->

3638 let inp = writeMarkdown def{ writerWrapText = True} doc

3739 in return $ bench (name ++ " reader") $ nfIO $

38− (reader def{ readerSmart = True }) inp

40+ (fmap handleError <$> reader def{ readerSmart = True }) inp

3941 | otherwise -> trace ("\nCould not find writer for " ++ name ++

4042 "\n") Nothing

4143

@@ -52,7 +54,7 @@ main = do

5254 defaultOptions args

5355 inp <- readFile "tests/testsuite.txt"

5456 let opts = def{ readerSmart = True }

55− let doc = readMarkdown opts inp

57+ let doc = handleError $ readMarkdown opts inp

5658 let readers' = [(n,r) | (n, StringReader r) <- readers]

5759 let readerBs = mapMaybe (readerBench doc)

5860 $ filter (\(n,_) -> n /="haddock") readers'

pandoc.cabal+1

@@ -290,6 +290,7 @@ Library

290290 Text.Pandoc.Pretty,

291291 Text.Pandoc.Shared,

292292 Text.Pandoc.MediaBag,

293+ Text.Pandoc.Error,

293294 Text.Pandoc.Readers.HTML,

294295 Text.Pandoc.Readers.LaTeX,

295296 Text.Pandoc.Readers.Markdown,

pandoc.hs+12−10

@@ -72,6 +72,8 @@ import Control.Applicative ((<$>), (<|>))

7272import Text.Pandoc.Readers.Txt2Tags (getT2TMeta)

7373import Data.Monoid

7474

75+import Text.Pandoc.Error

76+

7577type Transform = Pandoc -> Pandoc

7678

7779copyrightMessage :: String

@@ -1275,17 +1277,17 @@ main = do

12751277 then 0

12761278 else tabStop)

12771279

1278− let handleIncludes' = if readerName' == "latex" ||

1279− readerName' == "latex+lhs"

1280+ let handleIncludes' :: String -> IO (Either PandocError String)

1281+ handleIncludes' = if readerName' `elem` ["latex", "latex+lhs"]

12801282 then handleIncludes

1281− else return

1282−

1283− (doc, media) <-

1284− case reader of

1285− StringReader r-> (, mempty) <$>

1286− ( readSources >=>

1287− handleIncludes' . convertTabs . intercalate "\n" >=>

1288− r readerOpts ) sources

1283+ else return . Right

1284+

1285+ (doc, media) <- fmap handleError $

1286+ case reader of

1287+ StringReader r-> do

1288+ srcs <- convertTabs . intercalate "\n" <$> readSources sources

1289+ doc <- handleIncludes' srcs

1290+ either (return . Left) (\s -> fmap (,mempty) <$> r readerOpts s) doc

12891291 ByteStringReader r -> readFiles sources >>= r readerOpts

12901292

12911293 let writerOptions = def { writerStandalone = standalone',

src/Text/Pandoc.hs+15−11

@@ -166,8 +166,9 @@ import Text.Pandoc.Writers.Haddock

166166import Text.Pandoc.Writers.Custom

167167import Text.Pandoc.Templates

168168import Text.Pandoc.Options

169−import Text.Pandoc.Shared (safeRead, warn)

169+import Text.Pandoc.Shared (safeRead, warn, mapLeft)

170170import Text.Pandoc.MediaBag (MediaBag)

171+import Text.Pandoc.Error

171172import Data.Aeson

172173import qualified Data.ByteString.Lazy as BL

173174import Data.List (intercalate)

@@ -203,19 +204,22 @@ parseFormatSpec = parse formatSpec ""

203204 '-' -> Set.delete ext

204205 _ -> Set.insert ext

205206

206−data Reader = StringReader (ReaderOptions -> String -> IO Pandoc)

207− | ByteStringReader (ReaderOptions -> BL.ByteString -> IO (Pandoc, MediaBag))

208207

209−mkStringReader :: (ReaderOptions -> String -> Pandoc) -> Reader

208+data Reader = StringReader (ReaderOptions -> String -> IO (Either PandocError Pandoc))

209+ | ByteStringReader (ReaderOptions -> BL.ByteString -> IO (Either PandocError (Pandoc,MediaBag)))

210+

211+mkStringReader :: (ReaderOptions -> String -> (Either PandocError Pandoc)) -> Reader

210212mkStringReader r = StringReader (\o s -> return $ r o s)

211213

212−mkStringReaderWithWarnings :: (ReaderOptions -> String -> (Pandoc, [String])) -> Reader

214+mkStringReaderWithWarnings :: (ReaderOptions -> String -> Either PandocError (Pandoc, [String])) -> Reader

213215mkStringReaderWithWarnings r = StringReader $ \o s -> do

214− let (doc, warnings) = r o s

215− mapM_ warn warnings

216− return doc

216+ case r o s of

217+ Left err -> return $ Left err

218+ Right (doc, warnings) -> do

219+ mapM_ warn warnings

220+ return (Right doc)

217221

218−mkBSReader :: (ReaderOptions -> BL.ByteString -> (Pandoc, MediaBag)) -> Reader

222+mkBSReader :: (ReaderOptions -> BL.ByteString -> (Either PandocError (Pandoc, MediaBag))) -> Reader

219223mkBSReader r = ByteStringReader (\o s -> return $ r o s)

220224

221225-- | Association list of formats and readers.

@@ -360,8 +364,8 @@ class ToJSONFilter a => ToJsonFilter a

360364 where toJsonFilter :: a -> IO ()

361365 toJsonFilter = toJSONFilter

362366

363−readJSON :: ReaderOptions -> String -> Pandoc

364−readJSON _ = either error id . eitherDecode' . UTF8.fromStringLazy

367+readJSON :: ReaderOptions -> String -> Either PandocError Pandoc

368+readJSON _ = mapLeft ParseFailure . eitherDecode' . UTF8.fromStringLazy

365369

366370writeJSON :: WriterOptions -> Pandoc -> String

367371writeJSON _ = UTF8.toStringLazy . encode

src/Text/Pandoc/Error.hsnew file+64

@@ -0,0 +1,64 @@

1+{-

3+

4+This program is free software; you can redistribute it and/or modify

5+it under the terms of the GNU General Public License as published by

6+the Free Software Foundation; either version 2 of the License, or

7+(at your option) any later version.

8+

9+This program is distributed in the hope that it will be useful,

10+but WITHOUT ANY WARRANTY; without even the implied warranty of

11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

12+GNU General Public License for more details.

13+

14+You should have received a copy of the GNU General Public License

15+along with this program; if not, write to the Free Software

16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

17+-}

18+{- |

19+ Module : Text.Pandoc.Error

21+ License : GNU GPL, version 2 or above

22+

23+ Maintainer : John MacFarlane <jgm@berkeley.edu>

24+ Stability : alpha

25+ Portability : portable

26+

27+This module provides a standard way to deal with possible errors encounted

28+during parsing.

29+

30+-}

31+module Text.Pandoc.Error (PandocError(..), handleError) where

32+

33+import Text.Parsec.Error

34+import Text.Parsec.Pos hiding (Line)

35+import Text.Pandoc.Compat.Except

36+

37+type Input = String

38+

39+data PandocError = -- | Generic parse failure

40+ ParseFailure String

41+ -- | Error thrown by a Parsec parser

42+ | ParsecError Input ParseError

43+ deriving (Show)

44+

45+

46+instance Error PandocError where

47+ strMsg = ParseFailure

48+

49+

50+-- | An unsafe method to handle `PandocError`s.

51+handleError :: Either PandocError a -> a

52+handleError (Right r) = r

53+handleError (Left err) =

54+ case err of

55+ ParseFailure string -> error string

56+ ParsecError input err' ->

57+ let errPos = errorPos err'

58+ errLine = sourceLine errPos

59+ errColumn = sourceColumn errPos

60+ theline = (lines input ++ [""]) !! (errLine - 1)

61+ in error $ "\nError at " ++ show err' ++ "\n" ++

62+ theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++

63+ "^"

64+

src/Text/Pandoc/ImageSize.hs+37−31

@@ -1,4 +1,5 @@

11{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

2+{-# OPTIONS_GHC -fno-warn-type-defaults #-}

23{-

45

@@ -38,8 +39,11 @@ import Control.Monad

3839import Data.Bits

3940import Data.Binary

4041import Data.Binary.Get

41−import Text.Pandoc.Shared (safeRead)

42+import Text.Pandoc.Shared (safeRead, hush)

4243import qualified Data.Map as M

44+import Text.Pandoc.Compat.Except

45+import Control.Monad.Trans

46+import Data.Maybe (fromMaybe)

4347

4448-- quick and dirty functions to get image sizes

4549-- algorithms borrowed from wwwis.pl

@@ -64,7 +68,7 @@ imageType img = case B.take 4 img of

6468 "%!PS"

6569 | (B.take 4 $ B.drop 1 $ B.dropWhile (/=' ') img) == "EPSF"

6670 -> return Eps

67− _ -> fail "Unknown image type"

71+ _ -> (hush . Left) "Unknown image type"

6872

6973imageSize :: ByteString -> Maybe ImageSize

7074imageSize img = do

@@ -114,7 +118,7 @@ pngSize img = do

114118 ([w1,w2,w3,w4,h1,h2,h3,h4] :: [Integer]) -> return

115119 ((shift w1 24) + (shift w2 16) + (shift w3 8) + w4,

116120 (shift h1 24) + (shift h2 16) + (shift h3 8) + h4)

117− _ -> fail "PNG parse error"

121+ _ -> (hush . Left) "PNG parse error"

118122 let (dpix, dpiy) = findpHYs rest''

119123 return $ ImageSize { pxX = x, pxY = y, dpiX = dpix, dpiY = dpiy }

120124

@@ -143,7 +147,7 @@ gifSize img = do

143147 dpiX = 72,

144148 dpiY = 72

145149 }

146− _ -> fail "GIF parse error"

150+ _ -> (hush . Left) "GIF parse error"

147151

148152jpegSize :: ByteString -> Maybe ImageSize

149153jpegSize img = do

@@ -174,36 +178,37 @@ findJfifSize bs = do

174178 Just (c,bs'') | c >= '\xc0' && c <= '\xc3' -> do

175179 case map fromIntegral $ unpack $ B.take 4 $ B.drop 3 bs'' of

176180 [h1,h2,w1,w2] -> return (shift w1 8 + w2, shift h1 8 + h2)

177− _ -> fail "JPEG parse error"

181+ _ -> (hush . Left) "JPEG parse error"

178182 Just (_,bs'') -> do

179183 case map fromIntegral $ unpack $ B.take 2 bs'' of

180184 [c1,c2] -> do

181185 let len = shift c1 8 + c2

182186 -- skip variables

183187 findJfifSize $ B.drop len bs''

184− _ -> fail "JPEG parse error"

185− Nothing -> fail "Did not find length record"

188+ _ -> (hush . Left) "JPEG parse error"

189+ Nothing -> (hush . Left) "Did not find length record"

186190

187191exifSize :: ByteString -> Maybe ImageSize

188−exifSize bs = runGet (Just <$> exifHeader bl) bl

192+exifSize bs = hush . runGet header $ bl

189193 where bl = BL.fromChunks [bs]

194+ header = runExceptT $ exifHeader bl

190195-- NOTE: It would be nicer to do

191196-- runGet ((Just <$> exifHeader) <|> return Nothing)

192197-- which would prevent pandoc from raising an error when an exif header can't

193198-- be parsed. But we only get an Alternative instance for Get in binary 0.6,

194199-- and binary 0.5 ships with ghc 7.6.

195200

196−exifHeader :: BL.ByteString -> Get ImageSize

201+exifHeader :: BL.ByteString -> ExceptT String Get ImageSize

197202exifHeader hdr = do

198− _app1DataSize <- getWord16be

199− exifHdr <- getWord32be

200− unless (exifHdr == 0x45786966) $ fail "Did not find exif header"

201− zeros <- getWord16be

202− unless (zeros == 0) $ fail "Expected zeros after exif header"

203+ _app1DataSize <- lift getWord16be

204+ exifHdr <- lift getWord32be

205+ unless (exifHdr == 0x45786966) $ throwError "Did not find exif header"

206+ zeros <- lift getWord16be

207+ unless (zeros == 0) $ throwError "Expected zeros after exif header"

203208 -- beginning of tiff header -- we read whole thing to use

204209 -- in getting data from offsets:

205210 let tiffHeader = BL.drop 8 hdr

206− byteAlign <- getWord16be

211+ byteAlign <- lift getWord16be

207212 let bigEndian = byteAlign == 0x4d4d

208213 let (getWord16, getWord32, getWord64) =

209214 if bigEndian

@@ -213,17 +218,17 @@ exifHeader hdr = do

213218 num <- getWord32

214219 den <- getWord32

215220 return $ fromIntegral num / fromIntegral den

216− tagmark <- getWord16

217− unless (tagmark == 0x002a) $ fail "Failed alignment sanity check"

218− ifdOffset <- getWord32

219− skip (fromIntegral ifdOffset - 8) -- skip to IDF

220− numentries <- getWord16

221− let ifdEntry = do

222− tag <- getWord16 >>= \t ->

223− maybe (return UnknownTagType) return

224− (M.lookup t tagTypeTable)

225− dataFormat <- getWord16

226− numComponents <- getWord32

221+ tagmark <- lift getWord16

222+ unless (tagmark == 0x002a) $ throwError "Failed alignment sanity check"

223+ ifdOffset <- lift getWord32

224+ lift $ skip (fromIntegral ifdOffset - 8) -- skip to IDF

225+ numentries <- lift getWord16

226+ let ifdEntry :: ExceptT String Get (TagType, DataFormat)

227+ ifdEntry = do

228+ tag <- fromMaybe UnknownTagType . flip M.lookup tagTypeTable

229+ <$> lift getWord16

230+ dataFormat <- lift getWord16

231+ numComponents <- lift getWord32

227232 (fmt, bytesPerComponent) <-

228233 case dataFormat of

229234 1 -> return (UnsignedByte . runGet getWord8, 1)

@@ -238,9 +243,10 @@ exifHeader hdr = do

238243 10 -> return (SignedRational . runGet getRational, 8)

239244 11 -> return (SingleFloat . runGet getWord32 {- TODO -}, 4)

240245 12 -> return (DoubleFloat . runGet getWord64 {- TODO -}, 8)

241− _ -> fail $ "Unknown data format " ++ show dataFormat

246+ _ -> throwError $ "Unknown data format " ++ show dataFormat

242247 let totalBytes = fromIntegral $ numComponents * bytesPerComponent

243− payload <- if totalBytes <= 4 -- data is right here

248+ payload <- lift $

249+ if totalBytes <= 4 -- data is right here

244250 then fmt <$>

245251 (getLazyByteString (fromIntegral totalBytes) <*

246252 skip (4 - totalBytes))

@@ -252,9 +258,9 @@ exifHeader hdr = do

252258 entries <- sequence $ replicate (fromIntegral numentries) ifdEntry

253259 subentries <- case lookup ExifOffset entries of

254260 Just (UnsignedLong offset) -> do

255− pos <- bytesRead

256− skip (fromIntegral offset - (fromIntegral pos - 8))

257− numsubentries <- getWord16

261+ pos <- lift bytesRead

262+ lift $ skip (fromIntegral offset - (fromIntegral pos - 8))

263+ numsubentries <- lift getWord16

258264 sequence $

259265 replicate (fromIntegral numsubentries) ifdEntry

260266 _ -> return []

src/Text/Pandoc/Parsing.hs+6−13

@@ -190,6 +190,8 @@ import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$))

190190import Data.Monoid

191191import Data.Maybe (catMaybes)

192192

193+import Text.Pandoc.Error

194+

193195type Parser t s = Parsec t s

194196

195197type ParserT = ParsecT

@@ -845,25 +847,16 @@ readWithM :: (Monad m, Functor m)

845847 => ParserT [Char] st m a -- ^ parser

846848 -> st -- ^ initial state

847849 -> String -- ^ input

848− -> m a

850+ -> m (Either PandocError a)

849851readWithM parser state input =

850− handleError <$> (runParserT parser state "source" input)

851− where

852− handleError (Left err') =

853− let errPos = errorPos err'

854− errLine = sourceLine errPos

855− errColumn = sourceColumn errPos

856− theline = (lines input ++ [""]) !! (errLine - 1)

857− in error $ "\nError at " ++ show err' ++ "\n" ++

858− theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++

859− "^"

860− handleError (Right result) = result

852+ mapLeft (ParsecError input) <$> runParserT parser state "source" input

853+

861854

862855-- | Parse a string with a given parser and state

863856readWith :: Parser [Char] st a

864857 -> st

865858 -> String

866− -> a

859+ -> Either PandocError a

867860readWith p t inp = runIdentity $ readWithM p t inp

868861

869862returnWarnings :: (Stream s m c)

src/Text/Pandoc/Pretty.hs+11−7

@@ -250,6 +250,11 @@ renderDoc :: (IsString a, Monoid a)

250250 => Doc -> DocState a

251251renderDoc = renderList . toList . unDoc

252252

253+data IsBlock = IsBlock Int [String]

254+

255+-- This would be nicer with a pattern synonym

256+-- pattern VBlock i s <- mkIsBlock -> Just (IsBlock ..)

257+

253258renderList :: (IsString a, Monoid a)

254259 => [D] -> DocState a

255260renderList [] = return ()

@@ -323,11 +328,11 @@ renderList (BreakingSpace : xs) = do

323328 outp 1 " "

324329 renderList xs'

325330

326−renderList (b1@Block{} : b2@Block{} : xs) =

327− renderList (mergeBlocks False b1 b2 : xs)

331+renderList (Block i1 s1 : Block i2 s2 : xs) =

332+ renderList (mergeBlocks False (IsBlock i1 s1) (IsBlock i2 s2) : xs)

328333

329−renderList (b1@Block{} : BreakingSpace : b2@Block{} : xs) =

330− renderList (mergeBlocks True b1 b2 : xs)

334+renderList (Block i1 s1 : BreakingSpace : Block i2 s2 : xs) =

335+ renderList (mergeBlocks True (IsBlock i1 s1) (IsBlock i2 s2) : xs)

331336

332337renderList (Block width lns : xs) = do

333338 st <- get

@@ -339,15 +344,14 @@ renderList (Block width lns : xs) = do

339344 modify $ \s -> s{ prefix = oldPref }

340345 renderList xs

341346

342−mergeBlocks :: Bool -> D -> D -> D

343−mergeBlocks addSpace (Block w1 lns1) (Block w2 lns2) =

347+mergeBlocks :: Bool -> IsBlock -> IsBlock -> D

348+mergeBlocks addSpace (IsBlock w1 lns1) (IsBlock w2 lns2) =

344349 Block (w1 + w2 + if addSpace then 1 else 0) $

345350 zipWith (\l1 l2 -> pad w1 l1 ++ l2) (lns1 ++ empties) (map sp lns2 ++ empties)

346351 where empties = replicate (abs $ length lns1 - length lns2) ""

347352 pad n s = s ++ replicate (n - realLength s) ' '

348353 sp "" = ""

349354 sp xs = if addSpace then (' ' : xs) else xs

350−mergeBlocks _ _ _ = error "mergeBlocks tried on non-Block!"

351355

352356blockToDoc :: Int -> [String] -> Doc

353357blockToDoc _ lns = text $ intercalate "\n" lns

src/Text/Pandoc/Readers/CommonMark.hs+3−2

@@ -37,10 +37,11 @@ import Data.Text (unpack, pack)

3737import Data.List (groupBy)

3838import Text.Pandoc.Definition

3939import Text.Pandoc.Options

40+import Text.Pandoc.Error

4041

4142-- | Parse a CommonMark formatted string into a 'Pandoc' structure.

42−readCommonMark :: ReaderOptions -> String -> Pandoc

43−readCommonMark opts = nodeToPandoc . commonmarkToNode opts' . pack

43+readCommonMark :: ReaderOptions -> String -> Either PandocError Pandoc

44+readCommonMark opts = Right . nodeToPandoc . commonmarkToNode opts' . pack

4445 where opts' = if readerSmart opts

4546 then [optNormalize, optSmart]

4647 else [optNormalize]

src/Text/Pandoc/Readers/DocBook.hs+16−11

@@ -15,6 +15,9 @@ import Control.Applicative ((<$>))

1515import Data.List (intersperse)

1616import Data.Maybe (fromMaybe)

1717import Text.TeXMath (readMathML, writeTeX)

18+import Text.Pandoc.Error (PandocError)

19+import Text.Pandoc.Compat.Except

20+import Data.Default

1821

1922{-

2023

@@ -497,7 +500,7 @@ List of all DocBook tags, with [x] indicating implemented,

497500[x] ?asciidoc-br? - line break from asciidoc docbook output

498501-}

499502

500−type DB = State DBState

503+type DB = ExceptT PandocError (State DBState)

501504

502505data DBState = DBState{ dbSectionLevel :: Int

503506 , dbQuoteType :: QuoteType

@@ -507,16 +510,18 @@ data DBState = DBState{ dbSectionLevel :: Int

507510 , dbFigureTitle :: Inlines

508511 } deriving Show

509512

510−readDocBook :: ReaderOptions -> String -> Pandoc

511−readDocBook _ inp = Pandoc (dbMeta st') (toList $ mconcat bs)

512− where (bs, st') = runState (mapM parseBlock $ normalizeTree $ parseXML inp')

513− DBState{ dbSectionLevel = 0

514− , dbQuoteType = DoubleQuote

515− , dbMeta = mempty

516− , dbAcceptsMeta = False

517− , dbBook = False

518− , dbFigureTitle = mempty

519− }

513+instance Default DBState where

514+ def = DBState{ dbSectionLevel = 0

515+ , dbQuoteType = DoubleQuote

516+ , dbMeta = mempty

517+ , dbAcceptsMeta = False

518+ , dbBook = False

519+ , dbFigureTitle = mempty }

520+

521+

522+readDocBook :: ReaderOptions -> String -> Either PandocError Pandoc

523+readDocBook _ inp = (\blocks -> Pandoc (dbMeta st') (toList . mconcat $ blocks)) <$> bs

524+ where (bs , st') = flip runState def . runExceptT . mapM parseBlock . normalizeTree . parseXML $ inp'

520525 inp' = handleInstructions inp

521526

522527-- We treat <?asciidoc-br?> specially (issue #1236), converting it

src/Text/Pandoc/Readers/Docx.hs+11−8

@@ -96,14 +96,17 @@ import Control.Applicative ((<$>))

9696import Data.Sequence (ViewL(..), viewl)

9797import qualified Data.Sequence as Seq (null)

9898

99+import Text.Pandoc.Error

100+import Text.Pandoc.Compat.Except

101+

99102readDocx :: ReaderOptions

100103 -> B.ByteString

101− -> (Pandoc, MediaBag)

104+ -> Either PandocError (Pandoc, MediaBag)

102105readDocx opts bytes =

103106 case archiveToDocx (toArchive bytes) of

104− Right docx -> (Pandoc meta blks, mediaBag) where

105− (meta, blks, mediaBag) = (docxToOutput opts docx)

106− Left _ -> error $ "couldn't parse docx file"

107+ Right docx -> (\(meta, blks, mediaBag) -> (Pandoc meta blks, mediaBag))

108+ <$> (docxToOutput opts docx)

109+ Left _ -> Left (ParseFailure "couldn't parse docx file")

107110

108111data DState = DState { docxAnchorMap :: M.Map String String

109112 , docxMediaBag :: MediaBag

@@ -122,10 +125,10 @@ data DEnv = DEnv { docxOptions :: ReaderOptions

122125instance Default DEnv where

123126 def = DEnv def False

124127

125−type DocxContext = ReaderT DEnv (State DState)

128+type DocxContext = ExceptT PandocError (ReaderT DEnv (State DState))

126129

127−evalDocxContext :: DocxContext a -> DEnv -> DState -> a

128−evalDocxContext ctx env st = evalState (runReaderT ctx env) st

130+evalDocxContext :: DocxContext a -> DEnv -> DState -> Either PandocError a

131+evalDocxContext ctx env st = flip evalState st . flip runReaderT env . runExceptT $ ctx

129132

130133-- This is empty, but we put it in for future-proofing.

131134spansToKeep :: [String]

@@ -551,7 +554,7 @@ bodyToOutput (Body bps) = do

551554 blks',

552555 mediaBag)

553556

554−docxToOutput :: ReaderOptions -> Docx -> (Meta, [Block], MediaBag)

557+docxToOutput :: ReaderOptions -> Docx -> Either PandocError (Meta, [Block], MediaBag)

555558docxToOutput opts (Docx (Document _ body)) =

556559 let dEnv = def { docxOptions = opts} in

557560 evalDocxContext (bodyToOutput body) dEnv def

src/Text/Pandoc/Readers/EPUB.hs+20−17

@@ -35,18 +35,20 @@ import Control.DeepSeq.Generics (deepseq, NFData)

3535

3636import Debug.Trace (trace)

3737

38+import Text.Pandoc.Error

39+

3840type Items = M.Map String (FilePath, MimeType)

3941

40−readEPUB :: ReaderOptions -> BL.ByteString -> (Pandoc, MediaBag)

42+readEPUB :: ReaderOptions -> BL.ByteString -> Either PandocError (Pandoc, MediaBag)

4143readEPUB opts bytes = runEPUB (archiveToEPUB opts $ toArchive bytes)

4244

43−runEPUB :: Except String a -> a

44−runEPUB = either error id . runExcept

45+runEPUB :: Except PandocError a -> Either PandocError a

46+runEPUB = runExcept

4547

4648-- Note that internal reference are aggresively normalised so that all ids

4749-- are of the form "filename#id"

4850--

49−archiveToEPUB :: (MonadError String m) => ReaderOptions -> Archive -> m (Pandoc, MediaBag)

51+archiveToEPUB :: (MonadError PandocError m) => ReaderOptions -> Archive -> m (Pandoc, MediaBag)

5052archiveToEPUB os archive = do

5153 -- root is path to folder with manifest file in

5254 (root, content) <- getManifest archive

@@ -64,19 +66,20 @@ archiveToEPUB os archive = do

6466 return $ (ast, mediaBag)

6567 where

6668 os' = os {readerParseRaw = True}

67− parseSpineElem :: MonadError String m => FilePath -> (FilePath, MimeType) -> m Pandoc

69+ parseSpineElem :: MonadError PandocError m => FilePath -> (FilePath, MimeType) -> m Pandoc

6870 parseSpineElem (normalise -> r) (normalise -> path, mime) = do

6971 when (readerTrace os) (traceM path)

7072 doc <- mimeToReader mime r path

7173 let docSpan = B.doc $ B.para $ B.spanWith (takeFileName path, [], []) mempty

7274 return $ docSpan <> doc

73− mimeToReader :: MonadError String m => MimeType -> FilePath -> FilePath -> m Pandoc

75+ mimeToReader :: MonadError PandocError m => MimeType -> FilePath -> FilePath -> m Pandoc

7476 mimeToReader "application/xhtml+xml" (normalise -> root) (normalise -> path) = do

7577 fname <- findEntryByPathE (root </> path) archive

76− return $ fixInternalReferences path .

78+ html <- either throwError return .

7779 readHtml os' .

7880 UTF8.toStringLazy $

7981 fromEntry fname

82+ return $ fixInternalReferences path html

8083 mimeToReader s _ path

8184 | s `elem` imageMimes = return $ imageToPandoc path

8285 | otherwise = return $ mempty

@@ -114,7 +117,7 @@ imageMimes = ["image/gif", "image/jpeg", "image/png"]

114117

115118type CoverImage = FilePath

116119

117−parseManifest :: (MonadError String m) => Element -> m (Maybe CoverImage, Items)

120+parseManifest :: (MonadError PandocError m) => Element -> m (Maybe CoverImage, Items)

118121parseManifest content = do

119122 manifest <- findElementE (dfName "manifest") content

120123 let items = findChildren (dfName "item") manifest

@@ -130,7 +133,7 @@ parseManifest content = do

130133 mime <- findAttrE (emptyName "media-type") e

131134 return (uid, (href, mime))

132135

133−parseSpine :: MonadError String m => Items -> Element -> m [(FilePath, MimeType)]

136+parseSpine :: MonadError PandocError m => Items -> Element -> m [(FilePath, MimeType)]

134137parseSpine is e = do

135138 spine <- findElementE (dfName "spine") e

136139 let itemRefs = findChildren (dfName "itemref") spine

@@ -141,7 +144,7 @@ parseSpine is e = do

141144 guard linear

142145 findAttr (emptyName "idref") ref

143146

144−parseMeta :: MonadError String m => Element -> m Meta

147+parseMeta :: MonadError PandocError m => Element -> m Meta

145148parseMeta content = do

146149 meta <- findElementE (dfName "metadata") content

147150 let dcspace (QName _ (Just "http://purl.org/dc/elements/1.1/") (Just "dc")) = True

@@ -159,7 +162,7 @@ renameMeta :: String -> String

159162renameMeta "creator" = "author"

160163renameMeta s = s

161164

162−getManifest :: MonadError String m => Archive -> m (String, Element)

165+getManifest :: MonadError PandocError m => Archive -> m (String, Element)

163166getManifest archive = do

164167 metaEntry <- findEntryByPathE ("META-INF" </> "container.xml") archive

165168 docElem <- (parseXMLDocE . UTF8.toStringLazy . fromEntry) metaEntry

@@ -266,18 +269,18 @@ emptyName s = QName s Nothing Nothing

266269

267270-- Convert Maybe interface to Either

268271

269−findAttrE :: MonadError String m => QName -> Element -> m String

272+findAttrE :: MonadError PandocError m => QName -> Element -> m String

270273findAttrE q e = mkE "findAttr" $ findAttr q e

271274

272−findEntryByPathE :: MonadError String m => FilePath -> Archive -> m Entry

275+findEntryByPathE :: MonadError PandocError m => FilePath -> Archive -> m Entry

273276findEntryByPathE (normalise -> path) a =

274277 mkE ("No entry on path: " ++ path) $ findEntryByPath path a

275278

276−parseXMLDocE :: MonadError String m => String -> m Element

279+parseXMLDocE :: MonadError PandocError m => String -> m Element

277280parseXMLDocE doc = mkE "Unable to parse XML doc" $ parseXMLDoc doc

278281

279−findElementE :: MonadError String m => QName -> Element -> m Element

282+findElementE :: MonadError PandocError m => QName -> Element -> m Element

280283findElementE e x = mkE ("Unable to find element: " ++ show e) $ findElement e x

281284

282−mkE :: MonadError String m => String -> Maybe a -> m a

283−mkE s = maybe (throwError s) return

285+mkE :: MonadError PandocError m => String -> Maybe a -> m a

286+mkE s = maybe (throwError . ParseFailure $ s) return

src/Text/Pandoc/Readers/HTML.hs+13−6

@@ -1,4 +1,5 @@

1−{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}

1+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,

2+ViewPatterns#-}

23{-

45

@@ -43,7 +44,7 @@ import Text.Pandoc.Definition

4344import qualified Text.Pandoc.Builder as B

4445import Text.Pandoc.Builder (Blocks, Inlines, trimInlines, HasMeta(..))

4546import Text.Pandoc.Shared ( extractSpaces, renderTags'

46− , escapeURI, safeRead )

47+ , escapeURI, safeRead, mapLeft )

4748import Text.Pandoc.Options (ReaderOptions(readerParseRaw, readerTrace)

4849 , Extension (Ext_epub_html_exts,

4950 Ext_native_divs, Ext_native_spans))

@@ -62,15 +63,18 @@ import Text.TeXMath (readMathML, writeTeX)

6263import Data.Default (Default (..), def)

6364import Control.Monad.Reader (Reader,ask, asks, local, runReader)

6465

66+import Text.Pandoc.Error

67+

68+import Text.Parsec.Error

69+

6570

6671-- | Convert HTML-formatted string to 'Pandoc' document.

6772readHtml :: ReaderOptions -- ^ Reader options

6873 -> String -- ^ String to parse (assumes @'\n'@ line endings)

69− -> Pandoc

74+ -> Either PandocError Pandoc

7075readHtml opts inp =

71− case flip runReader def $ runParserT parseDoc (HTMLState def{ stateOptions = opts } []) "source" tags of

72− Left err' -> error $ "\nError at " ++ show err'

73− Right result -> result

76+ mapLeft (ParseFailure . getError) . flip runReader def $

77+ runParserT parseDoc (HTMLState def{ stateOptions = opts } []) "source" tags

7478 where tags = stripPrefixes . canonicalizeTags $

7579 parseTagsOptions parseOptions{ optTagPosition = True } inp

7680 parseDoc = do

@@ -78,6 +82,9 @@ readHtml opts inp =

7882 meta <- stateMeta . parserState <$> getState

7983 bs' <- replaceNotes (B.toList blocks)

8084 return $ Pandoc meta bs'

85+ getError (errorMessages -> ms) = case ms of

86+ [] -> ""

87+ (m:_) -> messageString m

8188

8289replaceNotes :: [Block] -> TagParser [Block]

8390replaceNotes = walkM replaceNotes'

src/Text/Pandoc/Readers/Haddock.hs+5−3

@@ -26,15 +26,17 @@ import Documentation.Haddock.Parser

2626import Documentation.Haddock.Types

2727import Debug.Trace (trace)

2828

29+import Text.Pandoc.Error

30+

2931-- | Parse Haddock markup and return a 'Pandoc' document.

3032readHaddock :: ReaderOptions -- ^ Reader options

3133 -> String -- ^ String to parse

32− -> Pandoc

34+ -> Either PandocError Pandoc

3335readHaddock opts =

3436#if MIN_VERSION_haddock_library(1,2,0)

35− B.doc . docHToBlocks . trace' . _doc . parseParas

37+ Right . B.doc . docHToBlocks . trace' . _doc . parseParas

3638#else

37− B.doc . docHToBlocks . trace' . parseParas

39+ Right . B.doc . docHToBlocks . trace' . parseParas

3840#endif

3941 where trace' x = if readerTrace opts

4042 then trace (show x) x

src/Text/Pandoc/Readers/LaTeX.hs+4−7

@@ -57,11 +57,12 @@ import qualified Data.Map as M

5757import qualified Control.Exception as E

5858import System.FilePath (takeExtension, addExtension)

5959import Text.Pandoc.Highlighting (fromListingsLanguage)

60+import Text.Pandoc.Error

6061

6162-- | Parse LaTeX from string and return 'Pandoc' document.

6263readLaTeX :: ReaderOptions -- ^ Reader options

6364 -> String -- ^ String to parse (assumes @'\n'@ line endings)

64− -> Pandoc

65+ -> Either PandocError Pandoc

6566readLaTeX opts = readWith parseLaTeX def{ stateOptions = opts }

6667

6768parseLaTeX :: LP Pandoc

@@ -853,12 +854,8 @@ rawEnv name = do

853854type IncludeParser = ParserT [Char] [String] IO String

854855

855856-- | Replace "include" commands with file contents.

856−handleIncludes :: String -> IO String

857−handleIncludes s = do

858− res <- runParserT includeParser' [] "input" s

859− case res of

860− Right s' -> return s'

861− Left e -> error $ show e

857+handleIncludes :: String -> IO (Either PandocError String)

858+handleIncludes s = mapLeft (ParsecError s) <$> runParserT includeParser' [] "input" s

862859

863860includeParser' :: IncludeParser

864861includeParser' =

src/Text/Pandoc/Readers/Markdown.hs+40−32

@@ -1,4 +1,5 @@

11{-# LANGUAGE RelaxedPolyRec #-} -- needed for inlinesBetween on GHC < 7

2+{-# LANGUAGE ScopedTypeVariables #-}

23{-

45

@@ -64,13 +65,14 @@ import Text.HTML.TagSoup.Match (tagOpen)

6465import qualified Data.Set as Set

6566import Text.Printf (printf)

6667import Debug.Trace (trace)

68+import Text.Pandoc.Error

6769

6870type MarkdownParser a = ParserT [Char] ParserState (Reader ParserState) a

6971

7072-- | Read markdown from an input string and return a Pandoc document.

7173readMarkdown :: ReaderOptions -- ^ Reader options

7274 -> String -- ^ String to parse (assuming @'\n'@ line endings)

73− -> Pandoc

75+ -> Either PandocError Pandoc

7476readMarkdown opts s =

7577 runMarkdown opts s parseMarkdown

7678

@@ -78,16 +80,17 @@ readMarkdown opts s =

7880-- and a list of warnings.

7981readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options

8082 -> String -- ^ String to parse (assuming @'\n'@ line endings)

81− -> (Pandoc, [String])

83+ -> Either PandocError (Pandoc, [String])

8284readMarkdownWithWarnings opts s = runMarkdown opts s (returnWarnings parseMarkdown)

8385

84−runMarkdown :: ReaderOptions -> String -> MarkdownParser a -> a

85−runMarkdown opts inp p = fst res

86+runMarkdown :: forall a . ReaderOptions -> String -> MarkdownParser a -> Either PandocError a

87+runMarkdown opts inp p = fst <$> res

8688 where

8789 imd = readWithM (returnState p) def{ stateOptions = opts } (inp ++ "\n\n")

90+ res :: Either PandocError (a, ParserState)

8891 res = runReader imd s

8992 s :: ParserState

90− s = snd $ runReader imd s

93+ s = either def snd res

9194

9295--

9396-- Constants and data structure definitions

@@ -246,8 +249,9 @@ yamlMetaBlock = try $ do

246249 H.foldrWithKey (\k v m ->

247250 if ignorable k

248251 then m

249− else B.setMeta (T.unpack k)

250− (yamlToMeta opts v) m)

252+ else case yamlToMeta opts v of

253+ Left _ -> m

254+ Right v' -> B.setMeta (T.unpack k) v' m)

251255 nullMeta hashmap

252256 Right Yaml.Null -> return nullMeta

253257 Right _ -> do

@@ -279,38 +283,42 @@ yamlMetaBlock = try $ do

279283ignorable :: Text -> Bool

280284ignorable t = T.pack "_" `T.isSuffixOf` t

281285

282−toMetaValue :: ReaderOptions -> Text -> MetaValue

283−toMetaValue opts x =

284− case readMarkdown opts' (T.unpack x) of

285− Pandoc _ [Plain xs] -> MetaInlines xs

286− Pandoc _ [Para xs]

286+toMetaValue :: ReaderOptions -> Text -> Either PandocError MetaValue

287+toMetaValue opts x = toMeta <$> readMarkdown opts' (T.unpack x)

288+ where

289+ toMeta p =

290+ case p of

291+ Pandoc _ [Plain xs] -> MetaInlines xs

292+ Pandoc _ [Para xs]

287293 | endsWithNewline x -> MetaBlocks [Para xs]

288294 | otherwise -> MetaInlines xs

289− Pandoc _ bs -> MetaBlocks bs

290− where endsWithNewline t = T.pack "\n" `T.isSuffixOf` t

291− opts' = opts{readerExtensions=readerExtensions opts `Set.difference` meta_exts}

292− meta_exts = Set.fromList [ Ext_pandoc_title_block

293− , Ext_mmd_title_block

294− , Ext_yaml_metadata_block

295− ]

296−

297−yamlToMeta :: ReaderOptions -> Yaml.Value -> MetaValue

295+ Pandoc _ bs -> MetaBlocks bs

296+ endsWithNewline t = T.pack "\n" `T.isSuffixOf` t

297+ opts' = opts{readerExtensions=readerExtensions opts `Set.difference` meta_exts}

298+ meta_exts = Set.fromList [ Ext_pandoc_title_block

299+ , Ext_mmd_title_block

300+ , Ext_yaml_metadata_block

301+ ]

302+

303+yamlToMeta :: ReaderOptions -> Yaml.Value -> Either PandocError MetaValue

298304yamlToMeta opts (Yaml.String t) = toMetaValue opts t

299305yamlToMeta _ (Yaml.Number n)

300306 -- avoid decimal points for numbers that don't need them:

301− | base10Exponent n >= 0 = MetaString $ show

307+ | base10Exponent n >= 0 = return $ MetaString $ show

302308 $ coefficient n * (10 ^ base10Exponent n)

303− | otherwise = MetaString $ show n

304−yamlToMeta _ (Yaml.Bool b) = MetaBool b

305−yamlToMeta opts (Yaml.Array xs) = B.toMetaValue $ map (yamlToMeta opts)

306− $ V.toList xs

307−yamlToMeta opts (Yaml.Object o) = MetaMap $ H.foldrWithKey (\k v m ->

309+ | otherwise = return $ MetaString $ show n

310+yamlToMeta _ (Yaml.Bool b) = return $ MetaBool b

311+yamlToMeta opts (Yaml.Array xs) = B.toMetaValue <$> mapM (yamlToMeta opts)

312+ (V.toList xs)

313+yamlToMeta opts (Yaml.Object o) = MetaMap <$> H.foldrWithKey (\k v m ->

308314 if ignorable k

309315 then m

310− else M.insert (T.unpack k)

311− (yamlToMeta opts v) m)

312− M.empty o

313−yamlToMeta _ _ = MetaString ""

316+ else (do

317+ v' <- yamlToMeta opts v

318+ m' <- m

319+ return (M.insert (T.unpack k) v' m')))

320+ (return M.empty) o

321+yamlToMeta _ _ = return $ MetaString ""

314322

315323stopLine :: MarkdownParser ()

316324stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()

@@ -466,6 +474,7 @@ block = do

466474 res <- choice [ mempty <$ blanklines

467475 , codeBlockFenced

468476 , yamlMetaBlock

477+ , guardEnabled Ext_latex_macros *> macro

469478 -- note: bulletList needs to be before header because of

470479 -- the possibility of empty list items: -

471480 , bulletList

@@ -475,7 +484,6 @@ block = do

475484 , htmlBlock

476485 , table

477486 , codeBlockIndented

478− , guardEnabled Ext_latex_macros *> macro

479487 , rawTeXBlock

480488 , lineBlock

481489 , blockQuote

src/Text/Pandoc/Readers/MediaWiki.hs+5−5

@@ -58,21 +58,21 @@ import Data.Maybe (fromMaybe)

5858import Text.Printf (printf)

5959import Debug.Trace (trace)

6060

61+import Text.Pandoc.Error

62+

6163-- | Read mediawiki from an input string and return a Pandoc document.

6264readMediaWiki :: ReaderOptions -- ^ Reader options

6365 -> String -- ^ String to parse (assuming @'\n'@ line endings)

64− -> Pandoc

66+ -> Either PandocError Pandoc

6567readMediaWiki opts s =

66− case runParser parseMediaWiki MWState{ mwOptions = opts

68+ readWith parseMediaWiki MWState{ mwOptions = opts

6769 , mwMaxNestingLevel = 4

6870 , mwNextLinkNumber = 1

6971 , mwCategoryLinks = []

7072 , mwHeaderMap = M.empty

7173 , mwIdentifierList = []

7274 }

73− "source" (s ++ "\n") of

74− Left err' -> error $ "\nError:\n" ++ show err'

75− Right result -> result

75+ (s ++ "\n")

7676

7777data MWState = MWState { mwOptions :: ReaderOptions

7878 , mwMaxNestingLevel :: Int

src/Text/Pandoc/Readers/Native.hs+14−26

33

44This program is free software; you can redistribute it and/or modify

55it under the terms of the GNU General Public License as published by

6−the Free Software Foundation; either version 2 of the License, or

6+the Free Software Foundation; Either version 2 of the License, or

77(at your option) any later version.

88

99This program is distributed in the hope that it will be useful,

@@ -33,6 +33,9 @@ module Text.Pandoc.Readers.Native ( readNative ) where

3333import Text.Pandoc.Definition

3434import Text.Pandoc.Shared (safeRead)

3535

36+import Text.Pandoc.Error

37+import Control.Applicative

38+

3639-- | Read native formatted text and return a Pandoc document.

3740-- The input may be a full pandoc document, a block list, a block,

3841-- an inline list, or an inline. Thus, for example,

@@ -44,33 +47,18 @@ import Text.Pandoc.Shared (safeRead)

4447-- > Pandoc nullMeta [Plain [Str "hi"]]

4548--

4649readNative :: String -- ^ String to parse (assuming @'\n'@ line endings)

47− -> Pandoc

48−readNative s =

49− case safeRead s of

50− Just d -> d

51− Nothing -> Pandoc nullMeta $ readBlocks s

50+ -> Either PandocError Pandoc

51+readNative s = maybe (Pandoc nullMeta <$> readBlocks s) Right (safeRead s)

5252

53−readBlocks :: String -> [Block]

54−readBlocks s =

55− case safeRead s of

56− Just d -> d

57− Nothing -> [readBlock s]

53+readBlocks :: String -> Either PandocError [Block]

54+readBlocks s = maybe ((:[]) <$> readBlock s) Right (safeRead s)

5855

59−readBlock :: String -> Block

60−readBlock s =

61− case safeRead s of

62− Just d -> d

63− Nothing -> Plain $ readInlines s

56+readBlock :: String -> Either PandocError Block

57+readBlock s = maybe (Plain <$> readInlines s) Right (safeRead s)

6458

65−readInlines :: String -> [Inline]

66−readInlines s =

67− case safeRead s of

68− Just d -> d

69− Nothing -> [readInline s]

59+readInlines :: String -> Either PandocError [Inline]

60+readInlines s = maybe ((:[]) <$> readInline s) Right (safeRead s)

7061

71−readInline :: String -> Inline

72−readInline s =

73− case safeRead s of

74− Just d -> d

75− Nothing -> error "Cannot parse document"

62+readInline :: String -> Either PandocError Inline

63+readInline s = maybe (Left . ParseFailure $ "Could not read: " ++ s) Right (safeRead s)

7664

src/Text/Pandoc/Readers/OPML.hs+28−20

@@ -1,3 +1,4 @@

1+{-# LANGUAGE FlexibleContexts #-}

12module Text.Pandoc.Readers.OPML ( readOPML ) where

23import Data.Char (toUpper)

34import Text.Pandoc.Options

@@ -11,8 +12,11 @@ import Data.Generics

1112import Data.Monoid

1213import Control.Monad.State

1314import Control.Applicative ((<$>), (<$))

15+import Data.Default

16+import Text.Pandoc.Compat.Except

17+import Text.Pandoc.Error

1418

15−type OPML = State OPMLState

19+type OPML = ExceptT PandocError (State OPMLState)

1620

1721data OPMLState = OPMLState{

1822 opmlSectionLevel :: Int

@@ -21,17 +25,19 @@ data OPMLState = OPMLState{

2125 , opmlDocDate :: Inlines

2226 } deriving Show

2327

24−readOPML :: ReaderOptions -> String -> Pandoc

28+instance Default OPMLState where

29+ def = OPMLState{ opmlSectionLevel = 0

30+ , opmlDocTitle = mempty

31+ , opmlDocAuthors = []

32+ , opmlDocDate = mempty

33+ }

34+

35+readOPML :: ReaderOptions -> String -> Either PandocError Pandoc

2536readOPML _ inp = setTitle (opmlDocTitle st')

26− $ setAuthors (opmlDocAuthors st')

27− $ setDate (opmlDocDate st')

28− $ doc $ mconcat bs

29− where (bs, st') = runState (mapM parseBlock $ normalizeTree $ parseXML inp)

30− OPMLState{ opmlSectionLevel = 0

31− , opmlDocTitle = mempty

32− , opmlDocAuthors = []

33− , opmlDocDate = mempty

34− }

37+ . setAuthors (opmlDocAuthors st')

38+ . setDate (opmlDocDate st')

39+ . doc . mconcat <$> bs

40+ where (bs, st') = flip runState def . runExceptT $ (mapM parseBlock $ normalizeTree $ parseXML inp)

3541

3642-- normalize input, consolidating adjacent Text and CRef elements

3743normalizeTree :: [Content] -> [Content]

@@ -58,14 +64,16 @@ attrValue attr elt =

5864 Just z -> z

5965 Nothing -> ""

6066

61−asHtml :: String -> Inlines

62−asHtml s = case readHtml def s of

63− Pandoc _ [Plain ils] -> fromList ils

64− _ -> mempty

67+exceptT :: Either PandocError a -> OPML a

68+exceptT = either throwError return

69+

70+asHtml :: String -> OPML Inlines

71+asHtml s = (\(Pandoc _ bs) -> case bs of

72+ [Plain ils] -> fromList ils

73+ _ -> mempty) <$> exceptT (readHtml def s)

6574

66−asMarkdown :: String -> Blocks

67−asMarkdown s = fromList bs

68− where Pandoc _ bs = readMarkdown def s

75+asMarkdown :: String -> OPML Blocks

76+asMarkdown s = (\(Pandoc _ bs) -> fromList bs) <$> exceptT (readMarkdown def s)

6977

7078getBlocks :: Element -> OPML Blocks

7179getBlocks e = mconcat <$> (mapM parseBlock $ elContent e)

@@ -82,8 +90,8 @@ parseBlock (Elem e) =

8290 "outline" -> gets opmlSectionLevel >>= sect . (+1)

8391 "?xml" -> return mempty

8492 _ -> getBlocks e

85− where sect n = do let headerText = asHtml $ attrValue "text" e

86− let noteBlocks = asMarkdown $ attrValue "_note" e

93+ where sect n = do headerText <- asHtml $ attrValue "text" e

94+ noteBlocks <- asMarkdown $ attrValue "_note" e

8795 modify $ \st -> st{ opmlSectionLevel = n }

8896 bs <- getBlocks e

8997 modify $ \st -> st{ opmlSectionLevel = n - 1 }

src/Text/Pandoc/Readers/Org.hs+12−12

@@ -60,10 +60,12 @@ import Data.Maybe (fromMaybe, isJust)

6060import Data.Monoid (mconcat, mempty, mappend)

6161import Network.HTTP (urlEncode)

6262

63+import Text.Pandoc.Error

64+

6365-- | Parse org-mode string and return a Pandoc document.

6466readOrg :: ReaderOptions -- ^ Reader options

6567 -> String -- ^ String to parse (assuming @'\n'@ line endings)

66− -> Pandoc

68+ -> Either PandocError Pandoc

6769readOrg opts s = runOrg opts s parseOrg

6870

6971data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext

@@ -71,13 +73,13 @@ data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext

7173

7274type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)

7375

74−runOrg :: ReaderOptions -> String -> OrgParser a -> a

75−runOrg opts inp p = fst res

76+runOrg :: ReaderOptions -> String -> OrgParser a -> Either PandocError a

77+runOrg opts inp p = fst <$> res

7678 where

7779 imd = readWithM (returnState p) def{ orgStateOptions = opts } (inp ++ "\n\n")

7880 res = runReader imd def { finalState = s }

7981 s :: OrgParserState

80− s = snd $ runReader imd (def { finalState = s })

82+ s = either def snd res

8183

8284parseOrg :: OrgParser Pandoc

8385parseOrg = do

@@ -1259,17 +1261,15 @@ math = B.math <$> choice [ math1CharBetween '$'

12591261

12601262displayMath :: OrgParser Inlines

12611263displayMath = B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"

1262− , rawMathBetween "$$" "$$" ]

1263−

1264−updatePositions :: Char

1265− -> OrgParser (Char)

1266−updatePositions c = do

1267− when (c `elem` emphasisPreChars) updateLastPreCharPos

1268− when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos

1269− return c

1264+ , rawMathBetween "$$" "$$"

1265+ ]

12701266

12711267symbol :: OrgParser Inlines

12721268symbol = B.str . (: "") <$> (oneOf specialChars >>= updatePositions)

1269+ where updatePositions c = do

1270+ when (c `elem` emphasisPreChars) updateLastPreCharPos

1271+ when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos

1272+ return c

12731273

12741274emphasisBetween :: Char

12751275 -> OrgParser Inlines

src/Text/Pandoc/Readers/RST.hs+4−2

@@ -51,13 +51,15 @@ import Data.Monoid (mconcat, mempty)

5151import Data.Sequence (viewr, ViewR(..))

5252import Data.Char (toLower, isHexDigit, isSpace)

5353

54+import Text.Pandoc.Error

55+

5456-- | Parse reStructuredText string and return Pandoc document.

5557readRST :: ReaderOptions -- ^ Reader options

5658 -> String -- ^ String to parse (assuming @'\n'@ line endings)

57− -> Pandoc

59+ -> Either PandocError Pandoc

5860readRST opts s = (readWith parseRST) def{ stateOptions = opts } (s ++ "\n\n")

5961

60−readRSTWithWarnings :: ReaderOptions -> String -> (Pandoc, [String])

62+readRSTWithWarnings :: ReaderOptions -> String -> Either PandocError (Pandoc, [String])

6163readRSTWithWarnings opts s = (readWith (returnWarnings parseRST)) def{ stateOptions = opts } (s ++ "\n\n")

6264

6365type RSTParser = Parser [Char] ParserState

src/Text/Pandoc/Readers/TWiki.hs+3−2

@@ -48,17 +48,18 @@ import Data.Maybe (fromMaybe)

4848import Text.HTML.TagSoup

4949import Data.Char (isAlphaNum)

5050import qualified Data.Foldable as F

51+import Text.Pandoc.Error

5152

5253-- | Read twiki from an input string and return a Pandoc document.

5354readTWiki :: ReaderOptions -- ^ Reader options

5455 -> String -- ^ String to parse (assuming @'\n'@ line endings)

55− -> Pandoc

56+ -> Either PandocError Pandoc

5657readTWiki opts s =

5758 (readWith parseTWiki) def{ stateOptions = opts } (s ++ "\n\n")

5859

5960readTWikiWithWarnings :: ReaderOptions -- ^ Reader options

6061 -> String -- ^ String to parse (assuming @'\n'@ line endings)

61− -> (Pandoc, [String])

62+ -> Either PandocError (Pandoc, [String])

6263readTWikiWithWarnings opts s =

6364 (readWith parseTWikiWithWarnings) def{ stateOptions = opts } (s ++ "\n\n")

6465 where parseTWikiWithWarnings = do

src/Text/Pandoc/Readers/Textile.hs+2−1

@@ -68,11 +68,12 @@ import Text.Printf

6868import Control.Applicative ((<$>), (*>), (<*), (<$))

6969import Data.Monoid

7070import Debug.Trace (trace)

71+import Text.Pandoc.Error

7172

7273-- | Parse a Textile text and return a Pandoc document.

7374readTextile :: ReaderOptions -- ^ Reader options

7475 -> String -- ^ String to parse (assuming @'\n'@ line endings)

75− -> Pandoc

76+ -> Either PandocError Pandoc

7677readTextile opts s =

7778 (readWith parseTextile) def{ stateOptions = opts } (s ++ "\n\n")

7879

src/Text/Pandoc/Readers/Txt2Tags.hs+3−2

@@ -48,6 +48,7 @@ import Data.Monoid (Monoid, mconcat, mempty, mappend)

4848import Control.Monad (void, guard, when)

4949import Data.Default

5050import Control.Monad.Reader (Reader, runReader, asks)

51+import Text.Pandoc.Error

5152

5253import Data.Time.LocalTime (getZonedTime)

5354import Text.Pandoc.Compat.Directory(getModificationTime)

@@ -83,12 +84,12 @@ getT2TMeta inps out = do

8384 return $ T2TMeta curDate curMtime (intercalate ", " inps) out

8485

8586-- | Read Txt2Tags from an input string returning a Pandoc document

86−readTxt2Tags :: T2TMeta -> ReaderOptions -> String -> Pandoc

87+readTxt2Tags :: T2TMeta -> ReaderOptions -> String -> Either PandocError Pandoc

8788readTxt2Tags t opts s = flip runReader t $ readWithM parseT2T (def {stateOptions = opts}) (s ++ "\n\n")

8889

8990-- | Read Txt2Tags (ignoring all macros) from an input string returning

9091-- a Pandoc document

91−readTxt2TagsNoMacros :: ReaderOptions -> String -> Pandoc

92+readTxt2TagsNoMacros :: ReaderOptions -> String -> Either PandocError Pandoc

9293readTxt2TagsNoMacros = readTxt2Tags def

9394

9495parseT2T :: T2T Pandoc

src/Text/Pandoc/Shared.hs+13−3

@@ -85,6 +85,8 @@ module Text.Pandoc.Shared (

8585 -- * Error handling

8686 err,

8787 warn,

88+ mapLeft,

89+ hush,

8890 -- * Safe read

8991 safeRead,

9092 -- * Temp directory

@@ -113,7 +115,7 @@ import System.FilePath ( (</>), takeExtension, dropExtension)

113115import Data.Generics (Typeable, Data)

114116import qualified Control.Monad.State as S

115117import qualified Control.Exception as E

116−import Control.Monad (msum, unless)

118+import Control.Monad (msum, unless, MonadPlus(..))

117119import Text.Pandoc.Pretty (charWidth)

118120import Text.Pandoc.Compat.Locale (defaultTimeLocale)

119121import Data.Time

@@ -855,6 +857,14 @@ warn msg = do

855857 name <- getProgName

856858 UTF8.hPutStrLn stderr $ name ++ ": " ++ msg

857859

860+mapLeft :: (a -> b) -> Either a c -> Either b c

861+mapLeft f (Left x) = Left (f x)

862+mapLeft _ (Right x) = Right x

863+

864+hush :: Either a b -> Maybe b

865+hush (Left _) = Nothing

866+hush (Right x) = Just x

867+

858868-- | Remove intermediate "." and ".." directories from a path.

859869--

860870-- > collapseFilePath "./foo" == "foo"

@@ -883,11 +893,11 @@ collapseFilePath = joinPath . reverse . foldl go [] . splitDirectories

883893-- Safe read

884894--

885895

886−safeRead :: (Monad m, Read a) => String -> m a

896+safeRead :: (MonadPlus m, Read a) => String -> m a

887897safeRead s = case reads s of

888898 (d,x):_

889899 | all isSpace x -> return d

890− _ -> fail $ "Could not read `" ++ s ++ "'"

900+ _ -> mzero

891901

892902--

893903-- Temp directory

tests/Tests/Old.hs+2−1

@@ -18,6 +18,7 @@ import Prelude hiding ( readFile )

1818import qualified Data.ByteString.Lazy as B

1919import Text.Pandoc.UTF8 (toStringLazy)

2020import Text.Printf

21+import Text.Pandoc.Error

2122

2223readFileUTF8 :: FilePath -> IO String

2324readFileUTF8 f = B.readFile f >>= return . toStringLazy

@@ -182,7 +183,7 @@ lhsReaderTest :: String -> Test

182183lhsReaderTest format =

183184 testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"]

184185 ("lhs-test" <.> format) norm

185− where normalizer = writeNative def . normalize . readNative

186+ where normalizer = writeNative def . normalize . handleError . readNative

186187 norm = if format == "markdown+lhs"

187188 then "lhs-test-markdown.native"

188189 else "lhs-test.native"

tests/Tests/Readers/Docx.hs+4−3

@@ -13,6 +13,7 @@ import Text.Pandoc.Writers.Native (writeNative)

1313import qualified Data.Map as M

1414import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory)

1515import Codec.Archive.Zip

16+import Text.Pandoc.Error

1617

1718-- We define a wrapper around pandoc that doesn't normalize in the

1819-- tests. Since we do our own normalization, we want to make sure

@@ -41,8 +42,8 @@ compareOutput :: ReaderOptions

4142compareOutput opts docxFile nativeFile = do

4243 df <- B.readFile docxFile

4344 nf <- Prelude.readFile nativeFile

44− let (p, _) = readDocx opts df

45− return $ (noNorm p, noNorm (readNative nf))

45+ let (p, _) = handleError $ readDocx opts df

46+ return $ (noNorm p, noNorm (handleError $ readNative nf))

4647

4748testCompareWithOptsIO :: ReaderOptions -> String -> FilePath -> FilePath -> IO Test

4849testCompareWithOptsIO opts name docxFile nativeFile = do

@@ -79,7 +80,7 @@ compareMediaPathIO mediaPath mediaBag docxPath = do

7980compareMediaBagIO :: FilePath -> IO Bool

8081compareMediaBagIO docxFile = do

8182 df <- B.readFile docxFile

82− let (_, mb) = readDocx def df

83+ let (_, mb) = handleError $ readDocx def df

8384 bools <- mapM

8485 (\(fp, _, _) -> compareMediaPathIO fp mb docxFile)

8586 (mediaDirectory mb)

tests/Tests/Readers/EPUB.hs+2−1

@@ -9,9 +9,10 @@ import Text.Pandoc.Readers.EPUB

99import Text.Pandoc.MediaBag (MediaBag, mediaDirectory)

1010import Control.Applicative

1111import System.FilePath (joinPath)

12+import Text.Pandoc.Error

1213

1314getMediaBag :: FilePath -> IO MediaBag

14−getMediaBag fp = snd . readEPUB def <$> BL.readFile fp

15+getMediaBag fp = snd . handleError . readEPUB def <$> BL.readFile fp

1516

1617testMediaBag :: FilePath -> [(String, String, Int)] -> IO ()

1718testMediaBag fp bag = do

tests/Tests/Readers/LaTeX.hs+2−1

@@ -8,9 +8,10 @@ import Tests.Arbitrary()

88import Text.Pandoc.Builder

99import Text.Pandoc

1010import Data.Monoid (mempty)

11+import Text.Pandoc.Error

1112

1213latex :: String -> Pandoc

13−latex = readLaTeX def

14+latex = handleError . readLaTeX def

1415

1516infix 4 =:

1617(=:) :: ToString c

tests/Tests/Readers/Markdown.hs+7−6

@@ -9,19 +9,20 @@ import Text.Pandoc.Builder

99import qualified Data.Set as Set

1010-- import Text.Pandoc.Shared ( normalize )

1111import Text.Pandoc

12+import Text.Pandoc.Error

1213

1314markdown :: String -> Pandoc

14−markdown = readMarkdown def

15+markdown = handleError . readMarkdown def

1516

1617markdownSmart :: String -> Pandoc

17−markdownSmart = readMarkdown def { readerSmart = True }

18+markdownSmart = handleError . readMarkdown def { readerSmart = True }

1819

1920markdownCDL :: String -> Pandoc

20−markdownCDL = readMarkdown def { readerExtensions = Set.insert

21+markdownCDL = handleError . readMarkdown def { readerExtensions = Set.insert

2122 Ext_compact_definition_lists $ readerExtensions def }

2223

2324markdownGH :: String -> Pandoc

24−markdownGH = readMarkdown def { readerExtensions = githubMarkdownExtensions }

25+markdownGH = handleError . readMarkdown def { readerExtensions = githubMarkdownExtensions }

2526

2627infix 4 =:

2728(=:) :: ToString c

@@ -30,7 +31,7 @@ infix 4 =:

3031

3132testBareLink :: (String, Inlines) -> Test

3233testBareLink (inp, ils) =

33− test (readMarkdown def{ readerExtensions =

34+ test (handleError . readMarkdown def{ readerExtensions =

3435 Set.fromList [Ext_autolink_bare_uris, Ext_raw_html] })

3536 inp (inp, doc $ para ils)

3637

@@ -220,7 +221,7 @@ tests = [ testGroup "inline code"

220221 =?> para (note (para "See [^1]"))

221222 ]

222223 , testGroup "lhs"

223− [ test (readMarkdown def{ readerExtensions = Set.insert

224+ [ test (handleError . readMarkdown def{ readerExtensions = Set.insert

224225 Ext_literate_haskell $ readerExtensions def })

225226 "inverse bird tracks and html" $

226227 "> a\n\n< b\n\n<div>\n"

tests/Tests/Readers/Org.hs+3−2

@@ -8,12 +8,13 @@ import Text.Pandoc.Builder

88import Text.Pandoc

99import Data.List (intersperse)

1010import Data.Monoid (mempty, mappend, mconcat)

11+import Text.Pandoc.Error

1112

1213org :: String -> Pandoc

13−org = readOrg def

14+org = handleError . readOrg def

1415

1516orgSmart :: String -> Pandoc

16−orgSmart = readOrg def { readerSmart = True }

17+orgSmart = handleError . readOrg def { readerSmart = True }

1718

1819infix 4 =:

1920(=:) :: ToString c

tests/Tests/Readers/RST.hs+2−1

@@ -7,10 +7,11 @@ import Tests.Helpers

77import Tests.Arbitrary()

88import Text.Pandoc.Builder

99import Text.Pandoc

10+import Text.Pandoc.Error

1011import Data.Monoid (mempty)

1112

1213rst :: String -> Pandoc

13−rst = readRST def{ readerStandalone = True }

14+rst = handleError . readRST def{ readerStandalone = True }

1415

1516infix 4 =:

1617(=:) :: ToString c

tests/Tests/Readers/Txt2Tags.hs+2−1

@@ -7,12 +7,13 @@ import Tests.Helpers

77import Tests.Arbitrary()

88import Text.Pandoc.Builder

99import Text.Pandoc

10+import Text.Pandoc.Error

1011import Data.List (intersperse)

1112import Data.Monoid (mempty, mconcat)

1213import Text.Pandoc.Readers.Txt2Tags

1314

1415t2t :: String -> Pandoc

15−t2t s = readTxt2Tags (T2TMeta "date" "mtime" "in" "out") def s

16+t2t = handleError . readTxt2Tags (T2TMeta "date" "mtime" "in" "out") def

1617

1718infix 4 =:

1819(=:) :: ToString c

tests/Tests/Writers/Docx.hs+4−3

@@ -7,6 +7,7 @@ import Tests.Helpers

77import Test.Framework

88import Text.Pandoc.Readers.Docx

99import Text.Pandoc.Writers.Docx

10+import Text.Pandoc.Error

1011

1112type Options = (WriterOptions, ReaderOptions)

1213

@@ -15,9 +16,9 @@ compareOutput :: Options

1516 -> IO (Pandoc, Pandoc)

1617compareOutput opts nativeFile = do

1718 nf <- Prelude.readFile nativeFile

18− df <- writeDocx (fst opts) (readNative nf)

19− let (p, _) = readDocx (snd opts) df

20− return (p, readNative nf)

19+ df <- writeDocx (fst opts) (handleError $ readNative nf)

20+ let (p, _) = handleError $ readDocx (snd opts) df

21+ return (p, handleError $ readNative nf)

2122

2223testCompareWithOptsIO :: Options -> String -> FilePath -> IO Test

2324testCompareWithOptsIO opts name nativeFile = do