From 695dc4ffafdbfe6220f60fe0cc7eedd0b241b0ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Wed, 18 Mar 2026 22:01:27 +0100 Subject: Peer count and collapsible list --- src/Main.hs | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 87e1aec..a1f4f5e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -131,13 +131,15 @@ setup = do H.span ! A.id "invite_generated_url" $ return () H.button ! A.id "invite_clipboard" $ "copy to clipboard" - H.div ! A.id "peers" $ do + H.div ! A.id "peers" ! A.class_ "collapsed" $ do H.h2 $ do - "Peers" + H.span $ "Peers (" >> (H.span ! A.id "peer_count" $ "0") >> ")" + H.preEscapedText $ T.concat + [ "" + , "" + , "" + ] H.ul ! A.id "peer_list" $ return () - H.form ! A.id "peer_add_form" ! A.action "javascript:void(0);" $ do - H.input ! A.id "peer_add_input" ! A.type_ "text" - H.input ! A.type_ "submit" ! A.value "search" H.div ! A.id "conversation" ! A.class_ "selected-content" $ do H.h2 ! A.id "msg_header" $ do @@ -257,17 +259,11 @@ setup = do JS.addEventListener inviteClipboard "click" $ \_ -> do js_navigator_clipboard_writeText =<< js_get_textContent inviteGeneratedUrl - JS.getElementById "peer_add_input" >>= \case - Just peerAddInput -> JS.getElementById "peer_add_form" >>= \case - Just peerAddForm -> do - JS.addEventListener peerAddForm "submit" $ \_ -> do - value <- T.pack . fromJSString <$> js_get_value peerAddInput - js_set_value peerAddInput $ toJSString "" - case readRefDigest $ encodeUtf8 value of - Just dgst -> runExceptT (discoverySearch server dgst) >>= \case - Right _ -> return () - Left err -> JS.consoleLog $ "Failed to search for " <> show dgst <> ": " <> showErebosError err - Nothing -> JS.consoleLog "invalid identity reference" + 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") Nothing -> return () Nothing -> return () @@ -591,7 +587,11 @@ watchPeers gs@GlobalState {..} server htmlList = do | otherwise = do (( p, s, li ) :) <$> update ps - modifyMVar_ peerListVar update + count <- modifyMVar peerListVar $ \plist -> do + plist' <- update plist + return ( plist', length plist' ) + maybe (return ()) (flip js_set_textContent $ toJSString $ show count) =<< + JS.getElementById "peer_count" readMVar currentContextVar >>= \case WaitingForPeerConversation dgst token @@ -650,6 +650,9 @@ foreign import javascript unsafe "$1.classList.add($2)" foreign import javascript unsafe "$1.classList.remove($2)" js_classList_remove :: JSVal -> JSString -> IO () +foreign import javascript unsafe "$1.classList.toggle($2)" + js_classList_toggle :: JSVal -> JSString -> IO () + foreign import javascript unsafe "$1.querySelectorAll('*').forEach(child => child.classList.remove($2))" js_removeClassFromAllChildren :: JSVal -> JSString -> IO () -- cgit v1.2.3