module Handler.Help where

import Import
import Handler.Utils
import Handler.Info (faqsWidget)
import Jobs

import qualified Data.Map as Map

import qualified Data.Yaml as Yaml

import qualified Control.Monad.State.Class as State


data HelpIdentOptions = HIUser | HIEmail | HIAnonymous
  deriving (Eq, Ord, Bounded, Enum, Show, Read)

instance Universe HelpIdentOptions
instance Finite HelpIdentOptions

nullaryPathPiece ''HelpIdentOptions (camelToPathPiece' 1)
embedRenderMessage ''UniWorX ''HelpIdentOptions (("Help" <>) . dropPrefix "HI")

data HelpForm = HelpForm
  { hfReferer :: Maybe (Route UniWorX)
  , hfUserId  :: Either (Maybe Address) UserId
  , hfSubject :: Maybe Text
  , hfRequest :: Maybe Html
  , hfError   :: Maybe ErrorResponse
  }

helpForm :: Maybe (Route UniWorX) -> Maybe UserId -> Form HelpForm
helpForm mReferer mUid = renderWForm FormStandard $ do
  MsgRenderer mr <- getMsgRenderer

  let defaultActions =
        [ ( HIEmail
          , Left . Just <$> (Address <$> aopt textField (fslpI MsgName $ mr MsgName) Nothing <*> apreq emailField (fslpI MsgEMail $ mr MsgEMail) Nothing)
          )
        , ( HIAnonymous
          , pure $ Left Nothing
          )
        ]
      identActions :: Map _ (AForm _ (Either (Maybe Address) UserId))
      identActions = Map.fromList $ case mUid of
        (Just uid) -> (HIUser, pure $ Right uid):defaultActions
        Nothing    -> defaultActions

  sessErr <- lookupSessionJson SessionError

  hfReferer' <- wopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer)
  hfUserId'  <- multiActionW identActions (fslI MsgHelpAnswer) (HIUser <$ mUid)
  hfSubject' <- wopt textField (fslpI MsgHelpSubject $ mr MsgHelpSubject) Nothing
  hfRequest' <- case sessErr of
    Nothing -> fmap Just <$> wreq htmlField (fslpI MsgHelpRequest $ mr MsgHelpRequest) Nothing
    Just _  -> wopt htmlField (fslpI MsgHelpRequest $ mr MsgHelpRequest) Nothing
  hfError'   <- case sessErr of
    Nothing -> return $ pure Nothing
    Just err ->
      let prettyErr = decodeUtf8 $ Yaml.encode err
       in optionalActionW
            (err <$ aforced textareaField (fslI MsgHelpError) (Textarea prettyErr))
            (fslI MsgHelpSendLastError)
            (Just True)

  return $ HelpForm
    <$> hfReferer'
    <*> hfUserId'
    <*> hfSubject'
    <*> (fmap markupOutput <$> hfRequest')
    <*> hfError'

validateHelpForm :: FormValidator HelpForm Handler ()
validateHelpForm = do
  HelpForm{..} <- State.get

  guardValidation MsgHelpErrorOrRequestRequired $ is _Just hfRequest || is _Just hfError

getHelpR, postHelpR :: Handler Html
getHelpR = postHelpR
postHelpR = do
  mUid <- maybeAuthId
  mReferer <- flip formResultMaybe return <=< runInputGetResult $ iopt routeField (toPathPiece GetReferer)
  isModal <- hasCustomHeader HeaderIsModal

  ((res,formWidget'),formEnctype) <- runFormPost . validateForm validateHelpForm $ helpForm mReferer mUid

  formResultModal res HelpR $ \HelpForm{..} -> do
    now <- liftIO getCurrentTime
    hfReferer' <- traverse toTextUrl hfReferer
    queueJob' JobHelpRequest
      { jHelpSender  = hfUserId
      , jSubject     = hfSubject
      , jHelpRequest = hfRequest
      , jRequestTime = now
      , jReferer     = hfReferer'
      , jError       = hfError
      }

    whenIsJust hfError $ \error' ->
      modifySessionJson SessionError $ assertM (/= error')

    tell . pure =<< messageI Success MsgHelpSent

  defaultLayout $ do
    setTitleI MsgHelpTitle
    let formWidget = wrapForm formWidget' def
          { formAction = Just $ SomeRoute HelpR
          , formEncoding = formEnctype
          , formAttrs = [ asyncSubmitAttr | isModal ]
          }

    mFaqs <- (>>= \(mWgt, truncated) -> (, truncated) <$> mWgt) <$> traverse (faqsWidget $ Just 5) (Just <$> mReferer)

    $(widgetFile "help")