Surpress MsgMassInputTip for common case of single submission sheets

This commit is contained in:
Steffen Jost 2019-05-13 17:30:49 +02:00
parent 1a8d0fff57
commit ae96c6269c
3 changed files with 41 additions and 22 deletions

View File

@ -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

View File

@ -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

View File

@ -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
<input id="#{theId}" name="#{name}" *{attrs} type="email" multiple :isReq:required="" value="#{val'}" :isJust suggestions:list=#{datalistId}>
@ -739,7 +752,7 @@ multiUserField onlySuggested suggestions = Field{..}
$forall email <- suggestedEmails
<option value=#{email}>
|]
fieldParse (all Text.null -> True) _ = return $ Right Nothing
fieldParse (all Text.null -> True) _ = return $ Right Nothing
fieldParse ts _ = runExceptT . fmap Just $ do
let ts' = concatMap (Text.splitOn ",") ts
emails <- forM ts' $ \t -> either (\errStr -> throwE . SomeMessage $ MsgInvalidEmail [st|#{t} (#{errStr})|]) (return . decodeUtf8 . Email.toByteString) $ Email.validate (encodeUtf8 t)