diff --git a/messages/button/de.msg b/messages/button/de.msg new file mode 100644 index 000000000..de25fb0c6 --- /dev/null +++ b/messages/button/de.msg @@ -0,0 +1,3 @@ +AmbiguousButtons: Mehrere Submit-Buttons aktiv +WrongButtonValue: Submit-Button hat falschen Wert +MultipleButtonValues: Submit-Button hat mehrere Werte \ No newline at end of file diff --git a/messages/dummy/de.msg b/messages/dummy/de.msg index f3ca7cae1..5a24922aa 100644 --- a/messages/dummy/de.msg +++ b/messages/dummy/de.msg @@ -1 +1,2 @@ -DummyIdent: Nutzer-Kennung \ No newline at end of file +DummyIdent: Nutzer-Kennung +DummyNoFormData: Keine Formulardaten empfangen \ No newline at end of file diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index f09698963..3868a0cba 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -93,6 +93,7 @@ SheetEditOk tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetNa SheetNameDup tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tid}-#{display ssh}-#{csh}. SheetDelHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{sheetName} wirklich aus Kurs #{display tid}-#{display ssh}-#{csh} herauslöschen? Alle assoziierten Abgaben und Korrekturen gehen ebenfalls verloren! SheetDelOk tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{csh}: #{sheetName} gelöscht. +SheetDelHasSubmissions objs@Int: Inkl. #{tshow objs} #{pluralDE objs "Abgabe" "Abgaben"}! SheetDeleteQuestion: Wollen Sie das unten aufgeführte Übungsblatt und alle zugehörigen Abgaben wirklich löschen? SheetDeleted: Übungsblatt gelöscht @@ -194,6 +195,7 @@ AddCorrector: Zusätzlicher Korrektor CorrectorExists email@UserEmail: #{email} ist bereits als Korrektor eingetragen SheetCorrectorsTitle tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: Korrektoren für #{display tid}-#{display ssh}-#{csh} #{sheetName} CountTutProp: Tutorien zählen gegen Proportion +AutoAssignCorrs: Korrekturen am Ende der Abgabefrist automatisch zuteilen Corrector: Korrektor Correctors: Korrektoren CorState: Status @@ -244,6 +246,7 @@ CorrUploadField: Korrekturen CorrUpload: Korrekturen hochladen CorrSetCorrector: Korrektor zuweisen CorrAutoSetCorrector: Korrekturen verteilen +CorrDelete: Abgaben löschen NatField name@Text: #{name} muss eine natürliche Zahl sein! JSONFieldDecodeFailure aesonFailure@String: Konnte JSON nicht parsen: #{aesonFailure} SecretJSONFieldDecryptFailure: Konnte versteckte vertrauliche Daten nicht entschlüsseln @@ -387,11 +390,17 @@ MailSubmissionRatedIntro courseName@Text termDesc@Text: Ihre Abgabe im Kurs #{co MailSubjectSheetActive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} wurde herausgegeben MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie können nun #{sheetName} im Kurs #{courseName} (#{termDesc}) herunterladen. +MailSubjectSubmissionsUnassigned csh@CourseShorthand sheetName@SheetName: Abgaben zu #{sheetName} in #{csh} konnten nicht verteilt werden +MailSubmissionsUnassignedIntro n@Int courseName@Text termDesc@Text sheetName@SheetName: #{tshow n} Abgaben zu #{sheetName} im Kurs #{courseName} (#{termDesc}) konnten nicht automatisiert verteilt werden. + MailSubjectSheetSoonInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden MailSheetSoonInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze. MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabfrist für #{sheetName} in #{csh} abgelaufen MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Die Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) beendet. -MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n@Int: #{display n} Abgaben wurden Ihnen zur Korrektur für #{sheetName} im Kurs #{courseName} (#{termDesc}) zugeteilt. + +MailSubjectCorrectionsAssigned csh@CourseShorthand sheetName@SheetName: Ihnen wurden Korrekturen zu #{sheetName} in #{csh} zugeteilt +MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n@Int: #{display n} #{pluralDE n "Abgabe wurde" "Abgaben wurden"} Ihnen zur Korrektur für #{sheetName} im Kurs #{courseName} (#{termDesc}) zugeteilt. + MailEditNotifications: Benachrichtigungen ein-/ausschalten MailSubjectSupport: Supportanfrage @@ -415,8 +424,8 @@ SheetTypeInfoNotGraded: Blätter ohne Wertung werden nirgends angerechnet, die B SheetTypeInfoBonus: Bonus Blätter zählen normal, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter. SheetGradingBonusIncluded: Erzielte Bonuspunkte wurden hier bereits zu den erreichten normalen Punkten hinzugezählt. SummaryTitle: Zusammenfassung über alle -SheetGradingSummaryTitle count@Integer: #{display count} #{pluralDE count "Blatt" "Blätter"} -SubmissionGradingSummaryTitle count@Integer: #{display count} #{pluralDE count "Abgabe" "Abgaben"} +SheetGradingSummaryTitle intgr@Integer: #{display intgr} #{pluralDE intgr "Blatt" "Blätter"} +SubmissionGradingSummaryTitle intgr@Integer: #{display intgr} #{pluralDE intgr "Abgabe" "Abgaben"} SheetTypeBonus': Bonus SheetTypeNormal': Normal @@ -439,6 +448,7 @@ NotificationTriggerSheetActive: Ich kann ein neues Übungsblatt herunterladen NotificationTriggerSheetSoonInactive: Ich kann ein Übungsblatt bald nicht mehr abgeben NotificationTriggerSheetInactive: Abgabefrist eines meiner Übungsblätter ist abgelaufen NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugeteilt +NotificationTriggerCorrectionsNotDistributed: Abgaben eines meiner Übungsblätter konnten keinem Korrektur zugeteilt werden CorrCreate: Abgaben erstellen UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}" diff --git a/models/sheets b/models/sheets index e6e7c1051..207f22ee0 100644 --- a/models/sheets +++ b/models/sheets @@ -12,6 +12,7 @@ Sheet solutionFrom UTCTime Maybe uploadMode UploadMode submissionMode SheetSubmissionMode default='UserSubmissions' + autoDistribute Bool default=false CourseSheet course name SheetEdit user UserId diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index df4ab5e40..bb26aa344 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -13,10 +13,12 @@ import qualified Data.CaseInsensitive as CI data DummyMessage = MsgDummyIdent + | MsgDummyNoFormData dummyForm :: ( RenderMessage site FormMessage , RenderMessage site DummyMessage + , RenderMessage site ButtonMessage , YesodPersist site , SqlBackendCanRead (YesodPersistBackend site) , Button site SubmitButton @@ -33,6 +35,7 @@ dummyLogin :: ( YesodAuth site , SqlBackendCanRead (YesodPersistBackend site) , RenderMessage site FormMessage , RenderMessage site DummyMessage + , RenderMessage site ButtonMessage , Button site SubmitButton , Show (ButtonCssClass site) ) => AuthPlugin site @@ -46,7 +49,9 @@ dummyLogin = AuthPlugin{..} FormFailure errs -> do lift . forM_ errs $ addMessage Error . toHtml redirect LoginR - FormMissing -> redirect LoginR + FormMissing -> do + lift $ addMessageI Warning MsgDummyNoFormData + redirect LoginR FormSuccess ident -> lift . setCredsRedirect $ Creds "dummy" (CI.original ident) [] apDispatch _ _ = notFound diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index ce07bb83c..0eebdd5f3 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -53,6 +53,7 @@ userPrincipalName = Ldap.Attr "userPrincipalName" campusForm :: ( RenderMessage site FormMessage , RenderMessage site CampusMessage + , RenderMessage site ButtonMessage , Button site SubmitButton , Show (ButtonCssClass site) ) => AForm (HandlerT site IO) CampusLogin @@ -65,6 +66,7 @@ campusLogin :: forall site. ( YesodAuth site , RenderMessage site FormMessage , RenderMessage site CampusMessage + , RenderMessage site ButtonMessage , Button site SubmitButton , Show (ButtonCssClass site) ) => LdapConf -> LdapPool -> AuthPlugin site diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs index 3efad0d32..53001ce92 100644 --- a/src/Auth/PWHash.hs +++ b/src/Auth/PWHash.hs @@ -27,6 +27,7 @@ data PWHashMessage = MsgPWHashIdent hashForm :: ( RenderMessage site FormMessage , RenderMessage site PWHashMessage + , RenderMessage site ButtonMessage , Button site SubmitButton , Show (ButtonCssClass site) ) => AForm (HandlerT site IO) HashLogin @@ -41,6 +42,7 @@ hashLogin :: ( YesodAuth site , SqlBackendCanRead (YesodPersistBackend site) , RenderMessage site FormMessage , RenderMessage site PWHashMessage + , RenderMessage site ButtonMessage , Button site SubmitButton , Show (ButtonCssClass site) ) => PWHashAlgorithm -> AuthPlugin site diff --git a/src/Foundation.hs b/src/Foundation.hs index ceb1c7722..7d5aef0cd 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -161,6 +161,7 @@ mkMessage "UniWorX" "messages/uniworx" "de" mkMessageVariant "UniWorX" "Campus" "messages/campus" "de" mkMessageVariant "UniWorX" "Dummy" "messages/dummy" "de" mkMessageVariant "UniWorX" "PWHash" "messages/pw-hash" "de" +mkMessageVariant "UniWorX" "Button" "messages/button" "de" -- This instance is required to use forms. You can modify renderMessage to -- achieve customized and internationalized form validation messages. diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 0b1514618..794d88071 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -8,6 +8,7 @@ import Handler.Utils import Handler.Utils.Submission import Handler.Utils.Table.Cells import Handler.Utils.SheetType +import Handler.Utils.Delete -- import Handler.Utils.Zip import Utils.Lens @@ -39,8 +40,6 @@ import qualified Database.Esqueleto as E -- import Network.Mime -import Web.PathPieces - import Text.Hamlet (ihamletFile) import Database.Persist.Sql (updateWhereCount) @@ -286,24 +285,29 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = d data ActionCorrections = CorrDownload | CorrSetCorrector | CorrAutoSetCorrector + | CorrDelete deriving (Eq, Ord, Read, Show, Enum, Bounded) -instance PathPiece ActionCorrections where - fromPathPiece = readFromPathPiece - toPathPiece = showToPathPiece -instance RenderMessage UniWorX ActionCorrections where - renderMessage m ls CorrDownload = renderMessage m ls MsgCorrDownload - renderMessage m ls CorrSetCorrector = renderMessage m ls MsgCorrSetCorrector - renderMessage m ls CorrAutoSetCorrector = renderMessage m ls MsgCorrAutoSetCorrector +instance Universe ActionCorrections +instance Finite ActionCorrections + +nullaryPathPiece ''ActionCorrections $ camelToPathPiece' 1 +embedRenderMessage ''UniWorX ''ActionCorrections id data ActionCorrectionsData = CorrDownloadData | CorrSetCorrectorData (Maybe UserId) | CorrAutoSetCorrectorData SheetId + | CorrDeleteData correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler + postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords) + { drAbort = SomeRoute currentRoute + , drSuccess = SomeRoute currentRoute + } + ((actionRes', table), statistics) <- runDB $ do -- Query for Table tableRes <- makeCorrectionsTable whereClause displayColumns psValidator return def @@ -395,6 +399,12 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = unassigned' <- forM (Set.toList stillUnassigned) $ \sid -> encrypt sid :: DB CryptoFileNameSubmission addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr) redirect currentRoute + FormSuccess (CorrDeleteData, subs) -> do + subs' <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable + getDeleteR (submissionDeleteRoute subs') + { drAbort = SomeRoute currentRoute + , drSuccess = SomeRoute currentRoute + } fmap toTypedContent . defaultLayout $ do setTitleI MsgCourseCorrectionsTitle @@ -415,10 +425,13 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = type ActionCorrections' = (ActionCorrections, AForm (HandlerT UniWorX IO) ActionCorrectionsData) -downloadAction :: ActionCorrections' +downloadAction, deleteAction :: ActionCorrections' downloadAction = ( CorrDownload , pure CorrDownloadData ) +deleteAction = ( CorrDelete + , pure CorrDeleteData + ) assignAction :: Either CourseId SheetId -> ActionCorrections' assignAction selId = ( CorrSetCorrector @@ -490,6 +503,7 @@ postCCorrectionsR tid ssh csh = do correctionsR whereClause colonnade psValidator $ Map.fromList [ downloadAction , assignAction (Left cid) + , deleteAction ] getSSubsR, postSSubsR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent @@ -513,6 +527,7 @@ postSSubsR tid ssh csh shn = do [ downloadAction , assignAction (Right shid) , autoAssignAction shid + , deleteAction ] correctionData :: TermId -> SchoolId -> CourseShorthand -> SheetName -> _ -- CryptoFileNameSubmission -> _ diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 3ac565d92..59c898aab 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -6,6 +6,7 @@ import Utils.Lens -- import Utils.DB import Handler.Utils import Handler.Utils.Table.Cells +import Handler.Utils.Course import Handler.Utils.Delete -- import Data.Time @@ -391,28 +392,10 @@ getCDeleteR, postCDeleteR :: TermId -> SchoolId -> CourseShorthand -> Handler Ht getCDeleteR = postCDeleteR postCDeleteR tid ssh csh = do Entity cId _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh - deleteR DeleteRoute - { drRecords = Set.singleton cId - , drRenderRecord = \(Entity _ Course{courseName, courseTerm, courseSchool}) -> do - School{schoolName} <- getJust courseSchool - return [whamlet| - #{courseName} (_{SomeMessage $ ShortTermIdentifier (unTermKey courseTerm)}, #{schoolName}) - |] - , drRecordConfirmString = \(Entity _ Course{courseShorthand, courseTerm, courseSchool}) -> - return [st|#{unSchoolKey courseSchool}/#{termToText (unTermKey courseTerm)}/#{courseShorthand}|] - , drCaption = SomeMessage MsgCourseDeleteQuestion - , drSuccessMessage = SomeMessage MsgCourseDeleted - , drAbort = SomeRoute $ CourseR tid ssh csh CShowR - , drSuccess = SomeRoute CourseListR + deleteR $ (courseDeleteRoute $ Set.singleton cId) + { drAbort = SomeRoute $ CourseR tid ssh csh CShowR + , drSuccess = SomeRoute $ TermSchoolCourseListR tid ssh } -{- TODO - | False -- DELETE -- TODO: This no longer works that way!!! See new way in Handler.Term.termEditHandler - , Just cid <- cfCourseId res -> do - runDB $ deleteCascade cid -- TODO Sicherheitsabfrage einbauen! - let cti = toPathPiece $ cfTerm res - addMessage Info [shamlet| Kurs #{cti}/#{cfShort res} wurde gelöscht!|] - redirect $ TermCourseListR $ cfTerm res --} -- | Course Creation and Editing diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 4f421ec3c..0058fee8e 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -106,9 +106,9 @@ postProfileDataR = do defaultLayout $(widgetFile "deletedUser") - (FormSuccess BtnAbort ) -> do - addMessageI Info MsgAborted - redirect ProfileDataR + -- (FormSuccess BtnAbort ) -> do + -- addMessageI Info MsgAborted + -- redirect ProfileDataR _other -> getProfileDataR diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 3cb1b9d24..ffe76f342 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -498,6 +498,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do , sheetSolutionFrom = sfSolutionFrom , sheetUploadMode = sfUploadMode , sheetSubmissionMode = sfSubmissionMode + , sheetAutoDistribute = False } mbsid <- dbAction newSheet case mbsid of @@ -533,20 +534,8 @@ getSDelR, postSDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Han getSDelR = postSDelR postSDelR tid ssh csh shn = do sid <- runDB $ fetchSheetId tid ssh csh shn - deleteR DeleteRoute - { drRecords = Set.singleton sid - , drRenderRecord = \(Entity _ Sheet{sheetName, sheetCourse}) -> do - Course{courseTerm, courseSchool, courseName} <- getJust sheetCourse - School{schoolName} <- getJust courseSchool - return [whamlet| - #{sheetName} (_{ShortTermIdentifier (unTermKey courseTerm)}, #{schoolName}, #{courseName}) - |] - , drRecordConfirmString = \(Entity _ Sheet{sheetName, sheetCourse}) -> do - Course{courseTerm, courseSchool, courseShorthand} <- getJust sheetCourse - return [st|#{termToText (unTermKey courseTerm)}/#{unSchoolKey courseSchool}/#{courseShorthand}/#{sheetName}|] - , drCaption = SomeMessage MsgSheetDeleteQuestion - , drSuccessMessage = SomeMessage MsgSheetDeleted - , drAbort = SomeRoute $ CSheetR tid ssh csh shn SShowR + deleteR $ (sheetDeleteRoute $ Set.singleton sid) + { drAbort = SomeRoute $ CSheetR tid ssh csh shn SShowR , drSuccess = SomeRoute $ CourseR tid ssh csh SheetListR } @@ -608,7 +597,7 @@ defaultLoads shid = do toMap = foldMap $ \(E.Value uid, E.Value load, E.Value state) -> Map.singleton uid (state, load) -correctorForm :: SheetId -> MForm Handler (FormResult (Set SheetCorrector), [FieldView UniWorX]) +correctorForm :: SheetId -> MForm Handler (FormResult (Bool {- ^ autoDistribute -} , Set SheetCorrector), [FieldView UniWorX]) correctorForm shid = do cListIdent <- newFormIdent let @@ -621,7 +610,7 @@ correctorForm shid = do let currentLoads :: DB Loads currentLoads = foldMap (\(Entity _ SheetCorrector{..}) -> Map.singleton sheetCorrectorUser (sheetCorrectorState, sheetCorrectorLoad)) <$> selectList [ SheetCorrectorSheet ==. shid ] [] - (defaultLoads', currentLoads') <- lift . runDB $ (,) <$> defaultLoads shid <*> currentLoads + (autoDistribute, defaultLoads', currentLoads') <- lift . runDB $ (,,) <$> (sheetAutoDistribute <$> getJust shid) <*> defaultLoads shid <*> currentLoads loads' <- fmap (Map.fromList [(uid, (CorrectorNormal, mempty)) | uid <- formCIDs] `Map.union`) $ if | Map.null currentLoads' , null formCIDs -> defaultLoads' <$ when (not $ Map.null defaultLoads') (addMessageI Warning MsgCorrectorsDefaulted) @@ -633,6 +622,7 @@ correctorForm shid = do didDelete = any (flip Set.member deletions) formCIDs (countTutRes, countTutView) <- mreq checkBoxField (fsm MsgCountTutProp) . Just $ any (\(_, Load{..}) -> fromMaybe False byTutorial) $ Map.elems loads' + (autoDistributeRes, autoDistributeView) <- mreq checkBoxField (fsm MsgAutoAssignCorrs) (Just autoDistribute) let tutorField :: Field Handler [UserEmail] tutorField = convertField (map CI.mk) (map CI.original) $ multiEmailField @@ -726,23 +716,25 @@ correctorForm shid = do cID <- encrypt uid :: WidgetT UniWorX IO CryptoUUIDUser toWidget [hamlet||] - return (corrResults, [ countTutView - , FieldView - { fvLabel = text $ mr MsgCorrectors - , fvTooltip = Nothing - , fvId = "" - , fvInput = Yesod.encodeCellTable tableDefault corrColonnade corrData >> mapM_ idField corrData >> mapM_ delField deletions' - , fvErrors = Nothing - , fvRequired = True - } - , addTutView - { fvInput = [whamlet| -
- ^{fvInput addTutView} -