From 18e85f8dfbf9323945969cdf831c9a16f90299a0 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sun, 27 Nov 2016 16:38:46 +0100
Subject: [PATCH] Changed readNative to use PandocMonad.
---
src/Text/Pandoc.hs | 4 ++--
src/Text/Pandoc/Readers/Native.hs | 9 ++++++---
tests/Tests/Old.hs | 4 +++-
tests/Tests/Readers/Docx.hs | 4 +++-
tests/Tests/Readers/Odt.hs | 4 +++-
tests/Tests/Writers/Docx.hs | 8 +++++---
6 files changed, 22 insertions(+), 11 deletions(-)
diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs
index 70d1300b3..34b6b8d0c 100644
--- a/src/Text/Pandoc.hs
+++ b/src/Text/Pandoc.hs
@@ -183,7 +183,7 @@ import Text.Pandoc.Options
import Text.Pandoc.Shared (safeRead, warn, mapLeft, pandocVersion)
import Text.Pandoc.MediaBag (MediaBag)
import Text.Pandoc.Error
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, runIOorExplode)
import Data.Aeson
import qualified Data.ByteString.Lazy as BL
import Data.List (intercalate)
@@ -243,7 +243,7 @@ mkBSReaderWithWarnings r = ByteStringReader $ \o s ->
-- | Association list of formats and readers.
readers :: [(String, Reader IO)]
-readers = [ ("native" , StringReader $ \_ s -> return $ readNative s)
+readers = [ ("native" , StringReader $ \_ s -> runIOorExplode (readNative s))
,("json" , mkStringReader readJSON )
,("markdown" , mkStringReaderWithWarnings readMarkdownWithWarnings)
,("markdown_strict" , mkStringReaderWithWarnings readMarkdownWithWarnings)
diff --git a/src/Text/Pandoc/Readers/Native.hs b/src/Text/Pandoc/Readers/Native.hs
index 4ec164e19..917a4a144 100644
--- a/src/Text/Pandoc/Readers/Native.hs
+++ b/src/Text/Pandoc/Readers/Native.hs
@@ -34,6 +34,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Shared (safeRead)
import Text.Pandoc.Error
+import Text.Pandoc.Class
-- | Read native formatted text and return a Pandoc document.
-- The input may be a full pandoc document, a block list, a block,
@@ -45,9 +46,11 @@ import Text.Pandoc.Error
--
-- > Pandoc nullMeta [Plain [Str "hi"]]
--
-readNative :: String -- ^ String to parse (assuming @'\n'@ line endings)
- -> Either PandocError Pandoc
-readNative s = maybe (Pandoc nullMeta <$> readBlocks s) Right (safeRead s)
+readNative :: PandocMonad m
+ => String -- ^ String to parse (assuming @'\n'@ line endings)
+ -> m (Either PandocError Pandoc)
+readNative s =
+ return $ maybe (Pandoc nullMeta <$> readBlocks s) Right (safeRead s)
readBlocks :: String -> Either PandocError [Block]
readBlocks s = maybe ((:[]) <$> readBlock s) Right (safeRead s)
diff --git a/tests/Tests/Old.hs b/tests/Tests/Old.hs
index bb0e2aac2..b76043887 100644
--- a/tests/Tests/Old.hs
+++ b/tests/Tests/Old.hs
@@ -196,7 +196,9 @@ lhsReaderTest :: String -> Test
lhsReaderTest format =
testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"]
("lhs-test" <.> format) norm
- where normalizer = purely $ writeNative def . normalize . handleError . readNative
+ where normalizer = purely $ \nat -> do
+ d <- handleError <$> readNative nat
+ writeNative def $ normalize d
norm = if format == "markdown+lhs"
then "lhs-test-markdown.native"
else "lhs-test.native"
diff --git a/tests/Tests/Readers/Docx.hs b/tests/Tests/Readers/Docx.hs
index 3e630dd49..59147b664 100644
--- a/tests/Tests/Readers/Docx.hs
+++ b/tests/Tests/Readers/Docx.hs
@@ -14,6 +14,7 @@ import qualified Data.Map as M
import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory)
import Codec.Archive.Zip
import Text.Pandoc.Error
+import Text.Pandoc.Class (runIOorExplode)
-- We define a wrapper around pandoc that doesn't normalize in the
-- tests. Since we do our own normalization, we want to make sure
@@ -43,7 +44,8 @@ compareOutput opts docxFile nativeFile = do
df <- B.readFile docxFile
nf <- Prelude.readFile nativeFile
let (p, _) = handleError $ readDocx opts df
- return $ (noNorm p, noNorm (handleError $ readNative nf))
+ df' <- runIOorExplode $ readNative nf
+ return $ (noNorm p, noNorm $ handleError df')
testCompareWithOptsIO :: ReaderOptions -> String -> FilePath -> FilePath -> IO Test
testCompareWithOptsIO opts name docxFile nativeFile = do
diff --git a/tests/Tests/Readers/Odt.hs b/tests/Tests/Readers/Odt.hs
index dff62c54b..0ff527130 100644
--- a/tests/Tests/Readers/Odt.hs
+++ b/tests/Tests/Readers/Odt.hs
@@ -5,6 +5,7 @@ import Text.Pandoc.Options
import Text.Pandoc.Readers.Native
import Text.Pandoc.Readers.Markdown
import Text.Pandoc.Definition
+import Text.Pandoc.Class (runIOorExplode)
import Tests.Helpers
import Test.Framework
import qualified Data.ByteString.Lazy as B
@@ -62,7 +63,8 @@ compareOdtToNative :: TestCreator
compareOdtToNative opts odtPath nativePath = do
nativeFile <- Prelude.readFile nativePath
odtFile <- B.readFile odtPath
- let native = getNoNormVia id "native" $ readNative nativeFile
+ native <- getNoNormVia id "native" <$>
+ runIOorExplode (readNative nativeFile)
let odt = getNoNormVia fst "odt" $ readOdt opts odtFile
return (odt,native)
diff --git a/tests/Tests/Writers/Docx.hs b/tests/Tests/Writers/Docx.hs
index a76583796..cdaa2c097 100644
--- a/tests/Tests/Writers/Docx.hs
+++ b/tests/Tests/Writers/Docx.hs
@@ -21,10 +21,12 @@ compareOutput opts nativeFileIn nativeFileOut = do
nf <- Prelude.readFile nativeFileIn
nf' <- Prelude.readFile nativeFileOut
let wopts = fst opts
- df <- runIOorExplode $ writeDocx wopts{writerUserDataDir = Just (".." </> "data")}
- (handleError $ readNative nf)
+ df <- runIOorExplode $ do
+ d <- handleError <$> readNative nf
+ writeDocx wopts{writerUserDataDir = Just (".." </> "data")} d
+ df' <- handleError <$> runIOorExplode (readNative nf')
let (p, _) = handleError $ readDocx (snd opts) df
- return (p, handleError $ readNative nf')
+ return (p, df')
testCompareWithOptsIO :: Options -> String -> FilePath -> FilePath -> IO Test
testCompareWithOptsIO opts name nativeFileIn nativeFileOut = do