Initialize Repo

Working (but likely buggy!) lexing, parsing, and evaluation of Tree Calculus terms

test/Spec.hs

@@ -0,0 +1,112 @@
+module Main where
+
+import Eval
+import Lexer
+import Parser
+import Research
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck
+import Text.Megaparsec (runParser)
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Sapling Tests"
+  [ lexerTests
+  , parserTests
+  , integrationTests
+  , evaluationTests
+  , propertyTests
+  ]
+
+lexerTests :: TestTree
+lexerTests = testGroup "Lexer Tests"
+  [ testCase "Lex simple identifiers" $ do
+      let input = "x a b = a"
+      let expected = Right [LIdentifier "x", LIdentifier "a", LIdentifier "b", LAssign, LIdentifier "a"]
+      runParser saplingLexer "" input @?= expected
+
+  , testCase "Lex Tree Calculus terms" $ do
+      let input = "t t t"
+      let expected = Right [LKeywordT, LKeywordT, LKeywordT]
+      runParser saplingLexer "" input @?= expected
+
+  , testCase "Handle invalid input" $ do
+      let input = "x = "
+      case runParser saplingLexer "" input of
+        Left _ -> return ()
+        Right _ -> assertFailure "Expected failure on invalid input"
+  ]
+
+parserTests :: TestTree
+parserTests = testGroup "Parser Tests"
+  [ testCase "Parse function definitions" $ do
+      let input = "x a b = a"
+      let expected = SFunc "x" ["a", "b"] (SApp (SVar "a") [])
+      parseSapling input @?= expected
+
+  , testCase "Parse nested Tree Calculus terms" $ do
+      let input = "t (t t) t"
+      let expected = TFork (TStem TLeaf) TLeaf
+      parseSapling input @?= expected
+
+  , testCase "Parse sequential Tree Calculus terms" $ do
+      let input = "t t t"
+      let expected = TFork TLeaf TLeaf
+      parseSapling input @?= expected
+  ]
+
+integrationTests :: TestTree
+integrationTests = testGroup "Integration Tests"
+  [ testCase "Combine lexer and parser" $ do
+      let input = "x = t t t"
+      let expected = SFunc "x" [] (TFork TLeaf TLeaf)
+      parseSapling input @?= expected
+
+  , testCase "Complex Tree Calculus expression" $ do
+      let input = "t (t t t) t"
+      let expected = TFork (TFork TLeaf TLeaf) TLeaf
+      parseSapling input @?= expected
+  ]
+
+evaluationTests :: TestTree
+evaluationTests = testGroup "Evaluation Tests"
+  [ testCase "Evaluate single Leaf" $ do
+      let input = "t"
+      let ast = parseSapling input
+      evalSapling ast @?= Leaf
+
+  , testCase "Evaluate single Stem" $ do
+      let input = "t t"
+      let ast = parseSapling input
+      evalSapling ast @?= Stem Leaf
+
+  , testCase "Evaluate single Fork" $ do
+      let input = "t t t"
+      let ast = parseSapling input
+      evalSapling ast @?= Fork Leaf Leaf
+
+  , testCase "Evaluate nested Fork and Stem" $ do
+      let input = "t (t t) t"
+      let ast = parseSapling input
+      evalSapling ast @?= Fork (Stem Leaf) Leaf
+
+  , testCase "Evaluate `not` function" $ do
+      let input = "t (t (t t) (t t t)) t)"
+      let ast = parseSapling input
+      evalSapling ast @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
+  ]
+
+propertyTests :: TestTree
+propertyTests = testGroup "Property Tests"
+  [ testProperty "Lexing and parsing round-trip" $ \input ->
+      case runParser saplingLexer "" input of
+        Left _ -> property True  -- Ignore invalid lexes
+        Right tokens -> case runParser parseExpression "" tokens of
+          Left _ -> property True  -- Ignore invalid parses
+          Right ast -> parseSapling input === ast
+  ]
+