From 0cc1d7689f18f00b91e73b930a17b227b6f0a71e Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 13 May 2019 15:34:45 +0200 Subject: [PATCH 1/4] UX Hilfe Online Korrektur --- messages/uniworx/de.msg | 3 +++ src/Handler/Corrections.hs | 5 +++-- templates/submission-assign.hamlet | 2 ++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 2f846eadd..a243e5297 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -7,6 +7,7 @@ BtnRegister: Anmelden BtnDeregister: Abmelden BtnHijack: Sitzung übernehmen BtnSave: Speichern +PressSaveToSave: Änderungen werden erst durch Drücken des Knopfes "Speichern" gespeichert. BtnCandidatesInfer: Studienfachzuordnung automatisch lernen BtnCandidatesDeleteConflicts: Konflikte löschen BtnCandidatesDeleteAll: Alle Beobachtungen löschen @@ -16,6 +17,8 @@ BtnLecInvDecline: Ablehnen BtnCorrInvAccept: Annehmen BtnCorrInvDecline: Ablehnen + + Aborted: Abgebrochen Remarks: Hinweise Registered: Angemeldet diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 01af2b880..0cf975867 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -617,7 +617,7 @@ postCorrectionR tid ssh csh shn cid = do <$> areq checkBoxField (fslI MsgRatingDone) (Just $ submissionRatingDone Submission{..}) <*> pointsForm <*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment)) - let corrForm = wrapForm corrForm' def + let corrForm = wrapForm' BtnSave corrForm' def { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR , formEncoding = corrEncoding } @@ -948,9 +948,10 @@ postSAssignR tid ssh csh shn cID = do ] addMessageI Success MsgCorrectorUpdated redirect actionUrl - let corrForm = wrapForm corrForm' def + let corrForm = wrapForm' BtnSave corrForm' def { formAction = Just $ SomeRoute actionUrl , formEncoding = corrEncoding + , formSubmit = FormDualSubmit } defaultLayout $ do setTitleI MsgCorrectorAssignTitle diff --git a/templates/submission-assign.hamlet b/templates/submission-assign.hamlet index 9b3911766..2caf92979 100644 --- a/templates/submission-assign.hamlet +++ b/templates/submission-assign.hamlet @@ -1 +1,3 @@ +

+ _{MsgPressSaveToSave} ^{corrForm} From 028c0eab3230fdedef91b8e1c730fae8cd3f185a Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 13 May 2019 16:29:00 +0200 Subject: [PATCH 2/4] Attempt filter UI subs --- src/Handler/Corrections.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 0cf975867..520f21c6d 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -196,7 +196,7 @@ colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ for ) colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData))) -colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell id +colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ formCell id (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId) (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment)) @@ -268,6 +268,9 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d E.limit 1 return (user E.^. UserSurname) ) + , ( "comment" -- sorting by comment specifically requested by correctors to easily see submissions to be done + , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingComment + ) ] , dbtFilter = Map.fromList [ ( "term" @@ -515,7 +518,7 @@ postCorrectionsR = do , prismAForm (singletonFilter "term" ) mPrev $ aopt (lift `hoistField` selectField termOptions) (fslI MsgTerm) , prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool) , Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` searchField False) (fslI MsgSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev))) - , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime) + , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime) ] courseOptions = runDB $ do courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand) @@ -531,6 +534,7 @@ postCorrectionsR = do & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information & restrictSorting (\name _ -> name /= "corrector") & defaultSorting [SortAscBy "israted", SortDescBy "ratingTime", SortAscBy "assignedtime" ] + & defaultFilter (Map.fromList [("israted",["no","Nein","No","False","Just False"]), ("sheet-search",["foo"])]) -- this does not work. "no" is the form value that we wanted correctionsR whereClause colonnade filterUI psValidator $ Map.fromList [ downloadAction ] @@ -879,8 +883,8 @@ postCorrectionsGradeR = do uid <- requireAuthId let whereClause = ratedBy uid displayColumns = mconcat -- should match getSSubsR for consistent UX - [ dbRow - , colSchool + [ -- dbRow, + colSchool , colTerm , colCourse , colSheet From ae96c6269c4da406eb267d51ef4b896916a04a12 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 13 May 2019 17:30:49 +0200 Subject: [PATCH 3/4] Surpress MsgMassInputTip for common case of single submission sheets --- messages/uniworx/de.msg | 4 +++- src/Handler/Submission.hs | 32 ++++++++++++++++++-------------- src/Handler/Utils/Form.hs | 27 ++++++++++++++++++++------- 3 files changed, 41 insertions(+), 22 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index a243e5297..c20d2af83 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -8,6 +8,7 @@ BtnDeregister: Abmelden BtnHijack: Sitzung übernehmen BtnSave: Speichern PressSaveToSave: Änderungen werden erst durch Drücken des Knopfes "Speichern" gespeichert. +BtnHandIn: Abgeben BtnCandidatesInfer: Studienfachzuordnung automatisch lernen BtnCandidatesDeleteConflicts: Konflikte löschen BtnCandidatesDeleteAll: Alle Beobachtungen löschen @@ -203,6 +204,7 @@ SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt. SubmissionEditHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{csh} #{sheetName}: Abgabe editieren/anlegen CorrectionHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName cid@CryptoFileNameSubmission: #{display tid}-#{display ssh}-#{csh} #{sheetName}: Korrektur SubmissionMembers: Abgebende +SubmissionMember: Abgebende(r) SubmissionArchive: Zip-Archiv der Abgabedatei(en) SubmissionFile: Datei zur Abgabe SubmissionFiles: Abgegebene Dateien @@ -957,7 +959,7 @@ TutorialCreated tutn@TutorialName: Tutorium #{tutn} erfolgreich angelegt TutorialEditHeading tutn@TutorialName: #{tutn} bearbeiten -MassInputTip: Es können mehrere Werte angegeben werden. Werte müssen mit + zur Liste hinzugefügt werden und können mit - wieder entfernt werden. Die Liste wird zunächst nur lokal in Ihrem Browser gespeichert und muss noch zusammen mit dem Rest des Formulars Gesendet werden. +MassInputTip: Es können mehrere Werte angegeben werden. Werte müssen mit + zur Liste hinzugefügt werden und können mit - wieder entfernt werden. Alle Änderungen müssen noch durch Drücken des Forumular-Knopfes bestätigt werden. HealthReport: Instanz-Zustand InstanceIdentification: Instanz-Identifikation diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 15c228664..c843f7e1e 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -162,14 +162,23 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident addField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Bool -> Field m (Set (Either UserEmail UserId)) addField isAdmin = multiUserField True $ courseUsers <$ guard isAdmin - addFieldSettings, submittorSettings :: FieldSettings UniWorX - addFieldSettings = fslI MsgSubmissionMembers + addFieldSettings, submittorSettings, singleSubSettings :: FieldSettings UniWorX + addFieldSettings = fslI MsgSubmissionMembers submittorSettings = fslI MsgSubmissionMembers & setTooltip MsgMassInputTip + singleSubSettings = fslI MsgSubmissionMember + + maxSize | Arbitrary{..} <- grouping = Just maxParticipants + | otherwise = Nothing + mayEdit = is _Arbitrary grouping + + submittorSettings' + | maxSize > Just 1 = submittorSettings + | otherwise = singleSubSettings miButtonAction' :: forall p. PathPiece p => Maybe (Route UniWorX) -> p -> Maybe (SomeRoute UniWorX) miButtonAction' mCurrent frag = mCurrent <&> \current -> SomeRoute (current :#: frag) - submittorsForm + submittorsForm | isLecturer = do-- Form is being used by lecturer; allow Everything™ let miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) @@ -183,7 +192,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident | otherwise -> FormSuccess $ Set.toList newData return (addRes', $(widgetFile "widgets/massinput/submissionUsers/add")) - + mRoute <- getCurrentRoute submittors <- massInputAccumW miAdd (miCell' mempty) (miButtonAction' mRoute) miLayout miIdent submittorSettings True (Just $ Set.toList prefillUsers) MsgRenderer mr <- getMsgRenderer @@ -193,13 +202,8 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident | otherwise = do uid <- liftHandlerT requireAuthId mRoute <- getCurrentRoute - - let - maxSize - | Arbitrary{..} <- grouping = Just maxParticipants - | otherwise = Nothing - mayEdit = is _Arbitrary grouping + let miAdd :: ListPosition -> Natural -> (Text -> Text) @@ -231,7 +235,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident guard $ Map.size dat > 1 -- User may drop from submission only if it already exists; no directly creating submissions for other people - guard $ maybe True (/= Right uid) (dat !? delPos) || isJust msmid + guard $ maybe True (/= Right uid) (dat !? delPos) || isJust msmid miDeleteList dat delPos @@ -248,8 +252,8 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident postProcess :: Map ListPosition (Either UserEmail UserId, ()) -> Set (Either UserEmail UserId) postProcess = setOf $ folded . _1 - fmap postProcess <$> massInputW MassInput{..} submittorSettings True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers) - + fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers) + getSubmissionNewR, postSubmissionNewR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html getSubmissionNewR = postSubmissionNewR @@ -335,7 +339,7 @@ submissionHelper tid ssh csh shn mcid = do | otherwise = (mempty , Set.singleton $ Right userID) invites <- sourceInvitationsList smid <&> Set.fromList . map (\(email, InvDBDataSubmissionUser) -> Left email) - + return . over _2 (Set.union invites) $ foldMap breakUserFromBuddies submittors lastEdits <- do diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index aa3828422..92fbccf72 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -75,14 +75,27 @@ instance Finite ButtonSave saveButton :: (Button (HandlerSite m) ButtonSave, MonadHandler m) => AForm m () saveButton = combinedButtonFieldF_ (Proxy @ButtonSave) "" - - nullaryPathPiece ''ButtonSave $ camelToPathPiece' 1 embedRenderMessage ''UniWorX ''ButtonSave id instance Button UniWorX ButtonSave where btnClasses BtnSave = [BCIsButton, BCPrimary] + + +data ButtonHandIn = BtnHandIn + deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) +instance Universe ButtonHandIn +instance Finite ButtonHandIn + +nullaryPathPiece ''ButtonHandIn $ camelToPathPiece' 1 + +embedRenderMessage ''UniWorX ''ButtonHandIn id +instance Button UniWorX ButtonHandIn where + btnClasses BtnHandIn = [BCIsButton, BCPrimary] + + + data ButtonRegister = BtnRegister | BtnDeregister deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) instance Universe ButtonRegister @@ -190,7 +203,7 @@ multiActionM :: (RenderMessage UniWorX action, PathPiece action, Ord action, Eq -> (Html -> MForm Handler (FormResult a, Widget)) multiActionM acts fSettings defAction = renderAForm FormStandard $ multiActionA acts fSettings defAction - + ------------ -- Fields -- ------------ @@ -549,7 +562,7 @@ utcTimeField = checkMMap (return . localTimeToUTC') utcToLocalTime localTimeFiel LTUUnique{_ltuResult} -> Right _ltuResult LTUNone{} -> Left MsgIllDefinedUTCTime LTUAmbiguous{} -> Left MsgAmbiguousUTCTime - + langField :: Bool -- ^ Only allow values from `appLanguages` -> Field (HandlerT UniWorX IO) Lang @@ -703,7 +716,7 @@ multiUserField onlySuggested suggestions = Field{..} lookupExpr | onlySuggested = suggestions | otherwise = Just $ E.from return - + fieldEnctype = UrlEncoded fieldView theId name attrs val isReq = do val' <- case val of @@ -723,7 +736,7 @@ multiUserField onlySuggested suggestions = Field{..} return $ emails ++ rEmails datalistId <- maybe (return $ error "Not to be used") (const newIdent) suggestions - + [whamlet| $newline never @@ -739,7 +752,7 @@ multiUserField onlySuggested suggestions = Field{..} $forall email <- suggestedEmails