```{-# 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 =
(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 =
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 =
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 =
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/

```