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

refactor(course-visibility): use utils in course list

Browse Source
This commit is contained in:
Sarah Vaupel 2020-07-29 14:49:22 +02:00
parent b1d0893993
commit ec43ab1ad1
3 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Handler/Course/Show.hs
View File

@ -5,6 +5,7 @@ module Handler.Course.Show
import Import import Import
import Utils.Course
import Utils.Form import Utils.Form
import Handler.Utils import Handler.Utils
import qualified Database.Esqueleto.Utils as E import qualified Database.Esqueleto.Utils as E
@ -86,9 +87,9 @@ getCShowR tid ssh csh = do
& over (mapped . _1) E.unValue & over (mapped . _1) E.unValue
& over (mapped . _2) E.unValue & over (mapped . _2) E.unValue
lastEditText <- formatTime SelFormatDateTime $ maybe id max (guardOn visible =<< courseNewsVisibleFrom) courseNewsLastEdit lastEditText <- formatTime SelFormatDateTime $ maybe id max (guardOn visible =<< courseNewsVisibleFrom) courseNewsLastEdit
mayEdit <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNEditR mayEditNews <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNEditR
mayDelete <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNDeleteR mayDelete <- hasWriteAccessTo $ CNewsR tid ssh csh cID CNDeleteR
return (cID, n, visible, files, lastEditText, mayEdit, mayDelete) return (cID, n, visible, files, lastEditText, mayEditNews, mayDelete)
events' <- fmap (sortOn $ courseEventTime . entityVal) . lift $ selectList [ CourseEventCourse ==. cid ] [] events' <- fmap (sortOn $ courseEventTime . entityVal) . lift $ selectList [ CourseEventCourse ==. cid ] []
events <- mapM (\(Entity evId ev) -> (, ev) <$> encrypt evId) events' events <- mapM (\(Entity evId ev) -> (, ev) <$> encrypt evId) events'
@ -221,18 +222,15 @@ getCShowR tid ssh csh = do
hiddenEventNotes = all (\(_,CourseEvent{..}) -> is _Nothing courseEventNote) events hiddenEventNotes = all (\(_,CourseEvent{..}) -> is _Nothing courseEventNote) events
courseVisFrom = courseVisibleFrom course courseVisFrom = courseVisibleFrom course
courseVisTo = courseVisibleTo course courseVisTo = courseVisibleTo course
courseIsVisible courseVisible = courseIsVisible' now course
| Just visFrom <- courseVisFrom, Just visTo <- courseVisTo = visFrom <= now && now <= visTo
| Just visFrom <- courseVisFrom = visFrom <= now
| otherwise = False
mayCreateNews <- hasWriteAccessTo $ CourseR tid ssh csh CNewsNewR mayCreateNews <- hasWriteAccessTo $ CourseR tid ssh csh CNewsNewR
mayCreateEvents <- hasWriteAccessTo $ CourseR tid ssh csh CEventsNewR mayCreateEvents <- hasWriteAccessTo $ CourseR tid ssh csh CEventsNewR
mayEditCourse <- hasWriteAccessTo $ CourseR tid ssh csh CEditR mayEdit <- hasWriteAccessTo $ CourseR tid ssh csh CEditR
let heading = [whamlet| let heading = [whamlet|
$newline never $newline never
^{courseName course} ^{courseName course}
$if not courseIsVisible && mayEditCourse $if not courseVisible && mayEdit
\ #{iconInvisible} \ #{iconInvisible}
|] |]

5
src/Utils/Course.hs
View File

@ -4,6 +4,7 @@ module Utils.Course
, isCourseLecturer, isCourseTutor, isCourseCorrector, isCourseParticipant, isCourseAssociated , isCourseLecturer, isCourseTutor, isCourseCorrector, isCourseParticipant, isCourseAssociated
, isCourseLecturer' , isCourseLecturer'
, courseIsVisible , courseIsVisible
, courseIsVisible'
, numCourseParticipants , numCourseParticipants
) where ) where
@ -84,6 +85,10 @@ courseIsVisible now course =
E.||. E.val (Just now) E.<=. course E.^. CourseVisibleTo E.||. E.val (Just now) E.<=. course E.^. CourseVisibleTo
) )
courseIsVisible' :: UTCTime -> Course -> Bool
courseIsVisible' now Course{..} = NTop courseVisibleFrom <= now' && now' <= NTop courseVisibleTo
where now' = NTop $ Just now
numCourseParticipants :: E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Int) numCourseParticipants :: E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Int)
numCourseParticipants course = E.subSelectCount . E.from $ \courseParticipant -> numCourseParticipants course = E.subSelectCount . E.from $ \courseParticipant ->
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId

8
templates/course.hamlet
View File

@ -8,7 +8,7 @@ $newline never
<dd .deflist__dd> <dd .deflist__dd>
$if not (null news) $if not (null news)
<ul .course-news .list--iconless> <ul .course-news .list--iconless>
$forall (cID, CourseNews{courseNewsTitle, courseNewsSummary, courseNewsContent}, isVisible, files, lastEditText, mayEdit, mayDelete) <- news $forall (cID, CourseNews{courseNewsTitle, courseNewsSummary, courseNewsContent}, isVisible, files, lastEditText, mayEditNews, mayDelete) <- news
<li .course-news-item ##{"news-" <> toPathPiece cID}> <li .course-news-item ##{"news-" <> toPathPiece cID}>
$case (courseNewsTitle, courseNewsSummary) $case (courseNewsTitle, courseNewsSummary)
$# $of (Just title, Just summary) $# $of (Just title, Just summary)
@ -50,9 +50,9 @@ $# #{summary}
\ _{MsgCourseNewsFiles} \ _{MsgCourseNewsFiles}
<p .course-news-item__last-edit> <p .course-news-item__last-edit>
_{MsgCourseNewsLastEdited lastEditText} _{MsgCourseNewsLastEdited lastEditText}
$if mayEdit || mayDelete $if mayEditNews || mayDelete
<ul .course-news-item__actions .list--inline .list--comma-separated> <ul .course-news-item__actions .list--inline .list--comma-separated>
$if mayEdit $if mayEditNews
<li> <li>
^{modal (i18n MsgCourseNewsActionEdit) (Left (SomeRoute (CNewsR tid ssh csh cID CNEditR)))} ^{modal (i18n MsgCourseNewsActionEdit) (Left (SomeRoute (CNewsR tid ssh csh cID CNEditR)))}
$if mayDelete $if mayDelete
@ -125,7 +125,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
$nothing $nothing
_{MsgCourseParticipantsCount participants} _{MsgCourseParticipantsCount participants}
$if mayEditCourse $if mayEdit
<dt .deflist__dt> <dt .deflist__dt>
$if isJust courseVisFrom && isNothing courseVisTo $if isJust courseVisFrom && isNothing courseVisTo
_{MsgCourseVisibleFrom} _{MsgCourseVisibleFrom}