| _{MsgTableCorrector}
| _{MsgTableCorState}
+ |
+ _{MsgConsiderDeficits}
+ ^{messageTooltip =<< messageI Info MsgConsiderDeficitsTip}
| _{MsgCorByTut}
| _{MsgTableCorProportion}
|
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index f619a1044..fa933ab47 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -918,9 +918,9 @@ fillDb = do
forM_ [fhamann, maxMuster, tinaTester] $ \uid -> do
p <- liftIO getRandom
void . insert $ SheetPseudonym shId p uid
- void . insert $ SheetCorrector jost shId (Load (Just True) 0) CorrectorNormal
- void . insert $ SheetCorrector gkleen shId (Load (Just True) 1) CorrectorNormal
- void . insert $ SheetCorrector svaupel shId (Load (Just True) 1) CorrectorNormal
+ void . insert $ SheetCorrector jost shId (Load (Just True) 0 1) CorrectorNormal
+ void . insert $ SheetCorrector gkleen shId (Load (Just True) 1 1) CorrectorNormal
+ void . insert $ SheetCorrector svaupel shId (Load (Just True) 1 1) CorrectorNormal
void $ insertFile (SheetFileResidual shId SheetHint) "H10-2.hs"
void $ insertFile (SheetFileResidual shId SheetSolution) "H10-3.hs"
void $ insertFile (SheetFileResidual shId SheetExercise) "ProMo_Uebung10.pdf"
diff --git a/test/Handler/Utils/SubmissionSpec.hs b/test/Handler/Utils/SubmissionSpec.hs
index ff2c1c22b..8cf5bb3a6 100644
--- a/test/Handler/Utils/SubmissionSpec.hs
+++ b/test/Handler/Utils/SubmissionSpec.hs
@@ -26,7 +26,13 @@ import Database.Persist.Sql (fromSqlKey)
import qualified Database.Esqueleto as E
--- import Data.Maybe (fromJust)
+import Data.Monoid (First(..))
+
+import Utils (guardOn)
+
+import Control.Lens.Extras (is)
+
+import Data.Maybe (fromJust)
userNumber :: TVar Natural
@@ -46,8 +52,8 @@ makeUsers (fromIntegral -> n) = do
return $ zipWith Entity uids users
distributionExample :: SqlPersistM [(Natural, [Maybe Load])] -- ^ Number of submissions and corrector specification
- -> ([Entity Submission] -> [Entity SheetCorrector] -> SqlPersistM ()) -- ^ Setup hook
- -> (Map (Maybe SheetCorrector) (Set SubmissionId) -> Expectation)
+ -> (Natural -> [Entity Submission] -> [Entity SheetCorrector] -> SqlPersistM ()) -- ^ Setup hook
+ -> (Map (Maybe SheetCorrector) (Set (SubmissionId, Maybe Natural)) -> Expectation)
-> YesodExample UniWorX ()
distributionExample mkParameters setupHook cont = do
situations <- runDB $ do
@@ -88,11 +94,18 @@ distributionExample mkParameters setupHook cont = do
return (sid, (submissions, sheetCorrectors'))
- mapM_ (uncurry setupHook) $ map snd situations
+ mapM_ (\(n, (subs, corrs)) -> setupHook n subs corrs) . zip [1..] $ map snd situations
- return situations
+ situations' <- forM situations $ \(sid, (submissions, sheetCorrectors)) -> (sid, ) <$> do
+ submissions' <- mapM (fmap fromJust . getEntity . entityKey) submissions
+ sheetCorrectors' <- mapM (fmap fromJust . getEntity . entityKey) sheetCorrectors
+ return (submissions', sheetCorrectors')
- let subIds = concatMap (\(_, (subs, _)) -> map entityKey subs) situations
+ return situations'
+
+ let
+ subIds :: [SubmissionId]
+ subIds = concatMap (\(_, (subs, _)) -> mapMaybe (\(Entity subId Submission{..}) -> guardOn (is _Nothing submissionRatingBy) subId) subs) situations
results <- runHandler . Yesod.runDB . mapM (\sid -> assignSubmissions sid Nothing) $ map fst situations
@@ -104,15 +117,16 @@ distributionExample mkParameters setupHook cont = do
cont . Map.fromListWith mappend $ do
Entity subId Submission{..} <- submissions
let key = listToMaybe . filter (\(Entity _ (SheetCorrector uid _ _ _)) -> Just uid == submissionRatingBy) $ concatMap (\(_, (_, corrs)) -> corrs) situations
- return (entityVal <$> key, Set.singleton subId)
+ sheet = getFirst . foldMap (\(n, (sid, _)) -> First $ guardOn (sid == submissionSheet) n) $ zip [1..] situations
+ return (entityVal <$> key, Set.singleton (subId, sheet))
spec :: Spec
spec = withApp . describe "Submission distribution" $ do
it "is fair" $
distributionExample
- (return [(500, replicate 10 (Just $ Load Nothing 1))])
- (\_ _ -> return ())
+ (return [(500, replicate 10 (Just $ Load Nothing 1 1))])
+ (\_ _ _ -> return ())
(\result -> do
let countResult = Map.map Set.size result
countResult `shouldNotSatisfy` Map.member Nothing
@@ -120,20 +134,20 @@ spec = withApp . describe "Submission distribution" $ do
)
it "follows distribution" $
distributionExample
- (return [(500, replicate 6 (Just $ Load Nothing 1) ++ replicate 2 (Just $ Load Nothing 2))])
- (\_ _ -> return ())
+ (return [(500, replicate 6 (Just $ Load Nothing 1 1) ++ replicate 2 (Just $ Load Nothing 2 1))])
+ (\_ _ _ -> return ())
(\result -> do
let countResult = Map.map Set.size result
countResult `shouldNotSatisfy` Map.member Nothing
- countResult `shouldSatisfy` all (\(Just (SheetCorrector _ _ (Load _ prop) _), subsSet) -> (== 50 * prop) $ fromIntegral subsSet) . Map.toList
+ countResult `shouldSatisfy` all (\(Just (SheetCorrector _ _ (Load _ prop _) _), subsSet) -> (== 50 * prop) $ fromIntegral subsSet) . Map.toList
)
it "follows cumulative distribution over multiple sheets" $ do
ns <- liftIO . replicateM 5 . fmap fromInteger $ getRandomR (0, 100)
let ns' = ns ++ [500 - sum ns]
- loads = replicate 6 (Just $ Load Nothing 1) ++ replicate 2 (Just $ Load Nothing 2)
+ loads = replicate 6 (Just $ Load Nothing 1 1) ++ replicate 2 (Just $ Load Nothing 2 1)
distributionExample
(return [ (n, loads) | n <- ns' ])
- (\_ _ -> return ())
+ (\_ _ _ -> return ())
(\result -> do
let countResult = Map.map Set.size result
countResult' = Map.mapKeysWith (+) (fmap $ \SheetCorrector{..} -> (fromSqlKey sheetCorrectorUser, byProportion sheetCorrectorLoad)) countResult
@@ -144,12 +158,12 @@ spec = withApp . describe "Submission distribution" $ do
let ns = replicate 4 100
loads = do
(onesBefore, onesAfter) <- zip [0,2..6] [6,4..0]
- return $ replicate onesBefore (Just $ Load Nothing 1)
- ++ replicate 2 (Just $ Load Nothing 2)
- ++ replicate onesAfter (Just $ Load Nothing 1)
+ return $ replicate onesBefore (Just $ Load Nothing 1 1)
+ ++ replicate 2 (Just $ Load Nothing 2 1)
+ ++ replicate onesAfter (Just $ Load Nothing 1 1)
distributionExample
(return $ zip ns loads)
- (\_ _ -> return ())
+ (\_ _ _ -> return ())
(\result -> do
let countResult = Map.map Set.size result
countResult' = Map.mapKeysWith (+) (fmap $ \SheetCorrector{..} -> fromSqlKey sheetCorrectorUser) countResult
@@ -159,11 +173,11 @@ spec = withApp . describe "Submission distribution" $ do
it "handles tutorials with proportion" $ do
ns <- liftIO . replicateM 5 . fmap fromInteger $ getRandomR (0, 100)
let ns' = ns ++ [500 - sum ns]
- loads = replicate 6 (Just $ Load (Just True) 1) ++ replicate 2 (Just $ Load (Just True) 2)
+ loads = replicate 6 (Just $ Load (Just True) 1 1) ++ replicate 2 (Just $ Load (Just True) 2 1)
tutSubIds <- liftIO $ newTVarIO Map.empty
distributionExample
(return [ (n, loads) | n <- ns' ])
- (\subs corrs -> do
+ (\_ subs corrs -> do
tutSubmissions <- liftIO $ getRandomR (5,10)
subs' <- liftIO $ shuffleM subs
forM_ (take tutSubmissions subs') $ \(Entity subId Submission{..}) -> do
@@ -192,3 +206,19 @@ spec = withApp . describe "Submission distribution" $ do
-- HUnit.assertEqual ("Submission " <> show (fromSqlKey subId) <> " assigned to multiple correctors") 1 $ Set.size assignedTo
-- HUnit.assertEqual ("Submission " <> show (fromSqlKey subId) <> " assigned to non-tutors (" <> show (Set.map fromSqlKey tutors) <> ")") Set.empty (Set.map fromSqlKey $ assignedTo `Set.difference` tutors)
)
+ it "allows disabling deficit consideration" $
+ distributionExample
+ (return . replicate 2 $ (500, replicate 2 (Just $ Load Nothing 1 0)))
+ (\n subs corrs -> if
+ | n < 2
+ , Entity _ SheetCorrector{ sheetCorrectorUser = corrId } : _ <- corrs
+ -> forM_ subs $ \(Entity subId _) ->
+ update subId [SubmissionRatingBy =. Just corrId]
+ | otherwise -> return ()
+ )
+ (\result -> do
+ let secondResult = Map.map (Set.size . Set.filter (views _2 (== Just 1))) result
+ allEqual [] = True
+ allEqual ((_, c) : xs) = all (\(_, c') -> c == c') xs
+ secondResult `shouldSatisfy` allEqual . Map.toList
+ )
diff --git a/test/Model/TypesSpec.hs b/test/Model/TypesSpec.hs
index a5c011ea5..e1736ce03 100644
--- a/test/Model/TypesSpec.hs
+++ b/test/Model/TypesSpec.hs
@@ -149,6 +149,7 @@ instance Arbitrary Load where
arbitrary = do
byTutorial <- arbitrary
byProportion <- getNonNegative <$> arbitrary
+ byDeficit <- oneof [ pure 0, pure 1, arbitrary ]
return Load{..}
shrink = genericShrink
@@ -523,16 +524,29 @@ spec = do
toPathPiece ExamCloseSeparate `shouldBe` "separate"
toPathPiece (ExamCloseOnFinished False) `shouldBe` "on-finished"
toPathPiece (ExamCloseOnFinished True) `shouldBe` "on-finished-hidden"
+ describe "Load" $
+ it "decodes some examples from json" . example $ do
+ let t str expect = Aeson.eitherDecode str `shouldBe` Right expect
+ t "{}" $ Load Nothing 0 1
+ t "{\"byTutorial\": true, \"byProportion\": {\"numerator\": 0, \"denominator\": 1}}" $ Load (Just True) 0 1
describe "CompactCorrectorLoad" $ do
it "matches expectations" . example $ do
- showCompactCorrectorLoad Load{ byTutorial = Just False, byProportion = 0 } CorrectorNormal `shouldBe` "T"
- showCompactCorrectorLoad Load{ byTutorial = Just True, byProportion = 0 } CorrectorNormal `shouldBe` "(T)"
- showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 1 } CorrectorNormal `shouldBe` "1.0"
- showCompactCorrectorLoad Load{ byTutorial = Just False, byProportion = 1 } CorrectorNormal `shouldBe` "1.0 + T"
- showCompactCorrectorLoad Load{ byTutorial = Just True, byProportion = 1 } CorrectorNormal `shouldBe` "1.0 + (T)"
- showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 0 } CorrectorNormal `shouldBe` ""
- showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 1 } CorrectorMissing `shouldBe` "[1.0]"
- showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 1 } CorrectorExcused `shouldBe` "{1.0}"
+ showCompactCorrectorLoad Load{ byTutorial = Just False, byProportion = 0, byDeficit = 1 } CorrectorNormal `shouldBe` "T"
+ showCompactCorrectorLoad Load{ byTutorial = Just True, byProportion = 0, byDeficit = 1 } CorrectorNormal `shouldBe` "(T)"
+ showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 1, byDeficit = 1 } CorrectorNormal `shouldBe` "1.0"
+ showCompactCorrectorLoad Load{ byTutorial = Just False, byProportion = 1, byDeficit = 1 } CorrectorNormal `shouldBe` "1.0 + T"
+ showCompactCorrectorLoad Load{ byTutorial = Just True, byProportion = 1, byDeficit = 1 } CorrectorNormal `shouldBe` "1.0 + (T)"
+ showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 0, byDeficit = 1 } CorrectorNormal `shouldBe` ""
+ showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 1, byDeficit = 1 } CorrectorMissing `shouldBe` "[1.0]"
+ showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 1, byDeficit = 1 } CorrectorExcused `shouldBe` "{1.0}"
+ showCompactCorrectorLoad Load{ byTutorial = Just False, byProportion = 0, byDeficit = 0 } CorrectorNormal `shouldBe` "T - D"
+ showCompactCorrectorLoad Load{ byTutorial = Just True, byProportion = 0, byDeficit = 0 } CorrectorNormal `shouldBe` "(T) - D"
+ showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 1, byDeficit = 0 } CorrectorNormal `shouldBe` "1.0 - D"
+ showCompactCorrectorLoad Load{ byTutorial = Just False, byProportion = 1, byDeficit = 0 } CorrectorNormal `shouldBe` "1.0 + T - D"
+ showCompactCorrectorLoad Load{ byTutorial = Just True, byProportion = 1, byDeficit = 0 } CorrectorNormal `shouldBe` "1.0 + (T) - D"
+ showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 0, byDeficit = 0 } CorrectorNormal `shouldBe` "-D"
+ showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 1, byDeficit = 0 } CorrectorMissing `shouldBe` "[1.0 - D]"
+ showCompactCorrectorLoad Load{ byTutorial = Nothing, byProportion = 1, byDeficit = 0 } CorrectorExcused `shouldBe` "{1.0 - D}"
termExample :: (TermIdentifier, Text) -> Expectation
termExample (term, encoded) = example $ do
|