18e85f8 · typeable/pandoc

src/Text/Pandoc.hs+2−2

compare with master

unifiedsplit

@@ -183,7 +183,7 @@ import Text.Pandoc.Options

183import Text.Pandoc.Shared (safeRead, warn, mapLeft, pandocVersion)

184import Text.Pandoc.MediaBag (MediaBag)

185import Text.Pandoc.Error

186−import Text.Pandoc.Class (PandocMonad)

186+import Text.Pandoc.Class (PandocMonad, runIOorExplode)

187import Data.Aeson

188import qualified Data.ByteString.Lazy as BL

189import Data.List (intercalate)

@@ -243,7 +243,7 @@ mkBSReaderWithWarnings r = ByteStringReader $ \o s ->

243

244-- | Association list of formats and readers.

245readers :: [(String, Reader IO)]

246−readers = [ ("native" , StringReader $ \_ s -> return $ readNative s)

246+readers = [ ("native" , StringReader $ \_ s -> runIOorExplode (readNative s))

247 ,("json" , mkStringReader readJSON )

248 ,("markdown" , mkStringReaderWithWarnings readMarkdownWithWarnings)

249 ,("markdown_strict" , mkStringReaderWithWarnings readMarkdownWithWarnings)

src/Text/Pandoc/Readers/Native.hs+6−3

@@ -34,6 +34,7 @@ import Text.Pandoc.Definition

34import Text.Pandoc.Shared (safeRead)

35

36import Text.Pandoc.Error

37+import Text.Pandoc.Class

37

38

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

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

39-- 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,

@@ -45,9 +46,11 @@ import Text.Pandoc.Error

45--

46--

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

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

47--

48--

49+readNative :: PandocMonad m

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

50+ => String -- ^ String to parse (assuming @'\n'@ line endings)

49− -> Either PandocError Pandoc

51+ -> m (Either PandocError Pandoc)

52+readNative s =

50−readNative s = maybe (Pandoc nullMeta <$> readBlocks s) Right (safeRead s)

53+ return $ maybe (Pandoc nullMeta <$> readBlocks s) Right (safeRead s)

51

54

52readBlocks :: String -> Either PandocError [Block]

55readBlocks :: String -> Either PandocError [Block]

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

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

tests/Tests/Old.hs+3−1

@@ -196,7 +196,9 @@ lhsReaderTest :: String -> Test

196lhsReaderTest format =

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

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

199+ where normalizer = purely $ \nat -> do

200+ d <- handleError <$> readNative nat

199− where normalizer = purely $ writeNative def . normalize . handleError . readNative

201+ writeNative def $ normalize d

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

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

201 then "lhs-test-markdown.native"

203 then "lhs-test-markdown.native"

202 else "lhs-test.native"

204 else "lhs-test.native"

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

@@ -14,6 +14,7 @@ import qualified Data.Map as M

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

15import Codec.Archive.Zip

16import Text.Pandoc.Error

17+import Text.Pandoc.Class (runIOorExplode)

17

18

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

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

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

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

@@ -43,7 +44,8 @@ compareOutput opts docxFile nativeFile = do

43 df <- B.readFile docxFile

44 df <- B.readFile docxFile

44 nf <- Prelude.readFile nativeFile

45 nf <- Prelude.readFile nativeFile

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

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

47+ df' <- runIOorExplode $ readNative nf

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

48+ return $ (noNorm p, noNorm $ handleError df')

47

49

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

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

49testCompareWithOptsIO opts name docxFile nativeFile = do

51testCompareWithOptsIO opts name docxFile nativeFile = do

tests/Tests/Readers/Odt.hs+3−1

@@ -5,6 +5,7 @@ import Text.Pandoc.Options

5import Text.Pandoc.Readers.Native

6import Text.Pandoc.Readers.Markdown

7import Text.Pandoc.Definition

8+import Text.Pandoc.Class (runIOorExplode)

8import Tests.Helpers

9import Tests.Helpers

9import Test.Framework

10import Test.Framework

10import qualified Data.ByteString.Lazy as B

11import qualified Data.ByteString.Lazy as B

@@ -62,7 +63,8 @@ compareOdtToNative :: TestCreator

62compareOdtToNative opts odtPath nativePath = do

63compareOdtToNative opts odtPath nativePath = do

63 nativeFile <- Prelude.readFile nativePath

64 nativeFile <- Prelude.readFile nativePath

64 odtFile <- B.readFile odtPath

65 odtFile <- B.readFile odtPath

65− let native = getNoNormVia id "native" $ readNative nativeFile

66+ native <- getNoNormVia id "native" <$>

67+ runIOorExplode (readNative nativeFile)

66 let odt = getNoNormVia fst "odt" $ readOdt opts odtFile

68 let odt = getNoNormVia fst "odt" $ readOdt opts odtFile

67 return (odt,native)

69 return (odt,native)

68

70

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

@@ -21,10 +21,12 @@ compareOutput opts nativeFileIn nativeFileOut = do

21 nf <- Prelude.readFile nativeFileIn

22 nf' <- Prelude.readFile nativeFileOut

23 let wopts = fst opts

24+ df <- runIOorExplode $ do

25+ d <- handleError <$> readNative nf

24− df <- runIOorExplode $ writeDocx wopts{writerUserDataDir = Just (".." </> "data")}

26+ writeDocx wopts{writerUserDataDir = Just (".." </> "data")} d

25− (handleError $ readNative nf)

27+ df' <- handleError <$> runIOorExplode (readNative nf')

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

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

27− return (p, handleError $ readNative nf')

29+ return (p, df')

28

30

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

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

30testCompareWithOptsIO opts name nativeFileIn nativeFileOut = do

32testCompareWithOptsIO opts name nativeFileIn nativeFileOut = do