Newtype wrappers for some JavaScript values

8 files changed, 208 insertions, 100 deletions

diff --git a/erebos-webapp.cabal b/erebos-webapp.cabal
index 14f6eea..d8446fe 100644
--- a/erebos-webapp.cabal
+++ b/erebos-webapp.cabal
@@ -28,6 +28,10 @@ executable erebos-webapp
     main-is:          Main.hs
     other-modules:
         JavaScript
+        JavaScript.Element
+        JavaScript.Event
+        JavaScript.Val
+        JavaScript.Window
         Paths_erebos_webapp
         Storage.Cache
         Storage.IndexedDB
diff --git a/src/JavaScript.hs b/src/JavaScript.hs
index 81b3502..6c07370 100644
--- a/src/JavaScript.hs
+++ b/src/JavaScript.hs
@@ -1,40 +1,18 @@
 module JavaScript (
-    getElementById,
-    documentQuerySelector,
-    querySelector,
-
-    asEventListener,
-    addEventListener,
+    module JavaScript.Event,
+    module JavaScript.Element,
+    module JavaScript.Window,
 
+    toJSVal,
     consoleLog,
     consoleLogVal,
 ) where
 
-import GHC.Wasm.Prim
-
-getElementById :: String -> IO (Maybe JSVal)
-getElementById = fmap nullToNothing . js_document_getElementById . toJSString
-foreign import javascript unsafe "document.getElementById($1)"
-    js_document_getElementById :: JSString -> IO JSVal
-
-documentQuerySelector :: String -> IO (Maybe JSVal)
-documentQuerySelector = fmap nullToNothing . js_document_querySelector . toJSString
-foreign import javascript unsafe "document.querySelector($1)"
-    js_document_querySelector :: JSString -> IO JSVal
-
-querySelector :: String -> JSVal -> IO (Maybe JSVal)
-querySelector sel e = nullToNothing <$> js_querySelector e (toJSString sel)
-foreign import javascript unsafe "$1.querySelector($2)"
-    js_querySelector :: JSVal -> JSString -> IO JSVal
+import JavaScript.Element
+import JavaScript.Event
+import JavaScript.Val
+import JavaScript.Window
 
-foreign import javascript "wrapper"
-    asEventListener :: (JSVal -> IO ()) -> IO JSVal
-
-addEventListener :: JSVal -> String -> (JSVal -> IO ()) -> IO ()
-addEventListener obj ev cb = do
-    js_addEventListener obj (toJSString ev) =<< asEventListener cb
-foreign import javascript unsafe "$1.addEventListener($2, $3)"
-    js_addEventListener :: JSVal -> JSString -> JSVal -> IO ()
 
 consoleLog :: String -> IO ()
 consoleLog = js_consoleLog . toJSString
@@ -43,10 +21,3 @@ foreign import javascript unsafe "console.log($1)"
 
 foreign import javascript unsafe "console.log($1)"
     consoleLogVal :: JSVal -> IO ()
-
-
-nullToNothing :: JSVal -> Maybe JSVal
-nullToNothing val | isNull val = Nothing
-                  | otherwise  = Just val
-foreign import javascript unsafe "$1 === null"
-    isNull :: JSVal -> Bool
diff --git a/src/JavaScript/Element.hs b/src/JavaScript/Element.hs
new file mode 100644
index 0000000..2eac8f2
--- /dev/null
+++ b/src/JavaScript/Element.hs
@@ -0,0 +1,38 @@
+module JavaScript.Element (
+    Element, IsElement(..),
+    getElementById,
+    documentQuerySelector,
+    querySelector,
+) where
+
+import JavaScript.Event
+import JavaScript.Val
+
+
+newtype Element = Element JSVal
+    deriving (ToJSVal, FromJSVal)
+
+class IsElement a where
+    toElement :: a -> Element
+
+instance IsElement Element where
+    toElement = id
+
+instance IsEventTarget Element where
+    toEventTarget = fromJSValUnchecked . toJSVal
+
+
+getElementById :: String -> IO (Maybe Element)
+getElementById = fmap nullToNothing . js_document_getElementById . toJSString
+foreign import javascript unsafe "document.getElementById($1)"
+    js_document_getElementById :: JSString -> IO JSVal
+
+documentQuerySelector :: String -> IO (Maybe Element)
+documentQuerySelector = fmap nullToNothing . js_document_querySelector . toJSString
+foreign import javascript unsafe "document.querySelector($1)"
+    js_document_querySelector :: JSString -> IO JSVal
+
+querySelector :: IsElement e => String -> e -> IO (Maybe Element)
+querySelector sel e = nullToNothing <$> js_querySelector (toJSVal $ toElement e) (toJSString sel)
+foreign import javascript unsafe "$1.querySelector($2)"
+    js_querySelector :: JSVal -> JSString -> IO JSVal
diff --git a/src/JavaScript/Event.hs b/src/JavaScript/Event.hs
new file mode 100644
index 0000000..4bc61d2
--- /dev/null
+++ b/src/JavaScript/Event.hs
@@ -0,0 +1,38 @@
+module JavaScript.Event (
+    EventTarget, IsEventTarget(..),
+    Event, IsEvent(..),
+    asEventListener,
+    addEventListener,
+) where
+
+import JavaScript.Val
+
+
+newtype EventTarget = EventTarget JSVal
+    deriving (ToJSVal, FromJSVal)
+
+class IsEventTarget a where
+    toEventTarget :: a -> EventTarget
+
+instance IsEventTarget EventTarget where
+    toEventTarget = id
+
+
+newtype Event = Event JSVal
+    deriving (ToJSVal, FromJSVal)
+
+class IsEvent a where
+    toEvent :: a -> Event
+
+instance IsEvent Event where
+    toEvent = id
+
+
+foreign import javascript "wrapper"
+    asEventListener :: (JSVal -> IO ()) -> IO JSVal
+
+addEventListener :: IsEventTarget a => a -> String -> (Event -> IO ()) -> IO ()
+addEventListener target ev cb = do
+    js_addEventListener (toJSVal $ toEventTarget target) (toJSString ev) =<< asEventListener (cb . fromJSValUnchecked)
+foreign import javascript unsafe "$1.addEventListener($2, $3)"
+    js_addEventListener :: JSVal -> JSString -> JSVal -> IO ()
diff --git a/src/JavaScript/Val.hs b/src/JavaScript/Val.hs
new file mode 100644
index 0000000..e1879b4
--- /dev/null
+++ b/src/JavaScript/Val.hs
@@ -0,0 +1,24 @@
+module JavaScript.Val (
+    module GHC.Wasm.Prim,
+    ToJSVal(..), FromJSVal(..),
+    nullToNothing,
+) where
+
+import GHC.Wasm.Prim
+
+
+class ToJSVal a where
+    toJSVal :: a -> JSVal
+
+class FromJSVal a where
+    fromJSValUnchecked :: JSVal -> a
+
+instance ToJSVal JSVal where toJSVal = id
+instance FromJSVal JSVal where fromJSValUnchecked = id
+
+
+nullToNothing :: FromJSVal a => JSVal -> Maybe a
+nullToNothing val | isNull val = Nothing
+                  | otherwise  = Just $ fromJSValUnchecked val
+foreign import javascript unsafe "$1 === null"
+    isNull :: JSVal -> Bool
diff --git a/src/JavaScript/Window.hs b/src/JavaScript/Window.hs
new file mode 100644
index 0000000..db30c9d
--- /dev/null
+++ b/src/JavaScript/Window.hs
@@ -0,0 +1,25 @@
+module JavaScript.Window (
+    Window, IsWindow(..),
+    globalWindow,
+) where
+
+import JavaScript.Event
+import JavaScript.Val
+
+
+newtype Window = Window JSVal
+    deriving (ToJSVal, FromJSVal)
+
+class IsWindow a where
+    toWindow :: a -> Window
+
+instance IsWindow Window where
+    toWindow = id
+
+instance IsEventTarget Window where
+    toEventTarget = fromJSValUnchecked . toJSVal
+
+globalWindow :: Window
+globalWindow = Window js_window
+foreign import javascript unsafe "window"
+    js_window :: JSVal
diff --git a/src/Main.hs b/src/Main.hs
index beb5683..2900476 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -40,7 +40,7 @@ import Text.Blaze.Html5 qualified as H
 import Text.Blaze.Html5.Attributes qualified as A
 import Text.Blaze.Html.Renderer.String
 
-import JavaScript qualified as JS
+import JavaScript as JS
 import Storage.Cache
 import Storage.IndexedDB
 import Version
@@ -236,8 +236,8 @@ setup = do
     JS.getElementById "name_set_input" >>= \case
         Just setNameInput -> JS.getElementById "name_set_form" >>= \case
             Just setNameForm -> JS.addEventListener setNameForm "submit" $ \_ -> do
-                name <- T.pack . fromJSString <$> js_get_value setNameInput
-                js_set_value setNameInput $ toJSString ""
+                name <- T.pack . fromJSString <$> js_get_value (toJSVal setNameInput)
+                js_set_value (toJSVal setNameInput) $ toJSString ""
                 Just h <- reloadHead globalHead
                 res <- runExceptT $ flip runReaderT h $ updateSharedIdentity name
                 case res of
@@ -248,21 +248,22 @@ setup = do
 
     JS.getElementById "msg_list" >>= \case
         Just messagesList -> do
+            let messagesList' = toJSVal messagesList
             void $ watchDirectMessageThreads globalHead $ \prev cur -> do
                 withMVar currentContextVar $ \case
                     SelectedConversation conv
                       | maybe False (msgPeer cur `sameIdentity`) (conversationPeer conv)
                       -> do
-                        scrollTop <- js_get_scrollTop messagesList
-                        scrollHeight <- js_get_scrollHeight messagesList
-                        clientHeight <- js_get_clientHeight messagesList
+                        scrollTop <- js_get_scrollTop messagesList'
+                        scrollHeight <- js_get_scrollHeight messagesList'
+                        clientHeight <- js_get_clientHeight messagesList'
 
-                        ul <- js_get_firstChild messagesList
+                        ul <- js_get_firstChild messagesList'
                         let ( remove, messages ) = dmThreadToListChange prev cur
                         appendMessages gs ul remove $ map (uncurry $ flip makeMessage) $ reverse messages
 
                         when (scrollTop + clientHeight >= scrollHeight) $ do
-                            js_set_scrollTop messagesList =<< js_get_scrollHeight messagesList
+                            js_set_scrollTop messagesList' =<< js_get_scrollHeight messagesList'
 
                     _ -> return ()
         Nothing -> return ()
@@ -293,8 +294,8 @@ setup = do
     Just inviteGeneratedUrl <- JS.getElementById "invite_generated_url"
     Just inviteClipboard <- JS.getElementById "invite_clipboard"
     JS.addEventListener inviteGenerateForm "submit" $ \_ -> do
-        name <- T.pack . fromJSString <$> js_get_value inviteGenerateInput
-        js_set_value inviteGenerateInput $ toJSString ""
+        name <- T.pack . fromJSString <$> js_get_value (toJSVal inviteGenerateInput)
+        js_set_value (toJSVal inviteGenerateInput) $ toJSString ""
         origin <- fromJSString <$> js_get_location_origin
         pathname <- fromJSString <$> js_get_location_pathname
         res <- runExceptT $ flip runReaderT globalHead $ do
@@ -307,29 +308,29 @@ setup = do
                     throwOtherError "no shared identity"
         case res of
             Right inviteText -> do
-                mapM_ (flip js_classList_add $ toJSString "generated") =<< JS.getElementById "invite_generated"
-                js_set_textContent inviteGeneratedName $ toJSString $ T.unpack name
-                js_set_textContent inviteGeneratedUrl $ toJSString inviteText
+                mapM_ (flip js_classList_add (toJSString "generated") . toJSVal) =<< JS.getElementById "invite_generated"
+                js_set_textContent (toJSVal inviteGeneratedName) $ toJSString $ T.unpack name
+                js_set_textContent (toJSVal inviteGeneratedUrl) $ toJSString inviteText
             Left err -> do
                 JS.consoleLog $ "Failed to send message: " <> showErebosError err
-                mapM_ (flip js_classList_remove $ toJSString "generated") =<< JS.getElementById "invite_generated"
+                mapM_ (flip js_classList_remove (toJSString "generated") . toJSVal) =<< JS.getElementById "invite_generated"
     JS.addEventListener inviteClipboard "click" $ \_ -> do
-        js_navigator_clipboard_writeText =<< js_get_textContent inviteGeneratedUrl
+        js_navigator_clipboard_writeText =<< js_get_textContent (toJSVal inviteGeneratedUrl)
 
     JS.getElementById "peers" >>= \case
         Just peersElem -> JS.querySelector "h2" peersElem >>= \case
             Just header -> do
                 JS.addEventListener header "click" $ \_ -> do
-                    js_classList_toggle peersElem (toJSString "collapsed")
+                    js_classList_toggle (toJSVal peersElem) (toJSString "collapsed")
             Nothing -> return ()
         Nothing -> return ()
 
     JS.addEventListener sendForm "submit" $ \_ -> do
-        js_focus sendText
+        js_focus (toJSVal sendText)
         readMVar currentContextVar >>= \case
             SelectedConversation conv -> do
-                msg <- T.pack . fromJSString <$> js_get_value sendText
-                js_set_value sendText $ toJSString ""
+                msg <- T.pack . fromJSString <$> js_get_value (toJSVal sendText)
+                js_set_value (toJSVal sendText) $ toJSString ""
                 res <- runExceptT $ flip runReaderT globalHead $ sendMessage conv msg
                 case res of
                     Right _ -> return ()
@@ -342,12 +343,12 @@ setup = do
             JS.querySelector ".close-button" experimentalWarning >>= \case
                 Just experimentalAccept -> do
                     JS.addEventListener experimentalAccept "click" $ \_ -> do
-                        js_element_remove experimentalWarning
+                        js_element_remove (toJSVal experimentalWarning)
                         js_storage_setItem (toJSString "experimental-accepted") (toJSString "")
                 Nothing -> return ()
         Nothing -> return ()
 
-    JS.addEventListener js_window "hashchange" $ \_ -> do
+    JS.addEventListener globalWindow "hashchange" $ \_ -> do
         processUrlParams gs server
     processUrlParams gs server
 
@@ -423,9 +424,9 @@ processUrlParams gs@GlobalState {..} server = do
 
         _ -> do
             modifyMVar_ currentContextVar $ \_ -> do
-                mapM_ (flip js_classList_remove (toJSString "selected")) =<<
+                mapM_ (flip js_classList_remove (toJSString "selected") . toJSVal) =<<
                     JS.documentQuerySelector "#sidebar ul li.selected"
-                mapM_ (\body -> js_removeAttribute body (toJSString "data-selected")) =<<
+                mapM_ (flip js_removeAttribute (toJSString "data-selected") . toJSVal) =<<
                     JS.getElementById "body"
                 return NoContext
 
@@ -474,7 +475,7 @@ watchConversations GlobalState {..} = do
                             | c `isSameConversation` selected = do
                                 when (conversationName c /= conversationName selected) $ do
                                     JS.getElementById "msg_header" >>= \case
-                                        Just header -> js_set_textContent header $ toJSString $ T.unpack $ conversationName c
+                                        Just header -> js_set_textContent (toJSVal header) $ toJSString $ T.unpack $ conversationName c
                                         Nothing -> return ()
                                 return ( SelectedConversation c, ( c, True ) : map (, False) cs )
                             | otherwise = do
@@ -496,7 +497,7 @@ watchConversations GlobalState {..} = do
                         js_set_textContent a $ toJSString $ T.unpack $ conversationName conv
                         js_appendChild li a
                         js_appendChild ul li
-                    js_replaceChildren convList ul
+                    js_replaceChildren (toJSVal convList) ul
                 Nothing -> return ()
 
             return $ zip [ 1 .. ] conversations
@@ -545,22 +546,22 @@ selectConversation gs@GlobalState {..} conv = do
             appendMessages gs ul 0 $ reverse $ conversationHistory conv
 
             JS.getElementById "msg_header" >>= \case
-                Just header -> js_set_textContent header $ toJSString $ T.unpack $ conversationName conv
+                Just header -> js_set_textContent (toJSVal header) $ toJSString $ T.unpack $ conversationName conv
                 Nothing -> return ()
-            maybe (return ()) (flip js_replaceChildren ul) =<< JS.getElementById "msg_list"
+            maybe (return ()) (flip js_replaceChildren ul . toJSVal) =<< JS.getElementById "msg_list"
 
-            mapM_ (flip js_classList_remove (toJSString "selected")) =<<
+            mapM_ (flip js_classList_remove (toJSString "selected") . toJSVal) =<<
                 JS.documentQuerySelector "#sidebar ul li.selected"
-            mapM_ (flip js_classList_add (toJSString "selected")) =<<
+            mapM_ (flip js_classList_add (toJSString "selected") . toJSVal) =<<
                 JS.documentQuerySelector ("#conversation_list ul li[data-conv='" <> show (conversationReference conv) <> "']")
 
             JS.getElementById "body" >>= \case
                 Just body -> do
-                    js_setAttribute body (toJSString "data-selected") (toJSString "conversation")
+                    js_setAttribute (toJSVal body) (toJSString "data-selected") (toJSString "conversation")
                 Nothing -> return ()
 
-            mapM_ (\mlist -> js_set_scrollTop mlist =<< js_get_scrollHeight mlist) =<< JS.getElementById "msg_list"
-            mapM_ js_focus =<< JS.getElementById "msg_text"
+            mapM_ (\mlist -> js_set_scrollTop (toJSVal mlist) =<< js_get_scrollHeight (toJSVal mlist)) =<< JS.getElementById "msg_list"
+            mapM_ (js_focus . toJSVal) =<< JS.getElementById "msg_text"
 
         return $ SelectedConversation conv
 
@@ -578,14 +579,14 @@ selectPeer GlobalState {..} server dgst = do
             Nothing -> do
                 return $ SelectedPeer $ Left dgst
 
-        mapM_ (flip js_classList_remove (toJSString "selected")) =<<
+        mapM_ (flip js_classList_remove (toJSString "selected") . toJSVal) =<<
             JS.documentQuerySelector "#sidebar ul li.selected"
-        mapM_ (`js_classList_add` toJSString "selected") =<<
+        mapM_ (flip js_classList_add (toJSString "selected") . toJSVal) =<<
             JS.documentQuerySelector ("ul#peer_list li[data-peer='" <> show dgst <> "']")
 
         JS.getElementById "body" >>= \case
             Just body -> do
-                js_setAttribute body (toJSString "data-selected") (toJSString "peer")
+                js_setAttribute (toJSVal body) (toJSString "data-selected") (toJSString "peer")
             Nothing -> return ()
         return selected
 
@@ -593,23 +594,23 @@ updatePeerDetails :: Peer -> IO ()
 updatePeerDetails peer = do
     paddr <- getPeerAddress peer
     pid <- getPeerIdentity peer
-    maybe (return ()) (flip js_set_textContent $ toJSString $ showPeer pid) =<<
+    maybe (return ()) (flip js_set_textContent (toJSString $ showPeer pid) . toJSVal) =<<
         JS.getElementById "peer_name_value"
     case pid of
         PeerIdentityFull pidf -> do
-            maybe (return ()) (flip js_set_textContent $ toJSString $ show $ refDigest $ storedRef $ idData pidf) =<< JS.getElementById "peer_ref_value"
+            maybe (return ()) (flip js_set_textContent (toJSString $ show $ refDigest $ storedRef $ idData pidf) . toJSVal) =<< JS.getElementById "peer_ref_value"
             maybe (return ()) (\dmLinkElem ->
-                js_setAttribute dmLinkElem (toJSString "href") $ toJSString $ "#conv=" <> drop 7 (show $ refDigest $ storedRef $ head $ idDataF $ finalOwner pidf)
+                js_setAttribute (toJSVal dmLinkElem) (toJSString "href") $ toJSString $ "#conv=" <> drop 7 (show $ refDigest $ storedRef $ head $ idDataF $ finalOwner pidf)
                 ) =<< JS.getElementById "peer_dm_link"
         PeerIdentityRef wref _ -> do
-            maybe (return ()) (flip js_set_textContent $ toJSString $ show $ wrDigest wref) =<< JS.getElementById "peer_ref_value"
+            maybe (return ()) (flip js_set_textContent (toJSString $ show $ wrDigest wref) . toJSVal) =<< JS.getElementById "peer_ref_value"
         PeerIdentityUnknown _ -> do
-            maybe (return ()) (flip js_set_textContent $ toJSString "unknown") =<< JS.getElementById "peer_ref_value"
-    maybe (return ()) (flip js_set_textContent $ toJSString $ show paddr) =<<
+            maybe (return ()) (flip js_set_textContent (toJSString "unknown") . toJSVal) =<< JS.getElementById "peer_ref_value"
+    maybe (return ()) (flip js_set_textContent (toJSString $ show paddr) . toJSVal) =<<
         JS.getElementById "peer_address_value"
 
 
-watchPeers :: GlobalState -> Server -> JSVal -> IO ()
+watchPeers :: GlobalState -> Server -> Element -> IO ()
 watchPeers gs@GlobalState {..} server htmlList = do
     void $ forkIO $ void $ forever $ do
         peer <- getNextPeerChange server
@@ -637,7 +638,7 @@ watchPeers gs@GlobalState {..} server htmlList = do
                         js_setAttribute li (toJSString "data-peer") $ toJSString $ show $ refDigest $ storedRef $ idData pidf
                         js_set_textContent a $ toJSString shown
                         js_appendChild li a
-                        js_appendChild htmlList li
+                        js_appendChild (toJSVal htmlList) li
                         return [ ( peer, shown, li ) ]
 
                     update (( p, s, li ) : ps)
@@ -659,7 +660,7 @@ watchPeers gs@GlobalState {..} server htmlList = do
                 count <- modifyMVar peerListVar $ \plist -> do
                     plist' <- update plist
                     return ( plist', length plist' )
-                maybe (return ()) (flip js_set_textContent $ toJSString $ show count) =<<
+                maybe (return ()) (flip js_set_textContent (toJSString $ show count) . toJSVal) =<<
                     JS.getElementById "peer_count"
 
                 readMVar currentContextVar >>= \case
@@ -686,11 +687,11 @@ identityDigests pid = map (refDigest . storedRef) $ idDataF =<< unfoldOwners pid
 selectSelf :: GlobalState -> Server -> IO ()
 selectSelf GlobalState {..} _ = do
     modifyMVar_ currentContextVar $ \_ -> do
-        mapM_ (\body -> js_setAttribute body (toJSString "data-selected") (toJSString "self")) =<<
+        mapM_ (\body -> js_setAttribute (toJSVal body) (toJSString "data-selected") (toJSString "self")) =<<
             JS.getElementById "body"
-        mapM_ (flip js_classList_remove (toJSString "selected")) =<<
+        mapM_ (flip js_classList_remove (toJSString "selected") . toJSVal) =<<
             JS.documentQuerySelector "#sidebar ul li.selected"
-        mapM_ (flip js_classList_add (toJSString "selected")) =<<
+        mapM_ (flip js_classList_add (toJSString "selected") . toJSVal) =<<
             JS.documentQuerySelector ("#self ul li")
         return SelectedSelf
 
@@ -698,11 +699,11 @@ selectSelf GlobalState {..} _ = do
 selectCreateInvite :: GlobalState -> Server -> IO ()
 selectCreateInvite GlobalState {..} _ = do
     modifyMVar_ currentContextVar $ \_ -> do
-        mapM_ (\body -> js_setAttribute body (toJSString "data-selected") (toJSString "create-invite")) =<<
+        mapM_ (\body -> js_setAttribute (toJSVal body) (toJSString "data-selected") (toJSString "create-invite")) =<<
             JS.getElementById "body"
-        mapM_ (flip js_classList_remove (toJSString "selected")) =<<
+        mapM_ (flip js_classList_remove (toJSString "selected"). toJSVal) =<<
             JS.documentQuerySelector "#sidebar ul li.selected"
-        mapM_ (flip js_classList_add (toJSString "selected")) =<<
+        mapM_ (flip js_classList_add (toJSString "selected"). toJSVal) =<<
             JS.documentQuerySelector ("#create_invite_item")
         return SelectedSelf
 
@@ -773,9 +774,6 @@ foreign import javascript unsafe "$1.scrollHeight"
 foreign import javascript unsafe "$1.clientHeight"
     js_get_clientHeight :: JSVal -> IO Int
 
-foreign import javascript unsafe "window"
-    js_window :: JSVal
-
 foreign import javascript unsafe "window.location.hash"
     js_get_location_hash :: IO JSString
 
diff --git a/src/WebSocket.hs b/src/WebSocket.hs
index a1196ca..0492c81 100644
--- a/src/WebSocket.hs
+++ b/src/WebSocket.hs
@@ -20,13 +20,14 @@ import Foreign.Ptr
 
 import GHC.Wasm.Prim
 
-import JavaScript qualified as JS
+import JavaScript
+import JavaScript.Val
 
 
 data Connection = Connection
     { connUnique :: Unique
     , connAddress :: String
-    , connJS :: JSVal
+    , connJS :: WebSocket
     , connInQueue :: Chan ByteString
     }
 
@@ -47,32 +48,32 @@ startClient :: Server -> String -> Int -> String -> (Connection -> IO ()) -> IO
 startClient server addr port path fun = do
     connUnique <- newUnique
     let connAddress = "wss://" <> addr <> ":" <> show port <> "/" <> path
-    connJS <- js_initWebSocket (toJSString connAddress)
+    connJS <- initWebSocket connAddress
     connInQueue <- newChan
     let conn = Connection {..}
 
-    JS.addEventListener connJS "open" $ \_ -> do
+    addEventListener connJS "open" $ \_ -> do
         fun conn
 
-    JS.addEventListener connJS "message" $ \ev -> do
-        bytes <- js_get_data ev
+    addEventListener connJS "message" $ \ev -> do
+        bytes <- js_get_data $ toJSVal ev
         len <- js_get_byteLength bytes
         ptr <- mallocBytes len
         js_copyBytes ptr bytes
         bs <- unsafePackCStringFinalizer ptr len (free ptr)
         writeChan connInQueue bs
 
-    JS.addEventListener connJS "close" $ \_ -> do
+    addEventListener connJS "close" $ \_ -> do
         dropPeerAddress server $ CustomPeerAddress conn
 
-    JS.addEventListener connJS "error" $ \_ -> do
+    addEventListener connJS "error" $ \_ -> do
         dropPeerAddress server $ CustomPeerAddress conn
 
 
 sendMessage :: Connection -> ByteString -> IO ()
 sendMessage Connection {..} bs = do
     unsafeUseAsCStringLen bs $ \( ptr, len ) -> do
-        js_send connJS (castPtr ptr) len >>= \case
+        js_send (toJSVal connJS) (castPtr ptr) len >>= \case
             0 -> return ()
             1 -> error "websocket is not open"
 
@@ -82,9 +83,18 @@ receiveMessage Connection {..} = do
 
 closeConnection :: Connection -> IO ()
 closeConnection Connection {..} = do
-    js_close connJS
+    js_close (toJSVal connJS)
 
 
+newtype WebSocket = WebSocket JSVal
+    deriving (FromJSVal, ToJSVal)
+
+instance IsEventTarget WebSocket where
+    toEventTarget = fromJSValUnchecked . toJSVal
+
+initWebSocket :: String -> IO WebSocket
+initWebSocket addr = WebSocket <$> js_initWebSocket (toJSString addr)
+
 foreign import javascript unsafe "const ws = new WebSocket($1); ws.binaryType = 'arraybuffer'; return ws"
     js_initWebSocket :: JSString -> IO JSVal