Advertisement
Guest User

Untitled

a guest
May 3rd, 2016
56
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.46 KB | None | 0 0
  1. {-# LANGUAGE OverloadedStrings #-}
  2.  
  3. module Main where
  4.  
  5. import Control.Monad.State
  6. import Data.Text
  7. import Data.Monoid
  8. import qualified Data.Map as M
  9. import Control.Monad
  10.  
  11. -- All events, along with a payload, in our system.
  12. data Event
  13. = FunctionCalled Text
  14. | OrderPlaced Order
  15. deriving (Show, Eq)
  16.  
  17. -- A theoretical "Order"
  18. data Order = Order
  19. { orderId :: Int
  20. , orderCents :: Int
  21. } deriving (Show, Eq)
  22.  
  23. -- The name of an event handler; this will be used for {de}registering handlers.
  24. type Name = Text
  25.  
  26. -- The abstract type of a handler: An action run on an Event in some context.
  27. type Handler m a = Event -> m a
  28.  
  29. -- A map from listener names to event handlers.
  30. type ListenerMap m a = M.Map Name (Handler m a)
  31.  
  32. -- An "evented" context for actions.
  33. -- Has a ListenerMap as State, which it will use to call handlers
  34. -- as events flow into the system.
  35. type Evented m a b = StateT (ListenerMap m a) m b
  36.  
  37. -- Register a new handler with the given name.
  38. register :: Monad m => Name -> Handler m a -> Evented m a ()
  39. register name handler = modify (M.insert name handler)
  40.  
  41. -- Deregister the handler with a given name.
  42. deregister :: Monad m => Name -> Evented m a ()
  43. deregister name = modify (M.delete name)
  44.  
  45. -- Fire an event in our system, collecting all results from handlers.
  46. -- Result is a mapping from listener -> handler result
  47. fire :: Monad m => Event -> Evented m a (M.Map Name a)
  48. fire e = get >>= traverse (\handler -> lift (handler e))
  49.  
  50. -- Fire an event, discarding any results.
  51. fire_ :: Monad m => Event -> Evented m a ()
  52. fire_ e = void (fire e)
  53.  
  54. -- A simple handler that logs information about our events.
  55. loggingHandler :: Event -> IO ()
  56. loggingHandler (FunctionCalled text) = print text
  57. loggingHandler (OrderPlaced (Order id_ cents_))
  58. = putStrLn ("Order: " <> show id_ <> " for " <> show cents_ <> " cents placed.")
  59.  
  60. -- Our initial handler mapping. Contains a single handler that logs events.
  61. handlers :: M.Map Text (Event -> IO ())
  62. handlers = M.fromList
  63. [ ("logger", loggingHandler)
  64. ]
  65.  
  66. -- Theoretical Evented IO operation that places an Order and fires an event.
  67. placeOrder :: Order -> Evented IO a ()
  68. placeOrder order = do
  69. -- do some database stuff...
  70. fire_ (OrderPlaced order)
  71.  
  72. -- A very basic program that goes through some "evented" processes.
  73. executeProgram = do
  74. placeOrder (Order 1 1000)
  75. deregister "logger"
  76. placeOrder (Order 2 3000)
  77. register "logger" loggingHandler
  78. placeOrder (Order 3 9000)
  79.  
  80. -- Run the program.
  81. main :: IO ()
  82. main = void (runStateT executeProgram handlers)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement