[Haskell-cafe] Haskell poker server
Cale Gibbard
cgibbard at gmail.com
Sun Aug 28 20:47:29 EDT 2005
Well, here's an attempt at a start on a similar mechanism for Haskell:
---------- (start Packet.hs)
module Packet where
import Data.Bits
import Data.Word
concatBits :: (Integral a, Bits a, Bits b) => [a] -> b
concatBits [] = 0
concatBits (x:xs) = shift (fromIntegral x) (sum (map bitSize xs)) +
concatBits xs
class Packet a where
readPacket :: [Word8] -> (a, [Word8])
instance Packet Word8 where
readPacket (x:xs) = (x,xs)
instance Packet Word16 where
readPacket xs = let (ys, zs) = splitAt 2 xs in (concatBits ys, zs)
instance Packet Word32 where
readPacket xs = let (ys, zs) = splitAt 4 xs in (concatBits ys, zs)
instance Packet Word64 where
readPacket xs = let (ys, zs) = splitAt 8 xs in (concatBits ys, zs)
instance (Packet a, Packet b) => Packet (a,b) where
readPacket xs = let (u, xs') = readPacket xs
(v, xs'') = readPacket xs'
in ((u,v), xs'')
instance (Packet a, Packet b, Packet c) => Packet (a,b,c) where
readPacket xs = let (u, xs') = readPacket xs
(v, xs'') = readPacket xs'
(w, xs''') = readPacket xs''
in ((u,v,w), xs''')
instance (Packet a) => Packet [a] where
readPacket [] = ([],[])
readPacket xs = let (u, xs') = readPacket xs
in (u : fst (readPacket xs'), [])
-------- (end Packet.hs)
With this you can convert lists of Word8's into particular structured
forms as you see fit. Additional instances of Packet can be added for
other types as needed. (As an easy example, if you have a GID newtype
based on Word32, you could just add Packet to the deriving clause,
assuming GHC extensions.)
For example:
readPacket [24,182,64,43,53,10,1]
:: ((Word8,Word32,Word16), [Word8])
== ((24,3057658677,2561),[])
readPacket [24,182,64,43,53,10,1,24,197,17,34,200,10,2]
:: ((Word8,Word32,Word16), [Word8])
== ((24,3057658677,2561),[24,197,17,34,200,10,2])
readPacket [24,182,64,43,53,10,1,24,197,17,34,200,10,2]
:: ([(Word8,Word32,Word16)], [Word8]) -- note the list type
== ([(24,3057658677,2561),(24,3306234568,2562)],[])
Anyway, I hope this is useful :)
- Cale
On 28/08/05, Joel Reymont <joelr1 at gmail.com> wrote:
> Alistair,
>
> Thanks alot for your examples. I still have one unanswered question...
>
> How would you read a tuple of values (24, GID, Seq) like in my Erlang
> example, where 24 is one byte, GID is a 4-byte integer and Seq is a 2-
> byte word? Is there an elegant way of specifying packet format and
> reading/writing Haskell data according to it?
>
> Thanks, Joel
>
> On Aug 28, 2005, at 11:58 PM, Alistair Bayley wrote:
>
> > Below is a contrived, non-optimal first attempt. The server just reads
> > seven bytes from the socket, prints them, and quits. And the client
> > just sends seven bytes and quits.
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
More information about the Haskell-Cafe
mailing list