From 754d6caa1ba056de70ba5fa868a1a4f3976876f9 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 22 Aug 2019 16:41:26 +0200 Subject: [PATCH] fix(course list): show complete registration span show regFrom to regTo, as requested by user feedback, or link to allocation Closes #446 --- messages/uniworx/de.msg | 1 + src/Handler/Course/List.hs | 22 +++++++++++---------- src/Handler/Utils/Table/Pagination.hs | 11 ++++++----- templates/table/course/course-teaser.hamlet | 13 +++++++++--- 4 files changed, 29 insertions(+), 18 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index dfa9c0138..0d7a1a441 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -30,6 +30,7 @@ Aborted: Abgebrochen Remarks: Hinweise Registered: Angemeldet RegisteredSince: Angemeldet seit +Registration: Anmeldung RegisterFrom: Anmeldungen von RegisterTo: Anmeldungen bis DeRegUntil: Abmeldungen bis diff --git a/src/Handler/Course/List.hs b/src/Handler/Course/List.hs index 4a29f3851..00395a855 100644 --- a/src/Handler/Course/List.hs +++ b/src/Handler/Course/List.hs @@ -26,39 +26,39 @@ import qualified Database.Esqueleto.Utils as E -- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method. -type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User]) +type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User], Maybe (Entity Allocation)) colCourse :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colCourse = sortable (Just "course") (i18nCell MsgCourse) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } -> anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|_{courseName}|] colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colDescription = sortable Nothing mempty - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } -> case courseDescription of Nothing -> mempty (Just descr) -> cell $ modal (toWidget $ hasComment True) (Right $ toWidget descr) colCShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } -> anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|_{courseShorthand}|] colTerm :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colTerm = sortable (Just "term") (i18nCell MsgTerm) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _) } -> anchorCell (TermCourseListR courseTerm) [whamlet|#{courseTerm}|] colSchoolShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort) - $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}, _) } -> + $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}, _, _) } -> anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|_{schoolShorthand}|] colRegistered :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colRegistered = sortable (Just "registered") (i18nCell MsgRegistered) - $ \DBRow{ dbrOutput=(_, _, registered, _, _) } -> tickmarkCell registered + $ \DBRow{ dbrOutput=(_, _, registered, _, _, _) } -> tickmarkCell registered type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School) @@ -91,7 +91,9 @@ makeCourseTable whereClause colChoices psValidator = do dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> do lecturerList <- lift $ E.select $ E.from $ lecturerQuery $ E.val $ entityKey course - return (course, participants, registered, school, lecturerList) + courseAlloc <- lift $ getBy (UniqueAllocationCourse $ entityKey course) + >>= traverse (getJustEntity . allocationCourseAllocation . entityVal) + return (course, participants, registered, school, lecturerList, courseAlloc) snd <$> dbTable psValidator DBTable { dbtSQLQuery , dbtRowKey = \(course `E.InnerJoin` _) -> course E.^. CourseId @@ -165,8 +167,8 @@ makeCourseTable whereClause colChoices psValidator = do ] , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout - , dbsTemplate = DBSTCourse (_dbrOutput . _1) (_dbrOutput . _5) (_dbrOutput . _3) (_dbrOutput . _4) - -- ^ course ^ lecturer list ^ isRegistered ^ school + , dbsTemplate = DBSTCourse (_dbrOutput . _1) (_dbrOutput . _5) (_dbrOutput . _3) (_dbrOutput . _4) (_dbrOutput . _6 . _Just) + -- ^ course ^ lecturer list ^ isRegistered ^ school ^ allocation } , dbtParams = def , dbtIdent = "courses" :: Text diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index ff5e907f3..c3dc41c01 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -105,7 +105,7 @@ import Data.Semigroup as Sem (Semigroup(..)) import qualified Data.Conduit.List as C -import Handler.Utils.DateTime (formatTimeW) +import Handler.Utils.DateTime (formatTimeRangeW) import qualified Control.Monad.Catch as Catch @@ -444,7 +444,7 @@ data DBStyle r = DBStyle } data DBSTemplateMode r = DBSTDefault - | DBSTCourse (Lens' r (Entity Course)) (Lens' r [Entity User]) (Lens' r Bool) (Lens' r (Entity School)) + | DBSTCourse (Lens' r (Entity Course)) (Lens' r [Entity User]) (Lens' r Bool) (Lens' r (Entity School)) (Traversal' r (Entity Allocation)) instance Default (DBStyle r) where def = DBStyle @@ -1045,12 +1045,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db attrs = sortableContent ^. cellAttrs piSorting' = [ sSet | sSet <- fromMaybe [] piSorting, Just (sortKey sSet) /= sortableKey ] case dbsTemplate of - DBSTCourse _ _ _ _ -> return $(widgetFile "table/course/header") - DBSTDefault -> return $(widgetFile "table/cell/header") + DBSTCourse{} -> return $(widgetFile "table/course/header") + DBSTDefault -> return $(widgetFile "table/cell/header") in do wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable case dbsTemplate of - DBSTCourse c l r s -> do + DBSTCourse c l r s a -> do wRows <- forM rows $ \row' -> let Course{..} = row' ^. c . _entityVal lecturerUsers = row' ^. l @@ -1058,6 +1058,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db isRegistered = row' ^. r courseSchoolName = schoolName $ row' ^. s . _entityVal courseSemester = (termToText . unTermKey) courseTerm + courseAllocation = row' ^? a in return $(widgetFile "table/course/course-teaser") return $(widgetFile "table/course/colonnade") DBSTDefault -> do diff --git a/templates/table/course/course-teaser.hamlet b/templates/table/course/course-teaser.hamlet index b4f50fe97..f9a3f2a71 100644 --- a/templates/table/course/course-teaser.hamlet +++ b/templates/table/course/course-teaser.hamlet @@ -17,9 +17,16 @@ $forall lecturer <- courseLecturers
  • #{lecturer} - $maybe regTo <- courseRegisterTo -
    _{MsgRegisterTo} -
    ^{formatTimeW SelFormatDateTime regTo} + $maybe Entity _ Allocation{allocationTerm, allocationSchool, allocationShorthand, allocationName} <- courseAllocation +
    _{MsgRegistration} +