{-# LANGUAGE ScopedTypeVariables
            ,RankNTypes
            ,ExistentialQuantification
            ,MultiParamTypeClasses
            ,FunctionalDependencies
            ,FlexibleInstances
            ,UndecidableInstances
            ,FlexibleContexts #-}

{-
Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file COPYRIGHT

-}
module Main where

import Test.QuickCheck
import qualified Data.ListLike as LL
import Data.ListLike.Text
import Data.ListLike.Vector
import System.Random
import qualified Test.HUnit as HU
import System.IO
import Text.Printf
import Data.Word
import Data.List
import Data.Monoid
import TestInfrastructure
import Data.Foldable(foldr', fold, foldMap)
import System.Info


-- prop_singleton :: (Eq i,LL.ListLike f i) => f -> i -> Bool
--prop_singleton :: (Eq i, LL.ListLike f i, Arbitrary f, Show f, Show i, Arbitrary i) => f -> i -> Bool
prop_singleton f x = (LL.toList $ asTypeOf (LL.singleton x) f) == [x]

prop_empty f = (LL.toList l == []) && (LL.null l) && (LL.length l == 0)
    where l = asTypeOf LL.empty f

prop_tofromlist f =
    LL.toList f == l &&
    LL.length f == length l &&
    f == (LL.fromList . LL.toList $ f)
    where l = LL.toList f

prop_length f = LL.length f == length (LL.toList f)
prop_cons f i = llcmp (LL.cons i f) (i : (LL.toList f))
prop_append f1 f2 = llcmp (LL.append f1 f2) (LL.toList f1 ++ LL.toList f2)
prop_head f = not (LL.null f) ==> LL.head f == head (LL.toList f)
prop_last f = not (LL.null f) ==> LL.last f == last (LL.toList f)
prop_tail f = not (LL.null f) ==> llcmp (LL.tail f) (tail (LL.toList f))
prop_init f = not (LL.null f) ==> llcmp (LL.init f) (init (LL.toList f))
prop_null f = LL.null f == null (LL.toList f)
prop_length2 f = checkLengths f (LL.toList f)
prop_length3 f1 f2 = llcmp (LL.append f1 f2) (LL.toList f1 ++ LL.toList f2)

prop_map :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> item) -> Property
prop_map f func = llcmp llmap (map func (LL.toList f))
    where llmap = asTypeOf (LL.map func f) (LL.toList f)

prop_rigidMap f func = llcmp (LL.rigidMap func f) (map func (LL.toList f))
prop_reverse f = llcmp (LL.reverse f) (reverse (LL.toList f))
prop_intersperse f i = llcmp (LL.intersperse i f) (intersperse i (LL.toList f))

prop_concat f =
    llcmp (LL.concat f) (concat $ map LL.toList (LL.toList f))

prop_concatmap :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> [item]) -> Property
prop_concatmap f func =
    llcmp (LL.concatMap func f)
          (concatMap func (LL.toList f))

prop_rigidConcatMap f func =
    llcmp (LL.rigidConcatMap func f)
          (concatMap (LL.toList . func) (LL.toList f))

prop_any f func = (LL.any func f) == (any func (LL.toList f))
prop_all f func = (LL.all func f) == (all func (LL.toList f))
prop_maximum f = not (LL.null f) ==> LL.maximum f == maximum (LL.toList f)
prop_minimum f = not (LL.null f) ==> LL.minimum f == minimum (LL.toList f)
prop_replicate f count i = count <= 1000 ==> llcmp res (replicate count i)
    where res = asTypeOf (LL.replicate count i) f
prop_take f count = llcmp (LL.take count f) (take count (LL.toList f))
prop_drop f count = count >= 0 ==> llcmp (LL.drop count f) (drop count (LL.toList f))
prop_splitAt f count = count >= 0 ==>
    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.splitAt count $ f]
          [LL.splitAt count (LL.toList f)]
prop_takeWhile f func = llcmp (LL.takeWhile func f)
                              (takeWhile func (LL.toList f))
prop_dropWhile f func = llcmp (LL.dropWhile func f)
                              (dropWhile func (LL.toList f))
prop_span f func =
    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.span func $ f]
          [span func (LL.toList f)]
prop_break f func =
    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.break func $ f]
          [break func (LL.toList f)]
prop_group f =
    -- llcmp (map LL.toList (LL.group f)) (group (LL.toList f))
    (map LL.toList (LL.group f)) == (group (LL.toList f))
prop_inits f = (map LL.toList (LL.inits f)) == (inits (LL.toList f))
prop_tails f = (map LL.toList (LL.tails f)) == (tails (LL.toList f))
prop_isPrefixOf f1 f2 = LL.isPrefixOf f1 f2 ==
    (isPrefixOf (LL.toList f1) (LL.toList f2))
prop_isSuffixOf f1 f2 = LL.isSuffixOf f1 f2 ==
    (isSuffixOf (LL.toList f1) (LL.toList f2))
prop_isInfixOf f1 f2 = LL.isInfixOf f1 f2 ==
    (isInfixOf (LL.toList f1) (LL.toList f2))
prop_elem f i = LL.elem i f == elem i (LL.toList f)
prop_notElem f i = LL.notElem i f == notElem i (LL.toList f)
prop_find f func = LL.find func f == find func (LL.toList f)
prop_filter f func = llcmp (LL.filter func f) (filter func (LL.toList f))
prop_partition f func =
    (LL.toList f1, LL.toList f2) == partition func (LL.toList f)
    where (f1, f2) = LL.partition func f
prop_index f i = (i >= 0 && i < LL.length f) ==>
    (LL.index f i == ((LL.toList f) !! i))
prop_elemIndex f i = LL.elemIndex i f == elemIndex i (LL.toList f)
prop_elemIndices f i = LL.elemIndices i f == elemIndices i (LL.toList f)
prop_findIndex f func = LL.findIndex func f == findIndex func (LL.toList f)
prop_findIndices f func =
    LL.findIndices func f == findIndices func (LL.toList f)

prop_sequence f =
    case (llres, sequence testit) of
         (Just ll, Just l) -> llcmp ll l
         _ -> error "Error!"
    where testit = map Just (LL.toList f)
          llres = asTypeOf (LL.sequence testit) (Just f)

prop_mapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Bool
prop_mapM f func = llmapM == (mapM func (LL.toList f))
    where llmapM = asTypeOf (LL.mapM func f) (Just (LL.toList f))

prop_rigidMapM :: forall full item. (TestLL full item, TestLL [item] item) => full -> (item -> Maybe item) -> Property
prop_rigidMapM f func =
    case (LL.rigidMapM func f, mapM func (LL.toList f)) of
         (Just ll, Just l)  -> llcmp ll l
         (Nothing, Nothing) -> property True
         e -> error $ "error in prop_rigidMapM: " ++ show e

-- FIXME: can we test mapM_?

prop_nub f = llcmp (LL.nub f) (nub (LL.toList f))
prop_delete f i = llcmp (LL.delete i f) (delete i (LL.toList f))
prop_deleteFirsts f1 f2 = llcmp (LL.deleteFirsts f1 f2)
    ((LL.toList f1) \\ (LL.toList f2))
prop_union f1 f2 = llcmp (LL.union f1 f2)
    (union (LL.toList f1) (LL.toList f2))
prop_intersect f1 f2 = llcmp (LL.intersect f1 f2)
    (intersect (LL.toList f1) (LL.toList f2))
prop_sort f1 = llcmp (LL.sort f1) (sort (LL.toList f1))
prop_insert f i = llcmp (LL.insert i f) (insert i (LL.toList f))
prop_nubBy f func = llcmp (LL.nubBy func f) (nubBy func (LL.toList f))
prop_deleteBy f func i = llcmp (LL.deleteBy func i f)
                         (deleteBy func i (LL.toList f))
prop_deleteFirstsBy f1 f2 func = llcmp (LL.deleteFirstsBy func f1 f2)
    (deleteFirstsBy func (LL.toList f1) (LL.toList f2))
prop_unionBy f1 f2 func = llcmp (LL.unionBy func f1 f2)
    (unionBy func (LL.toList f1) (LL.toList f2))
prop_intersectBy f1 f2 func = llcmp (LL.intersectBy func f1 f2)
    (intersectBy func (LL.toList f1) (LL.toList f2))
prop_groupBy f func =
    (map LL.toList (LL.groupBy func f)) == (groupBy func (LL.toList f))
prop_sortBy1 f = llcmp (LL.sortBy compare f) (sortBy compare (LL.toList f))
prop_sortBy2 f = llcmp (LL.sortBy func f) (sortBy func (LL.toList f))
    where func x y = compare y x
prop_sortBy f func = llcmp (LL.sortBy func f) (sortBy func (LL.toList f))
prop_insertBy1 f i = llcmp (LL.insertBy compare i f)
    (insertBy compare i (LL.toList f))
prop_insertBy2 f i = llcmp (LL.insertBy func i f)
    (insertBy func i (LL.toList f))
    where func x y = compare y x
prop_genericLength f =
    LL.genericLength f == genericLength (LL.toList f)
prop_genericTake f (i::Integer) = (i >= 0) ==>
    llcmp (LL.genericTake i f) (genericTake i (LL.toList f))
prop_genericDrop f (i::Integer) = (i >= 0) ==>
    llcmp (LL.genericDrop i f) (genericDrop i (LL.toList f))
prop_genericSplitAt f (i::Integer) = i >= 0 ==>
    llcmp [(\(x, y) -> (LL.toList x, LL.toList y)) . LL.genericSplitAt i $ f]
          [LL.genericSplitAt i (LL.toList f)]
prop_genericReplicate f (count::Integer) i = count >= 0 ==>
    llcmp res (genericReplicate count i)
    where res = asTypeOf (LL.genericReplicate count i) f

--prop_zip :: (LL.ListLike full item, LL.ListLike result (item, Int)) =>
--    full -> Result
prop_zip f = LL.zip f f2 == zip (LL.toList f) f2
    where f2 = [(-5::Int)..]
prop_zipWith f =
    LL.toList res == (zipWith func (LL.toList f) f2)
    where f2 = [(100::Int)..(-100)]
          func x y = (y + 5, x)
          res = asTypeOf (LL.zipWith func f f2) [(5::Int, LL.head f)]
--FIXME: prop_unzip
--FIXME: prop_and
--FIXME: prop_or
--FIXME: prop_sum
--FIXME: prop_product
prop_foldl f func (i::Int) = LL.foldl func i f == foldl func i (LL.toList f)
prop_foldl' f func (i::Integer) =
    LL.foldl' func i f == foldl' func i (LL.toList f)
prop_foldl1 f func = not (LL.null f) ==>
    (LL.foldl1 func f) == (foldl1 func (LL.toList f))
prop_foldr f func (i::Int) = LL.foldr func i f == foldr func i (LL.toList f)
prop_foldr' f func (i::Integer) =
    LL.foldr' func i f == foldr' func i (LL.toList f)
prop_foldr1 f func = not (LL.null f) ==>
    LL.foldl1 func f == foldl1 func (LL.toList f)
prop_fold f = llcmp res resl
    where res = LL.fold f
          resl = fold (map LL.toList (LL.toList f))
prop_foldMap :: (LL.ListLike full item, Eq full) => full -> (item -> [Int]) -> Bool
prop_foldMap f func = res == resl
    where res = LL.foldMap func f
          resl = foldMap func  (LL.toList f) -- asTypeOf (foldMap (LL.toList f)) (head f)

prop_toString f =
    ((LL.fromString . LL.toString $ f) == f)
    where l = LL.toList f
prop_fromString f x =
    LL.toString (asTypeOf (LL.fromString x) f) == x
prop_lines f = map LL.toString res == lines (LL.toString f)
    where res = asTypeOf (LL.lines f) [f]
prop_words f = map LL.toString res == words (LL.toString f)
    where res = asTypeOf (LL.words f) [f]

allt = [apf "empty" (t prop_empty),
        apf "length" (t prop_length),
        apf "to/fromList" (t prop_tofromlist),
        apf "singleton" (t prop_singleton),
        apf "cons" (t prop_cons),
        apf "append" (t prop_append),
        apf "head" (t prop_head),
        apf "last" (t prop_last),
        apf "tail" (t prop_tail),
        apf "init" (t prop_init),
        apf "null" (t prop_null),
        apf "length2" (t prop_length2),
        apf "length3" (t prop_length3),
        apf "map" (t prop_map),
        apf "rigidMap" (t prop_rigidMap),
        apf "reverse" (t prop_reverse),
        apf "intersperse" (t prop_intersperse),
        apw "concat" (LLWrap prop_concat),
        apf "concatMap" (t prop_concatmap),
        apf "rigidConcatMap" (t prop_rigidConcatMap),
        apf "any" (t prop_any),
        apf "all" (t prop_all),
        apf "maximum" (t prop_maximum),
        apf "minimum" (t prop_minimum),
        apf "replicate" (t prop_replicate),
        apf "take" (t prop_take),
        apf "drop" (t prop_drop),
        apf "splitAt" (t prop_splitAt),
        apf "takeWhile" (t prop_takeWhile),
        apf "dropWhile" (t prop_dropWhile),
        apf "span" (t prop_span),
        apf "break" (t prop_break),
        apf "group" (t prop_group),
        apf "inits" (t prop_inits),
        apf "tails" (t prop_tails),
        apf "isPrefixOf" (t prop_isPrefixOf),
        apf "isSuffixOf" (t prop_isSuffixOf),
        apf "isInfixOf" (t prop_isInfixOf),
        apf "elem" (t prop_elem),
        apf "notElem" (t prop_notElem),
        apf "find" (t prop_find),
        apf "filter" (t prop_filter),
        apf "partition" (t prop_partition),
        apf "index" (t prop_index),
        apf "elemIndex" (t prop_elemIndex),
        apf "elemIndices" (t prop_elemIndices),
        apf "findIndex" (t prop_findIndex),
        apf "findIndices" (t prop_findIndices),
        apf "sequence" (t prop_sequence),
        apf "mapM" (t prop_mapM),
        apf "rigidMapM" (t prop_rigidMapM),
        -- FIXME: mapM_ ?
        apf "nub" (t prop_nub),
        apf "delete" (t prop_delete),
        apf "deleteFirsts" (t prop_deleteFirsts),
        apf "union" (t prop_union),
        apf "intersect" (t prop_intersect),
        apf "sort" (t prop_sort),
        apf "insert" (t prop_insert),
        -- toList
        -- fromList
        -- fromListLike
        apf "nubBy" (t prop_nubBy),
        apf "deleteBy" (t prop_deleteBy),
        apf "deleteFirstsBy" (t prop_deleteFirstsBy),
        apf "unionBy" (t prop_unionBy),
        apf "intersectBy" (t prop_intersectBy),
        apf "groupBy" (t prop_groupBy),
        apf "sortBy1" (t prop_sortBy1),
        apf "sortBy2" (t prop_sortBy2),
        apf "insertBy1" (t prop_insertBy1),
        apf "insertBy2" (t prop_insertBy2),
        apf "genericLength" (t prop_genericLength),
        apf "genericTake" (t prop_genericTake),
        apf "genericDrop" (t prop_genericDrop),
        apf "genericSplitAt" (t prop_genericSplitAt),
        apf "genericReplicate" (t prop_genericReplicate),
        apf "zip" (t prop_zip),
        apf "zipWith" (t prop_zipWith)
        -- apf "unzip" (t prop_unzip),
        -- apf "and" (t prop_and),
        -- apf "or" (t prop_or),
        -- apf "sum" (t prop_sum),
        -- apf "propduct" (t prop_product),
        -- sequence_
        ]

allf = (if compilerName == "hugs" then [] else [ apf "foldl" (t prop_foldl),
                                                 apf "foldr1" (t prop_foldr1),
                                                 apf "foldl1" (t prop_foldl1)])
       ++
       [
        apf "foldl'" (t prop_foldl'),
        apf "foldr" (t prop_foldr),
        apf "foldr'" (t prop_foldr'),
        apw "fold" (LLWrap prop_fold),
        apf "foldMap" (t prop_foldMap)
       ]

alls = [
        aps "toString" (t prop_toString),
        aps "fromString" (t prop_fromString),
        aps "lines" (t prop_lines),
        aps "words" (t prop_words)
        -- FIXME: aps (t prop_unlines),
        -- FIXME: aps (t prop_unwords)
       ]
allTests = HU.TestList $ reverse $
                       [HU.TestLabel "ListLike" (HU.TestList allt),
                        HU.TestLabel "FoldableLL" (HU.TestList allf),
                        HU.TestLabel "StringLike" (HU.TestList alls)]

testh = HU.runTestTT $ allTests
testv = runVerbTestText (HU.putTextToHandle stderr True) $ allTests

main =
    do testv
       return ()