From 0745542867c5144fae70e43de82e759c1ded5fb7 Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 28 Feb 2019 11:03:02 +0100 Subject: [PATCH] All mailto-links use single hamlet file now; added mailto for lecturers --- src/Handler/Course.hs | 6 +++--- src/Handler/Utils.hs | 26 ++++++++++++++++++++++++++ src/Handler/Utils/Table/Cells.hs | 3 ++- templates/adminUser.hamlet | 3 ++- templates/course.hamlet | 4 +++- templates/dsgvDisclaimer.hamlet | 3 +-- templates/imprint/de.hamlet | 14 ++++---------- templates/widgets/link-email.hamlet | 5 +++-- 8 files changed, 44 insertions(+), 20 deletions(-) diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index c5ded719d..89329ac7e 100644 --- a/src/Handler/Course.hs +++ b/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 (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 diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index ca32ba574..8face7168 100644 --- a/src/Handler/Utils.hs +++ b/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|^{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 diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 68bd0e9a3..dc86454dd 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/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) diff --git a/templates/adminUser.hamlet b/templates/adminUser.hamlet index 5909795a5..60d0d6b47 100644 --- a/templates/adminUser.hamlet +++ b/templates/adminUser.hamlet @@ -1,5 +1,6 @@

- #{userEmail} + $# Does not use link-email.hamlet, but should + ^{mailtoHtml userEmail}

^{formWidget} ^{submitButtonView} diff --git a/templates/course.hamlet b/templates/course.hamlet index 130fe7f0a..bccf46976 100644 --- a/templates/course.hamlet +++ b/templates/course.hamlet @@ -18,7 +18,9 @@
_{MsgLecturerFor}
- #{T.intercalate ", " lecturers} +