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

This commit is contained in:
SJost 2019-02-28 11:03:02 +01:00
parent f20f2cb005
commit 0745542867
8 changed files with 44 additions and 20 deletions

View File

@ -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 (course,schoolName,participants,registered,map E.unValue lecturers)
return $ (user E.^. UserDisplayName, user E.^. UserSurname, user E.^. UserEmail)
return (course,schoolName,participants,registered,lecturers)
mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
mDereg <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course

View File

@ -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

View File

@ -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)

View File

@ -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}

View File

@ -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

View File

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

View File

@ -9,9 +9,7 @@ $newline never
<li>Akademischer Rat
<li>Oettingenstraße 67
<li>D-80538 München
<li>E-Mail: #
<a href="mailto:jost@tcs.ifi.lmu.de">
jost@tcs.ifi.lmu.de
<li>E-Mail: ^{mailtoHtml "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: #
<a href="mailto:rbg@ifi.lmu.de">
rbg@ifi.lmu.de
<li>E-Mail: ^{mailtoHtml "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: #
<a href="mailto:praesidium@lmu.de">
praesidium@lmu.de
<li>E-Mail: ^{mailtoHtml "praesidium@lmu.de"}
<li>Web: #
<a href="https://www.lmu.de/">
https://www.lmu.de/

View File

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