diff --git a/messages/de.msg b/messages/de.msg
index 2a20f9bf6..15f357010 100644
--- a/messages/de.msg
+++ b/messages/de.msg
@@ -41,4 +41,12 @@ NotAParticipant user@Text tid@TermIdentifier csh@Text: #{user} ist nicht im Kurs
AddCorrector: Zusätzlicher Korrektor
CorrectorExists user@Text: #{user} ist bereits als Korrektor eingetragen
-SheetCorrectorsTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: Korrektoren für #{termToText tid}-#{courseShortHand} #{sheetName}
\ No newline at end of file
+SheetCorrectorsTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: Korrektoren für #{termToText tid}-#{courseShortHand} #{sheetName}
+CountTutProp: Tutorien zählen gegen Proportion
+Corrector: Korrektor
+Correctors: Korrektoren
+CorByTut: Nach Tutorium
+CorProportion: Anteil
+DeleteRow: Zeile entfernen
+ProportionNegative: Anteile dürfen nicht negativ sein
+CorrectorsUpdated: Korrektoren erfolgreich aktualisiert
\ No newline at end of file
diff --git a/models b/models
index ce5229b24..e9f9246da 100644
--- a/models
+++ b/models
@@ -118,6 +118,7 @@ SheetCorrector
sheet SheetId
load Load
UniqueSheetCorrector user sheet
+ deriving Show Eq Ord
SheetFile
sheet SheetId
file FileId
diff --git a/package.yaml b/package.yaml
index bb217ec2b..ccfb37678 100644
--- a/package.yaml
+++ b/package.yaml
@@ -81,6 +81,7 @@ dependencies:
- exceptions
- lens
- MonadRandom
+- email-validate
# The library contains all of our application code. The executable
# defined below is just a thin wrapper.
diff --git a/src/Foundation.hs b/src/Foundation.hs
index c2861c77f..228d92f4f 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -414,6 +414,7 @@ instance YesodBreadcrumbs UniWorX where
breadcrumb (CourseR tid csh (SheetR (SheetShowR shn))) = return (shn, Just $ CourseR tid csh $ SheetR SheetListR)
breadcrumb (CourseR tid csh (SheetR (SheetEditR shn))) = return ("Edit", Just $ CourseR tid csh $ SheetR $ SheetShowR shn)
breadcrumb (CourseR tid csh (SheetR (SheetDelR shn))) = return ("DELETE", Just $ CourseR tid csh $ SheetR $ SheetShowR shn)
+ breadcrumb (CourseR tid csh (SheetR (SheetCorrectorsR shn))) = return ("Korrektoren", Just $ CourseR tid csh $ SheetR $ SheetShowR shn)
breadcrumb (CourseR tid csh (SheetR (SubmissionR shn _))) = return ("Abgabe", Just $ CourseR tid csh $ SheetR $ SheetShowR shn)
breadcrumb SubmissionListR = return ("Abgaben", Just HomeR)
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 44e3734cc..0b86114e8 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -25,6 +25,7 @@ import qualified Data.Text as T
--
import Colonnade hiding (fromMaybe, singleton)
import Yesod.Colonnade
+import Text.Blaze (text)
--
import qualified Data.UUID.Cryptographic as UUID
import qualified Data.Conduit.List as C
@@ -33,12 +34,15 @@ import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E
import Control.Monad.Writer (MonadWriter(..), execWriterT)
-import Control.Monad.Trans.RWS.Lazy (RWST)
+import Control.Monad.Trans.RWS.Lazy (RWST, local)
+
+import qualified Text.Email.Validate as Email
import qualified Data.List as List
import Network.Mime
+import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map, (!), (!?))
@@ -413,7 +417,7 @@ data CorrectorForm = CorrectorForm
{ cfUserId :: UserId
, cfUserName :: Text
, cfResult :: FormResult Load
- , cfViewByTut, cfViewCountTut, cfViewProp :: FieldView UniWorX
+ , cfViewByTut, cfViewProp, cfViewDel :: FieldView UniWorX
}
type Loads = Map UserId Load
@@ -438,17 +442,46 @@ defaultLoads shid = fmap toMap . E.select . E.from $ \(sheet `E.InnerJoin` sheet
toMap = foldMap $ \(E.Value uid, E.Value load) -> Map.singleton uid load
-correctorForm :: SheetId -> MForm Handler (FormResult Loads, [FieldView UniWorX])
+correctorForm :: SheetId -> MForm Handler (FormResult (Set SheetCorrector), [FieldView UniWorX])
correctorForm shid = do
cListIdent <- newFormIdent
- formCIDs <- lift $ mapM decrypt =<< (catMaybes . map fromPathPiece <$> lookupPostParams cListIdent :: Handler [CryptoUUIDUser])
+ let
+ guardNonDeleted :: CryptoUUIDUser -> Handler (Maybe CryptoUUIDUser)
+ guardNonDeleted cID@CryptoID{..} = do
+ deleted <- lookupPostParam $ tshow ciphertext <> "-" <> "del"
+ case deleted of
+ Just _ -> return Nothing
+ Nothing -> return $ Just cID
+ formCIDs <- lift $ (mapM decrypt <=< fmap catMaybes . mapM (maybe (return Nothing) guardNonDeleted)) =<< (map fromPathPiece <$> lookupPostParams cListIdent :: Handler [Maybe CryptoUUIDUser])
loads'' <- lift . runDB $ defaultLoads shid
let loads' = loads'' `Map.union` Map.fromList [(uid, mempty) | uid <- formCIDs]
- (addTutRes, addTutView) <- mopt emailField (fsm MsgAddCorrector) (Just Nothing)
+ (countTutRes, countTutView) <- mreq checkBoxField (fsm MsgCountTutProp) Nothing
+ let
+ tutorField :: Field Handler [Text]
+ tutorField = multiEmailField
+ { fieldView = \theId name attrs val isReq -> asWidgetT $ do
+ listIdent <- newIdent
+ userId <- handlerToWidget requireAuthId
+ previousCorrectors <- handlerToWidget . runDB . E.select . E.from $ \(user `E.InnerJoin` sheetCorrector `E.InnerJoin` sheet `E.InnerJoin` course `E.InnerJoin` lecturer) -> E.distinctOnOrderBy [E.asc $ user E.^. UserEmail ] $ do
+ E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
+ E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
+ E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
+ E.on $ sheetCorrector E.^. SheetCorrectorUser E.==. user E.^. UserId
+ E.where_ $ lecturer E.^. LecturerUser E.==. E.val userId
+ return $ user E.^. UserEmail
+ toWidget [hamlet|
+ $newline never
+
+