module Handler.Help where import Import import Handler.Utils import Jobs import qualified Data.Map as Map 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 :: Text } helpForm :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> Maybe (Route UniWorX) -> Maybe UserId -> AForm _ HelpForm helpForm mr mReferer mUid = HelpForm <$> aopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer) <*> multiActionA identActions (fslI MsgHelpAnswer) (HIUser <$ mUid) <*> aopt textField (fslpI MsgHelpSubject $ mr MsgHelpSubject) Nothing <*> (unTextarea <$> areq textareaField (fslpI MsgHelpRequest $ mr MsgHelpRequest) Nothing) where identActions :: Map _ (AForm _ (Either (Maybe Address) UserId)) identActions = Map.fromList $ case mUid of (Just uid) -> (HIUser, pure $ Right uid):defaultActions Nothing -> defaultActions defaultActions = [ (HIEmail, Left . Just <$> (Address <$> aopt textField (fslpI MsgName $ mr MsgName) Nothing <*> apreq emailField (fslpI MsgEMail $ mr MsgEMail) Nothing)) , (HIAnonymous, pure $ Left Nothing) ] getHelpR, postHelpR :: Handler Html getHelpR = postHelpR postHelpR = do mUid <- maybeAuthId mReferer <- flip formResultMaybe return <=< runInputGetResult $ iopt routeField (toPathPiece GetReferer) isModal <- hasCustomHeader HeaderIsModal MsgRenderer mr <- getMsgRenderer ((res,formWidget'),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mr 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' } tell . pure =<< messageI Success MsgHelpSent defaultLayout $ do setTitleI MsgHelpTitle let formWidget = wrapForm formWidget' def { formAction = Just $ SomeRoute HelpR , formEncoding = formEnctype , formAttrs = [ ("data-ajax-submit", "") | isModal ] } $(widgetFile "help")