Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# LANGUAGE OverloadedStrings #-}
- module Main where
- import Control.Monad.State
- import Data.Text
- import Data.Monoid
- import qualified Data.Map as M
- import Control.Monad
- -- All events, along with a payload, in our system.
- data Event
- = FunctionCalled Text
- | OrderPlaced Order
- deriving (Show, Eq)
- -- A theoretical "Order"
- data Order = Order
- { orderId :: Int
- , orderCents :: Int
- } deriving (Show, Eq)
- -- The name of an event handler; this will be used for {de}registering handlers.
- type Name = Text
- -- The abstract type of a handler: An action run on an Event in some context.
- type Handler m a = Event -> m a
- -- A map from listener names to event handlers.
- type ListenerMap m a = M.Map Name (Handler m a)
- -- An "evented" context for actions.
- -- Has a ListenerMap as State, which it will use to call handlers
- -- as events flow into the system.
- type Evented m a b = StateT (ListenerMap m a) m b
- -- Register a new handler with the given name.
- register :: Monad m => Name -> Handler m a -> Evented m a ()
- register name handler = modify (M.insert name handler)
- -- Deregister the handler with a given name.
- deregister :: Monad m => Name -> Evented m a ()
- deregister name = modify (M.delete name)
- -- Fire an event in our system, collecting all results from handlers.
- -- Result is a mapping from listener -> handler result
- fire :: Monad m => Event -> Evented m a (M.Map Name a)
- fire e = get >>= traverse (\handler -> lift (handler e))
- -- Fire an event, discarding any results.
- fire_ :: Monad m => Event -> Evented m a ()
- fire_ e = void (fire e)
- -- A simple handler that logs information about our events.
- loggingHandler :: Event -> IO ()
- loggingHandler (FunctionCalled text) = print text
- loggingHandler (OrderPlaced (Order id_ cents_))
- = putStrLn ("Order: " <> show id_ <> " for " <> show cents_ <> " cents placed.")
- -- Our initial handler mapping. Contains a single handler that logs events.
- handlers :: M.Map Text (Event -> IO ())
- handlers = M.fromList
- [ ("logger", loggingHandler)
- ]
- -- Theoretical Evented IO operation that places an Order and fires an event.
- placeOrder :: Order -> Evented IO a ()
- placeOrder order = do
- -- do some database stuff...
- fire_ (OrderPlaced order)
- -- A very basic program that goes through some "evented" processes.
- executeProgram = do
- placeOrder (Order 1 1000)
- deregister "logger"
- placeOrder (Order 2 3000)
- register "logger" loggingHandler
- placeOrder (Order 3 9000)
- -- Run the program.
- main :: IO ()
- main = void (runStateT executeProgram handlers)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement