gistfile1.txt

{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving, MultiParamTypeClasses, InstanceSigs, ScopedTypeVariables, RankNTypes #-}

import Control.Monad.Codensity
import Control.Monad.Free
import Control.Monad.State

data Source = Deck | Discard

data Card
data Player

newtype Game a = Game (Codensity (StateT GameState (Free GameNode)) a)
  deriving (Functor, Applicative, Monad, MonadFree GameNode)

instance MonadState GameState Game where
  get = Game . lift $ get
  put = Game . lift . put

wrapEvent :: GameEvent (Game a) -> Game a
wrapEvent ge = do
  s <- get
  wrap $ GameNode s ge

changeFuture :: (forall a. Free GameNode a -> Free GameNode a) -> Game ()
changeFuture f = Game $ Codensity $ \cc -> mapStateT f (cc ())

data GameState

data GameNode a = GameNode
  { gameState :: GameState
  , gameEvent :: GameEvent a
  } deriving Functor

data GameEvent next
  = StartTurn Player next
  | EndTurn Player next
  | PlayCard (Card -> next)
  | DrawCard Player Source next
  | NextPlayer (Prep Player next)
    deriving Functor

data Prep a b = Prep (a -> b) a
  deriving Functor

deploy :: Prep a b -> b
deploy (Prep f x) = f x