All mailto-links use single hamlet file now; added mailto for lecturers

src/Handler/Course.hs

@@ -12,7 +12,7 @@ import Handler.Utils.Course
 import Handler.Utils.Delete
 
 -- import Data.Time
-import qualified Data.Text as T
+-- import qualified Data.Text as T
 import Data.Function ((&))
 -- import Yesod.Form.Bootstrap3
 
@@ -280,8 +280,8 @@ getCShowR tid ssh csh = do
     lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
       E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
       E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
-      return $ user E.^. UserDisplayName
+      return $ (user E.^. UserDisplayName, user E.^. UserSurname, user E.^. UserEmail)
-    return (course,schoolName,participants,registered,map E.unValue lecturers)
+    return (course,schoolName,participants,registered,lecturers)
   mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom    course
   mRegTo   <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo      course
   mDereg   <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course

src/Handler/Utils.hs

@@ -7,10 +7,14 @@ import Import
 import qualified Data.Text as T
 -- import qualified Data.Set (Set)
 import qualified Data.Set as Set
+import Data.CaseInsensitive (CI, original)
+-- import qualified Data.CaseInsensitive as CI
 
 import Language.Haskell.TH (Q, Exp)
 -- import Language.Haskell.TH.Datatype
 
+import Text.Hamlet (shamletFile)
+
 import Handler.Utils.DateTime as Handler.Utils
 import Handler.Utils.Form as Handler.Utils
 import Handler.Utils.Table as Handler.Utils
@@ -39,9 +43,16 @@ tidFromText = fmap TermKey . maybeRight . termFromText
 simpleLink :: Widget -> Route UniWorX -> Widget
 simpleLink lbl url = [whamlet|<a href=@{url}>^{lbl}|]
 
+-- | toWidget-Version of @nameHtml@, for convenience
 nameWidget :: Text -> Text -> Widget
 nameWidget displayName surname = toWidget $ nameHtml displayName surname
 
+-- | toWidget-Version of @nameEmailHtml@, for convenience
+nameEmailWidget :: (CI Text) -> Text -> Text -> Widget
+nameEmailWidget email displayName surname = toWidget $ nameEmailHtml email displayName surname
+
+-- | Show user's displayName, highlighting the surname if possible.
+--   Otherwise appends the surname in parenthesis
 nameHtml :: Text -> Text -> Html
 nameHtml displayName surname
   | null surname = toHtml displayName
@@ -59,6 +70,21 @@ nameHtml displayName surname
             |]
       [] -> error "Data.Text.splitOn returned empty list in violation of specification."
 
+-- | Like nameHtml just show a users displayname with hightlighted surname,
+--   but also wrap the name with a mailto-link
+nameEmailHtml :: (CI Text) -> Text -> Text -> Html
+nameEmailHtml email displayName surname =
+  wrapMailto email $ nameHtml displayName surname
+
+-- | Wrap mailto around given Html using single hamlet-file for consistency
+wrapMailto :: (CI Text) -> Html -> Html
+wrapMailto (original -> email) linkText
+  | null email = linkText
+  | otherwise  = $(shamletFile "templates/widgets/link-email.hamlet")
+
+-- | Just show an email address in a standard way, for convenience inside hamlet files.
+mailtoHtml :: (CI Text) -> Html
+mailtoHtml email = wrapMailto email $ toHtml email
 
 warnTermDays :: TermId -> [Maybe UTCTime] -> DB ()
 warnTermDays tid times = do

src/Handler/Utils/Table/Cells.hs

@@ -65,7 +65,8 @@ userCell :: IsDBTable m a => Text -> Text -> DBCell m a
 userCell displayName surname = cell $ nameWidget displayName surname
 
 emailCell :: IsDBTable m a => CI Text -> DBCell m a
-emailCell userEmail = cell $(widgetFile "widgets/link-email")
+emailCell email = cell $(widgetFile "widgets/link-email")
+  where linkText= toWgt email
 
 cellHasUser :: (IsDBTable m c, HasUser a) => a -> DBCell m c
 cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname)

templates/adminUser.hamlet

@@ -1,5 +1,6 @@
 <p>
-  <a href="mailto:#{userEmail}">#{userEmail}
+  $# Does not use link-email.hamlet, but should
+  ^{mailtoHtml userEmail}
 <form method=post action=@{AdminUserR uuid} enctype=#{formEnctype}>
   ^{formWidget}
   ^{submitButtonView}

templates/course.hamlet

@@ -18,7 +18,9 @@
         <dt .deflist__dt>_{MsgLecturerFor}
       <dd .deflist__dd>
         <div>
-          #{T.intercalate ", " lecturers}
+          <ul .list--inline .list--comma-separated>
+            $forall (E.Value displayname, E.Value surname, E.Value email) <- lecturers
+              <li>^{nameEmailWidget email displayname surname}
 
     $maybe link <- courseLinkExternal course
       <dt .deflist__dt>Website

templates/dsgvDisclaimer.hamlet

@@ -10,5 +10,4 @@
       bitten um Ihr Verständnis.
     <p>
       Bitte melden Sie etwaige Probleme an #
-        <a href="mailto:jost@tcs.ifi.lmu.de">
+        ^{mailtoHtml "jost@tcs.ifi.lmu.de"}
-          jost@tcs.ifi.lmu.de

templates/imprint/de.hamlet

@@ -9,9 +9,7 @@ $newline never
       <li>Akademischer Rat
       <li>Oettingenstraße 67
       <li>D-80538 München
-      <li>E-Mail: #
+      <li>E-Mail: ^{mailtoHtml "jost@tcs.ifi.lmu.de"}
-        <a href="mailto:jost@tcs.ifi.lmu.de">
-          jost@tcs.ifi.lmu.de
       <li>Web: #
         <a href="https://www.tcs.ifi.lmu.de/mitarbeiter/steffen-jost">
           https://www.tcs.ifi.lmu.de/mitarbeiter/steffen-jost
@@ -24,9 +22,7 @@ $newline never
       <li>Leiter Rechnerbetriebsgruppe
       <li>Oettingenstraße 67
       <li>D-80538 München
-      <li>E-Mail: #
+      <li>E-Mail: ^{mailtoHtml "rbg@ifi.lmu.de"}
-        <a href="mailto:rbg@ifi.lmu.de">
-          rbg@ifi.lmu.de
       <li>Web: #
         <a href="https://www.rz.ifi.lmu.de/rbg/">
           https://www.rz.ifi.lmu.de/rbg/
@@ -41,7 +37,7 @@ $newline never
     <ul style="list-style-type: none">
       <li>Oettingenstraße 67
       <li>D-80538 München
-      <li>E-Mail: rbg@ifi.lmu.de
+      <li>E-Mail: ^{mailtoHtml "rbg@ifi.lmu.de"}
       <li>Web: https://www.rz.ifi.lmu.de/rbg/
       <li>Telefon: +49 (0) 89 / 2180 - 9198
     <p>
@@ -68,9 +64,7 @@ $newline never
       <li>Geschwister-Scholl-Platz 1
       <li>80539 München<
       <li>Telefon: +49 (0) 89 / 2180 - 0
-      <li>E-Mail: #
+      <li>E-Mail: ^{mailtoHtml "praesidium@lmu.de"}
-        <a href="mailto:praesidium@lmu.de">
-          praesidium@lmu.de
       <li>Web: #
         <a href="https://www.lmu.de/">
           https://www.lmu.de/

templates/widgets/link-email.hamlet

@@ -1,2 +1,3 @@
-<a href="mailto:#{userEmail}">
+$# Used for all mailto-link, and used as both as shamlet and whamlet at once.
-  #{userEmail}
+<a href="mailto:#{email}">
+  ^{linkText}