Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX
This commit is contained in:
Gregor Kleen
commit
ae32725eea
@ -7,6 +7,8 @@ BtnRegister: Anmelden
|
||||
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
|
||||
@ -16,6 +18,8 @@ BtnLecInvDecline: Ablehnen
|
||||
BtnCorrInvAccept: Annehmen
|
||||
BtnCorrInvDecline: Ablehnen
|
||||
|
||||
|
||||
|
||||
Aborted: Abgebrochen
|
||||
Remarks: Hinweise
|
||||
Registered: Angemeldet
|
||||
@ -200,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
|
||||
@ -954,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
|
||||
|
||||
@ -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
|
||||
]
|
||||
@ -617,7 +621,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
|
||||
}
|
||||
@ -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
|
||||
@ -948,9 +952,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
|
||||
|
||||
@ -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
|
||||
@ -351,7 +355,7 @@ submissionHelper tid ssh csh shn mcid = do
|
||||
forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
|
||||
return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner)
|
||||
((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (Upload True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies
|
||||
let formWidget = wrapForm formWidget' def
|
||||
let formWidget = wrapForm' BtnHandIn formWidget' def
|
||||
{ formAction = Just $ SomeRoute actionUrl
|
||||
, formEncoding = formEnctype
|
||||
}
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -1 +1,3 @@
|
||||
<p>
|
||||
_{MsgPressSaveToSave}
|
||||
^{corrForm}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user