{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

module Main where

import Clay qualified as C
import DOM.HTML.Indexed qualified as I
import Data.Functor.Coyoneda
import Data.NT
import Data.Row
import Halogen as H
import Halogen.Component.Debounced
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Layout as L
import Halogen.HTML.Layout.BoxLayout
import Halogen.HTML.Layout.GridBagLayout
import Halogen.HTML.Properties as HP
import Halogen.Subscription qualified as HS
import Halogen.VDom.DOM.Monad
import JavaScript.Web.XMLHttpRequest
import Protolude hiding (log)
import UnliftIO (MonadUnliftIO)

#if defined(javascript_HOST_ARCH)
import Halogen.IO.Util as HA
import Halogen.VDom.Driver (runUI)
#endif

attachComponent :: IO (HalogenSocket VoidF () IO)
logStr :: Text -> IO ()

#if defined(javascript_HOST_ARCH)
attachComponent =
  HA.awaitBody >>= runUI chats testChats
logStr = log
#else
attachComponent = panic "This module can only be run on JavaScript"
logStr = putStrLn
#endif

main :: IO ()
main = do
  HalogenSocket {messages} <- attachComponent

  void $ HS.subscribe messages $ \st ->
    logStr $ "State changed: " <> show st

data Chat = Chat
  { chatMessages :: [ChatMessage],
    draft :: Text
  }
  deriving (Show)

data ChatMessage = ChatMessage Text
  deriving (Show)

testChats :: [Chat]
testChats =
  [ Chat
      [ ChatMessage "Hello",
        ChatMessage "Hi",
        ChatMessage "Hey"
      ]
      ""
  ]

type Slots = ("chat" .== H.Slot VoidF () ())

chats :: (MonadDOM m, MonadUnliftIO m) => H.Component query [Chat] () m
chats =
  H.mkComponent $
    H.ComponentSpec
      { initialState,
        render,
        eval
      }
  where
    initialState = pure
    render ::
      (MonadDOM m, MonadUnliftIO m) =>
      [Chat] -> H.ComponentHTML action Slots m
    render chats =
      HH.div_ $
        fmap
          ( \(index, input) ->
              HH.slot_ "chat" () chat input
          )
          (zip [1 ..] chats)
    eval = H.mkEval H.defaultEval

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
      DraftChanged draft -> do
        modify $ \chat -> chat {draft = draft}
      DraftSubmitted -> do
        modify $ \chat ->
          chat
            { chatMessages = chat.chatMessages ++ [ChatMessage chat.draft],
              draft = ""
            }