diff options
| -rw-r--r-- | erebos-webapp.cabal | 1 | ||||
| -rw-r--r-- | src/JavaScript/Element.hs | 39 | ||||
| -rw-r--r-- | src/JavaScript/Node.hs | 38 | ||||
| -rw-r--r-- | src/Main.hs | 25 |
4 files changed, 93 insertions, 10 deletions
diff --git a/erebos-webapp.cabal b/erebos-webapp.cabal index d8446fe..36e96d5 100644 --- a/erebos-webapp.cabal +++ b/erebos-webapp.cabal @@ -30,6 +30,7 @@ executable erebos-webapp JavaScript JavaScript.Element JavaScript.Event + JavaScript.Node JavaScript.Val JavaScript.Window Paths_erebos_webapp diff --git a/src/JavaScript/Element.hs b/src/JavaScript/Element.hs index 60f5c65..925b90e 100644 --- a/src/JavaScript/Element.hs +++ b/src/JavaScript/Element.hs @@ -1,5 +1,6 @@ module JavaScript.Element ( Element, IsElement(..), + module JavaScript.Node, getElementById, documentQuerySelector, @@ -10,9 +11,13 @@ module JavaScript.Element ( firstElementChild, lastElementChild, + + getAttribute, setAttribute, removeAttribute, + addClass, removeClass, toggleClass, ) where import JavaScript.Event +import JavaScript.Node import JavaScript.Val @@ -25,6 +30,9 @@ class IsElement a where instance IsElement Element where toElement = id +instance IsNode Element where + toNode = fromJSValUnchecked . toJSVal + instance IsEventTarget Element where toEventTarget = fromJSValUnchecked . toJSVal @@ -63,3 +71,34 @@ lastElementChild :: IsElement e => e -> IO (Maybe Element) lastElementChild = fmap nullToNothing . js_element_lastElementChild . toJSVal . toElement foreign import javascript unsafe "$1.lastElementChild" js_element_lastElementChild :: JSVal -> IO JSVal + + +getAttribute :: IsElement e => String -> e -> IO String +getAttribute name e = fromJSString <$> js_getAttribute (toJSVal $ toElement e) (toJSString name) +foreign import javascript unsafe "$1.getAttribute($2)" + js_getAttribute :: JSVal -> JSString -> IO JSString + +setAttribute :: IsElement e => String -> String -> e -> IO () +setAttribute name value e = js_setAttribute (toJSVal $ toElement e) (toJSString name) (toJSString value) +foreign import javascript unsafe "$1.setAttribute($2, $3)" + js_setAttribute :: JSVal -> JSString -> JSString -> IO () + +removeAttribute :: IsElement e => String -> e -> IO () +removeAttribute name e = js_removeAttribute (toJSVal $ toElement e) (toJSString name) +foreign import javascript unsafe "$1.removeAttribute($2)" + js_removeAttribute :: JSVal -> JSString -> IO () + +addClass :: IsElement e => String -> e -> IO () +addClass cls e = js_classList_add (toJSVal $ toElement e) (toJSString cls) +foreign import javascript unsafe "$1.classList.add($2)" + js_classList_add :: JSVal -> JSString -> IO () + +removeClass :: IsElement e => String -> e -> IO () +removeClass cls e = js_classList_remove (toJSVal $ toElement e) (toJSString cls) +foreign import javascript unsafe "$1.classList.remove($2)" + js_classList_remove :: JSVal -> JSString -> IO () + +toggleClass :: IsElement e => String -> e -> IO () +toggleClass cls e = js_classList_toggle (toJSVal $ toElement e) (toJSString cls) +foreign import javascript unsafe "$1.classList.toggle($2)" + js_classList_toggle :: JSVal -> JSString -> IO () diff --git a/src/JavaScript/Node.hs b/src/JavaScript/Node.hs new file mode 100644 index 0000000..c9ad8af --- /dev/null +++ b/src/JavaScript/Node.hs @@ -0,0 +1,38 @@ +module JavaScript.Node ( + Node, IsNode(..), + getTextContent, setTextContent, + appendChild, +) where + +import JavaScript.Event +import JavaScript.Val + + +newtype Node = Node JSVal + deriving (ToJSVal, FromJSVal) + +class IsNode a where + toNode :: a -> Node + +instance IsNode Node where + toNode = id + +instance IsEventTarget Node where + toEventTarget = fromJSValUnchecked . toJSVal + + +getTextContent :: IsNode n => n -> IO String +getTextContent n = fromJSString <$> js_get_textContent (toJSVal $ toNode n) +foreign import javascript unsafe "$1.textContent" + js_get_textContent :: JSVal -> IO JSString + +setTextContent :: IsNode n => String -> n -> IO () +setTextContent value n = js_set_textContent (toJSVal $ toNode n) (toJSString value) +foreign import javascript unsafe "$1.textContent = $2" + js_set_textContent :: JSVal -> JSString -> IO () + + +appendChild :: (IsNode c, IsNode p) => c -> p -> IO () +appendChild child parent = js_appendChild (toJSVal $ toNode parent) (toJSVal $ toNode child) +foreign import javascript unsafe "$1.appendChild($2)" + js_appendChild :: JSVal -> JSVal -> IO () diff --git a/src/Main.hs b/src/Main.hs index 8790221..1b08ab4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -485,19 +485,24 @@ watchConversations GlobalState {..} = do JS.getElementById "conversation_list" >>= \case Just convList -> do - ul <- js_document_createElement (toJSString "ul") + ul <- createElement "ul" forM_ conversations' $ \( conv, selected ) -> do - li <- js_document_createElement (toJSString "li") + li <- createElement "li" when selected $ do - js_classList_add li (toJSString "selected") - js_setAttribute li (toJSString "data-conv") $ toJSString $ show $ conversationReference conv - a <- js_document_createElement (toJSString "a") - js_setAttribute a (toJSString "href") $ toJSString $ "#conv=" <> drop 7 (show $ conversationReference conv) + addClass "selected" li + + case conversationHistory conv of + msg : _ | messageUnread msg -> addClass "unread-messages" li + _ -> return () + + setAttribute "data-conv" (show $ conversationReference conv) li + a <- createElement "a" + setAttribute "href" ("#conv=" <> drop 7 (show $ conversationReference conv)) a - js_set_textContent a $ toJSString $ T.unpack $ conversationName conv - js_appendChild li a - js_appendChild ul li - js_replaceChildren (toJSVal convList) ul + setTextContent (T.unpack $ conversationName conv) a + appendChild a li + appendChild li ul + js_replaceChildren (toJSVal convList) (toJSVal ul) Nothing -> return () return $ zip [ 1 .. ] conversations |