{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# 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 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 Int 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 Action = Increment Int | Decrement Int | Init

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

data Query a = IncrementQ a | DecrementQ a

component :: forall m. (MonadDOM m, MonadUnliftIO m) => H.Component Query () Int m
component =
  H.mkComponent $
    H.ComponentSpec
      { initialState,
        render,
        eval = H.mkEval $ H.defaultEval {handleAction, handleQuery, initialize = Just Init}
      }
  where
    initialState _ = pure 0

    render :: (MonadDOM m, MonadUnliftIO m) => Int -> H.ComponentHTML Action Slots m
    render state =
      L.runLayoutM (defGridBagSettings {rows = 3, cols = 3}) $ L.do
        L.with (GridBagLayoutConstraints 1 1 2 2) $ L.runLayoutM Vertical $ L.do
          HH.button [HE.onClick $ const $ Decrement 1] [HH.text "-"]
          L.if_ (state > 5) $ HH.button [HE.onClick $ const $ Decrement 2] [HH.text "--"]
          HH.div_ [HH.text $ show state]
          HH.button [HE.onClick $ const $ Increment 1] [HH.text "+"]
          L.if_ (state > 5) $ HH.button [HE.onClick $ const $ Increment 2] [HH.text "++"]
          slot_ "debounced" () debComp ()
          HH.div_ [HH.text "Test sentinel element"]
          L.end

        L.with (GridBagLayoutConstraints 3 3 1 1) $
          HH.div [HP.style $ C.border (C.px 2) C.solid C.black] [HH.text "Banner!"]

        L.end

    handleQuery = \case
      IncrementQ cb -> do
        modify (+ 1)
        get >>= H.raise
        pure $ Just cb
      DecrementQ cb -> do
        modify (subtract 1)
        get >>= H.raise
        pure $ Just cb

    handleAction = \case
      Init ->
        lift $ log "Initialized"
      Increment n -> do
        modify (+ n)
        get >>= H.raise
      Decrement n -> do
        modify (subtract n)
        get >>= H.raise

---------------------------------------

newtype DebChanged = DebChanged Text

debComp :: (MonadDOM m, MonadUnliftIO m) => Component VoidF () () m
debComp = unsafeMkDebouncedComponent 0.5 $ ComponentSpec {initialState, render, eval}
  where
    initialState _ = pure ""

    render txt = runLayoutM Vertical $ L.do
      HH.div_ [HH.text "The text below is debounced"]
      HH.div_ [HH.text $ "Input content: " <> txt]
      HH.input
        [ HP.type_ I.InputText,
          HP.value txt,
          HP.style $ C.width C.auto,
          HE.onInputValueChange $ Just . DebChanged
        ]
      L.end

    eval = NT $ \case
      Initialize a -> pure a
      Finalize a -> pure a
      Receive _i a -> pure a
      Action (DebChanged str) a ->
        put str $> a
      Query (Coyoneda _req _fct) _f -> panic "Void2"