refactor `chat` from `chats`main

1 files changed, 49 insertions, 62 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 54a54e5..7b665ae 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -38,12 +38,12 @@ import Halogen.IO.Util as HA
 import Halogen.VDom.Driver (runUI)
 #endif
 
-attachComponent :: IO (HalogenSocket Query [Chat] IO)
+attachComponent :: IO (HalogenSocket VoidF () IO)
 logStr :: Text -> IO ()
 
 #if defined(javascript_HOST_ARCH)
 attachComponent =
-  HA.awaitBody >>= runUI chats ()
+  HA.awaitBody >>= runUI chats testChats
 logStr = log
 #else
 attachComponent = panic "This module can only be run on JavaScript"
@@ -57,14 +57,6 @@ main = do
   void $ HS.subscribe messages $ \st ->
     logStr $ "State changed: " <> show st
 
-{-
-forever $ do
-  threadDelay 5_000_000
-  void $ query (IncrementQ ())
-  threadDelay 5_000_000
-  void $ query (DecrementQ ())
-  -}
-
 data Chat = Chat
   { chatMessages :: [ChatMessage],
     draft :: Text
@@ -74,6 +66,7 @@ data Chat = Chat
 data ChatMessage = ChatMessage Text
   deriving (Show)
 
+testChats :: [Chat]
 testChats =
   [ Chat
       [ ChatMessage "Hello",
@@ -83,73 +76,67 @@ testChats =
       ""
   ]
 
-data Action = NoOp | DraftChanged Int Text | DraftSubmitted Int
-
-data Query a = NoOpQ
+type Slots = ("chat" .== H.Slot VoidF () ())
 
-chats :: (MonadDOM m, MonadUnliftIO m) => H.Component Query () [Chat] m
+chats :: (MonadDOM m, MonadUnliftIO m) => H.Component query [Chat] () m
 chats =
   H.mkComponent $
     H.ComponentSpec
       { initialState,
         render,
-        eval =
-          H.mkEval $
-            H.defaultEval
-              { handleAction,
-                handleQuery,
-                initialize = Nothing
-              }
+        eval
       }
   where
-    initialState _ = pure testChats
-
+    initialState = pure
     render ::
       (MonadDOM m, MonadUnliftIO m) =>
-      [Chat] ->
-      H.ComponentHTML Action slots m
+      [Chat] -> H.ComponentHTML action Slots m
     render chats =
       HH.div_ $
         fmap
-          ( \(index, (Chat chatMessages draft)) ->
-              HH.div_
-                [ HH.div_
-                    (fmap (\(ChatMessage message) -> HH.text message) chatMessages),
-                  HH.input
-                    [ HP.value draft,
-                      HE.onInputValueChange $ Just . (DraftChanged index),
-                      HE.onClick (\_ -> DraftSubmitted index)
-                    ]
-                ]
+          ( \(index, input) ->
+              HH.slot_ "chat" () chat input
           )
           (zip [1 ..] chats)
+    eval = H.mkEval H.defaultEval
 
-    handleQuery = \case
-      NoOpQ -> do
-        pure Nothing
+data Action
+  = DraftChanged Text
+  | DraftSubmitted
 
+chat :: (MonadDOM m, MonadUnliftIO m) => H.Component query Chat () m
+chat =
+  H.mkComponent $
+    H.ComponentSpec
+      { initialState,
+        render,
+        eval =
+          H.mkEval $
+            H.defaultEval
+              { handleAction,
+                initialize = Nothing
+              }
+      }
+  where
+    initialState = pure
+    render (Chat chatMessages draft) =
+      HH.div_
+        [ HH.div_ $
+            fmap
+              (\(ChatMessage message) -> HH.text message)
+              chatMessages,
+          HH.input
+            [ HP.value draft,
+              HE.onInputValueChange $ Just . DraftChanged,
+              HE.onClick $ const DraftSubmitted
+            ]
+        ]
     handleAction = \case
-      NoOp -> do
-        get >>= H.raise
-      DraftChanged index draft -> do
-        modify $ \chats ->
-          fmap
-            ( \(indexOther, chat) ->
-                if indexOther == index then chat {draft = draft} else chat
-            )
-            (zip [1 ..] chats)
-        get >>= H.raise
-      DraftSubmitted index -> do
-        modify $ \chats ->
-          fmap
-            ( \(indexOther, chat) ->
-                if indexOther == index
-                  then
-                    chat
-                      { chatMessages =
-                          chat.chatMessages ++ [ChatMessage chat.draft]
-                      }
-                  else chat
-            )
-            (zip [1 ..] chats)
-        get >>= H.raise
+      DraftChanged draft -> do
+        modify $ \chat -> chat {draft = draft}
+      DraftSubmitted -> do
+        modify $ \chat ->
+          chat
+            { chatMessages = chat.chatMessages ++ [ChatMessage chat.draft],
+              draft = ""
+            }