72 lines
2.5 KiB
Haskell
72 lines
2.5 KiB
Haskell
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")
|