{-# 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 Query [Chat] IO)
logStr :: Text -> IO ()

#if defined(javascript_HOST_ARCH)
attachComponent =
  HA.awaitBody >>= runUI component ()
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

{-
forever $ do
  threadDelay 5_000_000
  void $ query (IncrementQ ())
  threadDelay 5_000_000
  void $ query (DecrementQ ())
  -}

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

data Message = Message Text
  deriving (Show)

testChats =
  [ Chat
      [ Message "Hello",
        Message "Hi",
        Message "Hey"
      ]
      ""
  ]

data Action = NoOp | DraftChanged Int Text | DraftSubmitted Int

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

data Query a = NoOpQ

component :: forall m. (MonadDOM m, MonadUnliftIO m) => H.Component Query () [Chat] m
component =
  H.mkComponent $
    H.ComponentSpec
      { initialState,
        render,
        eval = H.mkEval $ H.defaultEval {handleAction, handleQuery, initialize = Nothing}
      }
  where
    initialState _ = pure testChats

    render :: (MonadDOM m, MonadUnliftIO m) => [Chat] -> H.ComponentHTML Action Slots m
    render chats =
      L.runLayoutM Horizontal $ L.do
        HH.div_
          ( Protolude.map
              ( \(index, (Chat chatMessages draft)) ->
                  HH.div_
                    [ HH.div_
                        ( Protolude.map
                            ( \(Message message) ->
                                HH.text message
                            )
                            chatMessages
                        ),
                      HH.input
                        [ HP.value draft,
                          HE.onInputValueChange $ Just . (DraftChanged index),
                          HE.onClick (\_ -> DraftSubmitted index)
                        ]
                    ]
              )
              (zip [1 ..] chats)
          )
        L.end

    handleQuery = \case
      NoOpQ -> do
        pure Nothing

    handleAction = \case
      NoOp -> do
        get >>= H.raise
      DraftChanged index draft -> do
        modify
          ( \chats ->
              Protolude.map
                ( \(indexOther, chat) ->
                    if indexOther == index
                      then
                        chat {draft = draft}
                      else chat
                )
                (zip [1 ..] chats)
          )
        get >>= H.raise
      DraftSubmitted index -> do
        modify
          ( \chats ->
              Protolude.map
                ( \(indexOther, chat) ->
                    if indexOther == index
                      then
                        chat
                          { chatMessages =
                              chat.chatMessages
                                ++ [Message chat.draft]
                          }
                      else chat
                )
                (zip [1 ..] chats)
          )
        get >>= H.raise