{-# options_ghc -XGADTs -XScopedTypeVariables -XKindSignatures #-} 
module Games where 

import Random
import Iso

-- A game for type t, Game t, is a potentially infinite decision tree
-- with extra information about how to ask questions in the branches,
-- and elements of the datatype in the leaves.

-- /Game/
data Game :: * -> * where
  Single :: ISO t () -> Game t
  Split  :: ISO t (Either t1 t2) -> 
                      Game t1 -> Game t2 -> Game t
-- /End/

-- /Bit/
data Bit = O | I 
-- /End/
  deriving Show
  
showBits [] = ""
showBits (b:bs) = show b ++ showBits bs

-- /dec/
dec :: Game t -> [Bit] -> (t, [Bit])
dec (Single (Iso _ bld)) str = (bld (), str)
dec (Split _ _ _) [] = error "Input too short" 
dec (Split (Iso _ bld) g1 g2) (I : xs) 
  = let (x1, rest) = dec g1 xs 
    in (bld (Left x1), rest) 
dec (Split (Iso _ bld) g1 g2) (O : xs) 
  = let (x2, rest) = dec g2 xs
    in (bld (Right x2), rest)
-- /End/

-- /decOpt/
decOpt :: Game t -> [Bit] -> Maybe (t, [Bit])
decOpt (Single (Iso _ bld)) str = Just (bld (), str)
decOpt (Split _ _ _) [] = Nothing
decOpt (Split (Iso _ bld) g1 g2) (I:xs) 
  = do (x1, rest) <- decOpt g1 xs 
       return (bld (Left x1), rest) 
decOpt (Split (Iso _ bld) g1 g2) (O:xs) 
  = do (x2, rest) <- decOpt g2 xs
       return (bld (Right x2), rest)
-- /End/


-- /decRand/
decRandAux :: RandomGen g => g -> Game t -> t
decRandAux r (Single (Iso _ bld)) = bld ()
decRandAux r (Split (Iso _ bld) g1 g2) =
  let (b::Int,r') = random r
  in if even b then bld (Left (decRandAux r' g1)) 
          else bld (Right (decRandAux r' g2))
decRand :: Int -> Game t -> t
decRand i g = decRandAux (mkStdGen i) g
-- /decRand/

-- Coerce a game, via an isomorphism 
-- /coerceGame/
(+>) :: Game t -> ISO s t -> Game s 
(Single j) +> i      = Single (i `seqI` j)
(Split j g1 g2) +> i = Split  (i `seqI` j) g1 g2
-- /End/ 

infixl 4 +>

-- /enc/
enc :: Game t -> t -> [Bit] 
enc (Single _) x = []
enc (Split (Iso ask _) g1 g2) x 
  = case ask x of Left x1  -> I : enc g1 x1
                  Right x2 -> O : enc g2 x2
-- /End/

                                
testGame :: Game t -> t -> (t,[Bit])
testGame g x = dec g (enc g x)