module View.Header
  ( view
  , In(..)
  , Out(..)
  ) where

import           Data.Map         (Map)
import qualified Data.Map         as M
import qualified Data.Maybe       as Maybe
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 (..), 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_init  :: Dynamic t (Maybe Init)
  , _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

    let showLinks = Maybe.isJust <$> _in_init input

    signOut <- R.el "div" $ do
      ReflexUtil.visibleIfDyn showLinks R.blank (links $ _in_route input)
      (R.dyn $ nameSignOut <$> _in_init input) >>= ReflexUtil.flatten

    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)

  Link.view
    "/category"
    (R.ffor route (attrs CategoryRoute))
    (Msg.get Msg.Category_Title)

  Link.view
    "/statistics"
    (R.ffor route (attrs StatisticsRoute))
    (Msg.get Msg.Statistics_Title)

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

nameSignOut :: forall t m. MonadWidget t m => Maybe Init -> m (Event t ())
nameSignOut init =
  case init of
    Just 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