From a8ac673285877f12bf65843676c57979a9ee28ce Mon Sep 17 00:00:00 2001
From: Alexander Krotov <ilabdsf@gmail.com>
Date: Tue, 21 Nov 2017 16:20:35 +0300
Subject: Muse reader: Add partial round trip test

---
 test/Tests/Readers/Muse.hs | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

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"
-- 
cgit v1.2.3