TransElem.hs

newtype TransientElement = TransientElement
    { unTransientElement :: ElementPrim }
    
data ElementPrim = ElementPrim
    { ref :: JSRef Element
    , emap :: TMVar (M.HashMap String (TChan JSEvent))
    , capture :: String -> IO JSEvent }
    
data Element = Element
data Event   = Event

type JSEvent   = JSRef Event
type JSElement = JSRef Element

transientElementById :: ToJSString idt => idt -> IO TransientElement
transientElementById idt = do
    mRef <- safeGetDocumentElement idt
    case mRef of
      Just ref -> do
         m <- atomically (newTMVar M.empty)
         let capt eTyp = do
                 echan <- transListener ref m eTyp
                 let nam = fromJSString (toJSString eTyp) :: String
                 x <- atomically (dupTChan echan)
                 atomically (readTChan x)
         return (TransientElement (ElementPrim (castRef ref) m capt))
      Nothing -> let s :: String
                     s = fromJSString (toJSString idt)
                 in error $ "Element not found: " ++ s
                 
transListener :: JSRef a                                  -- ^ reference to element
              -> TMVar (M.HashMap String (TChan JSEvent)) -- ^ event map
              -> String                                   -- ^ event type
              -> IO (TChan JSEvent)                       -- ^ event channel to subscribe
transListener r emap typ = do
    (ech, attach) <- atomically $ do
         m <- takeTMVar emap
         (nmap, ech, add) <- case M.lookup typ m of
            Nothing -> do
                nc <- newTChan
                return (M.insert typ nc m, nc, True)
            Just c -> return (m, c, False)
         putTMVar emap nmap
         return (ech, add)
    when attach $
        attachHandler r typ $ \evt -> void . forkIO $
            atomically (writeTChan ech evt)
    return ech
    
captureEvent :: ToJSString t
             => TransientElement -> t -> IO JSEvent
captureEvent el eTyp = do
    let ElementPrim _ _ c = unTransientElement el
    evt <- c (fromJSString (toJSString eTyp))
    return evt
    
safeGetDocumentElement :: ToJSString a => a -> IO (Maybe JSElement)
safeGetDocumentElement eid = do
    r <- js_getDocumentElement (toJSString eid)
    return $ if (isNull r)
        then Nothing
        else Just r
        
foreign import javascript safe "$r = document.getElementById($1);"
    js_getDocumentElement :: JSString -> IO DocumentElement