From 4c1c172ac5e0fed1dc57c413a18f47183b561158 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 24 Oct 2018 21:42:45 +0200 Subject: [PATCH] Minor cleanup --- src/Handler/Submission.hs | 1 + src/Handler/SystemMessage.hs | 28 ++++++++++++++++++++++++---- src/Handler/Utils.hs | 13 ++++++++----- src/Jobs/Handler/HelpRequest.hs | 2 +- templates/mail/support.hamlet | 33 ++++++++++++++++++--------------- templates/system-message.hamlet | 20 ++++---------------- 6 files changed, 56 insertions(+), 41 deletions(-) diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index b8f80cbee..5055f6f26 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -25,6 +25,7 @@ import Jobs -- import Yesod.Form.Bootstrap3 import Handler.Utils +import Handler.Utils.Submission import Handler.Utils.Table.Cells import Network.Mime diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs index 5158e65f6..801b0b194 100644 --- a/src/Handler/SystemMessage.hs +++ b/src/Handler/SystemMessage.hs @@ -9,6 +9,7 @@ , FlexibleContexts , LambdaCase , MultiParamTypeClasses + , QuasiQuotes #-} module Handler.SystemMessage where @@ -44,9 +45,8 @@ postMessageR cID = do Just SystemMessageTranslation{..} -> (systemMessageTranslationSummary, systemMessageTranslationContent) let - mkForm :: Handler (((FormResult SystemMessage, Widget), Enctype), Map Lang ((FormResult (Entity SystemMessageTranslation, [Maybe BtnSubmitDelete]), Widget), Enctype), ((FormResult SystemMessageTranslation, Widget), Enctype)) mkForm = do - modifyRes'@((modifyRes, _), _) <- runFormPost . identForm FIDSystemMessageModify . renderAForm FormStandard + ((modifyRes, modifyView), modifyEnctype) <- runFormPost . identForm FIDSystemMessageModify . renderAForm FormStandard $ SystemMessage <$> aopt utcTimeField (fslI MsgSystemMessageFrom) (Just systemMessageFrom) <*> aopt utcTimeField (fslI MsgSystemMessageTo) (Just systemMessageTo) @@ -74,7 +74,7 @@ postMessageR cID = do let modifyTranss = Map.map (view $ _1._1) modifyTranss' - addTransRes'@((addTransRes, _), _) <- runFormPost . identForm FIDSystemMessageAddTranslation . renderAForm FormStandard + ((addTransRes, addTransView), addTransEnctype) <- runFormPost . identForm FIDSystemMessageAddTranslation . renderAForm FormStandard $ SystemMessageTranslation <$> pure smId <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") Nothing @@ -114,7 +114,27 @@ postMessageR cID = do addMessageI Success MsgSystemMessageEditTranslationSuccess redirect $ MessageR cID - return (modifyRes', modifyTranss', addTransRes') + let + messageEditModal = modal [whamlet|_{MsgSystemMessageEdit}|] $ Right + [whamlet| +
+ ^{modifyView} + |] + translationAddModal = modal [whamlet|_{MsgSystemMessageAddTranslation}|] $ Right + [whamlet| + + ^{addTransView} + |] + translationsEditModal + | not $ null modifyTranss' = modal [whamlet|_{MsgSystemMessageEditTranslations}|] $ Right + [whamlet| + $forall ((_, transView), transEnctype) <- modifyTranss' +
+ + ^{transView} + |] + | otherwise = mempty + return (messageEditModal, translationAddModal, translationsEditModal) maySubmit <- (== Authorized) <$> evalAccess (MessageR cID) True forms <- traverse (const mkForm) $ () <$ guard maySubmit diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 1b3d68334..2a5c6a160 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -22,7 +22,7 @@ import Handler.Utils.Table.Pagination as Handler.Utils import Handler.Utils.Zip as Handler.Utils import Handler.Utils.Rating as Handler.Utils hiding (extractRatings) -import Handler.Utils.Submission as Handler.Utils +-- import Handler.Utils.Submission as Handler.Utils import Handler.Utils.Sheet as Handler.Utils import Handler.Utils.Templates as Handler.Utils import Handler.Utils.Mail as Handler.Utils @@ -44,16 +44,19 @@ simpleLink :: Widget -> Route UniWorX -> Widget simpleLink lbl url = [whamlet|^{lbl}|] nameWidget :: Text -> Text -> Widget -nameWidget displayName surname - | null surname = toWidget displayName +nameWidget displayName surname = toWidget $ nameHtml displayName surname + +nameHtml :: Text -> Text -> Html +nameHtml displayName surname + | null surname = toHtml displayName | otherwise = case reverse $ T.splitOn surname displayName of - [_notContained] -> [whamlet|$newline never + [_notContained] -> [shamlet|$newline never #{displayName} ( #{surname} )|] (suffix:prefixes) -> let prefix = T.intercalate surname $ reverse prefixes - in [whamlet|$newline never + in [shamlet|$newline never #{prefix} #{surname} #{suffix} diff --git a/src/Jobs/Handler/HelpRequest.hs b/src/Jobs/Handler/HelpRequest.hs index ba466d700..0e03587a2 100644 --- a/src/Jobs/Handler/HelpRequest.hs +++ b/src/Jobs/Handler/HelpRequest.hs @@ -13,7 +13,7 @@ import Import hiding ((.=)) import Text.Hamlet import qualified Data.CaseInsensitive as CI -import Handler.Utils.DateTime +import Handler.Utils import Utils.Lens diff --git a/templates/mail/support.hamlet b/templates/mail/support.hamlet index e8ba2fb77..e239edf53 100644 --- a/templates/mail/support.hamlet +++ b/templates/mail/support.hamlet @@ -7,23 +7,26 @@ $newline never
$case userInfo $of Left (Just email) -
E-Mail -
#{email} +
E-Mail +
#{email} $of Left Nothing $of Right Nothing -
Ungültige UserId erhalten! +
Ungültige UserId erhalten! $of Right (Just (Entity _ User{..})) -
Name -
#{userDisplayName} -
E-Mail -
#{userEmail} +
Name +
^{const (const (nameHtml userDisplayName userSurname))} +
Identifikation +
#{userIdent} +
E-Mail +
#{userEmail} $maybe matrnr <- userMatrikelnummer -
Matrikelnummer -
#{matrnr} -
E-Mail Sprachen - $forall lang <- mailLanguages userMailLanguages -
#{lang} -
Zeit -
#{rtime} -

+

Matrikelnummer +
#{matrnr} + $if not (null (mailLanguages userMailLanguages)) +
Präferierte E-Mail Sprachen + $forall lang <- mailLanguages userMailLanguages +
#{lang} +
Zeit +
#{rtime} +

#{jHelpRequest} diff --git a/templates/system-message.hamlet b/templates/system-message.hamlet index 0775ebe58..577723162 100644 --- a/templates/system-message.hamlet +++ b/templates/system-message.hamlet @@ -5,20 +5,8 @@

#{content} -$maybe (((_, modifyView), modifyEnctype), modifyTranss, ((_, addTransView), addTransEnctype)) <- forms +$maybe (messageEditModal, translationAddModal, translationsEditModal) <- forms

-

_{MsgSystemMessageEdit} - - ^{modifyView} - -
-

_{MsgSystemMessageAddTranslation} - - ^{addTransView} - - $if not (null modifyTranss) -
-

_{MsgSystemMessageEditTranslations} - $forall ((_, transView), transEnctype) <- modifyTranss - - ^{transView} + ^{messageEditModal} + ^{translationAddModal} + ^{translationsEditModal}