{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Main where
import Control.Monad.State
import Control.Monad.Reader
class Monad m => Nomex m where
readAccount :: m Int
class Nomex m => NomexEffect m where
writeAccount :: Int -> m ()
setVictory :: (forall n. Nomex n => n Bool) -> m ()
data Exp a where
ReadAccount :: Exp Int
WriteAccount :: Int -> Exp ()
SetVictory :: (forall m. Nomex m => m Bool) -> Exp ()
Bind :: Exp a -> (a -> Exp b) -> Exp b
Return :: a -> Exp a
instance Monad Exp where
return = Return
(>>=) = Bind
instance Nomex Exp where
readAccount = ReadAccount
instance NomexEffect Exp where
writeAccount = WriteAccount
setVictory = SetVictory
data Game = Game { victory :: (forall m. Nomex m => m Bool)
, account :: Int
}
instance Nomex (State Game) where
readAccount = gets account
instance NomexEffect (State Game) where
writeAccount n = modify $ \game -> game { account = n }
setVictory v = modify $ \game -> game { victory = v }
instance Nomex (Reader Game) where
readAccount = asks account
evaluate :: Exp a -> State Game a
evaluate (WriteAccount i) = writeAccount i
evaluate ReadAccount = readAccount
evaluate (SetVictory v) = setVictory v
evaluate (Return a) = return a
evaluate (Bind a f) = (evaluate a) >>= evaluate . f
evalNoEff :: Exp a -> Reader Game a
evalNoEff ReadAccount = readAccount
evalNoEff (Return a) = return a
evalNoEff (Bind a f) = (evalNoEff a) >>= evalNoEff . f
isVictory :: Game -> Bool
isVictory g = runReader (evalNoEff (victory g)) g
incrAccount :: NomexEffect m => m ()
incrAccount = readAccount >>= writeAccount . (+101)
winOnBigMoney :: NomexEffect m => m ()
winOnBigMoney = setVictory $ do
i <- readAccount
--writeAccount 100
return (i > 100)
play = do
winOnBigMoney
incrAccount
initGame = Game (return False) 0
main = do
let g = execState (evaluate jeu) initGame
putStrLn $ show $ isVictory g