fix(Help Widget, Corrector Assignment): Modal Form closes in place; assign alerts
Closes #195
This commit is contained in:
Steffen Jost
parent
749cd2f7bc
commit
89d5364c93
@ -1,5 +1,5 @@
|
||||
[Dolphin]
|
||||
Timestamp=2018,3,14,10,57,55
|
||||
Timestamp=2019,6,26,19,32,25
|
||||
Version=4
|
||||
|
||||
[Settings]
|
||||
|
||||
@ -203,6 +203,7 @@ SheetErrHintEarly: Hinweise dürfen erst nach Beginn des Abgabezeitraums herausg
|
||||
SheetErrSolutionEarly: Lösungen dürfen erst nach Ende der Abgabezeitraums herausgegeben werden
|
||||
SheetNoCurrent: Es gibt momentan kein aktives Übungsblatt.
|
||||
SheetNoOldUnassigned: Alle Abgaben inaktiver Blätter sind bereits einen Korrektor zugeteilt.
|
||||
SheetsUnassignable name@Text: Momentan keine Abgaben zuteilbar für #{name}
|
||||
|
||||
Deadline: Abgabe
|
||||
Done: Eingereicht
|
||||
@ -403,6 +404,7 @@ UpdatedSheetCorrectorsAutoFailed n@Int: #{display n} #{pluralDE n "Abgabe konnte
|
||||
CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht automatisch zugewiesen werden:
|
||||
SelfCorrectors num@Int64: #{display num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt!
|
||||
|
||||
|
||||
CorrectionSheets: Übersicht Korrekturen nach Blättern
|
||||
CorrectionCorrectors: Übersicht Korrekturen nach Korrektoren
|
||||
AssignSubmissionExceptionNoCorrectors: Es sind keine Korrektoren eingestellt
|
||||
|
||||
@ -1436,7 +1436,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CourseR tid ssh csh CInviteR) = return ("Einladung", Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh (CUserR _)) = return ("Teilnehmer" , Just $ CourseR tid ssh csh CUsersR)
|
||||
breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh CAssignR) = return ("Zuteilung" , Just $ CourseR tid ssh csh CCorrectionsR)
|
||||
breadcrumb (CourseR tid ssh csh CAssignR) = return ("Zuteilung Korrekturen" , Just $ CourseR tid ssh csh CCorrectionsR)
|
||||
breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen" , Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu", Just $ CourseR tid ssh csh SheetListR)
|
||||
breadcrumb (CourseR tid ssh csh SheetCurrentR) = return ("Aktuelles Blatt", Just $ CourseR tid ssh csh SheetListR)
|
||||
@ -1454,7 +1454,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CSheetR tid ssh csh shn SEditR) = return ("Bearbeiten" , Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SDelR ) = return ("Löschen" , Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SSubsR) = return ("Abgaben" , Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SAssignR) = return ("Zuteilen" , Just $ CSheetR tid ssh csh shn SSubsR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SAssignR) = return ("Zuteilung Korrekturen" , Just $ CSheetR tid ssh csh shn SSubsR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SubmissionNewR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SubmissionOwnR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSubmissionR tid ssh csh shn _ SubShowR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
|
||||
@ -1052,11 +1052,8 @@ data SubAssignInfo = SubAssignInfo { saiName :: SheetName, saiSubmissionNr, saiC
|
||||
getCAssignR, postCAssignR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCAssignR = postCAssignR
|
||||
postCAssignR tid ssh csh = do
|
||||
(shids,cid) <- runDB $ do
|
||||
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
shids <- selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
|
||||
return (shids,cid)
|
||||
assignHandler tid ssh csh cid shids
|
||||
cid <- runDB $ getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
assignHandler tid ssh csh cid []
|
||||
|
||||
getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSAssignR = postSAssignR
|
||||
@ -1064,51 +1061,13 @@ postSAssignR tid ssh csh shn = do
|
||||
(shid,cid) <- runDB $ fetchSheetIdCourseId tid ssh csh shn
|
||||
assignHandler tid ssh csh cid [shid]
|
||||
|
||||
-- DEPRECATED assignHandler', delete me soonish
|
||||
assignHandler' :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html
|
||||
assignHandler' tid ssh csh _cid rawSids = do
|
||||
-- gather data
|
||||
openSubs <- runDB $ (\f -> foldM f Map.empty rawSids) $
|
||||
\acc sid -> maybeT (return acc) $ do
|
||||
Just Sheet{sheetName=saiName} <- lift $ get sid
|
||||
guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh saiName SAssignR -- we must check, whether the submission is already closed and thus assignable
|
||||
saiUnassignedNr <- lift $ count [SubmissionSheet ==. sid, SubmissionRatingBy ==. Nothing]
|
||||
guard $ 0 < saiUnassignedNr -- only consider sheets with unassigned submissions
|
||||
saiSubmissionNr <- lift $ count [SubmissionSheet ==. sid]
|
||||
saiCorrectorNr <- lift $ count [SheetCorrectorSheet ==. sid, SheetCorrectorState ==. CorrectorNormal]
|
||||
-- guard $ saiCorrectorNr > 0 -- COMMENTED OUT BECAUSE we should show sheets without possible correctors to inform the user about these problematic sheets
|
||||
return $ Map.insert sid SubAssignInfo{..} acc
|
||||
let sids = Map.keys openSubs
|
||||
linkBack <- simpleLinkI (SomeMessage MsgGenericBack) <$> case sids of
|
||||
[sid] -> do Sheet{sheetName} <- runDB $ getJust sid
|
||||
return $ CSheetR tid ssh csh sheetName SSubsR
|
||||
_ -> return $ CourseR tid ssh csh CCorrectionsR
|
||||
-- process form
|
||||
currentRoute <- getCurrentRoute
|
||||
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm FIDAssignSubmissions buttonForm
|
||||
assignmentStatus <- fmap (fromMaybe Map.empty) . formResultMaybe btnResult $ \BtnSubmissionsAssign ->
|
||||
-- Assign submissions
|
||||
fmap Just . runDB $ (\f -> foldM f Map.empty sids) $
|
||||
\acc sid -> flip (Map.insert sid) acc <$> assignSubmissions sid Nothing
|
||||
-- Too much important information for an alert message. Display proper info page instead
|
||||
let btnForm = wrapForm btnWdgt def
|
||||
{ formAction = SomeRoute <$> currentRoute
|
||||
, formEncoding = btnEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
headingShort = MsgMenuCorrectionsAssign
|
||||
headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign
|
||||
siteLayoutMsg headingShort $ do
|
||||
setTitleI headingLong
|
||||
$(widgetFile "corrections-assign")
|
||||
if null sids || not (null assignmentStatus)
|
||||
then linkBack -- TODO: convenience link might be unnecessary: either via breadcrumb or closing model. Remove, if modal works fine. Otherwise change to PrimaryAction?
|
||||
else btnForm
|
||||
{- TODO: Feature:
|
||||
make distivt buttons for each sheet, so that users see which sheet will be assigned.
|
||||
Currently this information is available within the page heading!
|
||||
|
||||
|
||||
{- TODO: make buttons for each sheet, so that users see which sheet is assigned
|
||||
Stub:
|
||||
data ButtonCorrectionsAssign = BtnCorrectionsAssignAll | BtnCorrectionsAssignSheet SheetName
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Button UniWorX ButtonCorrectionsAssign
|
||||
-- Are those needed any more?
|
||||
instance Universe ButtonCorrectionsAssign
|
||||
@ -1126,7 +1085,7 @@ assignHandler tid ssh csh cid assignSids = do
|
||||
(btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions
|
||||
|
||||
-- gather data
|
||||
(nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
|
||||
(assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
|
||||
-- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
nrParticipants <- count [CourseParticipantCourse ==. cid]
|
||||
|
||||
@ -1137,6 +1096,7 @@ assignHandler tid ssh csh cid assignSids = do
|
||||
groupsPossible =
|
||||
let foldFun (Entity _ Sheet{sheetGrouping=sgr}) acc = acc || sgr /= NoGroups
|
||||
in List.foldr foldFun False sheetList
|
||||
assignSheetNames = fmap sheetName $ mapMaybe (\sid -> Map.lookup sid sheets) assignSids
|
||||
|
||||
-- plan or assign unassigned submissions for given sheets
|
||||
let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational))
|
||||
@ -1166,7 +1126,10 @@ assignHandler tid ssh csh cid assignSids = do
|
||||
addMessageI msg_status $ UniWorXMessages $ msg_header : catMaybes [alert_ok, alert_fail]
|
||||
return status
|
||||
return $ Map.insert shn (status, countMapElems plan, deficit) acc
|
||||
assignment <- foldM buildA Map.empty assignSids
|
||||
assignSids' <- if null assignSids -- assignAll; we distinguish assignSids' here avoid useless Alerts
|
||||
then selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
|
||||
else return assignSids
|
||||
assignment <- foldM buildA Map.empty assignSids'
|
||||
|
||||
correctors <- E.select . E.from $ \(corrector `E.InnerJoin` user) -> do
|
||||
E.on $ corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
|
||||
@ -1210,7 +1173,7 @@ assignHandler tid ssh csh cid assignSids = do
|
||||
}
|
||||
in Map.insertWith (Map.unionWith (<>)) shnm cinf m
|
||||
|
||||
return (nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
|
||||
return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
|
||||
|
||||
let -- infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference
|
||||
-- create aggregate maps
|
||||
@ -1277,6 +1240,10 @@ assignHandler tid ssh csh cid assignSids = do
|
||||
| 0 < Map.size assignment = MsgMenuCorrectionsAssignSheet $ Text.intercalate ", " $ fmap CI.original $ Map.keys assignment
|
||||
| otherwise = MsgMenuCorrectionsAssign
|
||||
headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign
|
||||
|
||||
unassignableSheets = filter (\shn -> Map.notMember shn assignment) assignSheetNames
|
||||
unless (null unassignableSheets) $ addMessageI Warning $ MsgSheetsUnassignable $ Text.intercalate ", " $ fmap CI.original unassignableSheets
|
||||
|
||||
siteLayoutMsg headingShort $ do
|
||||
setTitleI headingLong
|
||||
$(widgetFile "corrections-overview")
|
||||
|
||||
@ -66,6 +66,6 @@ postHelpR = do
|
||||
let formWidget = wrapForm formWidget' def
|
||||
{ formAction = Just $ SomeRoute HelpR
|
||||
, formEncoding = formEnctype
|
||||
, formAttrs = [ ("data-ajax-submit", "") | isModal ]
|
||||
, formAttrs = [ asyncSubmitAttr | isModal ]
|
||||
}
|
||||
$(widgetFile "help")
|
||||
|
||||
@ -147,7 +147,7 @@ postProfileR = do
|
||||
|
||||
siteLayout [whamlet|_{MsgProfileFor} ^{nameWidget userDisplayName userSurname}|] $ do
|
||||
setTitle . toHtml $ "Profil " <> userIdent
|
||||
let settingsForm =
|
||||
let settingsForm =
|
||||
wrapForm formWidget FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ ProfileR :#: ProfileSettings
|
||||
@ -593,7 +593,7 @@ postUserNotificationR cID = do
|
||||
let formWidget = wrapForm nsInnerWdgt def
|
||||
{ formAction = Just . SomeRoute $ UserNotificationR cID
|
||||
, formEncoding = nsEnc
|
||||
, formAttrs = [ ("data-ajax-submit", "") | isModal ]
|
||||
, formAttrs = [ asyncSubmitAttr | isModal ]
|
||||
}
|
||||
|
||||
formResultModal nsRes (UserNotificationR cID, [ (toPathPiece GetBearer, toPathPiece jwt) | Just jwt <- pure mJwt ]) $ \ns -> do
|
||||
|
||||
@ -156,6 +156,11 @@ inputReadonly = addAttr "readonly" ""
|
||||
addAutosubmit :: FieldSettings site -> FieldSettings site
|
||||
addAutosubmit = addAttr "uw-auto-submit-input" ""
|
||||
|
||||
-- | Asynchronous Submit, e.g. use with forms in modals
|
||||
asyncSubmitAttr :: (Text,Text)
|
||||
asyncSubmitAttr = ("uw-async-form", "")
|
||||
|
||||
|
||||
------------------------------------------------
|
||||
-- Unique Form Identifiers to avoid accidents --
|
||||
------------------------------------------------
|
||||
|
||||
Loading…
Reference in New Issue
Block a user