-----------------------------------------------------------------------------
-- |
-- Module      :  Data.FailableList
-- Copyright   :  (c) 2009 John Millikin
-- License     :  BSD3
--
-- Maintainer  :  jmillikin@gmail.com
-- Portability :  portable
--
-----------------------------------------------------------------------------

module Main (tests) where
import Test.QuickCheck (Arbitrary, arbitrary)
import Test.Framework (Test, testGroup, defaultMain)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Data.FailableList (FailableList (..))
import qualified Data.FailableList as FL

main :: IO ()
main = defaultMain tests

tests :: [Test]
tests =
	[ testProperty "append" $ prop_Append
	, testProperty "map" $ prop_Map (1 +)
	, testProperty "mapEither Left" $ prop_MapEither (Left  . (1 +))
	, testProperty "mapEither Right" $ prop_MapEither (Right . (1 +))
	, testProperty "concatMap" $ prop_ConcatMap (return . (1 +))
	, testProperty "foldr" $ prop_FoldR (+) 0 (+ 2)
	, testProperty "foldl" $ prop_FoldL (+) 0
	, testProperty "unfoldr Left" $ prop_UnfoldR Left
	, let
		step x = Right $ if x > 0
			then Just (x, x `div` 10)
			else Nothing
		in testProperty "unfoldr Right" $ prop_UnfoldR step
	, testProperty "length" prop_Length
	]

instance Arbitrary a => Arbitrary (FailableList e a) where
	arbitrary = foldr Next Done `fmap` arbitrary

-- Pseudo type variables, for polymorphic properties
type A = Int
type B = Int
type E = Int

prop_Length :: FailableList E A -> Bool
prop_Length fl = FL.length fl == modelLength fl

prop_Append :: FailableList E A -> FailableList E A -> Bool
prop_Append x y = FL.append x y == modelAppend x y

prop_Map :: (A -> B) -> FailableList E A -> Bool
prop_Map f fl = FL.map f fl == modelMap f fl

prop_MapEither :: (A -> Either E B) -> FailableList E A -> Bool
prop_MapEither f fl = FL.mapEither f fl == modelMapEither f fl

prop_FoldR :: (A -> B -> B) -> B -> (E -> B) -> FailableList E A -> Bool
prop_FoldR f nil e fl = FL.foldr f nil e fl == modelFoldR f nil e fl

prop_FoldL :: (B -> A -> B) -> B -> FailableList E A -> Bool
prop_FoldL f nil fl = FL.foldl f nil fl == modelFoldL f nil fl

prop_UnfoldR :: (B -> Either E (Maybe (A, B))) -> B -> Bool
prop_UnfoldR f nil = FL.unfoldr f nil == modelUnfoldR f nil

prop_ConcatMap :: (A -> FailableList E B) -> FailableList E A -> Bool
prop_ConcatMap f fl = FL.concatMap f fl == modelConcatMap f fl

-- Versions of the basic operations, inefficient but known to be correct.
modelLength :: FailableList e a -> Int
modelLength  Done       = 0
modelLength (Fail _)    = 0
modelLength (Next x xs) = 1 + modelLength xs

modelAppend :: FailableList e a -> FailableList e a -> FailableList e a
modelAppend Done        y = y
modelAppend (Fail e)    _ = Fail e
modelAppend (Next x xs) y = Next x (modelAppend xs y)

modelMap :: (a -> b) -> FailableList e a -> FailableList e b
modelMap _  Done       = Done
modelMap _ (Fail e)    = Fail e
modelMap f (Next x xs) = Next (f x) (modelMap f xs)

modelMapEither :: (a -> Either e b) -> FailableList e a -> FailableList e b
modelMapEither _  Done       = Done
modelMapEither _ (Fail e)    = Fail e
modelMapEither f (Next x xs) = case f x of
	Left e -> Fail e
	Right x' -> Next x' (modelMapEither f xs)

modelConcatMap :: (a -> FailableList e b) -> FailableList e a -> FailableList e b
modelConcatMap _ Done     = Done
modelConcatMap _ (Fail e) = Fail e
modelConcatMap f (Next x xs) = modelAppend (f x) (modelConcatMap f xs)

modelFoldR :: (a -> b -> b) -> b -> (e -> b) -> FailableList e a -> b
modelFoldR f nil fail' = modelFoldR' where
	modelFoldR'  Done       = nil
	modelFoldR' (Fail e)    = fail' e
	modelFoldR' (Next a as) = f a (modelFoldR' as)

modelFoldL :: (b -> a -> b) -> b -> FailableList e a -> Either e b
modelFoldL _ _ (Fail e)    = Left e
modelFoldL _ z Done        = Right z
modelFoldL f z (Next x xs) = modelFoldL f (f z x) xs

modelUnfoldR :: (b -> Either e (Maybe (a, b))) -> b -> FailableList e a
modelUnfoldR f = unfoldr' where
	unfoldr' x = case f x of
		Right (Just (a, b)) -> Next a (unfoldr' b)
		Right       Nothing -> Done
		Left              e -> Fail e