-- New tests for Expr

module Testing.Unit.ExprTests (tests, runU) where

import Test.HUnit

import Data.Number.Sifflet

import Data.Sifflet.Tree as T

import Language.Sifflet.Examples

import Language.Sifflet.Expr
import Language.Sifflet.ExprTree

import Text.Sifflet.Repr ()

import Language.Sifflet.Util

import Testing.TestUtil

env0 :: Env
env0 = makeEnv [] []

envTest :: Env
envTest = extendEnv ["x", "y"] -- , "foo"] 
                    [VNumber (Exact 3), VNumber (Exact 7)] -- , VFun foo]
                    exampleEnv

fPlus :: Function
fPlus = envGetFunction baseEnv "+"

-- (ifExpr t a b represents "if t a else b")
ifExpr :: Bool -> Integer -> Integer -> Expr
ifExpr bool0 int1 int2 = eIf (eBool bool0) (eInt int1) (eInt int2)

plusExpr :: Integer -> Integer -> Expr
plusExpr int1 int2 = ePlus (eInt int1) (eInt int2)

testRepr :: Test
testRepr = assertAll
   [
     -- Functions
     assertEqual "repr of Function (primitive)" "<primfunc +>" 
                     (repr fPlus),
     -- Values
     assertEqual "repr of VString" "\"hi monde\"" (repr $ VString "hi monde"),
     assertEqual "repr of VNumber" "23" (repr $ VNumber (Exact 23)),
     assertEqual "repr of VBool" "False" (repr $ VBool False),
     -- add VList ...
     -- ExprNode
     assertEqual "reprl of ExprNode/symbol with no value" 
           ["casey"]
           (reprl $ ENode (NSymbol (Symbol "casey")) EvalUntried),
     assertEqual "reprl of ExprNode/symbol with value"
           ["casey", "23"]
           (reprl $ ENode (NSymbol (Symbol "casey"))
                          (EvalOk (VNumber (Exact 23)))),
     assertEqual "reprl of ExprNode/symbol with an error"
           ["casey", "error: unbound"]
           (reprl $ ENode (NSymbol (Symbol "casey")) (EvalError "unbound")),
     assertEqual "reprs of ExprNode/symbol with value"
           "casey 23"
           (reprs $ ENode (NSymbol (Symbol "casey")) 
                          (EvalOk (VNumber (Exact 23)))),
     
     assertEqual "reprl of ExprNode/string literal"
           ["\"adam\""]
           (reprl $ ENode (NString "adam") EvalUntried),
     assertEqual "reprl of ExprNode/int literal"
           ["23"]
           (reprl $ ENode (NNumber (Exact 23)) EvalUntried),
     assertEqual "reprl of ExprNode/boolean literal"
           ["False"]
           (reprl $ ENode (NBool False) (EvalOk (VBool False))),
     assertEqual "reprl of ExprNode/if"
           ["if"]
           (reprl $ ENode (NSymbol (Symbol "if")) EvalUntried),
     assertEqual "reprl of ExprNode/if/value"
           ["if", "5"]
           (reprl $ ENode (NSymbol (Symbol "if")) 
                          (EvalOk (VNumber (Exact 5)))),
     assertEqual "reprs of ExprNode/if/value"
           "if 5"
           (reprs $ ENode (NSymbol (Symbol "if")) 
                          (EvalOk (VNumber (Exact 5)))),
     --  Expr
     assertEqual "repr of Expr/variable"
                  "betty"
                  (repr $ eSymbol "betty"),
     assertEqual "repr of Expr/function call with args"
                  "(top sam \"johnny\")"
                  (repr (eCall "top" [eSymbol "sam", eString "johnny"]))
   ]

testEnv :: Test
testEnv = 
    let ints = map int
        e0 = makeEnv [] []
        e1 = extendEnv ["a", "b"] (ints [1, 3]) e0
        e2 = extendEnv ["b", "c", "d"] (ints [5, 7, 9]) e1
    in assertAll
                    [
     -- testing Env
     assertEqual "makeEnv + envGet"
                   (int 21)
                   (envGet (makeEnv ["a", "b"] [int 21, VString "hoot"])
                               "a"),
     assertEqual "envIns + envGet"
                   (int 12)
                   (envGet (envIns e0 "x" (int 12)) "x"),
     assertEqual "extendEnv e1 a" (int 1) (envGet e1 "a"),
     assertEqual "extendEnv e1 b" (int 3) (envGet e1 "b"),
     assertEqual "extendEnv e2 b" (int 5) (envGet e2 "b"),
     assertEqual "extendEnv e2 c" (int 7) (envGet e2 "c"),
     assertEqual "extendEnv e2 d" (int 9) (envGet e2 "d"),
     assertEqual "envSet e0 a 1" 
                 (makeEnv ["a"] [int 1])
                 (envSet e0 "a" (int 1)),
     assertEqual "envSet e1 a 7"
                 (extendEnv ["a", "b"] (ints [7, 3]) e0)
                 (envSet e1 "a" (int 7)),
     assertEqual "envSet e2 a 7"
                 (extendEnv ["b", "c", "d"] (ints [5, 7, 9])
                  (extendEnv ["a", "b"] (ints [7, 3]) e0))
                 (envSet e2 "a" (int 7)),
     assertEqual "envSet e2 b 18"
                 (extendEnv ["b", "c", "d"] (ints [18, 7, 9]) e1)
                 (envSet e2 "b" (int 18)),
     assertEqual "envSet e2 z 23"
                 (extendEnv ["b", "c", "d", "z"] 
                            (ints [5, 7, 9, 23])
                            e1)
                 (envSet e2 "z" (int 23))
                 ]


testExprTree :: Test
testExprTree = TestCase $ 
   let call1  = eCall "top" [eSymbol "sam", eString "johnny"]
   in assertEqual "testing reciprocals exprTree, treeExpr"
                  (Succ call1)
                  (treeToExpr (exprToTree call1))

int :: Integer -> Value
int = VNumber . Exact

testEval :: Test
testEval = 
    assertAll
             [assertEqual "eval 2 + 3"
                              (EvalOk (VNumber (Exact 5)))
                              (eval (ePlus (eInt 2) (eInt 3))
                              exampleEnv)
             ,
              assertEqual "eval x + y"
                                 (EvalOk (int 10))
                                 (eval (ePlus (eSymbol "x") (eSymbol "y"))
                                       envTest)
             ,
              assertEqual "eval foo 2 4"
                                 (EvalOk (int 8))
                                 (eval (eFoo (eInt 2) (eInt 4)) envTest)
             ,
              assertEqual "eval foo x y"
                                 (EvalOk (int 13))
                                 (eval (eFoo (eSymbol "x") (eSymbol "y"))
                                       envTest)
             ,
              assertEqual "eval (1 + x) + foo y 2"
                                 (EvalOk (int 20))
                                 (eval (ePlus (ePlus (eInt 1) (eSymbol "x"))
                                        (eFoo (eSymbol "y") (eInt 2)))
                                  envTest)
             ,
              assertEqual "eval max x y"
                                 (EvalOk (int 7))
                                 (eval (eMax (eSymbol "x") (eSymbol "y"))
                                       envTest)
             ,
              assertEqual "eval max 42 12"
                                 (EvalOk (int 42))
                                 (eval (eMax (eInt 42) (eInt 12)) envTest)
             ,
              assertEqual "eval fact 0"
                                 (EvalOk (int 1))
                                 (eval (eFact (eInt 0)) envTest)
             ,
              assertEqual "eval fact 5"
                              (EvalOk (int 120))
                              (eval (eFact (eInt 5)) envTest)
             ,
              assertEqual "eval literal"
                              (EvalOk (int 345))
                              (eval (eInt 345) env0)
             ,
              assertEqual "eval variable"
                              (EvalOk (int 331))
                              (eval (eSymbol "w3c") 
                                        (makeEnv ["w3c"] [int 331]))
             ,
              assertEqual "eval if false"
                              (EvalOk (int 281))
                              (eval (ifExpr False 279 281) env0)
             ,
              assertEqual "eval if true"
                                     (EvalOk (int 279))
                                     (eval (ifExpr True 279 281) env0)
             ,
              assertEqual "eval function call"
                                     (EvalOk (int 5))
                                     (eval (plusExpr 2 3) envTest)
             ,
              assertEqual "eval function call with unbound variable"
                                 (EvalError "unbound variable: j")
                                 (eval (ePlus (eSymbol "j") (eInt 1)) envTest)
             ,
              assertEqual "eval head okay"
                                 (EvalOk (int 5)) 
                                 (eval (eCall "head" [EList [eInt 5, eInt 7]])
                                       envTest)
             ,
              assertEqual "eval head with error"
                              (EvalError "head: empty list")
                              (eval (eCall "head" [EList []]) envTest)
             ,
              assertEqual "eval div by zero"
                              (EvalError 
                               "div: zero divisor ([VNumber 3,VNumber 0])")
                              (eval (eCall "div" [eSymbol "x", eInt 0])
                                    envTest)
                    ]

testEvalTree :: Test
testEvalTree = assertAll
   [let t = evalTree (exprToTree (plusExpr 5 7)) envTest
        ENode _ mvalue = rootLabel t 
    in assertEqual "evalTree: plus" (EvalOk (int 12)) mvalue,
   
    let t = evalTree (exprToTree (ifExpr True 8 21)) env0
        ENode _ mvalue = rootLabel t 
    in assertEqual "evalTree: if true" (EvalOk (int 8)) mvalue,
   
    let t = evalTree (exprToTree (ifExpr False 17 35)) env0
        ENode _ mvalue = rootLabel t 
    in assertEqual "evalTree: if false" (EvalOk (int 35)) mvalue,

    let t = evalTree (exprToTree (ePlus (eSymbol "j") (eInt 1))) envTest
        ENode _ mvalue = rootLabel t
    in assertEqual "evalTree: function call with unbound variable"
                   (EvalError "unbound variable: j")
                   mvalue
   ]

testUnevalTree :: Test
testUnevalTree = TestCase $ 
  let t1 = exprToTree (ePlus (eSymbol "a") (eTimes (eSymbol "b") (eInt 3)))
      t2 = evalTree t1 (makeEnv ["a", "b"] (map int [7, 5]))
  in assertEqual "unevalTree" t1 (unevalTree t2)

testExprSymbols :: Test
testExprSymbols = 
  let e1 = ePlus (eSymbol "x") (eSymbol "y")
      e2 = eTimes (ePlus (eSymbol "horse") (eInt 5))
                  (eMinus (eInt 6) 
                          (eTimes (eSymbol "neck") (eSymbol "tail")))
  in assertAll
          [
           assertEqual "exprSymbols: 0" 
                        (map Symbol ["x", "y", "+"]) (exprSymbols e1),
           assertEqual "exprSymbols: 1" 
                       ["x", "y"] (exprVarNames e1),
           assertEqual "exprSymbols: 2"
                       (map Symbol ["horse", "+", "neck", "tail", "*", "-"])
                       (exprSymbols e2),
           assertEqual "exprSymbols: 3"
                       ["horse", "neck"]
                       (exprVarNames e2)
          ]

testLambda :: Test
testLambda =
    let vx = ESymbol (Symbol "x")
        vy = ESymbol (Symbol "y")
        body = ePlus vx vy
    in assertAll
       [assertEqual "lambda ()"
                     (Fail "toLambdaExpr: no arguments; at least one needed")
                     (toLambdaExpr [] body)
       , assertEqual "lambda (x)"
                     (Succ (ELambda (Symbol "x") body))
                     (toLambdaExpr ["x"] body)
       , assertEqual "lambda (x y)"
                     (Succ (ELambda (Symbol "x")
                                    (ELambda (Symbol "y") body)))
                     (toLambdaExpr ["x", "y"] body)
       ]

testAppCall :: Test
testAppCall =
    let callFoo ns = ECall (Symbol "foo") (map eInt ns)
        call1 = callFoo [1]
        call2 = callFoo [1, 2]
        call3 = callFoo [1, 2, 3]
        appFoo n = EApp (ESymbol (Symbol "foo")) (eInt n)
        app1 = appFoo 1
        app2 = EApp app1 (eInt 2)
        app3 = EApp app2 (eInt 3)
    in assertAll
       [assertEqual "call to app 1" app1 (callToApp call1)
       , assertEqual "call to app 2" app2 (callToApp call2)
       , assertEqual "call to app 3" app3 (callToApp call3)
       , assertEqual "app to call 1" call1 (appToCall app1)
       , assertEqual "app to call 2" call2 (appToCall app2)
       , assertEqual "app to call 3" call3 (appToCall app3)
       ]


tests :: Test
tests = TestList [TestLabel "repr" testRepr, 
                  TestLabel "env" testEnv, 
                  TestLabel "expr tree" testExprTree,
                  TestLabel "eval" testEval, 
                  TestLabel "eval tree" testEvalTree, 
                  TestLabel "uneval tree" testUnevalTree, 
                  TestLabel "expr symbols" testExprSymbols,
                  TestLabel "expr lambda" testLambda,
                  TestLabel "ECall <-> EApp exprs" testAppCall
                 ]


runU :: IO ()
runU = utestloop tests