fix(course list): show complete registration span
show regFrom to regTo, as requested by user feedback, or link to allocation Closes #446
This commit is contained in:
Steffen Jost
parent
689b85ad08
commit
754d6caa1b
@ -30,6 +30,7 @@ Aborted: Abgebrochen
|
||||
Remarks: Hinweise
|
||||
Registered: Angemeldet
|
||||
RegisteredSince: Angemeldet seit
|
||||
Registration: Anmeldung
|
||||
RegisterFrom: Anmeldungen von
|
||||
RegisterTo: Anmeldungen bis
|
||||
DeRegUntil: Abmeldungen bis
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -17,9 +17,16 @@
|
||||
$forall lecturer <- courseLecturers
|
||||
<li>
|
||||
#{lecturer}
|
||||
$maybe regTo <- courseRegisterTo
|
||||
<div .course-teaser__duedate-label>_{MsgRegisterTo}
|
||||
<div .course-teaser__duedate-value>^{formatTimeW SelFormatDateTime regTo}
|
||||
$maybe Entity _ Allocation{allocationTerm, allocationSchool, allocationShorthand, allocationName} <- courseAllocation
|
||||
<div .course-teaser__duedate-label>_{MsgRegistration}
|
||||
<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}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user