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