feat: markdown help requests

This commit is contained in:
Gregor Kleen 2020-02-22 14:04:10 +01:00
parent 4879bb8404
commit 06f3ac6563
4 changed files with 38 additions and 37 deletions

View File

@ -19,7 +19,7 @@ data HelpForm = HelpForm
{ hfReferer :: Maybe (Route UniWorX) { hfReferer :: Maybe (Route UniWorX)
, hfUserId :: Either (Maybe Address) UserId , hfUserId :: Either (Maybe Address) UserId
, hfSubject :: Maybe Text , hfSubject :: Maybe Text
, hfRequest :: Text , hfRequest :: Html
} }
helpForm :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> Maybe (Route UniWorX) -> Maybe UserId -> AForm _ HelpForm helpForm :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> Maybe (Route UniWorX) -> Maybe UserId -> AForm _ HelpForm
@ -27,7 +27,7 @@ helpForm mr mReferer mUid = HelpForm
<$> aopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer) <$> aopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer)
<*> multiActionA identActions (fslI MsgHelpAnswer) (HIUser <$ mUid) <*> multiActionA identActions (fslI MsgHelpAnswer) (HIUser <$ mUid)
<*> aopt textField (fslpI MsgHelpSubject $ mr MsgHelpSubject) Nothing <*> aopt textField (fslpI MsgHelpSubject $ mr MsgHelpSubject) Nothing
<*> (unTextarea <$> areq textareaField (fslpI MsgHelpRequest $ mr MsgHelpRequest) Nothing) <*> areq htmlField (fslpI MsgHelpRequest $ mr MsgHelpRequest) Nothing
where where
identActions :: Map _ (AForm _ (Either (Maybe Address) UserId)) identActions :: Map _ (AForm _ (Either (Maybe Address) UserId))
identActions = Map.fromList $ case mUid of identActions = Map.fromList $ case mUid of

View File

@ -15,7 +15,7 @@ import Data.Bitraversable
dispatchJobHelpRequest :: Either (Maybe Address) UserId dispatchJobHelpRequest :: Either (Maybe Address) UserId
-> UTCTime -> UTCTime
-> Maybe Text -- ^ Help Subject -> Maybe Text -- ^ Help Subject
-> Text -- ^ Help Request -> Html -- ^ Help Request
-> Maybe Text -- ^ Referer -> Maybe Text -- ^ Referer
-> Handler () -> Handler ()
dispatchJobHelpRequest jSender jRequestTime jHelpSubject jHelpRequest jReferer = do dispatchJobHelpRequest jSender jRequestTime jHelpSubject jHelpRequest jReferer = do

View File

@ -45,7 +45,7 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
| JobHelpRequest { jHelpSender :: Either (Maybe Address) UserId | JobHelpRequest { jHelpSender :: Either (Maybe Address) UserId
, jRequestTime :: UTCTime , jRequestTime :: UTCTime
, jSubject :: Maybe Text , jSubject :: Maybe Text
, jHelpRequest :: Text , jHelpRequest :: Html
, jReferer :: Maybe Text , jReferer :: Maybe Text
} }
| JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings } | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings }

View File

@ -4,38 +4,39 @@ $newline never
<head> <head>
<meta charset="UTF-8"> <meta charset="UTF-8">
<body> <body>
<dl> <section>
$case userInfo <dl>
$of Left (Just Address{..}) $case userInfo
$maybe name <- addressName $of Left (Just Address{..})
$maybe name <- addressName
<dt>Name
<dd>#{name}
<dt>E-Mail
<dd>#{addressEmail}
$of Left Nothing
$of Right Nothing
<dt>Ungültige UserId erhalten!
$of Right (Just (Entity _ User{userDisplayName, userSurname, userIdent, userEmail, userMatrikelnummer, userLanguages}))
<dt>Name <dt>Name
<dd>#{name} <dd>^{const (const (nameHtml userDisplayName userSurname))}
<dt>E-Mail <dt>Identifikation
<dd>#{addressEmail} <dd>#{userIdent}
$of Left Nothing <dt>E-Mail
$of Right Nothing <dd>#{userEmail}
<dt>Ungültige UserId erhalten! $maybe matrnr <- userMatrikelnummer
$of Right (Just (Entity _ User{userDisplayName, userSurname, userIdent, userEmail, userMatrikelnummer, userLanguages})) <dt>Matrikelnummer
<dt>Name <dd>#{matrnr}
<dd>^{const (const (nameHtml userDisplayName userSurname))} $maybe langs <- fmap (view _Wrapped) userLanguages
<dt>Identifikation $if not (null langs)
<dd>#{userIdent} <dt>Präferierte E-Mail Sprachen
<dt>E-Mail $forall lang <- langs
<dd>#{userEmail} <dd>#{lang}
$maybe matrnr <- userMatrikelnummer <dt>Zeit
<dt>Matrikelnummer <dd>#{rtime}
<dd>#{matrnr} $maybe referer <- jReferer
$maybe langs <- fmap (view _Wrapped) userLanguages <dt>Referer
$if not (null langs) <dd>
<dt>Präferierte E-Mail Sprachen <a href=#{referer} style="font-family: monospace">
$forall lang <- langs #{referer}
<dd>#{lang} <section>
<dt>Zeit
<dd>#{rtime}
$maybe referer <- jReferer
<dt>Referer
<dd>
<a href=#{referer} style="font-family: monospace">
#{referer}
<p style="white-space: pre-wrap; font-family: monospace">
#{jHelpRequest} #{jHelpRequest}