module IntMap (intMapProps) where

import Test.Tasty
import Test.Tasty.QuickCheck as QC

import qualified Data.Set as Set

import           Data.RangeSet.IntMap (RIntSet)
import qualified Data.RangeSet.IntMap as RSet

import Control.Applicative

import Data.Semigroup

import SetAction

toRSet :: SetAction Int -> RIntSet
toRSet AEmpty               = RSet.empty
toRSet (ASingleton a)       = RSet.singleton a
toRSet (AFromList l)        = RSet.fromList l
toRSet (AInsert a set)      = RSet.insert a $ toRSet set
toRSet (ADelete a set)      = RSet.delete a $ toRSet set
toRSet (AUnion a b)         = RSet.union (toRSet a) (toRSet b)
toRSet (ADifference a b)    = RSet.difference (toRSet a) (toRSet b)
toRSet (AIntersection a b)  = RSet.intersection (toRSet a) (toRSet b)

elementsProp :: SetAction Int -> Property
elementsProp seta = Set.elems (toSet seta) === RSet.elems (toRSet seta)

sizeProp :: SetAction Int -> Property
sizeProp seta = Set.size (toSet seta) === RSet.size (toRSet seta)

nullProp :: SetAction Int -> Property
nullProp seta = Set.null (toSet seta) === RSet.null (toRSet seta)

memberProp :: Int -> SetAction Int -> Property
memberProp x seta = Set.member x (toSet seta) === RSet.member x (toRSet seta)

notMemberProp :: Int -> RSetAction Int -> Property
notMemberProp x seta = Set.notMember x (rangeToSet seta) === RSet.notMember x (rangeToRSet seta)

lookupLTProp :: Int -> RSetAction Int -> Property
lookupLTProp x seta = Set.lookupLT x (rangeToSet seta) === RSet.lookupLT x (rangeToRSet seta)

lookupGTProp :: Int -> SetAction Int -> Property
lookupGTProp x seta = Set.lookupGT x (toSet seta) === RSet.lookupGT x (toRSet seta)

lookupLEProp :: Int -> SetAction Int -> Property
lookupLEProp x seta = Set.lookupLE x (toSet seta) === RSet.lookupLE x (toRSet seta)

lookupGEProp :: Int -> RSetAction Int -> Property
lookupGEProp x seta = Set.lookupGE x (rangeToSet seta) === RSet.lookupGE x (rangeToRSet seta)

isSubsetProp :: SetAction Int -> RSetAction Int -> Property
isSubsetProp seta setb = Set.isSubsetOf (toSet seta) (rangeToSet setb) === RSet.isSubsetOf (toRSet seta) (rangeToRSet setb)

splitProp :: Int -> RSetAction Int -> Property
splitProp x seta = Set.elems sl === RSet.elems rl .&&. sm === rm .&&. Set.elems su === RSet.elems ru where
  (sl, sm, su) = Set.splitMember x (rangeToSet seta)
  (rl, rm, ru) = RSet.splitMember x (rangeToRSet seta)

rangeToRSet :: RSetAction Int -> RIntSet
rangeToRSet RAEmpty               = RSet.empty
rangeToRSet (RASingleton a)       = RSet.singletonRange a
rangeToRSet (RAFromList l)        = RSet.fromRangeList l
rangeToRSet (RAInsert a set)      = RSet.insertRange a $ rangeToRSet set
rangeToRSet (RADelete a set)      = RSet.deleteRange a $ rangeToRSet set
rangeToRSet (RAUnion a b)         = RSet.union (rangeToRSet a) (rangeToRSet b)
rangeToRSet (RADifference a b)    = RSet.difference (rangeToRSet a) (rangeToRSet b)
rangeToRSet (RAIntersection a b)  = RSet.intersection (rangeToRSet a) (rangeToRSet b)

rangeProp :: RSetAction Int -> Property
rangeProp seta = Set.elems (rangeToSet seta) === RSet.elems (rangeToRSet seta)

ordered :: Ord a => [(a,a)] -> Bool
ordered rs = all lt $ zip rs (tail rs)
  where
    lt :: Ord a => ((a,a),(a,a)) -> Bool
    lt ((_,y),(u,_)) = y < u

pairOrdered :: Ord a => [(a, a)] -> Bool
pairOrdered = all (uncurry (<=))

orderedProp :: RSetAction Int -> Bool
orderedProp setAction = ordered rs && pairOrdered rs
  where rs = RSet.toRangeList $ rangeToRSet $ setAction

ascListProp :: RSetAction Int -> Property
ascListProp setAction = RSet.fromAscList (RSet.toAscList rs) === rs
  where rs = rangeToRSet setAction

-- Complement laws
complementProps :: TestTree
complementProps = testGroup "complement"
  [ QC.testProperty "definition"   (\a e -> RSet.member e (rs a) === RSet.notMember e (RSet.complement (rs a)))
  , QC.testProperty "involutive"   (\a -> rs a === RSet.complement (RSet.complement (rs a)))
  , QC.testProperty "(full \\\\)"  (\a -> RSet.complement (rs a) === RSet.full RSet.\\ (rs a))
  ]
  where rs = rangeToRSet :: RSetAction Int -> RIntSet

-- Min/Max laws

findMinProp :: RSetAction Int -> Property
findMinProp seta
  | Set.null s  = label "trivial" $ property True
  | otherwise   = Set.findMin s === RSet.findMin rs
  where s   = rangeToSet seta
        rs  = rangeToRSet seta

findMaxProp :: RSetAction Int -> Property
findMaxProp seta
  | Set.null s  = label "trivial" $ property True
  | otherwise   = Set.findMax s === RSet.findMax rs
  where s   = rangeToSet seta
        rs  = rangeToRSet seta

minMaxProps :: TestTree
minMaxProps = testGroup "Min/Max properties"
  [ QC.testProperty "findMin"  findMinProp
  , QC.testProperty "findMax"  findMaxProp
  ]

-- Monoid laws
monoidLaws :: TestTree
monoidLaws = testGroup "Monoid laws"
  [ QC.testProperty "left identity"   (\a -> rs a === mempty <> rs a)
  , QC.testProperty "right identity"  (\a -> rs a === rs a <> mempty)
  , QC.testProperty "associativity"   (\a b c -> rs a <> (rs b <> rs c) === (rs a <> rs b) <> rs c)
  ]
  where rs = rangeToRSet :: RSetAction Int -> RIntSet

validProp :: SetAction Int -> Property
validProp s = RSet.valid (toRSet s) === True

validRProp :: RSetAction Int -> Property
validRProp s = RSet.valid (rangeToRSet s) === True

invalidProp :: Property
invalidProp = RSet.valid (RSet.fromNormalizedRangeList [(-10,-1),(1,0),(2,3 :: Int)]) === False

-- All QuickCheck properties
intMapProps :: TestTree
intMapProps = testGroup "QuickCheck IntMap properties"
  [ QC.testProperty "element operations are similar" elementsProp
  , QC.testProperty "size is consistent" sizeProp
  , QC.testProperty "null operation is similar" nullProp
  , QC.testProperty "member operation is similar" memberProp
  , QC.testProperty "notMember operation is similar" notMemberProp
  , QC.testProperty "lookupLT operation is similar" lookupLTProp
  , QC.testProperty "lookupGT operation is similar" lookupGTProp
  , QC.testProperty "lookupLE operation is similar" lookupLEProp
  , QC.testProperty "lookupGE operation is similar" lookupGEProp
  , QC.testProperty "isSubset operation is similar" isSubsetProp
  , QC.testProperty "split operation is similar" splitProp
  , QC.testProperty "range operations is similar" rangeProp
  , QC.testProperty "ranges remain is ordered" orderedProp
  , QC.testProperty "fromAscList . toAscList === id" ascListProp
  , complementProps
  , minMaxProps
  , monoidLaws
  , QC.testProperty "item sets valid" validProp
  , QC.testProperty "range sets valid" validRProp
  , QC.testProperty "fromNormalizedRangeList invalid" invalidProp
  ]