module Game.Mastermind.CodeSet where

import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.List.Key as Key
import Data.Function.HT (nest, )
import Data.Ord.HT (comparing, )

import Prelude hiding (null, )


class C set where
   empty :: set a
   union, intersection :: (Ord a) => set a -> set a -> set a
   unit :: set a
   -- | the left operand must be non-empty
   leftNonEmptyProduct :: Set.Set a -> set a -> set a
   flatten :: (Ord a) => set a -> [[a]]
   symbols :: (Ord a) => set a -> Set.Set a
   null :: set a -> Bool
   size :: set a -> Integer
   select :: set a -> Integer -> [a]
   representationSize :: set a -> Int
   -- | simplify set representation by combining set products where possible
   compress :: (Ord a) => set a -> set a

cube :: (C set) => Set.Set a -> Int -> set a
cube alphabet n =
   nest n (leftNonEmptyProduct alphabet) unit

unions :: (C set, Ord a) => [set a] -> set a
unions = foldr union empty


-- simulate priority queue
insertSortedBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
insertSortedBy cmp x =
   let recourse [] = [x]
       recourse (y:ys) =
          if cmp x y == GT
            then y : recourse ys
            else x:y:ys
   in  recourse

intersections :: (C set, Ord a) => [set a] -> set a
intersections =
   let go [] = error "intersections: empty list"
       go [(_, set)] = set
       go ((_,x):(_,y):rest) =
          let sec = intersection x y
          in  go (insertSortedBy (comparing fst) (size sec, sec) rest)
   in  go .
       List.sortBy (comparing fst) .
       map (\set -> (size set, set))

intersectionsSort :: (C set, Ord a) => [set a] -> set a
intersectionsSort =
   foldl1 intersection . Key.sort size

{- |
Like 'leftNonEmptyProduct' but the left operand can be empty.
-}
(*&) :: (C set) => Set.Set a -> set a -> set a
c *& set =
   if Set.null c
     then empty
     else leftNonEmptyProduct c set

(#*&) :: (C set) => a -> set a -> set a
c #*& set =
   leftNonEmptyProduct (Set.singleton c) set