module View.Header
  ( view
  , In(..)
  , Out(..)
  ) 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 qualified Component.Button as Button
import qualified Component.Link   as Link
import           Model.Route      (Route (..))
import qualified Util.Css         as CssUtil
import qualified Util.Reflex      as ReflexUtil
import qualified View.Icon        as Icon

data In t = In
  { _in_initResult    :: InitResult
  , _in_isInitSuccess :: Bool
  , _in_route         :: Dynamic t Route
  }

data Out t = Out
  { _out_signOut :: Event t ()
  }

view :: forall t m. MonadWidget t m => (In t) -> m (Out t)
view input =
  R.el "header" $ do

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

    signOut <- R.el "div" $ do
      rec
        showLinks <- R.foldDyn const (_in_isInitSuccess input) (False <$ signOut)
        ReflexUtil.visibleIfDyn showLinks R.blank (links $ _in_route input)
        signOut <- nameSignOut $ _in_initResult input
      return signOut

    return $ Out
      { _out_signOut = signOut
      }

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

  Link.view
    "/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 <- Button.view $
      (Button.defaultIn Icon.signOut)
        { Button._in_class = R.constDyn "signOut item"
        , Button._in_waiting = waiting
        }
    let signOutClic = Button._out_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