{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo       #-}

module View.Header
  ( view
  , HeaderIn(..)
  , HeaderOut(..)
  ) where

import qualified Data.Map           as M
import           Data.Time          (NominalDiffTime)
import           Prelude            hiding (error, init)
import           Reflex.Dom         (Event, MonadWidget)
import qualified Reflex.Dom         as R

import qualified Common.Message     as Message
import qualified Common.Message.Key as Key
import           Common.Model       (Init (..), InitResult (..), User (..))
import qualified Common.Model       as CM

import           Component.Button   (ButtonIn (..))
import qualified Component.Button   as Component
import qualified Icon

data HeaderIn = HeaderIn
  { _headerIn_initResult :: InitResult
  }

data HeaderOut t = HeaderOut
  { _headerOut_signOut :: Event t ()
  }

view :: forall t m. MonadWidget t m => HeaderIn -> m (HeaderOut t)
view headerIn =
  R.el "header" $ do

    R.divClass "title" $
      R.text $ Message.get Key.App_Title

    signOut <- nameSignOut $ _headerIn_initResult headerIn

    return $ HeaderOut
      { _headerOut_signOut = signOut
      }

nameSignOut :: forall t m. MonadWidget t m => InitResult -> m (Event t ())
nameSignOut initResult = case initResult of
  (InitSuccess init) -> do
    rec
      attr <- R.holdDyn
        (M.singleton "class" "nameSignOut")
        (fmap (const $ M.fromList [("style", "visibility: hidden"), ("class", "nameSignOut")]) signOut)

      signOut <- R.elDynAttr "nameSignOut" attr $ do
        case CM.findUser (_init_currentUser init) (_init_users init) of
          Just user -> R.divClass "name" $ R.text (_user_name user)
          Nothing   -> R.blank
        signOutButton

    return signOut
  _ ->
    return R.never

signOutButton :: forall t m. MonadWidget t m => m (Event t ())
signOutButton = do
  rec
    signOut <- Component.button $ ButtonIn
      { Component._buttonIn_class = R.constDyn "signOut item"
      , Component._buttonIn_content = Icon.signOut
      , Component._buttonIn_waiting = waiting
      }
    let signOutClic = Component._buttonOut_clic signOut
        waiting = R.leftmost
          [ fmap (const True) signOutClic
          , fmap (const False) signOutSuccess
          ]
    signOutSuccess <- askSignOut signOutClic >>= R.debounce (0.5 :: NominalDiffTime)

  return . fmap (const ()) . R.ffilter (== True) $ signOutSuccess

  where askSignOut :: forall t m. MonadWidget t m => Event t () -> m (Event t Bool)
        askSignOut signOut =
          fmap getResult <$> R.performRequestAsync xhrRequest
          where xhrRequest = fmap (const $ R.postJson "/signOut" ()) signOut
                getResult = (== 200) . R._xhrResponse_status