From ae96c6269c4da406eb267d51ef4b896916a04a12 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 13 May 2019 17:30:49 +0200 Subject: [PATCH] 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