Fix behaviour of correctors-form

messages/de.msg

@@ -87,6 +87,7 @@ DeleteRow: Zeile entfernen
 ProportionNegative: Anteile dürfen nicht negativ sein
 CorrectorsUpdated: Korrektoren erfolgreich aktualisiert
 CorrectorsPlaceholder: Korrektoren...
+CorrectorsDefaulted: Korrektoren-Liste wurde aus bisherigen Übungsblättern diesen Kurses generiert. Es sind keine Daten gespeichert.
 
 HomeHeading: Aktuelle Termine
 ProfileHeading: Benutzerprofil und Einstellungen

src/Handler/Sheet.hs

@@ -11,6 +11,8 @@
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE MultiWayIf, LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
 
 module Handler.Sheet where
 
@@ -24,7 +26,7 @@ import Handler.Utils.Zip
 import qualified Data.Text as T
 -- import Data.Function ((&))
 --
-import Colonnade hiding (fromMaybe, singleton)
+import Colonnade hiding (fromMaybe, singleton, bool)
 import Yesod.Colonnade
 import Text.Blaze (text)
 -- 
@@ -106,7 +108,6 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
       <*> fileAFormOpt        (fsb "Hinweis")
       <*> aopt utcTimeField   (fsb "Lösung ab")   (sfSolutionFrom <$> template)
       <*> fileAFormOpt        (fsb "Lösung")
-      <*> formToAForm (correctorForm msId (maybe [] sfCorrectors template))
       <*  submitButton
     return $ case result of
       FormSuccess sheetResult
@@ -431,16 +432,20 @@ defaultLoads :: SheetId -> DB Loads
 --
 -- For every user, that ever was a corrector for this course, return their last `Load`.
 -- "Last `Load`" is taken to mean their `Load` on the `Sheet` with the most recent creation time (first edit).
-defaultLoads shid = fmap toMap . E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> E.distinctOnOrderBy [E.asc (sheetCorrector E.^. SheetCorrectorUser)] $ do
+defaultLoads shid = do
-  E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
+  cId <- sheetCourse <$> getJust shid
+  fmap toMap . E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> E.distinctOnOrderBy [E.asc (sheetCorrector E.^. SheetCorrectorUser)] $ do
+    E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
 
-  let creationTime = E.sub_select . E.from $ \sheetEdit -> do
+    let creationTime = E.sub_select . E.from $ \sheetEdit -> do
-        E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
+          E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
-        return . E.min_ $ sheetEdit E.^. SheetEditTime
+          return . E.min_ $ sheetEdit E.^. SheetEditTime
 
-  E.orderBy [E.desc creationTime]
+    E.where_ $ sheet E.^. SheetCourse E.==. E.val cId
+    
+    E.orderBy [E.desc creationTime]
   
-  return (sheetCorrector E.^. SheetCorrectorUser, sheetCorrector E.^. SheetCorrectorLoad)
+    return (sheetCorrector E.^. SheetCorrectorUser, sheetCorrector E.^. SheetCorrectorLoad)
   where
     toMap :: [(E.Value UserId, E.Value Load)] -> Loads
     toMap = foldMap $ \(E.Value uid, E.Value load) -> Map.singleton uid load
@@ -450,17 +455,27 @@ correctorForm :: SheetId -> MForm Handler (FormResult (Set SheetCorrector), [Fie
 correctorForm shid = do
   cListIdent <- newFormIdent
   let
-    guardNonDeleted :: CryptoUUIDUser -> Handler (Maybe CryptoUUIDUser)
+    guardNonDeleted :: UserId -> Handler (Maybe UserId)
-    guardNonDeleted cID@CryptoID{..} = do
+    guardNonDeleted uid = do
+      cID@CryptoID{..} <- encrypt uid :: Handler CryptoUUIDUser
       deleted <- lookupPostParam $ tshow ciphertext <> "-" <> "del"
-      case deleted of
+      return $ bool Just (const Nothing) (isJust deleted) uid
-        Just _  -> return Nothing
+  formCIDs <- mapM decrypt =<< catMaybes <$> liftHandlerT (map fromPathPiece <$> lookupPostParams cListIdent :: Handler [Maybe CryptoUUIDUser])
-        Nothing -> return $ Just cID
+  let
-  formCIDs <- lift $ (mapM decrypt <=< fmap catMaybes . mapM (maybe (return Nothing) guardNonDeleted)) =<< (map fromPathPiece <$> lookupPostParams cListIdent :: Handler [Maybe CryptoUUIDUser])
+    currentLoads :: DB Loads
-  loads'' <- lift . runDB $ defaultLoads shid
+    currentLoads = Map.fromList . map (\(Entity _ SheetCorrector{..}) -> (sheetCorrectorUser, sheetCorrectorLoad)) <$> selectList [ SheetCorrectorSheet ==. shid ] []
-  let loads' = loads'' `Map.union` Map.fromList [(uid, mempty) | uid <- formCIDs]
+  (defaultLoads', currentLoads') <- lift . runDB $ (,) <$> defaultLoads shid <*> currentLoads
-  
+  loads' <- fmap (Map.fromList [(uid, mempty) | uid <- formCIDs] `Map.union`) $ if
-  (countTutRes, countTutView) <- mreq checkBoxField (fsm MsgCountTutProp) Nothing
+    | Map.null currentLoads'
+    , null formCIDs          -> defaultLoads' <$ when (not $ Map.null defaultLoads') (addMessageI "warn" MsgCorrectorsDefaulted)
+    | otherwise              -> return $ Map.fromList (map (, mempty) formCIDs) `Map.union` currentLoads'
+
+  deletions <- lift $ foldM (\dels uid -> maybe (Set.insert uid dels) (const dels) <$> guardNonDeleted uid) Set.empty (Map.keys loads')
+
+  let loads'' = Map.restrictKeys loads' (Map.keysSet loads' `Set.difference` deletions)
+      didDelete = any (flip Set.member deletions) formCIDs
+
+  (countTutRes, countTutView) <- mreq checkBoxField (fsm MsgCountTutProp) . Just $ any (\Load{..} -> fromMaybe False byTutorial) $ Map.elems loads'
   let
     tutorField :: Field Handler [Text]
     tutorField = multiEmailField
@@ -488,12 +503,14 @@ correctorForm shid = do
     FormSuccess (Just emails) -> fmap Map.unions . forM emails $ \email -> do
       mUid <- fmap (fmap entityKey) . lift . runDB $ getBy (UniqueEmail email)
       case mUid of
-        Nothing  -> loads' <$ addMessageI "error" (MsgEMailUnknown email)
+        Nothing  -> loads'' <$ addMessageI "error" (MsgEMailUnknown email)
         Just uid
-          | not (Map.member uid loads') -> return $ Map.insert uid mempty loads'
+          | not (Map.member uid loads') -> return $ Map.insert uid mempty loads''
-          | otherwise                   -> loads' <$ addMessageI "warning" (MsgCorrectorExists email)
+          | otherwise                   -> loads'' <$ addMessageI "warning" (MsgCorrectorExists email)
-    FormFailure errs -> loads' <$ mapM_ (addMessage "error" . toHtml) errs
+    FormFailure errs -> loads'' <$ mapM_ (addMessage "error" . toHtml) errs
-    _ -> return loads'
+    _ -> return loads''
+
+  let deletions' = deletions `Set.difference` Map.keysSet loads
   
   names <- fmap (Map.fromList . map (\(E.Value a, E.Value b) -> (a, b))) . lift . runDB . E.select . E.from $ \user -> do
     E.where_ $ user E.^. UserId `E.in_` E.valList (Map.keys  loads)
@@ -526,6 +543,8 @@ correctorForm shid = do
 
   mr <- getMessageRender
 
+  $logDebugS "SCorrR" $ tshow (didDelete, addTutRes)
+
   let
     corrColonnade = mconcat
       [ headed (textCell $ mr MsgCorrector) $ \CorrectorForm{..} -> textCell cfUserName
@@ -536,6 +555,7 @@ correctorForm shid = do
     corrResults
       | FormSuccess (Just es) <- addTutRes
       , not $ null es = FormMissing
+      | didDelete = FormMissing
       | otherwise = fmap Set.fromList $ sequenceA [ SheetCorrector <$> pure cfUserId <*> pure shid <*> cfResult
                                                   | CorrectorForm{..} <- corrData
                                                   ]
@@ -543,12 +563,16 @@ correctorForm shid = do
       cID <- encrypt cfUserId :: WidgetT UniWorX IO CryptoUUIDUser
       toWidget [hamlet|<input name=#{cListIdent} type=hidden value=#{toPathPiece cID}>|]
 
+    delField uid = do
+      cID <- encrypt uid :: WidgetT UniWorX IO CryptoUUIDUser
+      toWidget [hamlet|<input name="#{toPathPiece cID}-del" type=hidden value=yes>|]
+
   return (corrResults, [ countTutView
                        , FieldView
                            { fvLabel = text $ mr MsgCorrectors
                            , fvTooltip = Nothing
                            , fvId = ""
-                           , fvInput = encodeCellTable tableDefault corrColonnade corrData >> mapM_ idField corrData
+                           , fvInput = encodeCellTable tableDefault corrColonnade corrData >> mapM_ idField corrData >> mapM_ delField deletions
                            , fvErrors = Nothing
                            , fvRequired = True
                            }
@@ -585,8 +609,8 @@ getSCorrR tid@(unTermKey -> tident) csh shn = do
   let
     formTitle = MsgSheetCorrectorsTitle tident csh shn
     formText  = Nothing :: Maybe (SomeMessage UniWorX)
-    -- actionUrl = CSheetR tid csh shn SCorrR
+    actionUrl = CSheetR tid csh shn SCorrR
-    actionUrl = CSheetR tid csh shn SShowR
+    -- actionUrl = CSheetR tid csh shn SShowR
   defaultLayout $ do
     setTitleI $ MsgSheetCorrectorsTitle tident csh shn
     $(widgetFile "formPageI18n")