{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE MonoLocalBinds       #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}


module Main where


import           Control.Concurrent                (threadDelay)
import           Control.Lens                      hiding (view)
import           Control.Monad.IO.Class            (liftIO)
import           Data.Text                         (Text, pack)
import           Prelude                           hiding (div)

import           Shpadoinkle                       (Html, JSM, MonadJSM,
                                                    liftJSM, newTVarIO,
                                                    shpadoinkle)
-- import           Shpadoinkle.Backend.ParDiff       (runParDiff)
import           Shpadoinkle.Backend.Snabbdom      (runSnabbdom)
import           Shpadoinkle.Html                  as H (a, button, class', div,
                                                         div_, href, id', link',
                                                         onClick, onClickM, rel,
                                                         text, textProperty,
                                                         type')
import           Shpadoinkle.Html.Utils            (getBody)
import           Shpadoinkle.Lens                  (onRecord)
import           Shpadoinkle.Run                   (runJSorWarp)
import           Shpadoinkle.Widgets.Form.Dropdown as Dropdown
import           Shpadoinkle.Widgets.Types         (Humanize (..), Pick (..),
                                                    Present (..), Selected,
                                                    Toggle (..), fullOptions,
                                                    fullset, withOptions')


default (Text)


data Cheese = Cheddar | Munster | Mozzeralla
  deriving (Show, Eq, Ord, Bounded, Enum)


instance Humanize Cheese where
  humanize = pack . show


instance Humanize (Maybe Cheese) where
  humanize = maybe "Please Select" humanize


data Model = Model
  { _pickOne        :: Dropdown 'One Cheese
  , _pickAtleastOne :: Dropdown 'AtleastOne Cheese
  , _concTest       :: Int
  } deriving (Eq, Show)
makeLenses ''Model


conc :: MonadJSM m => Int -> Html m Int
conc x = div_
  [ text . pack $ show x
  , button
    [ onClick (+ 1)
    , onClickM . liftJSM $ do
      liftIO $ threadDelay 3000000
      return (* 3)
    ] [ text "TEST" ]
  ]


view :: MonadJSM m => Model -> Html m Model
view m = div_
  [ link' [ rel "stylesheet", href "https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css" ]
  , onRecord pickOne        $ dropdown bootstrap defConfig { _attrs = [ id' "One" ] } (_pickOne m)
  , onRecord pickAtleastOne $ dropdown bootstrap defConfig { _attrs = [ id' "AtleastOne" ] } (_pickAtleastOne m)
  , onRecord concTest $ conc $ _concTest m
  ]
  where
  bootstrap :: Present b => Present (Selected p b) => Dropdown p b -> Theme m p b
  bootstrap Dropdown {..} = Dropdown.Theme
    { _wrapper = div
      [ class' [ ("dropdown", True)
               , ("show", _toggle == Open) ]
      ]
    , _header  = pure . button
      [ class' ([ "btn", "btn-secondary", "dropdown-toggle" ] :: [Text])
      , type' "button"
      ]
      . present
    , _list    = div
      [ class' [ ("dropdown-menu", True)
               , ("show", _toggle == Open) ]
      ]
    , _item    = a [ class' "dropdown-item"
                   , textProperty "style" "cursor:pointer" ]
                 . present
    }


initial :: Model
initial = Model fullOptions (minBound `withOptions'` fullset) 4


app :: JSM ()
app = do
  model <- liftIO $ newTVarIO initial
  shpadoinkle id runSnabbdom initial model view getBody


main :: IO ()
main = runJSorWarp 8080 app