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
  ]