caching reflex widget event creation

cacheEventDraft.hs

------------- Spider synonims

type ES = Event Spider
type DS = Dynamic Spider

-------------- Dom + spider synonyms

type MS = MonadWidget Spider

data WidgetEvents m b where
    GetEvent :: MonadIO m => (forall a. EventName a -> (ES (EventResultType a) -> ES b) -> m (ES b)) -> WidgetEvents m b


-- extract an "unique event" dispatcher for the widget, where results are collapsed in type b
eventsOf :: forall m w b. (MS m, HasDomEvent Spider w) => w -> m (WidgetEvents m b)
eventsOf w = do
    mm <- liftIO $ newIORef Nothing
    return $ GetEvent (match mm w)
                    
-- dont't export, hide the intricacy of the dispatcher here, as an example we imagine there are procedures to init Mousemove 
match :: (MS m, HasDomEvent Spider w) => IORef (Maybe (ES (EventResultType 'MousemoveTag))) -> w -> EventName a -> (ES (EventResultType a) -> ES b) -> m (ES b)
match _ w Mousedown f =  return . f $ domEvent Mousedown w -- dumb solution
match _ w Mouseup f = return . f $ domEvent Mouseup w -- again
match mm w Mousemove f = do
    m <- liftIO $ readIORef mm
    e  <- case m of 
        Nothing -> do 
                --- monadically initialize 'e' instead of what I do next
                let e = domEvent Mousemove w
                liftIO $ writeIORef mm (Just e)
                return e
        Just e -> return e
    return $ f e

-- export, a box opener for GetEvent 
getEvent        :: WidgetEvents m b 
                -> EventName a  -- event to match
                -> (ES (EventResultType a) -> ES b) -- collapser
                -> m (ES b) -- the safe event 
getEvent (GetEvent g) x f = g x f