nybble
/
waterdeep
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add a WriterT for tracking the set of resources provided by an action

This commit is contained in:
Jesse D. McDonald 2014-07-26 17:08:39 -05:00
parent a8d2a603be
commit 7bdd14fc83
1 changed files with 29 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/Waterdeep/Types.hs
View File

@ -26,6 +26,7 @@ module Waterdeep.Types
, Waterdeep
, WaterdeepPrompt(..)
, WaterdeepState(..)
, ResourceSet
, lordName
, lordQuote
, lordBonus
@ -95,6 +96,9 @@ module Waterdeep.Types
, notifyState
, broadcast
, solicitChoice
, actionProvidedSet
, actionProvided
, delimitAction
, runWaterdeepC
, runWaterdeep
, runWaterdeepM
@ -108,9 +112,11 @@ import Control.Monad.Prompt
import Control.Monad.Random
import Control.Monad.State
import Control.Monad.State.Class
import Control.Monad.Writer.Class
import Control.Monad.Trans
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Control.Monad.Trans.State (StateT, runStateT)
import Control.Monad.Trans.Writer (WriterT(..), runWriterT)
import Data.Maybe
import Data.Monoid
import Lens.Family2
@ -122,6 +128,7 @@ import System.Random (StdGen)
import qualified Data.IntMap as IM
import qualified Data.MultiSet as MS
import qualified Data.Set as Set
import qualified System.Random as R
type PlayerID = Int
@ -256,8 +263,12 @@ data WaterdeepPrompt a where
Broadcast :: String -> WaterdeepPrompt ()
SolicitChoice :: PlayerID -> String -> [(String, a)] -> WaterdeepPrompt a
type ResourceSet = Set.Set Resource
data Waterdeep a =
Waterdeep { unWaterdeep :: StateT WaterdeepState (MaybeT (Prompt WaterdeepPrompt)) a }
Waterdeep { unWaterdeep :: WriterT ResourceSet
(StateT WaterdeepState
(MaybeT (Prompt WaterdeepPrompt))) a }
makeLenses ''Lord
makeLenses ''Faction
@ -300,7 +311,7 @@ instance MonadPlus Waterdeep where
(Waterdeep m) `mplus` (Waterdeep n) = Waterdeep (m `mplus` n)
instance MonadState WaterdeepState Waterdeep where
state = Waterdeep . state
state = Waterdeep . lift . state
instance MonadRandom Waterdeep where
getRandom = gameStdGen %%= random
@ -371,7 +382,7 @@ newBuildingState p b =
}
waterdeepPrompt :: WaterdeepPrompt a -> Waterdeep a
waterdeepPrompt = Waterdeep . lift . lift . prompt
waterdeepPrompt = Waterdeep . lift . lift . lift . prompt
notifyState :: Waterdeep ()
notifyState = get >>= waterdeepPrompt . NotifyState
@ -387,14 +398,26 @@ solicitChoice t cs = do
p <- use gameActivePlayer
waterdeepPrompt (SolicitChoice p t cs)
actionProvidedSet :: ResourceSet -> Waterdeep ()
actionProvidedSet s = Waterdeep $ tell s
actionProvided :: Resource -> Waterdeep ()
actionProvided r = actionProvidedSet $ Set.singleton r
delimitAction :: Waterdeep a -> Waterdeep (a, ResourceSet)
delimitAction (Waterdeep m) = Waterdeep . lift $ runWriterT m
evalWriterT :: Monad m => WriterT w m a -> m a
evalWriterT m = return . fst =<< runWriterT m
runWaterdeepC :: (Maybe (r, WaterdeepState) -> b) -> (forall a. WaterdeepPrompt a -> (a -> b) -> b) -> Waterdeep r -> WaterdeepState -> b
runWaterdeepC r p (Waterdeep m) s = runPromptC r p $ runMaybeT $ runStateT m s
runWaterdeepC r p (Waterdeep m) s = runPromptC r p $ runMaybeT $ runStateT (evalWriterT m) s
runWaterdeep :: (forall a. WaterdeepPrompt a -> a) -> Waterdeep r -> WaterdeepState -> Maybe (r, WaterdeepState)
runWaterdeep p (Waterdeep m) s = runPrompt p $ runMaybeT $ runStateT m s
runWaterdeep p (Waterdeep m) s = runPrompt p $ runMaybeT $ runStateT (evalWriterT m) s
runWaterdeepM :: (Monad m) => (forall a. WaterdeepPrompt a -> m a) -> Waterdeep r -> WaterdeepState -> m (Maybe (r, WaterdeepState))
runWaterdeepM p (Waterdeep m) s = runPromptM p $ runMaybeT $ runStateT m s
runWaterdeepM p (Waterdeep m) s = runPromptM p $ runMaybeT $ runStateT (evalWriterT m) s
data ContWD a where
Done :: Maybe (a, WaterdeepState) -> ContWD a