summaryrefslogtreecommitdiff
path: root/Game/Hanabi.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Game/Hanabi.hs')
-rw-r--r--Game/Hanabi.hs31
1 files changed, 30 insertions, 1 deletions
diff --git a/Game/Hanabi.hs b/Game/Hanabi.hs
index cb779d8..89da39f 100644
--- a/Game/Hanabi.hs
+++ b/Game/Hanabi.hs
@@ -5,7 +5,7 @@ module Game.Hanabi(
prettyEndGame, isMoveValid, checkEndGame, help,
-- * Datatypes
-- ** The Class of Strategies
- Strategies, Strategy(..), Verbose(..), STDIO, stdio, Blind, ViaHandles(..), Verbosity(..), verbose,
+ Strategies, Strategy(..), StrategyDict(..), mkSD, DynamicStrategy, mkDS, mkDS', Verbose(..), STDIO, stdio, Blind, ViaHandles(..), Verbosity(..), verbose,
-- ** The Game Specification
GameSpec(..), defaultGS, Rule(..), defaultRule, isRuleValid,
-- ** The Game State and Interaction History
@@ -26,6 +26,7 @@ import Data.Char(isSpace, isAlpha, isAlphaNum, toLower, toUpper)
import Data.Maybe(fromJust)
import Data.List(isPrefixOf, group)
import System.IO
+import Data.Dynamic
import GHC.Generics hiding (K1)
@@ -323,6 +324,34 @@ class Monad m => Strategy p m where
observe _pvs _moves st = return ((),st) -- The default does nothing.
-}
+
+-- StrategyDict should be used instead of class Strategy, maybe.
+
+-- | 'StrategyDict' is a dictionary implementation of class 'Strategy'. It can be used instead if you like.
+data StrategyDict m s = SD{sdName :: String, sdMove :: Mover s m, sdObserve :: Observer s m, sdState :: s}
+type HanabiT s m a = [PrivateView] -> [Move] -> s -> m (a, s)
+type Mover s m = HanabiT s m Move
+type Observer s m = [PrivateView] -> [Move] -> s -> m ()
+mkSD :: (Monad m, Typeable s, Strategy s m) => String -> s -> StrategyDict m s
+mkSD name s = SD{sdName=name, sdMove=move, sdObserve=observe, sdState=s}
+instance Monad m => Strategy (StrategyDict m s) m where
+ strategyName mp = do p <- mp
+ return $ sdName p
+ move pvs mvs s = sdMove s pvs mvs (sdState s) >>= \ (m, nexts) -> return (m, s{sdState=nexts})
+ observe pvs mvs s = sdObserve s pvs mvs $ sdState s
+
+
+-- Should DynamicStrategy be limited to IO?
+type DynamicStrategy m = StrategyDict m Dynamic
+mkDS :: (Monad m, Typeable s, Strategy s m) => String -> s -> DynamicStrategy m
+mkDS name s = mkDS' $ mkSD name s
+mkDS' :: (Monad m, Typeable s) => StrategyDict m s -> DynamicStrategy m
+mkDS' gs = SD{sdName = sdName gs,
+ sdMove = \pvs mvs dyn -> fmap (\(m,p)->(m, toDyn p)) $ sdMove gs pvs mvs (fromDyn dyn (error "mkDS': impossible")),
+ sdObserve = \pvs mvs dyn -> sdObserve gs pvs mvs (fromDyn dyn (error "mkDS': impossible")),
+ sdState = toDyn $ sdState gs}
+
+
-- | The 'Strategies' class defines the list of 'Strategy's. If all the strategies have the same type, one can use the list instance.
-- I (Susumu) guess that in most cases one can use 'Dynamic' in order to force the same type, but just in case, the tuple instance is also provided. (Also, the tuple instance should be more handy.)
--