All mailto-links use single hamlet file now; added mailto for lecturers
This commit is contained in:
parent
f20f2cb005
commit
0745542867
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"}
|
||||
|
||||
@ -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/
|
||||
|
||||
@ -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}
|
||||
Loading…
Reference in New Issue
Block a user