module Component.Modal
  ( ModalIn(..)
  , ModalOut(..)
  , modal
  ) where

import           Control.Monad     (void)
import qualified Data.Map          as M
import qualified Data.Map.Lazy     as LM
import           Data.Text         (Text)
import qualified Data.Text         as T
import           Data.Time.Clock   (NominalDiffTime)
import qualified GHCJS.DOM.Element as Element
import qualified GHCJS.DOM.Node    as Node
import           JSDOM.Types       (JSString)
import           Reflex.Dom        (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom        as R
import qualified Reflex.Dom.Class  as R

import qualified Util.Dom          as Dom

data ModalIn t m a = ModalIn
  { _modalIn_show    :: Event t ()
  , _modalIn_hide    :: Event t ()
  , _modalIn_content :: m a
  }

data ModalOut t a = ModalOut
  { _modalOut_content :: a
  , _modalOut_hide    :: Event t ()
  }

modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut t a)
modal modalIn = do
  rec
    let show = Show <$ (_modalIn_show modalIn)

        startHiding =
          R.attachWithMaybe
            (\a _ -> if a then Just StartHiding else Nothing)
            (R.current canBeHidden)
            (R.leftmost [ _modalIn_hide modalIn, curtainClick ])

    canBeHidden <-
      R.holdDyn True $ R.leftmost
        [ False <$ startHiding
        , True <$ endHiding
        ]

    endHiding <-
      R.delay (0.2 :: NominalDiffTime) (EndHiding <$ startHiding)

    let action =
          R.leftmost [ show, startHiding, endHiding ]

    modalClass <-
      R.holdDyn "" (fmap getModalClass action)

    (elem, (curtainClick, content)) <-
      R.buildElement "div" (fmap getAttributes modalClass) $ do
        (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
        content <- R.divClass "g-Modal__Content" $ _modalIn_content modalIn
        return (R.domEvent R.Click curtain, content)

  performShowEffects action elem

  return $ ModalOut
    { _modalOut_content = content
    , _modalOut_hide = curtainClick
    }

getAttributes :: Text -> LM.Map Text Text
getAttributes modalClass =
  M.singleton "class" $
    T.intercalate " " [ "g-Modal", modalClass]

performShowEffects
  :: forall t m a. MonadWidget t m
  => Event t Action
  -> Element.Element
  -> m ()
performShowEffects showEvent elem = do
  body <- Dom.getBody

  let showEffects =
        flip fmap showEvent (\case
          Show -> do
            Node.appendChild body elem
            Element.setClassName body ("g-Body--Modal" :: JSString)
          StartHiding ->
            return ()
          EndHiding -> do
            Node.removeChild body elem
            Element.setClassName body ("" :: JSString)
        )

  R.performEvent_ $ void `fmap` showEffects

data Action
  = Show
  | StartHiding
  | EndHiding

getModalClass :: Action -> Text
getModalClass Show        = "g-Modal--Show"
getModalClass StartHiding = "g-Modal--Hiding"
getModalClass _           = ""