aboutsummaryrefslogtreecommitdiff
path: root/test/Tests/Readers
diff options
context:
space:
mode:
authorAlexander Krotov <ilabdsf@gmail.com>2017-11-21 16:20:35 +0300
committerAlexander Krotov <ilabdsf@gmail.com>2017-11-26 02:01:39 +0300
commita8ac673285877f12bf65843676c57979a9ee28ce (patch)
tree71f12bd0236ee60fb9a1a83362c42cd78767ddc4 /test/Tests/Readers
parent5ba890a973cd1b87bb9f9b51a0be8a70a04cc1fa (diff)
downloadpandoc-a8ac673285877f12bf65843676c57979a9ee28ce.tar.gz
Muse reader: Add partial round trip test
Diffstat (limited to 'test/Tests/Readers')
-rw-r--r--test/Tests/Readers/Muse.hs29
1 files changed, 28 insertions, 1 deletions
diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs
index 1095ada31..ee910a450 100644
--- a/test/Tests/Readers/Muse.hs
+++ b/test/Tests/Readers/Muse.hs
@@ -5,10 +5,12 @@ import Data.List (intersperse)
import Data.Text (Text)
import qualified Data.Text as T
import Test.Tasty
+import Test.Tasty.QuickCheck
import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
+import Text.Pandoc.Walk (walk)
amuse :: Text -> Pandoc
amuse = purely $ readMuse def { readerExtensions = extensionsFromList [Ext_amuse]}
@@ -24,6 +26,30 @@ infix 4 =:
spcSep :: [Inlines] -> Inlines
spcSep = mconcat . intersperse space
+-- Tables and code blocks don't round-trip yet
+
+removeTables :: Block -> Block
+removeTables (Table{}) = Para [Str "table was here"]
+removeTables x = x
+
+removeCodeBlocks :: Block -> Block
+removeCodeBlocks (CodeBlock{}) = Para [Str "table was here"]
+removeCodeBlocks x = x
+
+-- Demand that any AST produced by Muse reader and written by Muse writer can be read back exactly the same way.
+-- Currently we remove code blocks and tables and compare third rewrite to the second.
+-- First and second rewrites are not equal yet.
+roundTrip :: Block -> Bool
+roundTrip b = d'' == d'''
+ where d = walk (removeCodeBlocks . removeTables) $ Pandoc nullMeta [b]
+ d' = rewrite d
+ d'' = rewrite d'
+ d''' = rewrite d''
+ rewrite = amuse . T.pack . (++ "\n") . T.unpack .
+ (purely $ writeMuse def { writerExtensions = extensionsFromList [Ext_amuse]
+ , writerWrapText = WrapPreserve
+ })
+
tests :: [TestTree]
tests =
[ testGroup "Inlines"
@@ -165,7 +191,8 @@ tests =
]
, testGroup "Blocks"
- [ "Block elements end paragraphs" =:
+ [ testProperty "Round trip" roundTrip
+ , "Block elements end paragraphs" =:
T.unlines [ "First paragraph"
, "----"
, "Second paragraph"