From 18e85f8dfbf9323945969cdf831c9a16f90299a0 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 27 Nov 2016 16:38:46 +0100 Subject: 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 -- cgit v1.2.3