Die folgenden Benutzer nehmen nicht an der Zentralvergabe teil, da # ihnen keine zentrale Dringlichkeit zugeordnet wurde: -
Benutzern, die nicht an der Zentralvergabe teilnehmen, werden # diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index c6e2c17ee..26a0399fb 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -5,8 +5,10 @@ module Database.Fill import "uniworx" Import hiding (Option(..), currentYear) import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS import qualified Data.Set as Set +import qualified Data.Map as Map import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate @@ -15,14 +17,21 @@ import Control.Applicative (ZipList(..)) import Handler.Utils.DateTime +import Control.Monad.Random.Class (weighted) import System.Random.Shuffle (shuffleM) import qualified Data.CaseInsensitive as CI +import qualified Data.Csv as Csv + + +testdataDir :: FilePath +testdataDir = "testdata" + insertFile :: FilePath -> DB FileId insertFile fileTitle = do - fileContent <- liftIO . fmap Just . BS.readFile $ "testdata" fileTitle + fileContent <- liftIO . fmap Just . BS.readFile $ testdataDir fileTitle fileModified <- liftIO getCurrentTime insert File{..} @@ -267,6 +276,7 @@ fillDb = do , "Clark", "Lewis", "Robinson", "Walker" , "Perez", "Hall", "Young", "Allen" ] + middlenames = [ Nothing, Just "Jamesson" ] toMatrikel :: [Int] -> [Text] toMatrikel ns | (cs, rest) <- splitAt 8 ns @@ -274,7 +284,7 @@ fillDb = do = foldMap tshow cs : toMatrikel rest | otherwise = [] - manyUser (userFirstName, userSurname) (Just -> userMatrikelnummer) = User + manyUser (firstName, middleName, userSurname) (Just -> userMatrikelnummer) = User { userIdent , userAuthentication = AuthLDAP , userLastAuthentication = Nothing @@ -282,9 +292,11 @@ fillDb = do , userMatrikelnummer , userEmail = userIdent , userDisplayEmail = userIdent - , userDisplayName = [st|#{userFirstName} #{userSurname}|] + , userDisplayName = case middleName of + Just middleName' -> [st|#{firstName} #{middleName'} #{userSurname}|] + Nothing -> [st|#{firstName} #{userSurname}|] , userSurname - , userFirstName + , userFirstName = maybe id (\m f -> f <> " " <> m) middleName firstName , userTitle = Nothing , userMaxFavourites = userDefaultMaxFavourites , userMaxFavouriteTerms = userDefaultMaxFavourites @@ -304,9 +316,11 @@ fillDb = do } where userIdent :: IsString t => t - userIdent = fromString $ repack [st|#{userFirstName}.#{userSurname}@campus.lmu.de|] + userIdent = fromString $ case middleName of + Just middleName' -> repack [st|#{firstName}.#{middleName'}.#{userSurname}@example.invalid|] + Nothing -> repack [st|#{firstName}.#{userSurname}@example.invalid|] matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int) - manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,) <$> firstNames <*> surnames) <*> ZipList matrikel + manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel forM_ [prevPrevTerm, prevTerm, currentTerm, nextTerm] $ \term@TermIdentifier{..} -> case season of Summer -> let (wYearStart, wWeekStart, _) = toWeekDate $ fromGregorian year 04 01 @@ -933,7 +947,7 @@ fillDb = do insert_ $ CourseEdit gkleen now bs void . insert' $ Lecturer gkleen bs CourseLecturer void . insertMany $ do - uid <- manyUsers + uid <- take 1024 manyUsers return $ CourseParticipant bs uid now Nothing Nothing forM_ [1..14] $ \shNr -> do shId <- insert Sheet @@ -951,7 +965,7 @@ fillDb = do , sheetSolutionFrom = Nothing , sheetAutoDistribute = False } - manyUsers' <- shuffleM manyUsers + manyUsers' <- shuffleM $ take 1024 manyUsers groupSizes <- getRandomRs (1, 3) let groups = go groupSizes manyUsers' where go [] _ = [] @@ -998,9 +1012,116 @@ fillDb = do , courseApplicationsRatingsVisible = False } insert_ $ CourseEdit gkleen now cid - void . insert' $ Lecturer gkleen cid CourseLecturer + -- void . insert' $ Lecturer gkleen cid CourseLecturer participants <- getRandomR (0, 50) - manyUsers' <- shuffleM manyUsers + manyUsers' <- shuffleM $ take 1024 manyUsers forM_ (take participants manyUsers') $ \uid -> void . insert $ CourseParticipant cid uid now Nothing Nothing + + bigAlloc <- insert' Allocation + { allocationName = "Große Zentralanmeldung" + , allocationShorthand = "big" + , allocationTerm = TermKey $ seasonTerm True Summer + , allocationSchool = ifi + , allocationDescription = Nothing + , allocationStaffDescription = Nothing + , allocationStaffRegisterFrom = Nothing + , allocationStaffRegisterTo = Nothing + , allocationStaffAllocationFrom = Nothing + , allocationStaffAllocationTo = Nothing + , allocationRegisterFrom = Nothing + , allocationRegisterTo = Just now + , allocationRegisterByStaffFrom = Nothing + , allocationRegisterByStaffTo = Nothing + , allocationRegisterByCourse = Nothing + , allocationOverrideDeregister = Just $ termTime True Summer 1 False Monday toMidnight + } + bigAllocCourses <- forM ([1..40] :: [Int]) $ \n -> do + csh <- pack . take 3 <$> getRandomRs ('A', 'Z') + + cap <- getRandomR (10,50) + + minCap <- round . (* fromIntegral cap) <$> getRandomR (0, 0.5 :: Double) + + cid <- insert' Course + { courseName = CI.mk [st|Zentralanmeldungskurs #{n} (#{csh})|] + , courseDescription = Nothing + , courseLinkExternal = Nothing + , courseShorthand = CI.mk csh + , courseTerm = TermKey $ seasonTerm False Winter + , courseSchool = ifi + , courseCapacity = Just cap + , courseRegisterFrom = Nothing + , courseRegisterTo = Nothing + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Nothing + , courseMaterialFree = True + , courseApplicationsRequired = False + , courseApplicationsInstructions = Nothing + , courseApplicationsText = False + , courseApplicationsFiles = NoUpload + , courseApplicationsRatingsVisible = False + } + insert_ $ CourseEdit gkleen now cid + insert_ $ AllocationCourse bigAlloc cid minCap + -- void . insert' $ Lecturer gkleen cid CourseLecturer + return cid + + forM_ manyUsers $ \uid -> do + totalCourses <- weighted $ do + n <- [1..10] + return (n, fromIntegral $ (1 - 10) ^ 2 - (1 - n) ^ 2) + + void . insert $ AllocationUser bigAlloc uid (fromIntegral totalCourses) Nothing + + appliedCourses <- weighted $ do + n <- [totalCourses - 2..totalCourses + 5] + return (n, fromIntegral $ (totalCourses + 1 - totalCourses - 5) ^ 2 - (totalCourses + 1 - n) ^ 2) + + appliedCourses' <- take appliedCourses <$> shuffleM bigAllocCourses + + forM_ (zip [0..] appliedCourses') $ \(prio, cid) -> do + rating <- weighted . Map.toList . Map.fromListWith (+) $ do + veto <- universeF :: [Bool] + grade <- universeF :: [ExamGrade] + rated <- universeF + + return ( bool Nothing (Just (veto, grade)) rated + , bool 5 1 veto * bool 5 1 rated + ) + + void $ insert CourseApplication + { courseApplicationCourse = cid + , courseApplicationUser = uid + , courseApplicationField = Nothing + , courseApplicationText = Nothing + , courseApplicationRatingVeto = maybe False (view _1) rating + , courseApplicationRatingPoints = view _2 <$> rating + , courseApplicationRatingComment = Nothing + , courseApplicationAllocation = Just bigAlloc + , courseApplicationAllocationPriority = Just prio + , courseApplicationTime = now + , courseApplicationRatingTime = now <$ rating + } + + numericPriorities <- flip foldMapM manyUsers $ \uid -> do + uRec <- get uid + case uRec of + Just User{ userMatrikelnummer = Just matr } -> do + prios <- replicateM 3 $ getRandomR (0, 300) + return . pure . AllocationPriorityNumericRecord matr . fromList $ sortOn Down prios + _other -> return mempty + + liftIO . LBS.writeFile (testdataDir "bigAlloc_numeric.csv") $ Csv.encode numericPriorities + + ordinalPriorities <- do + manyUsers' <- shuffleM manyUsers + flip foldMapM manyUsers' $ \uid -> do + uRec <- get uid + case uRec of + Just User{ userMatrikelnummer = Just matr } -> + return . pure $ Csv.Only matr + _other -> return mempty + + liftIO . LBS.writeFile (testdataDir "bigAlloc_ordinal.csv") $ Csv.encode ordinalPriorities