{-# 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 chats ()
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 :: [ChatMessage],
    draft :: Text
  }
  deriving (Show)

data ChatMessage = ChatMessage Text
  deriving (Show)

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

data Action = NoOp | DraftChanged Int Text | DraftSubmitted Int

data Query a = NoOpQ

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
              }
      }
  where
    initialState _ = pure testChats

    render ::
      (MonadDOM m, MonadUnliftIO 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)
                    ]
                ]
          )
          (zip [1 ..] chats)

    handleQuery = \case
      NoOpQ -> do
        pure Nothing

    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