event-handlers (empty) → 0.0.0.3

raw patch · 3 files changed

+137/−0 lines, 3 filesdep +basedep +containerssetup-changed

Dependencies added: base, containers

Files

• Setup.lhs +5/−0
• event-handlers.cabal +20/−0
• src/Data/Handler.hs +112/−0

@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain+

@@ -0,0 +1,20 @@+name:                   event-handlers+version:                0.0.0.3+stability:              experimental+license:                PublicDomain++cabal-version:          >= 1.2+build-type:             Simple++author:                 James Cook <james.cook@usma.edu>+maintainer:             James Cook <james.cook@usma.edu>+homepage:               http://code.haskell.org/~mokus/event-handlers++category:               Data, Control+synopsis:               Event handlers+description:            Simple event handler set management.++Library+  hs-source-dirs:       src+  exposed-modules:      Data.Handler+  build-depends:        base >= 3, containers

@@ -0,0 +1,112 @@+{-+ -      ``Data/Handler''+ -      (c) 2008 Cook, J. MR  SSD, Inc.+ -}+{-# LANGUAGE+        GeneralizedNewtypeDeriving,+        ExistentialQuantification,+        FlexibleContexts+  #-}++module Data.Handler+        ( HandlerSet+        , HandlerID+        +        , emptyHandlerSet+        , emptyHandlerSetWithSequencer+        +        , setHandlerSequencer+        +        , addHandlerToSet+        , removeHandlerFromSet+        , invokeHandlers+        ) where++-- generic "handler" concept.  a handler has:++-- at type level:+--  an argument type+--  a monad in which the handlers will run+--  a return type++-- at data level:+--  a numeric ID within the context of the set of handlers registered for a given event+--  a piece of code to run when triggered++-- I would also like to add a description field for each handler at some point,+-- and maybe also one for the whole handler set.++import qualified Data.Map as M++-- |An opaque identifier for handlers, useful for removing them from a set+-- later.+newtype HandlerID = HandlerID Int+        deriving (Eq, Ord, Enum)++-- |A collection of handlers that can be fired in a batch.+-- Consists of a collection of handlers and a sequencing rule that +-- determines how multiple handlers are ordered and their results+-- threaded or aggregated.+data HandlerSet m a b = HandlerSet+        { handlerSet            :: M.Map HandlerID (a -> m b)+        , handlerSequencer      :: a -> [a -> m b] -> m b+        , nextHandlerId         :: HandlerID+        }++----------------------------------------------------------------+-- some canned handler sequencing rules++-- |Make a simple handler sequencer that executes handlers sequentially+--  and returns whatever the last one returns (or the first 'b' parameter+--  passed to 'sequenceHandlers' if there are no handlers in the set)+sequenceHandlers :: Monad m => b -> a -> [a -> m b] -> m b+sequenceHandlers defReturn a = sh+        where+                sh []     = return defReturn+                sh [x]    = x a+                sh (x:xs) = x a >> sh xs++----------------------------------------------------------------+-- handler sets++-- |Create a new handler set with a simple default sequencer+--  ('sequenceHandlers' ())+emptyHandlerSet :: Monad m => HandlerSet m a ()+emptyHandlerSet = emptyHandlerSetWithSequencer (sequenceHandlers ())++-- |Create a new handler set using the provided function to coordinate+--  the dispatch of the handlers+emptyHandlerSetWithSequencer :: (a -> [a -> m b] -> m b) -> HandlerSet m a b+emptyHandlerSetWithSequencer sequencer = HandlerSet+        { handlerSet            = M.empty+        , handlerSequencer      = sequencer+        , nextHandlerId         = HandlerID 0+        }++-- |Add a handler to a set and return the updated set and the assigned 'HandlerID'+addHandlerToSet :: (a -> m b) -> HandlerSet m a b -> (HandlerSet m a b, HandlerID)+addHandlerToSet handler hs@(HandlerSet {handlerSet = hSet, nextHandlerId = hId}) = +        ( hs { handlerSet       = M.insert hId handler hSet+             , nextHandlerId    = succ hId+             }+        , hId+        )++-- |Attempt to remove a handler from a set (based on its 'HandlerID'), returning+-- the modified set and the handler removed, if any.+removeHandlerFromSet :: HandlerID -> HandlerSet m a b -> (HandlerSet m a b, Maybe (a -> m b))+removeHandlerFromSet hId hs@(HandlerSet {handlerSet = hSet}) =+        ( hs { handlerSet = rest }+        , maybeHandler+        ) where +                (matches, rest) = M.partitionWithKey (\k v -> k == hId) hSet+                maybeHandler = M.lookup hId matches++-- |Replace the handler sequencing rule in a 'HandlerSet'.+setHandlerSequencer :: (a -> [a -> m b] -> m b) -> HandlerSet m a b -> HandlerSet m a b+setHandlerSequencer sequencer hs = hs { handlerSequencer = sequencer }++-- |Invoke the handlers in a 'HandlerSet' with the provided input.+invokeHandlers :: Monad m => HandlerSet m a b -> a -> m b+invokeHandlers (HandlerSet {handlerSet = handlers, handlerSequencer = sequencer}) args = do+        sequencer args (M.elems handlers)