Course User Deregister
This commit is contained in:
Steffen Jost
parent
90c18b50cd
commit
431affe6ec
@ -112,6 +112,9 @@ CourseUserNote: Notiz
|
||||
CourseUserNoteTooltip: Nur für Dozenten dieses Kurses einsehbar
|
||||
CourseUserNoteSaved: Notizänderungen gespeichert
|
||||
CourseUserNoteDeleted: Teilnehmernotiz gelöscht
|
||||
CourseUserDeregister: Abmelden
|
||||
CourseUsersDeregistered count@Int64: #{show count} Teilnehmer abgemeldet
|
||||
|
||||
CourseLecturers: Kursverwalter
|
||||
CourseLecturer: Dozent
|
||||
CourseAssistant: Assistent
|
||||
|
||||
2
routes
2
routes
@ -75,7 +75,7 @@
|
||||
/register CRegisterR POST !timeANDcapacity
|
||||
/edit CEditR GET POST
|
||||
/delete CDeleteR GET POST !lecturerANDempty
|
||||
/users CUsersR GET
|
||||
/users CUsersR GET POST
|
||||
/users/#CryptoUUIDUser CUserR GET POST !lecturerANDparticipant
|
||||
/correctors CHiWisR GET
|
||||
/notes CNotesR GET POST !corrector
|
||||
|
||||
@ -14,6 +14,7 @@ import Handler.Utils.Delete
|
||||
import Handler.Utils.Database
|
||||
import Handler.Utils.Table.Cells
|
||||
import Handler.Utils.Table.Columns
|
||||
import Database.Persist.Sql (deleteWhereCount)
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
@ -819,57 +820,87 @@ colUserDegreeShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell
|
||||
colUserDegreeShort = sortable (Just "degree-short") (i18nCell MsgStudyFeatureDegree) $
|
||||
foldMap (i18nCell . ShortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
|
||||
|
||||
makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget
|
||||
makeCourseUserTable cid colChoices psValidator =
|
||||
-- -- psValidator has default sorting and filtering
|
||||
let dbtIdent = "courseUsers" :: Text
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
dbtSQLQuery = userTableQuery cid
|
||||
dbtRowKey = queryUser >>> (E.^. UserId)
|
||||
dbtProj = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms))
|
||||
dbtColonnade = colChoices
|
||||
dbtSorting = Map.fromList
|
||||
[ sortUserNameLink queryUser -- slower sorting through clicking name column header
|
||||
, sortUserSurname queryUser -- needed for initial sorting
|
||||
, sortUserDisplayName queryUser -- needed for initial sorting
|
||||
, sortUserEmail queryUser
|
||||
, sortUserMatriclenr queryUser
|
||||
, ("degree" , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
|
||||
, ("degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
|
||||
, ("field" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsName))
|
||||
, ("field-short" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsShorthand))
|
||||
, ("semesternr" , SortColumn $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
|
||||
, ("registration", SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration))
|
||||
, ("note" , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
|
||||
E.sub_select . E.from $ \edit -> do
|
||||
E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
|
||||
return . E.max_ $ edit E.^. CourseUserNoteEditTime
|
||||
)
|
||||
]
|
||||
dbtFilter = Map.fromList
|
||||
[ fltrUserNameLink queryUser
|
||||
, fltrUserEmail queryUser
|
||||
, fltrUserMatriclenr queryUser
|
||||
, fltrUserNameEmail queryUser
|
||||
-- , ("course-user-degree", error "TODO") -- TODO
|
||||
-- , ("field" , FilterColumn $ queryFeaturesField error "TODO") -- TODO
|
||||
, ("semesternr", FilterColumn $ E.mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
|
||||
-- , ("course-registration", error "TODO") -- TODO
|
||||
-- , ("course-user-note", error "TODO") -- TODO
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrUserNameEmailUI mPrev
|
||||
, fltrUserMatriclenrUI mPrev
|
||||
]
|
||||
dbtParams = def
|
||||
in dbTableWidget' psValidator DBTable{..}
|
||||
|
||||
data CourseUserAction = CourseUserDeregister
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
|
||||
getCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCUsersR tid ssh csh = do
|
||||
(course, numParticipants, participantTable) <- runDB $ do
|
||||
instance Universe CourseUserAction
|
||||
instance Finite CourseUserAction
|
||||
nullaryPathPiece ''CourseUserAction $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''CourseUserAction id
|
||||
|
||||
makeCourseUserTable :: CourseId -> _ -> _ -> DB (FormResult (CourseUserAction, Set UserId), Widget)
|
||||
makeCourseUserTable cid colChoices psValidator = do
|
||||
Just currentRoute <- liftHandlerT getCurrentRoute
|
||||
-- -- psValidator has default sorting and filtering
|
||||
let dbtIdent = "courseUsers" :: Text
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
dbtSQLQuery = userTableQuery cid
|
||||
dbtRowKey = queryUser >>> (E.^. UserId)
|
||||
dbtProj = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms))
|
||||
dbtColonnade = colChoices
|
||||
dbtSorting = Map.fromList
|
||||
[ sortUserNameLink queryUser -- slower sorting through clicking name column header
|
||||
, sortUserSurname queryUser -- needed for initial sorting
|
||||
, sortUserDisplayName queryUser -- needed for initial sorting
|
||||
, sortUserEmail queryUser
|
||||
, sortUserMatriclenr queryUser
|
||||
, ("degree" , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
|
||||
, ("degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
|
||||
, ("field" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsName))
|
||||
, ("field-short" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsShorthand))
|
||||
, ("semesternr" , SortColumn $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
|
||||
, ("registration", SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration))
|
||||
, ("note" , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
|
||||
E.sub_select . E.from $ \edit -> do
|
||||
E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
|
||||
return . E.max_ $ edit E.^. CourseUserNoteEditTime
|
||||
)
|
||||
]
|
||||
dbtFilter = Map.fromList
|
||||
[ fltrUserNameLink queryUser
|
||||
, fltrUserEmail queryUser
|
||||
, fltrUserMatriclenr queryUser
|
||||
, fltrUserNameEmail queryUser
|
||||
-- , ("course-user-degree", error "TODO") -- TODO
|
||||
-- , ("field" , FilterColumn $ queryFeaturesField error "TODO") -- TODO
|
||||
, ("semesternr", FilterColumn $ E.mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
|
||||
-- , ("course-registration", error "TODO") -- TODO
|
||||
-- , ("course-user-note", error "TODO") -- TODO
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrUserNameEmailUI mPrev
|
||||
, fltrUserMatriclenrUI mPrev
|
||||
]
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
, dbParamsFormAction = Just $ SomeRoute currentRoute
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional = \csrf -> do
|
||||
(res,vw) <- mreq (selectField optionsFinite) "" Nothing
|
||||
let formWgt = toWidget csrf <> fvInput vw
|
||||
formRes = (, mempty) . First . Just <$> res
|
||||
return (formRes,formWgt)
|
||||
, dbParamsFormEvaluate = liftHandlerT . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
, dbParamsFormIdent = def
|
||||
}
|
||||
over _1 postprocess <$> dbTable psValidator DBTable{..}
|
||||
where
|
||||
postprocess :: FormResult (First CourseUserAction, DBFormResult UserId Bool UserTableData) -> FormResult (CourseUserAction, Set UserId)
|
||||
postprocess inp = do
|
||||
(First (Just act), usrMap) <- inp
|
||||
let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap
|
||||
return (act, usrSet)
|
||||
|
||||
getCUsersR, postCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCUsersR = postCUsersR
|
||||
postCUsersR tid ssh csh = do
|
||||
(Entity cid course, numParticipants, (participantRes,participantTable)) <- runDB $ do
|
||||
let colChoices = mconcat
|
||||
[ colUserNameLink (CourseR tid ssh csh . CUserR)
|
||||
[ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
|
||||
, colUserNameLink (CourseR tid ssh csh . CUserR)
|
||||
, colUserEmail
|
||||
, colUserMatriclenr
|
||||
, colUserDegreeShort
|
||||
@ -879,10 +910,18 @@ getCUsersR tid ssh csh = do
|
||||
, colUserComment tid ssh csh
|
||||
]
|
||||
psValidator = def & defaultSortingByName
|
||||
Entity cid course <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
ent@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
numParticipants <- count [CourseParticipantCourse ==. cid]
|
||||
participantTable <- makeCourseUserTable cid colChoices psValidator
|
||||
return (course, numParticipants, participantTable)
|
||||
table <- makeCourseUserTable cid colChoices psValidator
|
||||
return (ent, numParticipants, table)
|
||||
formResult participantRes $ \case
|
||||
(CourseUserDeregister,selectedUsers) -> do
|
||||
nrDel <- runDB $ deleteWhereCount
|
||||
[ CourseParticipantCourse ==. cid
|
||||
, CourseParticipantUser <-. Set.toList selectedUsers
|
||||
]
|
||||
addMessageI Success $ MsgCourseUsersDeregistered nrDel
|
||||
redirect $ CourseR tid ssh csh CUsersR
|
||||
let headingLong = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{display tid}|]
|
||||
headingShort = prependCourseTitle tid ssh csh MsgCourseMembers
|
||||
siteLayout headingLong $ do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user