[Haskell-cafe] Haskell scripting system (please help me simplify
the design)
Joel Reymont
joelr1 at gmail.com
Thu Oct 27 11:01:59 EDT 2005
Folks,
With lots of help from #haskell and haskell-cafe I came up with the
following setup. It's working fine but requires quite a bit of
boilerplate code. Could you please help me simplify it?
I apologize for the very long message and will describe any parts
that are unclear. Please ask away. This is my first Haskell code,
written over the course of 3 weeks (1 week to learn Haskell) so I'm
bound to get some things wrong or unoptimal. Still, I'm quite amazed
that I have been able to get this to work and to work correctly in
such a short time span.
The system is basically a scripting engine to test a poker server
that lets you write simple scripts. I went out of my way to enable QA
techs to use as little Haskell as possible, thus I'm treating all
poker commands/packets as a list of properties.
What I found is that I'm writing a lot of boiler-plate code to handle
the convertion of property values into "storables". I think this
dovetails into the recent GADT discussion. I wonder if my design and
interaction between Packet, Convertible, Prop and Attr can be
simplified.
These are a couple of sample scripts (incomplete):
---
module Test where
import Script
import Handshake as H
script env =
do setDebugLevel 100
dotimes 1 $ launch $ H.script []
waitForChildren
---
module Handshake where
import Script
script env =
-- connect to server
do world <- connect env "192.168.0.197" 15667
-- setup callbacks
world <- add world [
[ onCmd := CmdHandshake Server,
call := onServerHandshake ],
[ onCmd := CmdConnectGame Server,
call := onConnectGame ],
[ onCmd := CmdServerInfo Server,
call := onServerInfo ],
[ onCmd := CmdLogon Server,
call := onLogon ],
[ onCmd := CmdGameInfo Server,
call := onGameInfo ],
[ onCmd := CmdMoney Server,
call := onMoney ]
]
-- start handshake
send world $ make (CmdHandshake Invalid) []
run world
onServerHandshake cmd world =
do send world $ make (CmdConnectGame Client)
[ localIP := "10.0.0.2",
affiliateID := [28] ]
return world
onServerInfo cmd world =
do send world $ make (CmdLogon Client) [ name := "foo",
password := "bar",
affiliateID := [28] ]
-- retrieve table id
tables' <- get tables cmd
debug 99 $ "Tables: " ++ show tables'
tableID' <- get tableID $ head tables'
debug 99 $ "TableID: " ++ show tableID'
debug 99 $ "World: " ++ show world
-- save it for later use
world <- set (tableID := tableID') world
-- return updated info
return world
onGameInfo cmd world =
do debug 99 "Got game!"
stop world
---
I'm describing binary packets using properties (from WxHaskell) with
the added twist that when you say attr := value you can specify what
value will be converted to for storage.
This is how I would use the system...
This describes the properties for the admin message and wait list
init commands. I would use the properties to serialize the commmands.
cmdProps (CmdAdminMessage Server) = [ title := "",
message := "",
postAction := 0 ]
cmdProps (CmdSrvWaitListInit Server) = [ waitListTables := [] ]
I also have a "dictionary" that describes the attributes such as
title, message, postAction, etc. I'm allowing deeply nested lists of
properties.
title :: Attr String WString = makeAttr "title"
message :: Attr String WString = makeAttr "message"
postAction :: Attr Word8 Word8 = makeAttr "postAction"
waitListTables :: Attr [TableID] (FixedList Word8 (LE TableID)) =
makeAttr "waitListTables"
Attr String WString means that a String is accepted on the right-hand
side and the string will be converted into a wide string for storage.
Same thing with a list of table ids that is converted into a list of
little-endian table ids (word32s) prefixed by a Word8 length for
storage.
The conversion/casting is done with code like this:
class Convertible a b where
convert_AB :: a -> b
convert_BA :: b -> a
instance Convertible [Word8] FastString where
convert_AB a = packWords a
convert_BA b = unpackWords b
instance Convertible Bool Bool where
convert_AB a = a
convert_BA b = b
instance Convertible Bool Word8 where
convert_AB True = 1
convert_AB False = 0
convert_BA 1 = True
convert_BA 0 = False
instance Convertible String WString where
convert_AB a = WString $ FS.pack a
convert_BA (WString b) = FS.unpack b
instance Convertible (String, String) (WString, WString) where
convert_AB (a1, a2) = (convert_AB a1, convert_AB a2)
convert_BA (b1, b2) = (convert_BA b1, convert_BA b2)
instance Convertible [String] (FixedList (LE Word32) WString) where
convert_AB a = FixedList $ map convert_AB a
convert_BA (FixedList b) = map convert_BA b
My concern is mostly with a lot of similar boilerplate code required
for casting, specially in very alike cases like the following:
data Pot = Pot [Prop] deriving (Eq, Show, Typeable)
data BaseTableState = BaseTableState [Prop] deriving (Eq, Show,
Typeable)
instance Packet Pot where
unstuff xs = case props
of Just props -> (Just $ Pot props, xs')
Nothing -> (Nothing, xs)
where (props, xs') = unstuffprops xs potProps <<< this is
the only difference
stuff (Pot a) = stuffprops a
size (Pot a) = sizeprops a
instance Convertible [Prop] Pot where
convert_AB a = Pot $ mergeprops a potProps
convert_BA (Pot b) = b
instance Packet BaseTableState where
unstuff xs = case props
of Just props -> (Just $ BaseTableState props, xs')
Nothing -> (Nothing, xs)
where (props, xs') = unstuffprops xs baseTableStateProps
stuff (BaseTableState a) = stuffprops a
size (BaseTableState a) = sizeprops a
instance Convertible [Prop] BaseTableState where
convert_AB a = BaseTableState $ mergeprops a baseTableStateProps
convert_BA (BaseTableState b) = b
Notice that the differences are only in the list of properties
required for conversion. I'm wondering if this can be simplified
somehow.
This is how I describe serialization:
class (Eq a) => Packet a where
unstuff :: P.FastString -> (Maybe a, P.FastString)
stuff :: a -> P.FastString
size :: a -> Int
instance Packet Word8 where
unstuff xs
| P.null xs = (Nothing, xs)
| otherwise = let (ys, zs) = P.splitAt 1 xs
in (Just $ concatBits ys, zs)
stuff a = P.packWords $ unpackBits a
size a = 1
instance Packet Bool where
unstuff xs
| P.null xs = (Nothing, xs)
| otherwise = (b, xs')
where (a :: Maybe Word8, xs') = unstuff xs
b = case a
of Just a -> if a == 0
then Just False
else Just True
Nothing -> Nothing
stuff True = stuff (1 :: Word8)
stuff False = stuff (0 :: Word8)
size a = 1
This is the foundation for properties, with the idea taken from
WxHaskell and the Convertible twist added on top:
infixr 0 :=
data Prop = forall a b. (Eq a, Eq b, Show a, Packet b, Convertible a b)
=> Attr a b := a
deriving (Typeable)
instance Show Prop where
show (Attr name _ _ := x) = name ++ " := " ++ show x
instance Eq Prop where
(Attr name1 (todyn1, fromdyn1) _ := x1) == (Attr name2 (todyn2,
fromdyn2) _ := x2)
| name1 == name1 =
case fromdyn1 $ todyn2 x2
of Just x2 -> x2 == x1
Nothing -> False
| otherwise = False
data Attr a b = Attr String
(a -> Dynamic, Dynamic -> Maybe a)
(a -> b, b -> a)
instance Show (Attr a b) where
show (Attr name _ _) = name
makeAttr :: (Typeable a, Convertible a b) => String -> Attr a b
makeAttr name = Attr name
(toDyn, fromDynamic)
(convert_AB, convert_BA)
setprop :: Prop -> [Prop] -> [Prop]
setprop _ [] = []
setprop (Attr name (todyn, fromdyn) _ := x) props =
map setprop' props
where setprop' prop@(attr@(Attr name' (todyn', fromdyn')
_) := x')
| name == name' =
case fromdyn' $ todyn x
of Just y -> attr := y
Nothing -> prop
| otherwise = prop
mergeprops :: [Prop] -> [Prop] -> [Prop]
mergeprops [] props = props
mergeprops (x:xs) props =
mergeprops xs (setprop x props)
get :: Typeable a => Attr a b -> [Prop] -> IO a
get a b = return $ getprop a b
getprop :: Typeable a => Attr a b -> [Prop] -> a
getprop attr props =
case findprop attr props
of Just x -> x
Nothing -> error $ "Could not retrieve "
++ show attr ++ " from " ++ show props
--
http://wagerlabs.com/
More information about the Haskell-Cafe
mailing list