module Map (mapProps) where

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

import qualified Data.Set as Set

import           Data.RangeSet.Map (RSet)
import qualified Data.RangeSet.Map as RSet

import Control.Applicative
import Data.Int

import Data.Semigroup

import SetAction

toRSet :: (Enum a, Ord a) => SetAction a -> RSet a
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 :: (Enum a, Ord a) => RSetAction a -> RSet a
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 Int8 -> 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 Int8 -> Bool
orderedProp setAction = ordered rs && pairOrdered rs
  where rs = RSet.toRangeList $ rangeToRSet $ setAction

ascListProp :: RSetAction Int8 -> 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 -> RSet Int

-- Min/Max laws

findMinProp :: RSetAction Int8 -> 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 Int8 -> 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 -> RSet Int

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
mapProps :: TestTree
mapProps = testGroup "QuickCheck Map 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
  ]