From 835c2549ca36553f08681df6df86dbb5179667d2 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 12 Sep 2024 12:55:53 +0200
Subject: [PATCH] add parsing tests

---
 test/Tree.hs                |  3 ++-
 test/Tree/Parse.hs          |  7 +++++++
 test/Tree/Parse/Base.hs     | 32 ++++++++++++++++++++++++++++++++
 test/Tree/Parse/Positive.hs | 23 +++++++++++++++++++++++
 4 files changed, 64 insertions(+), 1 deletion(-)
 create mode 100644 test/Tree/Parse.hs
 create mode 100644 test/Tree/Parse/Base.hs
 create mode 100644 test/Tree/Parse/Positive.hs

diff --git a/test/Tree.hs b/test/Tree.hs
index d4febc6dac..cecd03ea2f 100644
--- a/test/Tree.hs
+++ b/test/Tree.hs
@@ -3,7 +3,8 @@ module Tree where
 import Base
 import Tree.Asm qualified as Asm
 import Tree.Eval qualified as Eval
+import Tree.Parse qualified as Parse
 import Tree.Transformation qualified as Transformation
 
 allTests :: TestTree
-allTests = testGroup "JuvixTree tests" [Eval.allTests, Asm.allTests, Transformation.allTests]
+allTests = testGroup "JuvixTree tests" [Parse.allTests, Eval.allTests, Asm.allTests, Transformation.allTests]
diff --git a/test/Tree/Parse.hs b/test/Tree/Parse.hs
new file mode 100644
index 0000000000..7c9d4ebaf2
--- /dev/null
+++ b/test/Tree/Parse.hs
@@ -0,0 +1,7 @@
+module Tree.Parse where
+
+import Base
+import Tree.Parse.Positive qualified as P
+
+allTests :: TestTree
+allTests = testGroup "JuvixTree parsing" [P.allTests]
diff --git a/test/Tree/Parse/Base.hs b/test/Tree/Parse/Base.hs
new file mode 100644
index 0000000000..8e1049f894
--- /dev/null
+++ b/test/Tree/Parse/Base.hs
@@ -0,0 +1,32 @@
+module Tree.Parse.Base where
+
+import Base
+import Juvix.Compiler.Tree.Data.InfoTable
+import Juvix.Compiler.Tree.Pretty
+import Juvix.Compiler.Tree.Translation.FromSource
+import Juvix.Data.PPOutput
+
+treeParseAssertion :: Path Abs File -> (String -> IO ()) -> Assertion
+treeParseAssertion mainFile step = do
+  step "Parse"
+  r <- parseFile mainFile
+  case r of
+    Left err -> assertFailure (prettyString err)
+    Right tab -> do
+      withTempDir'
+        ( \dirPath -> do
+            let outputFile = dirPath <//> $(mkRelFile "out.out")
+            step "Print"
+            writeFileEnsureLn outputFile (ppPrint tab tab)
+            step "Parse printed"
+            r' <- parseFile outputFile
+            case r' of
+              Left err -> assertFailure (prettyString err)
+              Right tab' -> do
+                assertBool ("Check: print . parse = print . parse . print . parse") (ppPrint tab tab == ppPrint tab' tab')
+        )
+
+parseFile :: Path Abs File -> IO (Either MegaparsecError InfoTable)
+parseFile f = do
+  s <- readFile f
+  return (runParser f s)
diff --git a/test/Tree/Parse/Positive.hs b/test/Tree/Parse/Positive.hs
new file mode 100644
index 0000000000..f53a196e39
--- /dev/null
+++ b/test/Tree/Parse/Positive.hs
@@ -0,0 +1,23 @@
+module Tree.Parse.Positive where
+
+import Base
+import Tree.Eval.Positive qualified as Eval
+import Tree.Parse.Base
+
+type PosTest = Eval.PosTest
+
+testDescr :: PosTest -> TestDescr
+testDescr Eval.PosTest {..} =
+  let tRoot = Eval.root <//> _relDir
+      file' = tRoot <//> _file
+   in TestDescr
+        { _testName = _name,
+          _testRoot = tRoot,
+          _testAssertion = Steps $ treeParseAssertion file'
+        }
+
+allTests :: TestTree
+allTests =
+  testGroup
+    "JuvixTree parsing positive tests"
+    (map (mkTest . testDescr) Eval.tests)