module Game.Test.Mastermind (tests, ) where

import qualified Game.Mastermind.CodeSet.Tree as CodeSetTree
-- import qualified Game.Mastermind.CodeSet.Union as CodeSetUnion
import qualified Game.Mastermind.CodeSet as CodeSet
import qualified Game.Mastermind as MM

import qualified Data.Set as Set
import Control.Monad (liftM2, )

import Test.QuickCheck (Arbitrary(arbitrary), quickCheck, )


alphabet :: Set.Set Int
alphabet = Set.fromList [0..9]


newtype Code = Code [Int]
   deriving (Show)

-- can we get it working with empty lists, too?
instance Arbitrary Code where
   arbitrary =
      fmap (Code . take 5 . map (flip mod 10)) $
      liftM2 (:) arbitrary arbitrary
--      fmap (Code . take 5 . map (flip mod 10)) arbitrary


data CodePair = CodePair [Int] [Int]
   deriving (Show)

instance Arbitrary CodePair where
   arbitrary =
      liftM2
         (\(Code xs) (Code ys) ->
            uncurry CodePair $ unzip $ zip xs ys)
         arbitrary arbitrary


remainingMember :: CodePair -> Bool
remainingMember (CodePair secret attempt) =
   CodeSetTree.member secret $
   MM.remaining alphabet attempt (MM.evaluate secret attempt)

evalFromInt :: Int -> Int -> MM.Eval
evalFromInt size ident =
   let (rem0, x) = divMod ident size
       y = mod rem0 size
       rightPlaces = min x y
       rightSymbols = max x y - rightPlaces
   in  MM.Eval rightPlaces rightSymbols

remainingNotMember :: Int -> CodePair -> Bool
remainingNotMember evalIdent (CodePair secret attempt) =
   let eval = evalFromInt (length secret) evalIdent
   in  (eval == MM.evaluate secret attempt)
       ==
       (CodeSetTree.member secret $
        MM.remaining alphabet attempt eval)

remainingDisjoint :: Int -> Int -> Code -> Bool
remainingDisjoint evalIdent0 evalIdent1 (Code attempt) =
   let eval0 = evalFromInt (length attempt) evalIdent0
       eval1 = evalFromInt (length attempt) evalIdent1
       remaining0 = MM.remaining alphabet attempt eval0
       remaining1 = MM.remaining alphabet attempt eval1
   in  eval0 == eval1 ||
       CodeSetTree.null
          (CodeSetTree.intersection remaining0 remaining1)

evaluateCommutative :: CodePair -> Bool
evaluateCommutative (CodePair secret attempt) =
   MM.evaluate secret attempt
   ==
   MM.evaluate attempt secret

evaluateRemaining :: Int -> Code -> Bool
evaluateRemaining evalIdent (Code attempt) =
   let eval = evalFromInt (length attempt) evalIdent
   in  all ((eval ==) . MM.evaluate attempt) $
       take 100 $
       CodeSet.flatten $
       (MM.remaining alphabet attempt eval :: CodeSetTree.T Int)

{-
A more precise test would be to check
that for different numbers of rightPlace and rightSymbol
the codesets are disjoint
and their union is the set of all possible codes.
To this we need a union with simplification or a subset test.
-}
partitionSizes :: Code -> Bool
partitionSizes (Code attempt) =
   fromIntegral (Set.size alphabet) ^ length attempt
   ==
   sum (map snd (MM.partitionSizes alphabet attempt))


selectFlatten :: Int -> Code -> Bool
selectFlatten evalIdent (Code attempt) =
   let eval = evalFromInt (length attempt) evalIdent
       set :: CodeSetTree.T Int
       set = MM.remaining alphabet attempt eval
   in  map (CodeSet.select set) [0 .. min 100 (CodeSet.size set) - 1]
       ==
       take 100 (CodeSet.flatten set)


-- should also work, when selecting any code from the set of remaining possibilities
solve :: Code -> Bool
solve (Code secret) =
   let recourse remain =
          case CodeSet.flatten remain of
             [] -> False
             [attempt] -> secret == attempt
             attempt:_ ->
                recourse $ CodeSet.intersection remain $
                MM.remaining alphabet attempt $ MM.evaluate secret attempt
   in  recourse $
       (CodeSet.cube alphabet (length secret) :: CodeSetTree.T Int)


{-
Other possible tests:

the products in a set produced by 'remaining' must be disjoint.

set laws for the two set implementations,
   such as distributivity of union and intersection

check member against intersection with singleton
-}

tests :: [(String, IO ())]
tests =
   ("remainingMember", quickCheck remainingMember) :
   ("remainingNotMember", quickCheck remainingNotMember) :
   ("remainingDisjoint", quickCheck remainingDisjoint) :
   ("evaluateCommutative", quickCheck evaluateCommutative) :
   ("evaluateRemaining", quickCheck evaluateRemaining) :
   ("partitionSizes", quickCheck partitionSizes) :
   ("selectFlatten", quickCheck selectFlatten) :
   ("solve", quickCheck solve) :
   []