[Haskell-beginners] Modifications inside a Reader?

[Brian Troutwine]

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 at 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 at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>