Traversals.hs

-- | Tests for traversals

module TestSuite.Traversals where

--------------------------------------------------------------------------------

import Test.Tasty
import Test.Tasty.QuickCheck
import Test.QuickCheck

import Control.Applicative
import Control.Monad hiding ( mapM , mapM_ , forM , forM_ )
import Data.Foldable
import Data.Traversable
import Prelude hiding (foldl,foldr,mapM,mapM_,concat,concatMap)

import Data.Generics.Fixplate.Base
-- import Data.Generics.Fixplate.Misc
import Data.Generics.Fixplate.Morphisms
import Data.Generics.Fixplate.Traversals

import TestSuite.Tools
import TestSuite.Misc

--------------------------------------------------------------------------------

testgroup_Traversals :: TestTree
testgroup_Traversals = testGroup "Traversals"
  [ testProperty "left fold"        prop_leftFold
  , testProperty "lazy left fold"   prop_leftFoldLazy
  , testProperty "right fold"       prop_rightFold
  , testProperty "universe /1"      prop_universe1
  , testProperty "universe /2"      prop_universe2
  ]

--------------------------------------------------------------------------------
-- Tests

universeNaive :: Foldable f => Mu f -> [Mu f]
universeNaive x = x : concatMap universeNaive (children x)

{-
runtests_Traversals :: IO ()
runtests_Traversals = do
  quickCheck prop_leftFold
  quickCheck prop_leftFoldLazy
  quickCheck prop_rightFold
  quickCheck prop_universe1
  quickCheck prop_universe2
-}
  
prop_universe1 :: FixT Label -> Bool
prop_universe1 tree = universe tree == universeNaive tree

prop_universe2 :: FixT Label -> Bool
prop_universe2 tree = universe tree == foldRight (:) [] tree
  
prop_leftFold :: FixT Label -> Bool
prop_leftFold tree = 
  foldLeft (\xs (Fix (TreeF l s)) -> (l:xs)) [] tree == foldl (flip (:)) [] (fromFixT tree)

prop_leftFoldLazy :: FixT Label -> Bool
prop_leftFoldLazy tree = 
  foldLeftLazy (\xs (Fix (TreeF l s)) -> (l:xs)) [] tree == foldl (flip (:)) [] (fromFixT tree)
  
prop_rightFold :: FixT Label -> Bool
prop_rightFold tree = 
  foldRight (\(Fix (TreeF l s)) xs -> (l:xs)) [] tree == foldr (:) [] (fromFixT tree)

--------------------------------------------------------------------------------