observer pattern in haskell

observer.hs

{-# LANGUAGE ScopedTypeVariables #-}
import qualified Data.IntMap as M
import Data.IORef
import Data.Unique

{--
 - listen :: Event a -> (a -> IO ()) -> IO ()
 - fire   :: Event a -> a -> IO ()
 -}

data Event a = Event { listen :: (a -> IO ()) -> IO ()
                     , fire   :: a -> IO () 
                     }

newEvent :: IO (Event a)
newEvent = do
    handlers <- newIORef M.empty
    let listen' fn = do
            key <- fmap hashUnique newUnique
            modifyIORef handlers $ M.insert key fn
        fire'   a  =
            readIORef handlers >>= mapM_ ($ a) . M.elems
    return $ Event listen' fire'

-- test
main :: IO ()
main = do
    (e1::Event Int)    <- newEvent
    (e2::Event String) <- newEvent
    listen e1 (fire e2 . show . (+1))
    listen e2 putStrLn
    fire e1 1

Excellent example and awesome!

小伙,代码写得不错.