fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

merge minor

Browse Source
This commit is contained in:
SJost 2019-02-28 11:23:38 +01:00
commit 407e40ce3d
2 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Handler/Course.hs
View File

@ -282,9 +282,9 @@ getCShowR tid ssh csh = do
lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
return $ (user E.^. UserDisplayName, user E.^. UserSurname, user E.^. UserEmail) return (user E.^. UserDisplayName, user E.^. UserSurname, user E.^. UserEmail)
return (course,schoolName,participants,registration,lecturers) return (course,schoolName,participants,registration,lecturers)
mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
mDereg <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course mDereg <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course

8
src/Handler/Utils.hs
View File

@ -48,7 +48,7 @@ nameWidget :: Text -> Text -> Widget
nameWidget displayName surname = toWidget $ nameHtml displayName surname nameWidget displayName surname = toWidget $ nameHtml displayName surname
-- | toWidget-Version of @nameEmailHtml@, for convenience -- | toWidget-Version of @nameEmailHtml@, for convenience
nameEmailWidget :: (CI Text) -> Text -> Text -> Widget nameEmailWidget :: CI Text -> Text -> Text -> Widget
nameEmailWidget email displayName surname = toWidget $ nameEmailHtml email displayName surname nameEmailWidget email displayName surname = toWidget $ nameEmailHtml email displayName surname
-- | Show user's displayName, highlighting the surname if possible. -- | Show user's displayName, highlighting the surname if possible.
@ -72,18 +72,18 @@ nameHtml displayName surname
-- | Like nameHtml just show a users displayname with hightlighted surname, -- | Like nameHtml just show a users displayname with hightlighted surname,
-- but also wrap the name with a mailto-link -- but also wrap the name with a mailto-link
nameEmailHtml :: (CI Text) -> Text -> Text -> Html nameEmailHtml :: CI Text -> Text -> Text -> Html
nameEmailHtml email displayName surname = nameEmailHtml email displayName surname =
wrapMailto email $ nameHtml displayName surname wrapMailto email $ nameHtml displayName surname
-- | Wrap mailto around given Html using single hamlet-file for consistency -- | Wrap mailto around given Html using single hamlet-file for consistency
wrapMailto :: (CI Text) -> Html -> Html wrapMailto :: CI Text -> Html -> Html
wrapMailto (original -> email) linkText wrapMailto (original -> email) linkText
| null email = linkText | null email = linkText
| otherwise = $(shamletFile "templates/widgets/link-email.hamlet") | otherwise = $(shamletFile "templates/widgets/link-email.hamlet")
-- | Just show an email address in a standard way, for convenience inside hamlet files. -- | Just show an email address in a standard way, for convenience inside hamlet files.
mailtoHtml :: (CI Text) -> Html mailtoHtml :: CI Text -> Html
mailtoHtml email = wrapMailto email $ toHtml email mailtoHtml email = wrapMailto email $ toHtml email
warnTermDays :: TermId -> [Maybe UTCTime] -> DB () warnTermDays :: TermId -> [Maybe UTCTime] -> DB ()