On Dec 12, 2005, at 11:31 AM, Bulat Ziganshin wrote:
Hello Joel,
this code really looks strange: you asks to create global veriable,
but don't say its type :) polymorhism is for functions definitions,
any concrete data in Haskell have concrete type
It's a long story but I'll try to explain. I would also emphasize
that the code works and the type checker complains if I try to use,
say, Event String once Event Int has been used.
So this is how I do it...
This chunk lives in my internal libraries that I deliver to the
client. I have some pre-defined events and let the user of the
library come up with custom ones.
data Event a
= Go
| Quit
| ForcedQuit
| NetworkError Exception
| Timeout String
| Cmd Command
| Custom a
deriving Show
Yes, this looks bad but keep reading! The 'a' is the same throughout.
type Child a = (MVar (), TMVar (ClockTime, (Event a)), MVar ThreadId)
{-# NOINLINE children #-}
children :: MVar [Child a]
children = unsafePerformIO $ newMVar []
forkChild :: Show a => (TMVar (ClockTime, (Event a)) -> IO ()) -> IO
ThreadId
forkChild io =
do mvar <- newEmptyMVar
mbx <- atomically $ newEmptyTMVar
childs <- takeMVar children
thread <- newEmptyMVar
putMVar children ((mvar, mbx, thread):childs)
tid <- forkIO (io mbx `finally` putMVar mvar ())
putMVar thread tid
return tid
This is the poker bot state. I use the 'b' for the user data type.
data World a b = World
{
...
dispatchers :: ![(String, Dispatcher a b)],
trace_filter:: Event a -> Bool,
...
user_data :: !(Maybe b)
}
The monad...
type ScriptState a b = ErrorT String (StateT (World a b) IO)
type ScriptResult a b = IO (Either String (), World a b)
This is the type signature for the bot fun...
type Dispatcher a b = Event a -> ((ScriptState a b) (Status a))
data Status a
= Start
| Eat (Maybe (Event a))
| Skip
deriving Show
What each bot should return. Eat means do not process any further
dispatchers in the list of dispatchers kept in the bot state (World
above). Skip will continue processing by calling dispatchers upstream
with the same event.
Dispatchers can fail thus they are in the ScriptState monad.
This bit is actually exported
getdata :: Show b => (ScriptState a b) b
getdata =
do w <- get
return $ fromJust $ user_data w
setdata :: b -> (ScriptState a b) ()
setdata b =
do w <- get
put_ $ w { user_data = Just $ b }
launch :: (Show a, Show b) =>
HostInfo -> Dispatcher a b -> IO ()
launch hi script =
do forkChild $ run hi script
liftIO $ sleep_ 10
return ()
This is what a user "script" looks like. We are almost there, I promise!
data CustomEvent
= Tables [TableInfo]
| LoggedIn
| JoinedTable Word32
| SeatTaken Word8
| SeatNotTaken Word8
| DealerChip
| Quorum
deriving Show
main =
do initSnippets
launch host script
sleep_ 2000 -- 2 seconds
waitToFinish
Notice the call to setdata (). The type of 'b' will not be known
without it and ghc will not compile the program.
script Go =
do startScript
setdata ()
trace 10 "Kicking off"
push "goToLobby" $ goToLobby [28]
return $ Eat $ Just Go
script (Custom (JoinedTable 0)) =
do trace 10 "We are in the lobby"
return $ Eat $ Just Quit
script (Timeout _) =
fail $ "Script: Timeout received"
script event =
do fail $ "script: event: " ++ show event
return Skip
Now, as soom as I use my custom event in the script, 'a' in the
dispatcher signature and everywhere else will be "bound" to
CustomEvent and thus the chunk of code below will be resolved.
{-# NOINLINE children #-}
children :: MVar [Child a]
children = unsafePerformIO $ newMVar []
As soon as you try to post a different event somewhere in the script
ghc will complain of a type mismatch and suggest that you use
CustomEvent instead. Problem solved, everything works.
Did I explain this to everyone's satisfaction? Have I supplied enough
context? Is my code beautiful and efficient?
Finally, does anyone have _constructive_ criticism to offer? :D
Thanks, Joel
--
http://wagerlabs.com/
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
