TestUtil.hs

module Testing.TestUtil (assertAll, utestloop, vtestloop,
                         Diff(..), bboxDiff, gnodeDiff, sizeTreeDiff
                        )
where

import Test.HUnit

import Data.Sifflet.Geometry
import Data.Sifflet.Tree
import Data.Sifflet.TreeLayout

assertAll :: [Assertion] -> Test
assertAll assertions = TestList (map TestCase assertions)

 
-- General test loops -- used by the other TestX.hs files

-- unit test loop

utestloop :: Test -> IO()

utestloop tests = do
  count <- runTestTT tests
  print count
  putStrLn $ "Errors: " ++ show (errors count)
  putStrLn $ "Failures: " ++ show (failures count)

-- visual test loop: run all visual tests
-- Not really test data, but well!

vtestloop :: [IO()] -> IO()
vtestloop [] = return ()
vtestloop (t:ts) = do {t; vtestloop ts}

-- | Use to express the result of comparing structures of type a 
-- with some error tolerance

data Diff a = CloseEnough
            | TooFar a a
              deriving (Eq, Show)

-- Do these belong here, or in the modules where the data types
-- (BBox, GNode, etc.) are defined?

bboxDiff :: BBox -> BBox -> Diff BBox
bboxDiff b1@(BBox x1 y1 w1 h1) b2@(BBox x2 y2 w2 h2) =
    let closeEnough u v = abs (u - v) <= 2.0
    in if (closeEnough x1 x2 &&
           closeEnough y1 y2 &&
           closeEnough w1 w2 &&
           closeEnough h1 h2)
       then CloseEnough
       else TooFar b1 b2

gnodeDiff :: GNode Name -> GNode Name -> Diff (GNode Name)
gnodeDiff g1 g2 =
    let GNode (Name n1) textboxes1 bb1 inlets1 outlets1 = g1
        GNode (Name n2) textboxes2 bb2 inlets2 outlets2 = g2
    in if n1 == n2 &&
          all (uncurry textBoxCloseEnough) (zip textboxes1 textboxes2) &&
          bboxDiff bb1 bb2 == CloseEnough &&
          inlets1 == inlets2 &&
          outlets1 == outlets2
       then CloseEnough
       else TooFar g1 g2

textBoxCloseEnough :: TextBox -> TextBox -> Bool
textBoxCloseEnough tb1 tb2 =
    tbText tb1 == tbText tb2 &&
    bboxDiff (tbTextBB tb1) (tbTextBB tb2) == CloseEnough &&
    bboxDiff (tbBoxBB tb1) (tbBoxBB tb2) == CloseEnough


sizeTreeDiff :: Tree Size -> Tree Size -> Diff (Tree Size)
sizeTreeDiff t1 t2 =
    let Node size1 subtrees1 = t1
        Node size2 subtrees2 = t2
        sizeTreeCloseEnough t3 t4 = sizeTreeDiff t3 t4 == CloseEnough
    in if sizeDiff size1 size2 == CloseEnough &&
          all (uncurry sizeTreeCloseEnough) (zip subtrees1 subtrees2)
       then CloseEnough
       else TooFar t1 t2

sizeDiff :: Size -> Size -> Diff Size
sizeDiff s1 s2 =
    let close x1 x2 = abs(x1 - x2) < 3.0
    in if close (sizeW s1) (sizeW s2) &&
          close (sizeH s1) (sizeH s2)
       then CloseEnough
       else TooFar s1 s2