b74af67 · typeable/pandoc

benchmark/benchmark-pandoc.hs+6−4

compare with master

unifiedsplit

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

22import Data.Monoid

23import Data.Maybe (mapMaybe)

24import Debug.Trace (trace)

25+import Text.Pandoc.Error

26+import Control.Applicative

25

27

26readerBench :: Pandoc

28readerBench :: Pandoc

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

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

28 -> Maybe Benchmark

30 -> Maybe Benchmark

29readerBench doc (name, reader) =

31readerBench doc (name, reader) =

30 case lookup name writers of

32 case lookup name writers of

31 Just (PureStringWriter writer) ->

33 Just (PureStringWriter writer) ->

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

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

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

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

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

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

35 _ | name == "commonmark" ->

37 _ | name == "commonmark" ->

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

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

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

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

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

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

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

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

40 "\n") Nothing

42 "\n") Nothing

41

43

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

52 defaultOptions args

54 defaultOptions args

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

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

54 let opts = def{ readerSmart = True }

56 let opts = def{ readerSmart = True }

55− let doc = readMarkdown opts inp

57+ let doc = handleError $ readMarkdown opts inp

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

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

57 let readerBs = mapMaybe (readerBench doc)

59 let readerBs = mapMaybe (readerBench doc)

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

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

pandoc.cabal+1

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

290 Text.Pandoc.Pretty,

291 Text.Pandoc.Shared,

292 Text.Pandoc.MediaBag,

293+ Text.Pandoc.Error,

293 Text.Pandoc.Readers.HTML,

294 Text.Pandoc.Readers.HTML,

294 Text.Pandoc.Readers.LaTeX,

295 Text.Pandoc.Readers.LaTeX,

295 Text.Pandoc.Readers.Markdown,

296 Text.Pandoc.Readers.Markdown,

pandoc.hs+12−10

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

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

73import Data.Monoid

74

75+import Text.Pandoc.Error

76+

75type Transform = Pandoc -> Pandoc

77type Transform = Pandoc -> Pandoc

76

78

77copyrightMessage :: String

79copyrightMessage :: String

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

1275 then 0

1277 then 0

1276 else tabStop)

1278 else tabStop)

1277

1279

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

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

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

1279− readerName' == "latex+lhs"

1280 then handleIncludes

1282 then handleIncludes

1281− else return

1283+ else return . Right

1282−

1284+

1283− (doc, media) <-

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

1284− case reader of

1286+ case reader of

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

1287+ StringReader r-> do

1286− ( readSources >=>

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

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

1288− r readerOpts ) sources

1289+ doc <- handleIncludes' srcs

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

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

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

1290

1292

1291 let writerOptions = def { writerStandalone = standalone',

1293 let writerOptions = def { writerStandalone = standalone',

src/Text/Pandoc.hs+15−11

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

166import Text.Pandoc.Writers.Custom

167import Text.Pandoc.Templates

168import Text.Pandoc.Options

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

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

170import Text.Pandoc.MediaBag (MediaBag)

171+import Text.Pandoc.Error

171import Data.Aeson

172import Data.Aeson

172import qualified Data.ByteString.Lazy as BL

173import qualified Data.ByteString.Lazy as BL

173import Data.List (intercalate)

174import Data.List (intercalate)

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

203 '-' -> Set.delete ext

204 '-' -> Set.delete ext

204 _ -> Set.insert ext

205 _ -> Set.insert ext

205

206

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

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

208

207

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

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

210+

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

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

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

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

211

213

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

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

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

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

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

216+ case r o s of

217+ Left err -> return $ Left err

218+ Right (doc, warnings) -> do

215− mapM_ warn warnings

219+ mapM_ warn warnings

216− return doc

220+ return (Right doc)

217

221

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

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

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

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

220

224

221-- | Association list of formats and readers.

225-- | Association list of formats and readers.

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

360 where toJsonFilter :: a -> IO ()

364 where toJsonFilter :: a -> IO ()

361 toJsonFilter = toJSONFilter

365 toJsonFilter = toJSONFilter

362

366

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

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

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

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

365

369

366writeJSON :: WriterOptions -> Pandoc -> String

370writeJSON :: WriterOptions -> Pandoc -> String

367writeJSON _ = UTF8.toStringLazy . encode

371writeJSON _ = 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 @@

1{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

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

2{-

3{-

4

5

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

38import Data.Bits

39import Data.Bits

39import Data.Binary

40import Data.Binary

40import Data.Binary.Get

41import Data.Binary.Get

41−import Text.Pandoc.Shared (safeRead)

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

42import qualified Data.Map as M

43import qualified Data.Map as M

44+import Text.Pandoc.Compat.Except

45+import Control.Monad.Trans

46+import Data.Maybe (fromMaybe)

43

47

44-- quick and dirty functions to get image sizes

48-- quick and dirty functions to get image sizes

45-- algorithms borrowed from wwwis.pl

49-- algorithms borrowed from wwwis.pl

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

64 "%!PS"

68 "%!PS"

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

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

66 -> return Eps

70 -> return Eps

67− _ -> fail "Unknown image type"

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

68

72

69imageSize :: ByteString -> Maybe ImageSize

73imageSize :: ByteString -> Maybe ImageSize

70imageSize img = do

74imageSize img = do

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

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

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

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

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

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

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

117− _ -> fail "PNG parse error"

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

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

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

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

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

120

124

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

143 dpiX = 72,

147 dpiX = 72,

144 dpiY = 72

148 dpiY = 72

145 }

149 }

146− _ -> fail "GIF parse error"

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

147

151

148jpegSize :: ByteString -> Maybe ImageSize

152jpegSize :: ByteString -> Maybe ImageSize

149jpegSize img = do

153jpegSize img = do

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

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

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

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

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

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

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

177− _ -> fail "JPEG parse error"

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

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

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

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

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

180 [c1,c2] -> do

184 [c1,c2] -> do

181 let len = shift c1 8 + c2

185 let len = shift c1 8 + c2

182 -- skip variables

186 -- skip variables

183 findJfifSize $ B.drop len bs''

187 findJfifSize $ B.drop len bs''

184− _ -> fail "JPEG parse error"

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

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

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

186

190

187exifSize :: ByteString -> Maybe ImageSize

191exifSize :: ByteString -> Maybe ImageSize

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

192+exifSize bs = hush . runGet header $ bl

189 where bl = BL.fromChunks [bs]

193 where bl = BL.fromChunks [bs]

194+ header = runExceptT $ exifHeader bl

190-- NOTE: It would be nicer to do

195-- NOTE: It would be nicer to do

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

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

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

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

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

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

194-- and binary 0.5 ships with ghc 7.6.

199-- and binary 0.5 ships with ghc 7.6.

195

200

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

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

197exifHeader hdr = do

202exifHeader hdr = do

198− _app1DataSize <- getWord16be

203+ _app1DataSize <- lift getWord16be

199− exifHdr <- getWord32be

204+ exifHdr <- lift getWord32be

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

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

201− zeros <- getWord16be

206+ zeros <- lift getWord16be

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

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

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

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

204 -- in getting data from offsets:

209 -- in getting data from offsets:

205 let tiffHeader = BL.drop 8 hdr

210 let tiffHeader = BL.drop 8 hdr

206− byteAlign <- getWord16be

211+ byteAlign <- lift getWord16be

207 let bigEndian = byteAlign == 0x4d4d

212 let bigEndian = byteAlign == 0x4d4d

208 let (getWord16, getWord32, getWord64) =

213 let (getWord16, getWord32, getWord64) =

209 if bigEndian

214 if bigEndian

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

213 num <- getWord32

218 num <- getWord32

214 den <- getWord32

219 den <- getWord32

215 return $ fromIntegral num / fromIntegral den

220 return $ fromIntegral num / fromIntegral den

216− tagmark <- getWord16

221+ tagmark <- lift getWord16

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

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

218− ifdOffset <- getWord32

223+ ifdOffset <- lift getWord32

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

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

220− numentries <- getWord16

225+ numentries <- lift getWord16

221− let ifdEntry = do

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

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

227+ ifdEntry = do

223− maybe (return UnknownTagType) return

224− (M.lookup t tagTypeTable)

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

229+ <$> lift getWord16

225− dataFormat <- getWord16

230+ dataFormat <- lift getWord16

226− numComponents <- getWord32

231+ numComponents <- lift getWord32

227 (fmt, bytesPerComponent) <-

232 (fmt, bytesPerComponent) <-

228 case dataFormat of

233 case dataFormat of

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

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

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

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

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

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

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

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

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

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

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

242 let totalBytes = fromIntegral $ numComponents * bytesPerComponent

247 let totalBytes = fromIntegral $ numComponents * bytesPerComponent

248+ payload <- lift $

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

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

244 then fmt <$>

250 then fmt <$>

245 (getLazyByteString (fromIntegral totalBytes) <*

251 (getLazyByteString (fromIntegral totalBytes) <*

246 skip (4 - totalBytes))

252 skip (4 - totalBytes))

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

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

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

253 subentries <- case lookup ExifOffset entries of

259 subentries <- case lookup ExifOffset entries of

254 Just (UnsignedLong offset) -> do

260 Just (UnsignedLong offset) -> do

255− pos <- bytesRead

261+ pos <- lift bytesRead

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

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

257− numsubentries <- getWord16

263+ numsubentries <- lift getWord16

258 sequence $

264 sequence $

259 replicate (fromIntegral numsubentries) ifdEntry

265 replicate (fromIntegral numsubentries) ifdEntry

260 _ -> return []

266 _ -> return []

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

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

190import Data.Monoid

191import Data.Maybe (catMaybes)

192

193+import Text.Pandoc.Error

194+

193type Parser t s = Parsec t s

195type Parser t s = Parsec t s

194

196

195type ParserT = ParsecT

197type ParserT = ParsecT

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

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

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

846 -> st -- ^ initial state

848 -> st -- ^ initial state

847 -> String -- ^ input

849 -> String -- ^ input

848− -> m a

850+ -> m (Either PandocError a)

849readWithM parser state input =

851readWithM parser state input =

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

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

851− where

853+

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

861

854

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

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

863readWith :: Parser [Char] st a

856readWith :: Parser [Char] st a

864 -> st

857 -> st

865 -> String

858 -> String

866− -> a

859+ -> Either PandocError a

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

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

868

861

869returnWarnings :: (Stream s m c)

862returnWarnings :: (Stream s m c)

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

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

250 => Doc -> DocState a

251renderDoc = renderList . toList . unDoc

252

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+

253renderList :: (IsString a, Monoid a)

258renderList :: (IsString a, Monoid a)

254 => [D] -> DocState a

259 => [D] -> DocState a

255renderList [] = return ()

260renderList [] = return ()

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

323 outp 1 " "

328 outp 1 " "

324 renderList xs'

329 renderList xs'

325

330

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

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

327− renderList (mergeBlocks False b1 b2 : xs)

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

328

333

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

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

330− renderList (mergeBlocks True b1 b2 : xs)

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

331

336

332renderList (Block width lns : xs) = do

337renderList (Block width lns : xs) = do

333 st <- get

338 st <- get

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

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

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

340 renderList xs

345 renderList xs

341

346

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

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

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

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

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

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

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

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

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

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

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

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

348 sp "" = ""

353 sp "" = ""

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

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

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

351

355

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

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

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

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

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

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

37import Data.List (groupBy)

38import Text.Pandoc.Definition

39import Text.Pandoc.Options

40+import Text.Pandoc.Error

40

41

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

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

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

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

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

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

44 where opts' = if readerSmart opts

45 where opts' = if readerSmart opts

45 then [optNormalize, optSmart]

46 then [optNormalize, optSmart]

46 else [optNormalize]

47 else [optNormalize]

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

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

15import Data.List (intersperse)

16import Data.Maybe (fromMaybe)

17import Text.TeXMath (readMathML, writeTeX)

18+import Text.Pandoc.Error (PandocError)

19+import Text.Pandoc.Compat.Except

20+import Data.Default

18

21

19{-

22{-

20

23

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

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

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

498-}

501-}

499

502

500−type DB = State DBState

503+type DB = ExceptT PandocError (State DBState)

501

504

502data DBState = DBState{ dbSectionLevel :: Int

505data DBState = DBState{ dbSectionLevel :: Int

503 , dbQuoteType :: QuoteType

506 , dbQuoteType :: QuoteType

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

507 , dbFigureTitle :: Inlines

510 , dbFigureTitle :: Inlines

508 } deriving Show

511 } deriving Show

509

512

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+

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

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

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

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

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

524+ where (bs , st') = flip runState def . runExceptT . 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− }

520 inp' = handleInstructions inp

525 inp' = handleInstructions inp

521

526

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

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

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

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

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

97import qualified Data.Sequence as Seq (null)

98

99+import Text.Pandoc.Error

100+import Text.Pandoc.Compat.Except

101+

99readDocx :: ReaderOptions

102readDocx :: ReaderOptions

100 -> B.ByteString

103 -> B.ByteString

101− -> (Pandoc, MediaBag)

104+ -> Either PandocError (Pandoc, MediaBag)

102readDocx opts bytes =

105readDocx opts bytes =

103 case archiveToDocx (toArchive bytes) of

106 case archiveToDocx (toArchive bytes) of

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

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

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

108+ <$> (docxToOutput opts docx)

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

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

107

110

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

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

109 , docxMediaBag :: MediaBag

112 , docxMediaBag :: MediaBag

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

122instance Default DEnv where

125instance Default DEnv where

123 def = DEnv def False

126 def = DEnv def False

124

127

125−type DocxContext = ReaderT DEnv (State DState)

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

126

129

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

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

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

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

129

132

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

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

131spansToKeep :: [String]

134spansToKeep :: [String]

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

551 blks',

554 blks',

552 mediaBag)

555 mediaBag)

553

556

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

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

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

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

556 let dEnv = def { docxOptions = opts} in

559 let dEnv = def { docxOptions = opts} in

557 evalDocxContext (bodyToOutput body) dEnv def

560 evalDocxContext (bodyToOutput body) dEnv def

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

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

35

36import Debug.Trace (trace)

37

38+import Text.Pandoc.Error

39+

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

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

39

41

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

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

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

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

42

44

43−runEPUB :: Except String a -> a

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

44−runEPUB = either error id . runExcept

46+runEPUB = runExcept

45

47

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

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

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

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

48--

50--

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

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

50archiveToEPUB os archive = do

52archiveToEPUB os archive = do

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

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

52 (root, content) <- getManifest archive

54 (root, content) <- getManifest archive

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

64 return $ (ast, mediaBag)

66 return $ (ast, mediaBag)

65 where

67 where

66 os' = os {readerParseRaw = True}

68 os' = os {readerParseRaw = True}

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

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

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

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

69 when (readerTrace os) (traceM path)

71 when (readerTrace os) (traceM path)

70 doc <- mimeToReader mime r path

72 doc <- mimeToReader mime r path

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

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

72 return $ docSpan <> doc

74 return $ docSpan <> doc

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

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

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

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

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

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

76− return $ fixInternalReferences path .

78+ html <- either throwError return .

77 readHtml os' .

79 readHtml os' .

78 UTF8.toStringLazy $

80 UTF8.toStringLazy $

79 fromEntry fname

81 fromEntry fname

82+ return $ fixInternalReferences path html

80 mimeToReader s _ path

83 mimeToReader s _ path

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

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

82 | otherwise = return $ mempty

85 | otherwise = return $ mempty

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

114

117

115type CoverImage = FilePath

118type CoverImage = FilePath

116

119

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

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

118parseManifest content = do

121parseManifest content = do

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

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

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

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

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

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

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

131 return (uid, (href, mime))

134 return (uid, (href, mime))

132

135

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

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

134parseSpine is e = do

137parseSpine is e = do

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

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

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

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

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

141 guard linear

144 guard linear

142 findAttr (emptyName "idref") ref

145 findAttr (emptyName "idref") ref

143

146

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

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

145parseMeta content = do

148parseMeta content = do

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

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

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

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

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

159renameMeta "creator" = "author"

162renameMeta "creator" = "author"

160renameMeta s = s

163renameMeta s = s

161

164

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

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

163getManifest archive = do

166getManifest archive = do

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

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

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

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

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

266

269

267-- Convert Maybe interface to Either

270-- Convert Maybe interface to Either

268

271

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

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

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

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

271

274

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

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

273findEntryByPathE (normalise -> path) a =

276findEntryByPathE (normalise -> path) a =

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

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

275

278

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

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

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

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

278

281

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

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

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

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

281

284

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

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

283−mkE s = maybe (throwError s) return

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

2{-

3{-

4

5

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

43import qualified Text.Pandoc.Builder as B

44import qualified Text.Pandoc.Builder as B

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

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

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

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

46− , escapeURI, safeRead )

47+ , escapeURI, safeRead, mapLeft )

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

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

48 , Extension (Ext_epub_html_exts,

49 , Extension (Ext_epub_html_exts,

49 Ext_native_divs, Ext_native_spans))

50 Ext_native_divs, Ext_native_spans))

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

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

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

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

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

64

65

66+import Text.Pandoc.Error

67+

68+import Text.Parsec.Error

69+

65

70

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

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

67readHtml :: ReaderOptions -- ^ Reader options

72readHtml :: ReaderOptions -- ^ Reader options

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

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

69− -> Pandoc

74+ -> Either PandocError Pandoc

70readHtml opts inp =

75readHtml opts inp =

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

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

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

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

73− Right result -> result

74 where tags = stripPrefixes . canonicalizeTags $

78 where tags = stripPrefixes . canonicalizeTags $

75 parseTagsOptions parseOptions{ optTagPosition = True } inp

79 parseTagsOptions parseOptions{ optTagPosition = True } inp

76 parseDoc = do

80 parseDoc = do

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

78 meta <- stateMeta . parserState <$> getState

82 meta <- stateMeta . parserState <$> getState

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

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

80 return $ Pandoc meta bs'

84 return $ Pandoc meta bs'

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

86+ [] -> ""

87+ (m:_) -> messageString m

81

88

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

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

83replaceNotes = walkM replaceNotes'

90replaceNotes = walkM replaceNotes'

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

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

26import Documentation.Haddock.Types

27import Debug.Trace (trace)

28

29+import Text.Pandoc.Error

30+

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

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

30readHaddock :: ReaderOptions -- ^ Reader options

32readHaddock :: ReaderOptions -- ^ Reader options

31 -> String -- ^ String to parse

33 -> String -- ^ String to parse

32− -> Pandoc

34+ -> Either PandocError Pandoc

33readHaddock opts =

35readHaddock opts =

34#if MIN_VERSION_haddock_library(1,2,0)

36#if MIN_VERSION_haddock_library(1,2,0)

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

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

36#else

38#else

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

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

38#endif

40#endif

39 where trace' x = if readerTrace opts

41 where trace' x = if readerTrace opts

40 then trace (show x) x

42 then trace (show x) x

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

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

57import qualified Control.Exception as E

58import System.FilePath (takeExtension, addExtension)

59import Text.Pandoc.Highlighting (fromListingsLanguage)

60+import Text.Pandoc.Error

60

61

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

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

62readLaTeX :: ReaderOptions -- ^ Reader options

63readLaTeX :: ReaderOptions -- ^ Reader options

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

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

64− -> Pandoc

65+ -> Either PandocError Pandoc

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

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

66

67

67parseLaTeX :: LP Pandoc

68parseLaTeX :: LP Pandoc

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

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

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

854

855

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

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

856−handleIncludes :: String -> IO String

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

857−handleIncludes s = do

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

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

859− case res of

860− Right s' -> return s'

861− Left e -> error $ show e

862

859

863includeParser' :: IncludeParser

860includeParser' :: IncludeParser

864includeParser' =

861includeParser' =

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

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

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

2+{-# LANGUAGE ScopedTypeVariables #-}

2{-

3{-

4

5

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

64import qualified Data.Set as Set

65import qualified Data.Set as Set

65import Text.Printf (printf)

66import Text.Printf (printf)

66import Debug.Trace (trace)

67import Debug.Trace (trace)

68+import Text.Pandoc.Error

67

69

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

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

69

71

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

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

71readMarkdown :: ReaderOptions -- ^ Reader options

73readMarkdown :: ReaderOptions -- ^ Reader options

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

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

73− -> Pandoc

75+ -> Either PandocError Pandoc

74readMarkdown opts s =

76readMarkdown opts s =

75 runMarkdown opts s parseMarkdown

77 runMarkdown opts s parseMarkdown

76

78

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

78-- and a list of warnings.

80-- and a list of warnings.

79readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options

81readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options

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

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

81− -> (Pandoc, [String])

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

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

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

83

85

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

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

85−runMarkdown opts inp p = fst res

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

86 where

88 where

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

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

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

88 res = runReader imd s

91 res = runReader imd s

89 s :: ParserState

92 s :: ParserState

90− s = snd $ runReader imd s

93+ s = either def snd res

91

94

92--

95--

93-- Constants and data structure definitions

96-- Constants and data structure definitions

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

246 H.foldrWithKey (\k v m ->

249 H.foldrWithKey (\k v m ->

247 if ignorable k

250 if ignorable k

248 then m

251 then m

252+ else case yamlToMeta opts v of

253+ Left _ -> m

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

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

250− (yamlToMeta opts v) m)

251 nullMeta hashmap

255 nullMeta hashmap

252 Right Yaml.Null -> return nullMeta

256 Right Yaml.Null -> return nullMeta

253 Right _ -> do

257 Right _ -> do

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

279ignorable :: Text -> Bool

283ignorable :: Text -> Bool

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

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

281

285

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

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

283−toMetaValue opts x =

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

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

288+ where

289+ toMeta p =

290+ case p of

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

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

286− Pandoc _ [Para xs]

292+ Pandoc _ [Para xs]

287 | endsWithNewline x -> MetaBlocks [Para xs]

293 | endsWithNewline x -> MetaBlocks [Para xs]

288 | otherwise -> MetaInlines xs

294 | otherwise -> MetaInlines xs

289− Pandoc _ bs -> MetaBlocks bs

295+ Pandoc _ bs -> MetaBlocks bs

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

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

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

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

292− meta_exts = Set.fromList [ Ext_pandoc_title_block

298+ meta_exts = Set.fromList [ Ext_pandoc_title_block

293− , Ext_mmd_title_block

299+ , Ext_mmd_title_block

294− , Ext_yaml_metadata_block

300+ , Ext_yaml_metadata_block

295− ]

301+ ]

296−

302+

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

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

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

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

299yamlToMeta _ (Yaml.Number n)

305yamlToMeta _ (Yaml.Number n)

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

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

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

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

302 $ coefficient n * (10 ^ base10Exponent n)

308 $ coefficient n * (10 ^ base10Exponent n)

303− | otherwise = MetaString $ show n

309+ | otherwise = return $ MetaString $ show n

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

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

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

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

306− $ V.toList xs

312+ (V.toList xs)

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

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

308 if ignorable k

314 if ignorable k

309 then m

315 then m

316+ else (do

317+ v' <- yamlToMeta opts v

318+ m' <- m

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

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

311− (yamlToMeta opts v) m)

312− M.empty o

320+ (return M.empty) o

313−yamlToMeta _ _ = MetaString ""

321+yamlToMeta _ _ = return $ MetaString ""

314

322

315stopLine :: MarkdownParser ()

323stopLine :: MarkdownParser ()

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

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

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

466 res <- choice [ mempty <$ blanklines

474 res <- choice [ mempty <$ blanklines

467 , codeBlockFenced

475 , codeBlockFenced

468 , yamlMetaBlock

476 , yamlMetaBlock

477+ , guardEnabled Ext_latex_macros *> macro

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

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

470 -- the possibility of empty list items: -

479 -- the possibility of empty list items: -

471 , bulletList

480 , bulletList

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

475 , htmlBlock

484 , htmlBlock

476 , table

485 , table

477 , codeBlockIndented

486 , codeBlockIndented

478− , guardEnabled Ext_latex_macros *> macro

479 , rawTeXBlock

487 , rawTeXBlock

480 , lineBlock

488 , lineBlock

481 , blockQuote

489 , blockQuote

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

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

58import Text.Printf (printf)

59import Debug.Trace (trace)

60

61+import Text.Pandoc.Error

62+

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

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

62readMediaWiki :: ReaderOptions -- ^ Reader options

64readMediaWiki :: ReaderOptions -- ^ Reader options

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

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

64− -> Pandoc

66+ -> Either PandocError Pandoc

65readMediaWiki opts s =

67readMediaWiki opts s =

66− case runParser parseMediaWiki MWState{ mwOptions = opts

68+ readWith parseMediaWiki MWState{ mwOptions = opts

67 , mwMaxNestingLevel = 4

69 , mwMaxNestingLevel = 4

68 , mwNextLinkNumber = 1

70 , mwNextLinkNumber = 1

69 , mwCategoryLinks = []

71 , mwCategoryLinks = []

70 , mwHeaderMap = M.empty

72 , mwHeaderMap = M.empty

71 , mwIdentifierList = []

73 , mwIdentifierList = []

72 }

74 }

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

75+ (s ++ "\n")

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

75− Right result -> result

76

77data MWState = MWState { mwOptions :: ReaderOptions

78 , mwMaxNestingLevel :: Int

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

3

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

5it 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

7(at your option) any later version.

8

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

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

33import Text.Pandoc.Definition

34import Text.Pandoc.Shared (safeRead)

35

36+import Text.Pandoc.Error

37+import Control.Applicative

38+

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

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

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

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

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

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

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

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

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

45--

48--

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

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

47− -> Pandoc

50+ -> Either PandocError Pandoc

48−readNative s =

49− case safeRead s of

50− Just d -> d

51− Nothing -> Pandoc nullMeta $ readBlocks s

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

52

53−readBlocks :: String -> [Block]

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

54−readBlocks s =

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

55− case safeRead s of

56− Just d -> d

57− Nothing -> [readBlock s]

58

55

59−readBlock :: String -> Block

56+readBlock :: String -> Either PandocError Block

60−readBlock s =

61− case safeRead s of

62− Just d -> d

63− Nothing -> Plain $ readInlines s

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

64

58

65−readInlines :: String -> [Inline]

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

66−readInlines s =

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

67− case safeRead s of

68− Just d -> d

69− Nothing -> [readInline s]

70

61

71−readInline :: String -> Inline

62+readInline :: String -> Either PandocError Inline

72−readInline s =

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

73− case safeRead s of

74− Just d -> d

75− Nothing -> error "Cannot parse document"

76

64

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

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

1+{-# LANGUAGE FlexibleContexts #-}

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

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

2import Data.Char (toUpper)

3import Data.Char (toUpper)

3import Text.Pandoc.Options

4import Text.Pandoc.Options

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

11import Data.Monoid

12import Data.Monoid

12import Control.Monad.State

13import Control.Monad.State

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

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

15+import Data.Default

16+import Text.Pandoc.Compat.Except

17+import Text.Pandoc.Error

14

18

15−type OPML = State OPMLState

19+type OPML = ExceptT PandocError (State OPMLState)

16

20

17data OPMLState = OPMLState{

21data OPMLState = OPMLState{

18 opmlSectionLevel :: Int

22 opmlSectionLevel :: Int

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

21 , opmlDocDate :: Inlines

25 , opmlDocDate :: Inlines

22 } deriving Show

26 } deriving Show

23

27

28+instance Default OPMLState where

29+ def = OPMLState{ opmlSectionLevel = 0

30+ , opmlDocTitle = mempty

31+ , opmlDocAuthors = []

32+ , opmlDocDate = mempty

33+ }

34+

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

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

25readOPML _ inp = setTitle (opmlDocTitle st')

36readOPML _ inp = setTitle (opmlDocTitle st')

26− $ setAuthors (opmlDocAuthors st')

37+ . setAuthors (opmlDocAuthors st')

27− $ setDate (opmlDocDate st')

38+ . setDate (opmlDocDate st')

28− $ doc $ mconcat bs

39+ . doc . mconcat <$> bs

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

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

30− OPMLState{ opmlSectionLevel = 0

31− , opmlDocTitle = mempty

32− , opmlDocAuthors = []

33− , opmlDocDate = mempty

34− }

35

41

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

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

37normalizeTree :: [Content] -> [Content]

43normalizeTree :: [Content] -> [Content]

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

58 Just z -> z

64 Just z -> z

59 Nothing -> ""

65 Nothing -> ""

60

66

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

68+exceptT = either throwError return

69+

61−asHtml :: String -> Inlines

70+asHtml :: String -> OPML Inlines

62−asHtml s = case readHtml def s of

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

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

72+ [Plain ils] -> fromList ils

64− _ -> mempty

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

65

74

66−asMarkdown :: String -> Blocks

75+asMarkdown :: String -> OPML Blocks

67−asMarkdown s = fromList bs

68− where Pandoc _ bs = readMarkdown def s

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

69

77

70getBlocks :: Element -> OPML Blocks

78getBlocks :: Element -> OPML Blocks

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

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

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

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

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

83 "?xml" -> return mempty

91 "?xml" -> return mempty

84 _ -> getBlocks e

92 _ -> getBlocks e

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

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

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

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

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

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

88 bs <- getBlocks e

96 bs <- getBlocks e

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

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

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

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

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

61import Network.HTTP (urlEncode)

62

63+import Text.Pandoc.Error

64+

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

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

64readOrg :: ReaderOptions -- ^ Reader options

66readOrg :: ReaderOptions -- ^ Reader options

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

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

66− -> Pandoc

68+ -> Either PandocError Pandoc

67readOrg opts s = runOrg opts s parseOrg

69readOrg opts s = runOrg opts s parseOrg

68

70

69data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext

71data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext

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

71

73

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

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

73

75

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

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

75−runOrg opts inp p = fst res

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

76 where

78 where

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

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

78 res = runReader imd def { finalState = s }

80 res = runReader imd def { finalState = s }

79 s :: OrgParserState

81 s :: OrgParserState

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

82+ s = either def snd res

81

83

82parseOrg :: OrgParser Pandoc

84parseOrg :: OrgParser Pandoc

83parseOrg = do

85parseOrg = do

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

1259

1261

1260displayMath :: OrgParser Inlines

1262displayMath :: OrgParser Inlines

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

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

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

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

1263−

1265+ ]

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

1270

1266

1271symbol :: OrgParser Inlines

1267symbol :: OrgParser Inlines

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

1268symbol = 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

1273

1274emphasisBetween :: Char

1275 -> OrgParser Inlines

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

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

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

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

53

54+import Text.Pandoc.Error

55+

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

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

55readRST :: ReaderOptions -- ^ Reader options

57readRST :: ReaderOptions -- ^ Reader options

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

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

57− -> Pandoc

59+ -> Either PandocError Pandoc

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

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

59

61

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

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

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

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

62

64

63type RSTParser = Parser [Char] ParserState

65type RSTParser = Parser [Char] ParserState

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

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

48import Text.HTML.TagSoup

49import Data.Char (isAlphaNum)

50import qualified Data.Foldable as F

51+import Text.Pandoc.Error

51

52

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

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

53readTWiki :: ReaderOptions -- ^ Reader options

54readTWiki :: ReaderOptions -- ^ Reader options

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

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

55− -> Pandoc

56+ -> Either PandocError Pandoc

56readTWiki opts s =

57readTWiki opts s =

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

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

58

59

59readTWikiWithWarnings :: ReaderOptions -- ^ Reader options

60readTWikiWithWarnings :: ReaderOptions -- ^ Reader options

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

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

61− -> (Pandoc, [String])

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

62readTWikiWithWarnings opts s =

63readTWikiWithWarnings opts s =

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

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

64 where parseTWikiWithWarnings = do

65 where parseTWikiWithWarnings = do

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

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

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

69import Data.Monoid

70import Debug.Trace (trace)

71+import Text.Pandoc.Error

71

72

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

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

73readTextile :: ReaderOptions -- ^ Reader options

74readTextile :: ReaderOptions -- ^ Reader options

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

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

75− -> Pandoc

76+ -> Either PandocError Pandoc

76readTextile opts s =

77readTextile opts s =

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

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

78

79

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

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

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

49import Data.Default

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

51+import Text.Pandoc.Error

51

52

52import Data.Time.LocalTime (getZonedTime)

53import Data.Time.LocalTime (getZonedTime)

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

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

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

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

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

84

85

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

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

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

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

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

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

88

89

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

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

90-- a Pandoc document

91-- a Pandoc document

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

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

92readTxt2TagsNoMacros = readTxt2Tags def

93readTxt2TagsNoMacros = readTxt2Tags def

93

94

94parseT2T :: T2T Pandoc

95parseT2T :: T2T Pandoc

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

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

85 -- * Error handling

86 err,

87 warn,

88+ mapLeft,

89+ hush,

88 -- * Safe read

90 -- * Safe read

89 safeRead,

91 safeRead,

90 -- * Temp directory

92 -- * Temp directory

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

113import Data.Generics (Typeable, Data)

115import Data.Generics (Typeable, Data)

114import qualified Control.Monad.State as S

116import qualified Control.Monad.State as S

115import qualified Control.Exception as E

117import qualified Control.Exception as E

116−import Control.Monad (msum, unless)

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

117import Text.Pandoc.Pretty (charWidth)

119import Text.Pandoc.Pretty (charWidth)

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

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

119import Data.Time

121import Data.Time

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

855 name <- getProgName

857 name <- getProgName

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

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

857

859

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+

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

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

859--

869--

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

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

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

883-- Safe read

893-- Safe read

884--

894--

885

895

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

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

887safeRead s = case reads s of

897safeRead s = case reads s of

888 (d,x):_

898 (d,x):_

889 | all isSpace x -> return d

899 | all isSpace x -> return d

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

900+ _ -> mzero

891

901

892--

902--

893-- Temp directory

903-- Temp directory

tests/Tests/Old.hs+2−1

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

18import qualified Data.ByteString.Lazy as B

19import Text.Pandoc.UTF8 (toStringLazy)

20import Text.Printf

21+import Text.Pandoc.Error

21

22

22readFileUTF8 :: FilePath -> IO String

23readFileUTF8 :: FilePath -> IO String

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

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

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

182lhsReaderTest format =

183lhsReaderTest format =

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

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

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

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

185− where normalizer = writeNative def . normalize . readNative

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

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

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

187 then "lhs-test-markdown.native"

188 then "lhs-test-markdown.native"

188 else "lhs-test.native"

189 else "lhs-test.native"

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

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

13import qualified Data.Map as M

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

15import Codec.Archive.Zip

16+import Text.Pandoc.Error

16

17

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

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

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

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

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

41compareOutput opts docxFile nativeFile = do

42compareOutput opts docxFile nativeFile = do

42 df <- B.readFile docxFile

43 df <- B.readFile docxFile

43 nf <- Prelude.readFile nativeFile

44 nf <- Prelude.readFile nativeFile

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

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

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

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

46

47

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

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

48testCompareWithOptsIO opts name docxFile nativeFile = do

49testCompareWithOptsIO opts name docxFile nativeFile = do

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

79compareMediaBagIO :: FilePath -> IO Bool

80compareMediaBagIO :: FilePath -> IO Bool

80compareMediaBagIO docxFile = do

81compareMediaBagIO docxFile = do

81 df <- B.readFile docxFile

82 df <- B.readFile docxFile

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

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

83 bools <- mapM

84 bools <- mapM

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

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

85 (mediaDirectory mb)

86 (mediaDirectory mb)

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

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

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

10import Control.Applicative

11import System.FilePath (joinPath)

12+import Text.Pandoc.Error

12

13

13getMediaBag :: FilePath -> IO MediaBag

14getMediaBag :: FilePath -> IO MediaBag

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

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

15

16

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

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

17testMediaBag fp bag = do

18testMediaBag fp bag = do

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

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

8import Text.Pandoc.Builder

9import Text.Pandoc

10import Data.Monoid (mempty)

11+import Text.Pandoc.Error

11

12

12latex :: String -> Pandoc

13latex :: String -> Pandoc

13−latex = readLaTeX def

14+latex = handleError . readLaTeX def

14

15

15infix 4 =:

16infix 4 =:

16(=:) :: ToString c

17(=:) :: ToString c

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

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

9import qualified Data.Set as Set

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

11import Text.Pandoc

12+import Text.Pandoc.Error

12

13

13markdown :: String -> Pandoc

14markdown :: String -> Pandoc

14−markdown = readMarkdown def

15+markdown = handleError . readMarkdown def

15

16

16markdownSmart :: String -> Pandoc

17markdownSmart :: String -> Pandoc

17−markdownSmart = readMarkdown def { readerSmart = True }

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

18

19

19markdownCDL :: String -> Pandoc

20markdownCDL :: String -> Pandoc

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

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

21 Ext_compact_definition_lists $ readerExtensions def }

22 Ext_compact_definition_lists $ readerExtensions def }

22

23

23markdownGH :: String -> Pandoc

24markdownGH :: String -> Pandoc

24−markdownGH = readMarkdown def { readerExtensions = githubMarkdownExtensions }

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

25

26

26infix 4 =:

27infix 4 =:

27(=:) :: ToString c

28(=:) :: ToString c

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

30

31

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

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

32testBareLink (inp, ils) =

33testBareLink (inp, ils) =

33− test (readMarkdown def{ readerExtensions =

34+ test (handleError . readMarkdown def{ readerExtensions =

34 Set.fromList [Ext_autolink_bare_uris, Ext_raw_html] })

35 Set.fromList [Ext_autolink_bare_uris, Ext_raw_html] })

35 inp (inp, doc $ para ils)

36 inp (inp, doc $ para ils)

36

37

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

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

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

221 ]

222 ]

222 , testGroup "lhs"

223 , testGroup "lhs"

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

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

224 Ext_literate_haskell $ readerExtensions def })

225 Ext_literate_haskell $ readerExtensions def })

225 "inverse bird tracks and html" $

226 "inverse bird tracks and html" $

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

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

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

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

8import Text.Pandoc

9import Data.List (intersperse)

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

11+import Text.Pandoc.Error

11

12

12org :: String -> Pandoc

13org :: String -> Pandoc

13−org = readOrg def

14+org = handleError . readOrg def

14

15

15orgSmart :: String -> Pandoc

16orgSmart :: String -> Pandoc

16−orgSmart = readOrg def { readerSmart = True }

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

17

18

18infix 4 =:

19infix 4 =:

19(=:) :: ToString c

20(=:) :: ToString c

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

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

7import Tests.Arbitrary()

8import Text.Pandoc.Builder

9import Text.Pandoc

10+import Text.Pandoc.Error

10import Data.Monoid (mempty)

11import Data.Monoid (mempty)

11

12

12rst :: String -> Pandoc

13rst :: String -> Pandoc

13−rst = readRST def{ readerStandalone = True }

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

14

15

15infix 4 =:

16infix 4 =:

16(=:) :: ToString c

17(=:) :: ToString c

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

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

7import Tests.Arbitrary()

8import Text.Pandoc.Builder

9import Text.Pandoc

10+import Text.Pandoc.Error

10import Data.List (intersperse)

11import Data.List (intersperse)

11import Data.Monoid (mempty, mconcat)

12import Data.Monoid (mempty, mconcat)

12import Text.Pandoc.Readers.Txt2Tags

13import Text.Pandoc.Readers.Txt2Tags

13

14

14t2t :: String -> Pandoc

15t2t :: String -> Pandoc

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

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

16

17

17infix 4 =:

18infix 4 =:

18(=:) :: ToString c

19(=:) :: ToString c

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

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

7import Test.Framework

8import Text.Pandoc.Readers.Docx

9import Text.Pandoc.Writers.Docx

10+import Text.Pandoc.Error

10

11

11type Options = (WriterOptions, ReaderOptions)

12type Options = (WriterOptions, ReaderOptions)

12

13

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

15 -> IO (Pandoc, Pandoc)

16 -> IO (Pandoc, Pandoc)

16compareOutput opts nativeFile = do

17compareOutput opts nativeFile = do

17 nf <- Prelude.readFile nativeFile

18 nf <- Prelude.readFile nativeFile

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

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

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

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

20− return (p, readNative nf)

21+ return (p, handleError $ readNative nf)

21

22

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

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

23testCompareWithOptsIO opts name nativeFile = do

24testCompareWithOptsIO opts name nativeFile = do