tests.hs

#!/usr/bin/env runhaskell
{-# LANGUAGE DeriveGeneric #-}


-- To run tests: runhaskell tests.hs

import Data.Char (isDigit, isAlpha, isAlphaNum, isSpace)
import Data.List (intercalate)
import System.Exit (exitFailure, exitSuccess)

-- AST Data Types (from parser_standalone.hs)

data Expr
  = Number Int
  | BinOp Op Expr Expr
  | Var String
  deriving (Show, Eq)

data Op = Add | Sub | Mul | Div
  deriving (Show, Eq)

data KVPair = KVPair String String
  deriving (Show, Eq)


-- Tokenizer

data Token
  = TNum Int
  | TOp Char
  | TVar String
  | TLParen
  | TRParen
  | TEq
  | EOF
  deriving (Show, Eq)

tokenize :: String -> [Token]
tokenize [] = [EOF]
tokenize (c:cs)
  | isSpace c = tokenize cs
  | isDigit c = 
      let (num, rest) = span isDigit (c:cs)
      in TNum (read num) : tokenize rest
  | isAlpha c =
      let (var, rest) = span isAlphaNum (c:cs)
      in TVar var : tokenize rest
  | c == '+' || c == '-' || c == '*' || c == '/' = TOp c : tokenize cs
  | c == '(' = TLParen : tokenize cs
  | c == ')' = TRParen : tokenize cs
  | c == '=' = TEq : tokenize cs
  | otherwise = tokenize cs


-- Parser

parseExpr :: [Token] -> (Expr, [Token])
parseExpr tokens = parseAddSub tokens

parseAddSub :: [Token] -> (Expr, [Token])
parseAddSub tokens =
  let (left, rest) = parseMulDiv tokens
  in parseAddSub' left rest

parseAddSub' :: Expr -> [Token] -> (Expr, [Token])
parseAddSub' left (TOp '+' : rest) =
  let (right, rest') = parseMulDiv rest
  in parseAddSub' (BinOp Add left right) rest'
parseAddSub' left (TOp '-' : rest) =
  let (right, rest') = parseMulDiv rest
  in parseAddSub' (BinOp Sub left right) rest'
parseAddSub' left rest = (left, rest)

parseMulDiv :: [Token] -> (Expr, [Token])
parseMulDiv tokens =
  let (left, rest) = parsePrimary tokens
  in parseMulDiv' left rest

parseMulDiv' :: Expr -> [Token] -> (Expr, [Token])
parseMulDiv' left (TOp '*' : rest) =
  let (right, rest') = parsePrimary rest
  in parseMulDiv' (BinOp Mul left right) rest'
parseMulDiv' left (TOp '/' : rest) =
  let (right, rest') = parsePrimary rest
  in parseMulDiv' (BinOp Div left right) rest'
parseMulDiv' left rest = (left, rest)

parsePrimary :: [Token] -> (Expr, [Token])
parsePrimary (TNum n : rest) = (Number n, rest)
parsePrimary (TVar v : rest) = (Var v, rest)
parsePrimary (TLParen : rest) =
  let (expr, rest') = parseExpr rest
  in case rest' of
    (TRParen : rest'') -> (expr, rest'')
    _ -> error "Expected closing parenthesis"
parsePrimary _ = error "Expected a number, variable, or opening parenthesis"

parseKVPair :: [Token] -> (KVPair, [Token])
parseKVPair (TVar key : TEq : TVar value : rest) = (KVPair key value, rest)
parseKVPair (TVar key : TEq : TNum num : rest) = (KVPair key (show num), rest)
parseKVPair _ = error "Invalid key-value pair format (expected: key = value)"


-- Evaluator

evalExpr :: Expr -> Int
evalExpr (Number n) = n
evalExpr (Var _) = error "Variable evaluation not supported"
evalExpr (BinOp op left right) =
  let l = evalExpr left
      r = evalExpr right
  in case op of
    Add -> l + r
    Sub -> l - r
    Mul -> l * r
    Div -> if r == 0 then error "Division by zero" else l `div` r


-- Test Framework

data TestResult = Pass | Fail String deriving (Show, Eq)

test :: (Eq a, Show a) => String -> a -> a -> TestResult
test name expected actual =
  if expected == actual
    then Pass
    else Fail $ name ++ ": expected " ++ show expected ++ ", got " ++ show actual

-- Simple test runner

runTests :: String -> [TestResult] -> IO ()
runTests suiteName results = do
  putStrLn $ "=== " ++ suiteName ++ " ==="
  let (passed, failed) = countResults results
  mapM_ printResult results
  putStrLn $ "\n✓ Passed: " ++ show passed
  putStrLn $ "✗ Failed: " ++ show failed
  putStrLn ""
  return ()

countResults :: [TestResult] -> (Int, Int)
countResults results = 
  let passed = length $ filter (== Pass) results
      failed = length results - passed
  in (passed, failed)

printResult :: TestResult -> IO ()
printResult Pass = putStrLn "  ✓ PASS"
printResult (Fail msg) = putStrLn $ "  ✗ FAIL: " ++ msg


-- Tokenizer Tests

tokenizerTests :: [TestResult]
tokenizerTests =
  [ test "tokenize a single number" [TNum 42, EOF] (tokenize "42")
  , test "tokenize multiple numbers" [TNum 1, TOp '+', TNum 2, EOF] (tokenize "1 + 2")
  , test "tokenize operators" [TNum 5, TOp '+', TNum 3, TOp '*', TNum 2, EOF] (tokenize "5 + 3 * 2")
  , test "tokenize parentheses" [TLParen, TNum 1, TOp '+', TNum 2, TRParen, EOF] (tokenize "(1 + 2)")
  , test "tokenize a key-value pair" [TVar "name", TEq, TVar "bob", EOF] (tokenize "name = bob")
  , test "tokenize with spaces" [TNum 10, TOp '+', TNum 20, EOF] (tokenize "  10  +  20  ")
  , test "tokenize a variable" [TVar "x", EOF] (tokenize "x")
  , test "tokenize a multi-character variable" [TVar "result", EOF] (tokenize "result")
  , test "tokenize a complex expression" 
      [TVar "x", TOp '+', TNum 1, TOp '*', TNum 2, EOF] 
      (tokenize "x + 1 * 2")
  ]

-- Parser Tests

parserTests :: [TestResult]
parserTests =
  [ test "parse a single number" 
      (Number 42, [EOF]) 
      (parseExpr (tokenize "42"))
  
  , test "parse addition" 
      (BinOp Add (Number 1) (Number 2), [EOF]) 
      (parseExpr (tokenize "1 + 2"))
  
  , test "parse multiplication" 
      (BinOp Mul (Number 3) (Number 4), [EOF]) 
      (parseExpr (tokenize "3 * 4"))
  
  , test "parse precedence (multiplication before addition)" 
      (BinOp Add (Number 1) (BinOp Mul (Number 5) (Number 4)), [EOF]) 
      (parseExpr (tokenize "1 + 5 * 4"))
  
  , test "parse parentheses" 
      (BinOp Mul (BinOp Add (Number 7) (Number 9)) (Number 3), [EOF]) 
      (parseExpr (tokenize "(7 + 9) * 3"))
  
  , test "parse subtraction" 
      (BinOp Sub (Number 10) (Number 3), [EOF]) 
      (parseExpr (tokenize "10 - 3"))
  
  , test "parse division" 
      (BinOp Div (Number 20) (Number 4), [EOF]) 
      (parseExpr (tokenize "20 / 4"))
  
  , test "parse left-associative addition" 
      (BinOp Add (BinOp Add (Number 1) (Number 2)) (Number 3), [EOF]) 
      (parseExpr (tokenize "1 + 2 + 3"))
  
  , test "parse complex expression"
      (BinOp Add (BinOp Mul (Number 2) (Number 3)) (BinOp Mul (Number 4) (Number 5)), [EOF])
      (parseExpr (tokenize "2 * 3 + 4 * 5"))
  ]

-- Key-Value Pair Parser Tests

kvParserTests :: [TestResult]
kvParserTests =
  [ test "parse a simple key-value pair (string)" 
      (KVPair "name" "bob", [EOF]) 
      (parseKVPair (tokenize "name = bob"))
  
  , test "parse a key-value pair (number)" 
      (KVPair "age" "30", [EOF]) 
      (parseKVPair (tokenize "age = 30"))
  
  , test "parse a key-value pair with spaces" 
      (KVPair "key" "value", [EOF]) 
      (parseKVPair (tokenize "  key  =  value  "))
  ]


-- Evaluator Tests

evaluatorTests :: [TestResult]
evaluatorTests =
  [ test "evaluate a single number" 
      42 
      (evalExpr (Number 42))
  
  , test "evaluate addition" 
      5 
      (evalExpr (BinOp Add (Number 2) (Number 3)))
  
  , test "evaluate subtraction" 
      7 
      (evalExpr (BinOp Sub (Number 10) (Number 3)))
  
  , test "evaluate multiplication" 
      12 
      (evalExpr (BinOp Mul (Number 3) (Number 4)))
  
  , test "evaluate division" 
      5 
      (evalExpr (BinOp Div (Number 20) (Number 4)))
  
  , test "evaluate a complex expression: 1 + 5 * 4" 
      21 
      (evalExpr (BinOp Add (Number 1) (BinOp Mul (Number 5) (Number 4))))
  
  , test "evaluate a complex expression: (7 + 9) * 3" 
      48 
      (evalExpr (BinOp Mul (BinOp Add (Number 7) (Number 9)) (Number 3)))
  
  , test "evaluate left-associative addition: 1 + 2 + 3"
      6
      (evalExpr (BinOp Add (BinOp Add (Number 1) (Number 2)) (Number 3)))
  
  , test "evaluate a subtraction chain: 10 - 3 - 2"
      5
      (evalExpr (BinOp Sub (BinOp Sub (Number 10) (Number 3)) (Number 2)))
  ]


-- Integration Tests

integrationTests :: [TestResult]
integrationTests =
  let input1 = "1 + 5 * 4"
      (ast1, _) = parseExpr (tokenize input1)
      result1 = evalExpr ast1
      
      input2 = "(7 + 9) * 3"
      (ast2, _) = parseExpr (tokenize input2)
      result2 = evalExpr ast2
      
      input3 = "2 * 3 + 4 * 5"
      (ast3, _) = parseExpr (tokenize input3)
      result3 = evalExpr ast3
  in
  [ test "integration: parse and evaluate '1 + 5 * 4'" 21 result1
  , test "integration: parse and evaluate '(7 + 9) * 3'" 48 result2
  , test "integration: parse and evaluate '2 * 3 + 4 * 5'" 26 result3
  ]

-- Main Test Runner

main :: IO ()
main = do
  putStrLn ""
  putStrLn "╔════════════════════════════════════════╗"
  putStrLn "║       Tiny Parser - Test Suite         ║"
  putStrLn "╚════════════════════════════════════════╝"
  putStrLn ""
  
  runTests "Tokenizer Tests" tokenizerTests
  runTests "Parser Tests" parserTests
  runTests "Key-Value Parser Tests" kvParserTests
  runTests "Evaluator Tests" evaluatorTests
  runTests "Integration Tests" integrationTests
  
  let allTests = tokenizerTests ++ parserTests ++ kvParserTests ++ evaluatorTests ++ integrationTests
  let (totalPassed, totalFailed) = countResults allTests
  let totalTests = totalPassed + totalFailed
  
  putStrLn "╔════════════════════════════════════════╗"
  putStrLn "║         Test Results Summary           ║"
  putStrLn "╚════════════════════════════════════════╝"
  putStrLn $ "Total Tests: " ++ show totalTests
  putStrLn $ "✓ Passed: " ++ show totalPassed
  putStrLn $ "✗ Failed: " ++ show totalFailed
  putStrLn ""
  
  if totalFailed == 0
    then do
      putStrLn "🎉 All tests passed!"
      exitSuccess
    else do
      putStrLn "❌ Some tests failed!"
      exitFailure