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

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

import           Common.Model (Init (..), InitResult (..), User (..))
import qualified Common.Model as CM
import qualified Common.Msg   as Msg
import           Component    (ButtonIn (..))
import qualified Component    as Component
import qualified Icon
import           Model.Route  (Route (..))
import qualified Util.Css     as CssUtil
import qualified Util.Reflex  as ReflexUtil

data HeaderIn t = HeaderIn
  { _headerIn_initResult    :: InitResult
  , _headerIn_isInitSuccess :: Bool
  , _headerIn_route         :: Dynamic t Route
  }

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

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

    R.divClass "title" $
      R.text $ Msg.get Msg.App_Title

    signOut <- R.el "div" $ do
      rec
        showLinks <- R.foldDyn const (_headerIn_isInitSuccess headerIn) (False <$ signOut)
        ReflexUtil.visibleIfDyn showLinks R.blank (links $ _headerIn_route headerIn)
        signOut <- nameSignOut $ _headerIn_initResult headerIn
      return signOut

    return $ HeaderOut
      { _headerOut_signOut = signOut
      }

links :: forall t m. MonadWidget t m => Dynamic t Route -> m ()
links route = do
  Component.link
    "/"
    (R.ffor route (attrs RootRoute))
    (Msg.get Msg.Payment_Title)

  Component.link
    "/income"
    (R.ffor route (attrs IncomeRoute))
    (Msg.get Msg.Income_Title)

  where
    attrs linkRoute currentRoute =
      M.singleton "class" $
        CssUtil.classes
          [ ("item", True)
          , ("current", linkRoute == currentRoute)
          ]

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 $
      (Component.defaultButtonIn Icon.signOut)
        { _buttonIn_class = R.constDyn "signOut item"
        , _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 "/api/signOut" ()) signOut
                getResult = (== 200) . R._xhrResponse_status