diff --git a/messages/de.msg b/messages/de.msg index 51152d5b2..ab977b42c 100644 --- a/messages/de.msg +++ b/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 diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index eb1fba369..6d92f16e2 100644 --- a/src/Handler/Sheet.hs +++ b/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 - E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet +defaultLoads shid = do + 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 - E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId - return . E.min_ $ sheetEdit E.^. SheetEditTime + let creationTime = E.sub_select . E.from $ \sheetEdit -> do + E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId + 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 cID@CryptoID{..} = do + guardNonDeleted :: UserId -> Handler (Maybe UserId) + guardNonDeleted uid = do + cID@CryptoID{..} <- encrypt uid :: Handler CryptoUUIDUser 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] - - (countTutRes, countTutView) <- mreq checkBoxField (fsm MsgCountTutProp) Nothing + return $ bool Just (const Nothing) (isJust deleted) uid + formCIDs <- mapM decrypt =<< catMaybes <$> liftHandlerT (map fromPathPiece <$> lookupPostParams cListIdent :: Handler [Maybe CryptoUUIDUser]) + let + currentLoads :: DB Loads + currentLoads = Map.fromList . map (\(Entity _ SheetCorrector{..}) -> (sheetCorrectorUser, sheetCorrectorLoad)) <$> selectList [ SheetCorrectorSheet ==. shid ] [] + (defaultLoads', currentLoads') <- lift . runDB $ (,) <$> defaultLoads shid <*> currentLoads + loads' <- fmap (Map.fromList [(uid, mempty) | uid <- formCIDs] `Map.union`) $ if + | 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' - | otherwise -> loads' <$ addMessageI "warning" (MsgCorrectorExists email) - FormFailure errs -> loads' <$ mapM_ (addMessage "error" . toHtml) errs - _ -> return loads' + | not (Map.member uid loads') -> return $ Map.insert uid mempty loads'' + | otherwise -> loads'' <$ addMessageI "warning" (MsgCorrectorExists email) + FormFailure errs -> loads'' <$ mapM_ (addMessage "error" . toHtml) errs + _ -> 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||] + delField uid = do + cID <- encrypt uid :: WidgetT UniWorX IO CryptoUUIDUser + toWidget [hamlet||] + 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 SShowR + actionUrl = CSheetR tid csh shn SCorrR + -- actionUrl = CSheetR tid csh shn SShowR defaultLayout $ do setTitleI $ MsgSheetCorrectorsTitle tident csh shn $(widgetFile "formPageI18n")