{-# options_ghc -XEmptyDataDecls -XOverlappingInstances -XScopedTypeVariables #-}
module SetGames where 

import Data.Maybe
import Iso
import Games
import BasicGames
import List

getRight (Right x) = x 
getLeft (Left x)   = x 
nonemptyIso = Iso (\(x:xs) -> (x,xs)) (\(x,xs) -> x:xs) 

-- Diff functions used for representations of sets and multisets
-- /diff/
diff minus [] = []
diff minus (x:xs) = x : diff' x xs
  where diff' base [] = []
        diff' base (x:xs) = minus x base : diff' x xs

undiff plus [] = []
undiff plus (x:xs) = x : undiff' x xs
  where undiff' base [] = []
        undiff' base (x:xs) = base' : undiff' base' xs
                              where base' = plus base x
-- /End/


-- Makes use of isomorphism between [Nat] and { xs:[Nat] | sorted xs }
-- /natMultisetGame/
natMultisetGame :: Game Nat -> Game [Nat]
natMultisetGame g = 
  listGame g +> Iso (diff (-) . sort) (undiff (+)) 
-- /End/

-- Makes use of isomorphism between [Nat] and { xs:[Nat] | sorted xs && distinct xs }
-- /natSetGame/
natSetGame :: Game Nat -> Game [Nat]
natSetGame g = 
  listGame g +> Iso (diff (\ x y -> x-y-1) . sort)
                    (undiff (\ x y -> x+y+1))                     
-- /End/

-- Comparison of two elements based on their games
-- /compareByGame/
compareByGame :: Game a -> (a -> a -> Ordering)
compareByGame (Single _) x y = EQ
compareByGame (Split (Iso ask bld) g1 g2) x y =
  case (ask x, ask y) of
    (Left x1 , Left y1)  -> compareByGame g1 x1 y1
    (Right x2, Right y2) -> compareByGame g2 x2 y2
    (Left x1,  Right y2) -> LT
    (Right x2, Left y1)  -> GT
sortByGame :: Game a -> [a] -> [a]
sortByGame g = sortBy (compareByGame g)
-- /End/

-- Remove an element from a game, returning Nothing if the game was a singleton
removeEQ :: Game a -> a -> Maybe (Game a)
removeEQ (Single _) x = Nothing
removeEQ (Split (Iso ask bld) g1 g2) x =
  case ask x of
    Left x1 -> 
      Just $ case removeEQ g1 x1 of
        Nothing -> g2 +> rightI
        Just g1' -> Split (Iso ask bld) g1' g2
    Right x2 -> 
      Just $ case removeEQ g2 x2 of
        Nothing -> g1 +> leftI
        Just g2' -> Split (Iso ask bld) g1 g2'
  where rightI = Iso (getRight . ask)
                     (bld . Right)
        leftI  = Iso (getLeft . ask)
                     (bld . Left)

    

-- Remove every element less than or equal to an element according to 
-- the ordering induced by the game, returning Nothing if no elements would remain
-- /removeLE/
removeLE :: Game a -> a -> Maybe (Game a)
removeLE (Single _) x = Nothing
removeLE (Split (Iso ask bld) g1 g2) x =
  case ask x of 
    Left x1 -> 
      Just $ case removeLE g1 x1 of
        Nothing  -> g2 +> rightI
        Just g1' -> Split (Iso ask bld) g1' g2
    Right x2 -> case removeLE g2 x2 of
      Nothing  -> Nothing
      Just g2' -> Just (g2' +> rightI)
  where rightI = Iso (getRight . ask)
                     (bld . Right)
-- /End/

-- /removeLT/    
-- Remove every element less than an element according to 
-- the ordering induced by the game
-- Don't think this one works!!!
removeLT :: Game a -> a -> Game a
removeLT (Single iso) x = Single iso
removeLT (Split (Iso ask bld) g1 g2) x =
  case ask x of
    Left x1 -> Split (Iso ask bld) (removeLT g1 x1) g2
    Right x2 -> g2 +> Iso (getRight . ask) (bld . Right)
-- /End/
    
-- /setGame/
setGame :: Game a -> Game [a]
setGame g = setGame' g +> Iso (sortByGame g) id
  where setGame' g = Split listIso unitGame $
                     depGame g $ \x -> 
                     case removeLE g x of 
                       Just g' -> setGame' g'
                       Nothing -> constGame []
-- /End/

-- /multisetGame/
multisetGame :: Game a -> Game [a]
multisetGame g = multisetGame' g +> Iso (sortByGame g) id
  where multisetGame' g = Split listIso unitGame 
          (depGame g (\x -> multisetGame' (removeLT g x)))
-- /End/