subscribe.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Subscribe where

import qualified Data.IORef as IORef
import           Data.Proxy (Proxy (..))
import qualified Data.Map   as Map

-- Event types, just stupid examples

data Event
    = ResizeEvent Resize
    | OpenUrlEvent OpenUrl
    deriving (Show)

newtype Resize  = Resize (Int, Int) deriving (Show)
newtype OpenUrl = OpenUrl String    deriving (Show)

-- Typeclass and instances

class FromEvent a where
    eventName :: Proxy a -> String
    fromEvent :: Event -> Maybe a

instance FromEvent Resize where
    eventName _               = "resize"
    fromEvent (ResizeEvent x) = Just x
    fromEvent _               = Nothing

instance FromEvent OpenUrl where
    eventName _                = "resize"
    fromEvent (OpenUrlEvent x) = Just x
    fromEvent _                = Nothing

-- State

data Connection = Connection
    { cHandlers :: IORef.IORef (Map.Map String (Event -> IO ()))
    }

-- Using ScopedTypeVariables+forall to capture that 'a', that way we can refer
-- to it in 'proxy'.
subscribe :: forall a. FromEvent a => Connection -> (a -> IO ()) -> IO ()
subscribe conn f = IORef.atomicModifyIORef' (cHandlers conn) $ \handlers ->
    (Map.insert (eventName proxy) handler handlers, ())
  where
    proxy   = Proxy :: Proxy a
    handler = maybe (pure ()) f . fromEvent