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

@@ -30,6 +30,7 @@ Aborted: Abgebrochen
 Remarks: Hinweise
 Registered: Angemeldet
 RegisteredSince: Angemeldet seit
+Registration: Anmeldung
 RegisterFrom: Anmeldungen von
 RegisterTo: Anmeldungen bis
 DeRegUntil: Abmeldungen bis

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)
+      , dbsTemplate = DBSTCourse (_dbrOutput . _1) (_dbrOutput . _5) (_dbrOutput . _3) (_dbrOutput . _4) (_dbrOutput . _6 . _Just)
-      --                             ^ course          ^ lecturer list   ^ isRegistered    ^ school
+      --                             ^ course          ^ lecturer list   ^ isRegistered    ^ school        ^ allocation
       }
     , dbtParams = def
     , dbtIdent = "courses" :: Text

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")
+            DBSTCourse{} -> return $(widgetFile "table/course/header")
-            DBSTDefault        -> return $(widgetFile "table/cell/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

templates/table/course/course-teaser.hamlet

@@ -17,9 +17,16 @@
         $forall lecturer <- courseLecturers
           <li>
             #{lecturer}
-  $maybe regTo <- courseRegisterTo
+  $maybe Entity _ Allocation{allocationTerm, allocationSchool, allocationShorthand, allocationName} <- courseAllocation
-    <div .course-teaser__duedate-label>_{MsgRegisterTo}
+    <div .course-teaser__duedate-label>_{MsgRegistration}
-    <div .course-teaser__duedate-value>^{formatTimeW SelFormatDateTime regTo}
+    <div .course-teaser__duedate-value>
+      <a href=@{AllocationR allocationTerm allocationSchool allocationShorthand AShowR}>
+        #{allocationName}
+  $nothing
+    $maybe regFrom <- courseRegisterFrom
+      <div .course-teaser__duedate-label>_{MsgRegistration}
+      <div .course-teaser__duedate-value>^{formatTimeRangeW SelFormatDateTime regFrom courseRegisterTo}
+
   $maybe desc <- courseDescription
     <div .course-teaser__chevron>
     <div .course-teaser__description>#{desc}