Merge branch 'master' into 'live'

Minor cleanup

See merge request !83

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

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|
+            <form method=post action=@{MessageR cID} enctype=#{modifyEnctype}>
+              ^{modifyView}
+          |]
+        translationAddModal = modal [whamlet|_{MsgSystemMessageAddTranslation}|] $ Right
+          [whamlet|
+            <form method=post action=@{MessageR cID} enctype=#{addTransEnctype}>
+              ^{addTransView}
+          |]
+        translationsEditModal
+          | not $ null modifyTranss' = modal [whamlet|_{MsgSystemMessageEditTranslations}|] $ Right
+            [whamlet|
+              $forall ((_, transView), transEnctype) <- modifyTranss'
+                <section>
+                  <form method=post action=@{MessageR cID} enctype=#{transEnctype}>
+                    ^{transView}
+            |]
+          | otherwise = mempty
+      return (messageEditModal, translationAddModal, translationsEditModal)
 
   maySubmit <- (== Authorized) <$> evalAccess (MessageR cID) True
   forms <- traverse (const mkForm) $ () <$ guard maySubmit

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|<a href=@{url}>^{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} (
                             <b .surname>#{surname}
                             )|]
       (suffix:prefixes) ->
         let prefix = T.intercalate surname $ reverse prefixes
-        in [whamlet|$newline never
+        in [shamlet|$newline never
               #{prefix}
               <b .surname>#{surname}
               #{suffix}

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
 

templates/mail/support.hamlet

@@ -7,23 +7,26 @@ $newline never
     <dl>
       $case userInfo
         $of Left (Just email)
-          <dt> E-Mail
-          <dd> #{email}
+          <dt>E-Mail
+          <dd>#{email}
         $of Left  Nothing
         $of Right Nothing
-          <dt> Ungültige UserId erhalten!
+          <dt>Ungültige UserId erhalten!
         $of Right (Just (Entity _ User{..}))
-          <dt> Name
-          <dd> #{userDisplayName}
-          <dt> E-Mail
-          <dd> #{userEmail}
+          <dt>Name
+          <dd>^{const (const (nameHtml userDisplayName userSurname))}
+          <dt>Identifikation
+          <dd>#{userIdent}
+          <dt>E-Mail
+          <dd>#{userEmail}
           $maybe matrnr <- userMatrikelnummer
-            <dt> Matrikelnummer
-            <dd> #{matrnr}
-          <dt> E-Mail Sprachen
-          $forall lang <- mailLanguages userMailLanguages
-            <dd> #{lang}
-      <dt> Zeit
-      <dd> #{rtime}
-    <p style="white-space: pre">
+            <dt>Matrikelnummer
+            <dd>#{matrnr}
+          $if not (null (mailLanguages userMailLanguages))
+            <dt>Präferierte E-Mail Sprachen
+            $forall lang <- mailLanguages userMailLanguages
+              <dd>#{lang}
+      <dt>Zeit
+      <dd>#{rtime}
+    <p style="white-space: pre-wrap; font-family: monospace">
       #{jHelpRequest}

templates/system-message.hamlet

@@ -5,20 +5,8 @@
   <p>
     #{content}
 
-$maybe (((_, modifyView), modifyEnctype), modifyTranss, ((_, addTransView), addTransEnctype)) <- forms
+$maybe (messageEditModal, translationAddModal, translationsEditModal) <- forms
   <section>
-    <h2>_{MsgSystemMessageEdit}
-    <form method=post action=@{MessageR cID} enctype=#{modifyEnctype}>
-      ^{modifyView}
-
-  <section>
-    <h2>_{MsgSystemMessageAddTranslation}
-    <form method=post action=@{MessageR cID} enctype=#{addTransEnctype}>
-      ^{addTransView}
-  
-  $if not (null modifyTranss)
-    <section>
-      <h2>_{MsgSystemMessageEditTranslations}
-      $forall ((_, transView), transEnctype) <- modifyTranss
-        <form method=post action=@{MessageR cID} enctype=#{transEnctype}>
-          ^{transView}
+    ^{messageEditModal}
+    ^{translationAddModal}
+    ^{translationsEditModal}