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

module View.SignIn
  ( view
  ) where

import qualified Data.Either as Either
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Time (NominalDiffTime)
import Prelude hiding (error)
import Reflex.Dom (MonadWidget, Event)
import qualified Reflex.Dom as R

import qualified Common.Message as Message
import qualified Common.Message.Key as Key
import Common.Model (SignIn(SignIn))

import Component.Input (InputIn(..), InputOut(..))
import Component.Button (ButtonIn(..), ButtonOut(..))
import qualified Component.Button as Component
import qualified Component.Input as Component

view :: forall t m. MonadWidget t m => Either Text (Maybe Text) -> m ()
view result =
  R.divClass "signIn" $ do
    rec
      input <- Component.input $ InputIn
        { _inputIn_reset = R.ffilter Either.isRight signInResult
        , _inputIn_placeHolder = Message.get Key.SignIn_EmailPlaceholder
        }

      let userWantsEmailValidation = _inputOut_enter input <> _buttonOut_clic button

      dynValidatedEmail <- R.holdDyn False . R.mergeWith (\_ _ -> False) $
        [ fmap (const True) userWantsEmailValidation
        , fmap (const False) signInResult
        ]

      uniqDynValidatedEmail <- R.holdUniqDyn dynValidatedEmail

      let validatedEmail = R.tagPromptlyDyn
            (_inputOut_value input)
            (R.ffilter (== True) . R.updated $ uniqDynValidatedEmail)

      let waiting = R.leftmost
            [ fmap (const True) validatedEmail
            , fmap (const False) signInResult
            ]

      button <- Component.button $ ButtonIn
        { _buttonIn_class = ""
        , _buttonIn_content = R.text (Message.get Key.SignIn_Button)
        , _buttonIn_waiting = waiting
        }

      signInResult <- askSignIn validatedEmail >>= R.debounce (0.5 :: NominalDiffTime)

    showSignInResult result signInResult

askSignIn :: forall t m. MonadWidget t m => Event t Text -> m (Event t (Either Text Text))
askSignIn email =
  fmap getResult <$> R.performRequestAsync xhrRequest
  where xhrRequest = fmap (R.postJson "/signIn" . SignIn) email
        getResult response =
          case R._xhrResponse_responseText response of
            Just key ->
              if R._xhrResponse_status response == 200 then Right key else Left key
            _ -> Left "NoKey"

showSignInResult :: forall t m. MonadWidget t m => Either Text (Maybe Text) -> Event t (Either Text Text) -> m ()
showSignInResult result signInResult = do
  _ <- R.widgetHold (showInitResult result) $ R.ffor signInResult showResult
  R.blank

  where showInitResult (Left error) = showError error
        showInitResult (Right (Just success)) = showSuccess success
        showInitResult (Right Nothing) = R.blank

        showResult (Left error) = showError error
        showResult (Right success) = showSuccess success

        showError = R.divClass "error" . R.text
        showSuccess = R.divClass "success" . R.text