Re: [Haskell-beginners] Modifications inside a Reader?

19 Jun 2009

      Thanks so much! I've taken your suggestions, expanded on them and come
up with the code below. It is no no longer an echo server, but instead
is pretty close to the in-memory priority queue daemon I need. Anyway,
it's included below for completness' sake.

If anyone has comments (or questions, at this point) I'd be happy to hear them.

Brian

--

{-# LANGUAGE OverloadedStrings #-}
import Prelude hiding (putStrLn, catch, show, print)
import Network.Socket hiding (send, sendTo, recv, recvFrom)
import Network.Socket.ByteString
import Data.ByteString.Char8 hiding (head, singleton, empty)
import Control.Monad.State.Strict
import Control.Monad (forever)
import Control.Exception (bracket)
import Data.BloomFilter
import Data.BloomFilter.Easy
import Data.BloomFilter.Hash (cheapHashes)
import Data.PSQueue

type PrioQueue = PSQ ByteString Int
data Globals = Globals {
      socketG :: Socket
    , bloomF  :: !(Bloom ByteString)
    , prioQ   :: !(PrioQueue)
    }

type Echo = StateT Globals IO

run :: Echo ()
run = forever $ do
  sock <- gets socketG
  (msg, addr) <- liftIO $ recvFrom sock 1024
  let [op, priority, _category, payload] = split ':' msg
  bloom <- gets bloomF
  pQ    <- gets prioQ
  liftIO $ putStrLn op
  case op of
    "Get" ->
        case findMin pQ of
          Nothing -> return () -- Client will just timeout.
          Just qData -> liftIO $ sendTo sock (key qData) addr >> return ()
    "Put" ->
        case elemB payload bloom of
          True  -> return ()
          False -> modifyBloom (insertB payload)
                   >> modifyPrioQ (insert payload pri)
            where
              pri = (read . unpack) priority
    _ -> return () -- Client will just timeout.

modifyBloom :: (Bloom ByteString -> Bloom ByteString) -> Echo ()
modifyBloom f = modify (\s -> s { bloomF = f (bloomF s) })

modifyPrioQ :: (PrioQueue -> PrioQueue) -> Echo ()
modifyPrioQ f = modify (\s -> s { prioQ = f (prioQ s) })

main :: IO ()
main = bracket build disconnect loop
  where
    disconnect = sClose . socketG
    loop st    = runStateT run st >> return ()

build :: IO Globals
build = do
  addrinfos <- getAddrInfo
               (Just (defaultHints {addrFlags = [AI_PASSIVE]}))
               Nothing (Just "1514")
  let serveraddr = head addrinfos
  sock <- socket (addrFamily serveraddr) Datagram defaultProtocol
  bindSocket sock (addrAddress serveraddr)
  return $ Globals sock (emptyB (cheapHashes 10) 16777216) empty

On Thu, Jun 18, 2009 at 11:25 AM, Brent Yorgey<byorgey@seas.upenn.edu> wrote:
...
On Wed, Jun 17, 2009 at 08:32:53PM -0700, Brian Troutwine wrote:
...
Hello all.
I'm writing a UDP echo server, full source given below. The current
implementation echoes back the "payload" of every incoming message but
I would prefer that only unique payloads be echoed back. To that end
I've started in with Data.BloomFilter but am not sure how to update it
accordingly. I imagine that Reader is probably the wrong monad to be
using though I'm unsure how I might modify my program to use State.
Could someone lead me along a bit?
Also, any general comments on the style of my program?
Looks nice.  Changing your program to use 'State' instead of 'Reader'
(which is indeed the wrong monad if you want to update) should be a
piece of cake!
...
type Echo = StateT Globals IO
Now you should use 'gets' instead of 'asks':
...
run :: Echo ()
run = forever $ do
  s <- gets socketG
  ...
Then you'll probably want a little utility function for updating the
Bloom filter, like this:
...
modifyBloom :: (Bloom Bytestring -> Bloom Bytestring) -> Echo ()
modifyBloom f = modify (\s -> s { bloomF = f (bloomF s) })
('modify' is another State method; the ugliness and repetition in
evidence above is because of the unwieldy record-update syntax, which
is exactly why you want a helper function =).
Now you can use 'modifyBloom f' as an Echo () action which applies the
transformation f to the current Bloom filter.  And that's all!
-Brent
_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://www.haskell.org/mailman/listinfo/beginners