Haskell scripting system (please help me simplify the design)

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/

On Oct 27, 2005, at 11:01 AM, Joel Reymont wrote:
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.
Welcome to Haskell!
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.
[snip]
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.
You could consider creating a monad for the "unstuff" part of the operation that would hide dealing with the FastString, the tupling and the case analysis on Maybe. Your code might then look like: class (Eq a) => Packet a where unstuff :: Unstuff a stuff :: a -> P.FastString size :: a -> Int instance Packet BaseTableState where unstuff = unstuffprops baseTableStateProps >>= return . BaseTableState sutff (BaseTableState a) = stuffprops a size (BaseTableState a) = sizeprops a where Unstuff is the type constructor for your monad. If you end up doing a lot of instances like this, the monad could well be a win; it also gives you the opportunity to add error reporting during the parse if you want. As a side note, I see you are doing a bunch of operations on lists of properties. If performance is an issue, you might want to consider using Data.Map or similar. If your properties lists can get big, mergeprops looks like a potential problem ( O( n*(n+m) ) each time it's called ).

Robert, On Oct 27, 2005, at 4:59 PM, Robert Dockins wrote:
You could consider creating a monad for the "unstuff" part of the operation that would hide dealing with the FastString, the tupling and the case analysis on Maybe.
Could you elaborate on this a bit please? How would I write and use such a monad?
If you end up doing a lot of instances like this, the monad could well be a win; it also gives you the opportunity to add error reporting during the parse if you want.
This is exactly the problem I'm facing now. Parsing is failing and I need to take apart my pure code just for testing. How would you code this monad?
As a side note, I see you are doing a bunch of operations on lists of properties. If performance is an issue, you might want to consider using Data.Map or similar. If your properties lists can get big, mergeprops looks like a potential problem ( O( n*(n+m) ) each time it's called ).
What would I use as the key for each map entry? If I knew this then I could use a map :-). As it stands, each property is a solid chunk and I can't even extract the name of the attribute it was created with. I don't think Map lets me index on Strings, does it? Since I end up modifying properties a lot I think I sould use monads but I need to read up to get a clear picture. Joel -- http://wagerlabs.com/

On 27/10/05, Joel Reymont
On Oct 27, 2005, at 4:59 PM, Robert Dockins wrote: [snip]
As a side note, I see you are doing a bunch of operations on lists of properties. If performance is an issue, you might want to consider using Data.Map or similar. If your properties lists can get big, mergeprops looks like a potential problem ( O( n*(n+m) ) each time it's called ).
What would I use as the key for each map entry? If I knew this then I could use a map :-). As it stands, each property is a solid chunk and I can't even extract the name of the attribute it was created with. I don't think Map lets me index on Strings, does it? [snip] Joel
You can use any type in Ord as an index for a Map -- see fromList in the Data.Map documentation. Strings are actually quite an effective type of key, as they don't usually even need to be fully evaluated to be compared. - Cale

Something else just occurred to me... How would I represent "no command" using the Unstuff monad? I'm returning Maybe Command right now, would this change? On Oct 27, 2005, at 4:59 PM, Robert Dockins wrote:
You could consider creating a monad for the "unstuff" part of the operation that would hide dealing with the FastString, the tupling and the case analysis on Maybe.
Your code might then look like:
class (Eq a) => Packet a where unstuff :: Unstuff a stuff :: a -> P.FastString size :: a -> Int
instance Packet BaseTableState where unstuff = unstuffprops baseTableStateProps >>= return . BaseTableState sutff (BaseTableState a) = stuffprops a size (BaseTableState a) = sizeprops a
where Unstuff is the type constructor for your monad.
participants (3)
-
Cale Gibbard
-
Joel Reymont
-
Robert Dockins