[Haskell] Simulating client server communication with recursive
monads
John Vogel
jpvogel1 at gmail.com
Mon Jan 14 23:33:17 EST 2008
If you redefine as follows:
server :: [Integer] -> Writer [String] [Integer]
server [] = return []
server (a:as) = do
tell ["Server " ++ show a]
rs <- server as
return (a:rs)
You get this for the output:
["Server 0","Server 1","Server 2","Server 3","Server 4","Server 5","Server
6","Server 7","Server 8","Server 9","Server 1
0","Client 0","Client 1","Client 2","Client 3","Client 4","Client 5","Client
6","Client 7","Client 8","Client 9"]
Then you just need to alternate the pattern. Though a real simulation
of sever traffic would account for the packets
not being recieved, rerequested, or recieved out of order. It also depends
whether you are simulating TCP or UDP.
On 1/14/08, Jan Stranik <janstranik at yahoo.de> wrote:
>
> Hello,
>
> I am trying to simulate a client server traffic using recursive lazy
> evaluation. I am trying to do that in a recursive writer monad.
>
> Following code is my attempt to simulate client server interaction and
> collect its transcript:
>
> {-# OPTIONS -fglasgow-exts #-}
>
> module Main where
>
>
>
> import Control.Monad.Writer.Lazy
>
> simulation:: Writer [String] ()
>
> simulation = mdo
>
> a <- server cr
>
> cr <- client $ take 10 a
>
> return ()
>
>
>
> server:: [Integer] -> Writer [String] [Integer]
>
> server (a:as) = do
>
> tell ["server " ++ show a]
>
> rs <- server as
>
> return ((a*2):rs)
>
>
>
> server [] = return []
>
>
>
> client:: [Integer] -> Writer [String] [Integer]
>
> client as = do
>
> dc <- doClient as
>
> return (0:dc)
>
> where
>
> doClient (a:as) = do
>
> tell ["Client " ++ show a]
>
> as' <- doClient as
>
> return ((a+1):as')
>
> doClient [] = return []
>
>
>
> main = return $ snd $ runWriter simulation
>
>
>
> The problem that I see is that the transcript collected contains first all
> output from the server, and then output from the client.
>
> Here is an example of output that I see:
>
> :["server 0","server 1","server 3","server 7","server 15","server
> 31","server 63","server 127","server 255","server 511","server 1023","Client
> 0","Client 2","Client 6","Client 14","Client 30","Client 62","Client
> 126","Client 254","Client 510","Client 1022"]
>
>
>
> I would like to collect the output like:
>
> :["client 0","server 0", "client 1",…]
>
>
>
> This would allow me to remove the ending condition in simulation (take
> 10), and instead rely fully on lazy evaluation to collect as many simulation
> steps as needed by my computation.
>
> I am still relatively new to the concepts of recursive monadic
> computations, so I would appreciate any suggestions from experts on this
> mailing list.
>
>
>
> Thank you
>
>
>
> Jan
>
>
>
> _______________________________________________
> Haskell mailing list
> Haskell at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell/attachments/20080114/84277dd1/attachment.htm
More information about the Haskell
mailing list