ExprTreeTests.hs

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

import Test.HUnit

import Data.Number.Sifflet

import Data.Sifflet.Geometry
import Data.Sifflet.Tree as T
import Data.Sifflet.TreeGraph
import Data.Sifflet.TreeLayout
import Data.Sifflet.WGraph

import Language.Sifflet.Examples

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

import Text.Sifflet.Repr ()

import Testing.Common.ExprTreeTests
import Testing.TestUtil

-- ============================================================
-- UNIT TESTS 

utestGNode :: Test
utestGNode = 
  let tpp = "The Purple Platypus"
      gnode = makeGNode testStyle zeroIoletCounter (Name tpp)
      Size w h = measureText testStyle tpp
      m = 18.0 -- style textMargin
      mm = 2.0 * m
      x = m
      y = 36.5 -- where does this come from????
      w' = w + mm
      h' = h + mm
  in assertAll
          [assertEqual "GNode of The Purple Platypus"
                       CloseEnough
                       (gnodeDiff 
                        (GNode (Name tpp) 
                                   [TextBox tpp
                                    (BBox x y w h)
                                    (BBox 0 0 w' h')]
                                   (BBox 0 0 w' h')
                                   [] 
                                   [])
                        gnode)
          ,
           assertEqual "Translation of GNode by 10, 20"
                       CloseEnough
                       (gnodeDiff
                        (GNode (Name tpp)
                                   [TextBox tpp
                                    (BBox (x + 10.0) (y + 20.0) w h)
                                    (BBox 10.0 20.0 w' h')]
                                   (BBox 10.0 20.0 w' h') [] [])
                        (translate 10 20 gnode))
          ]

utestRepr :: Test
utestRepr = TestCase $
  assertEqual "repr of aDemoExpr"
              ("(if (> ant (+ butterfly 5)) " ++
               "(+ ant (+ butterfly cheetah)) (* (+ ant 7) (- butterfly 12)))")
              (repr aDemoExpr)

utestEval :: Test
utestEval = TestCase $
        assertEqual "value of aDemoExpr"
                    (EvalOk (VNumber (Exact (-24))))
                    (eval aDemoExpr demoEnv)


utestGraphToExprTree :: Test
utestGraphToExprTree = TestCase $ 
  do  
    let expr = ePlus (eTimes (eSymbol "x") (eInt 5))
                     (eMinus (eInt 7) (eSymbol "y"))
        exprTree = exprToTree expr
        layoutTree = treeLayout testStyle zeroIoletCounter exprTree
        graph = treeLayoutToGraph layoutTree
    assertEqual "recover expr from tlo tree" exprTree 
                (graphToExprTree graph 1)

utest1 :: Test
utest1 = TestCase $
         do
           let factFunction = envGetFunction exampleEnv "fact"
               factTree = exprToTree (functionBody factFunction)
               tlo = treeLayout defaultStyle zeroIoletCounter factTree
           let g = orderedTreeToGraph (fmap WSimple tlo)
           assertEqual "graph extract expr tree" factTree
                           (grExtractExprTree g 1)

utest2 :: Test
utest2 = TestCase $ 
    do
      let nSymbol s = ENode (NSymbol (Symbol s)) EvalUntried
          t1 = fmap nSymbol (T.Node "horse" [leaf "saddle", leaf "rider"])
          t2 = fmap nSymbol (T.Node "mule" [leaf "plough", leaf "farmer"])
          y1 :: TreeLayout ExprNode
          y1 = treeLayout wstyle zeroIoletCounter t1
          y2 :: TreeLayout ExprNode
          y2 = treeLayout wstyle zeroIoletCounter t2
          g1 = treeLayoutToGraph y1 :: WGraph
          g2 = grUpdateTreeLayout g1 1 y2 :: WGraph
      assertEqual "grUpdateLayout" y2 (grExtractLayoutTree g2 1)

tests :: Test
tests = TestList [TestLabel "GNode test" utestGNode,
                      TestLabel "repr of Expr" utestRepr,
                      TestLabel "eval of Expr" utestEval,
                      TestLabel "tlo to expr" utestGraphToExprTree,
                      utest1, utest2]

runU :: IO Counts
runU = runTestTT tests