module Database.Fill ( fillDb ) where import "uniworx" Import hiding (Option(..), currentYear) import Handler.Utils.Form (SheetGrading'(..), SheetType'(..), SheetGroup'(..)) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as Text -- import Data.Text.IO (hPutStrLn) import qualified Data.Set as Set import qualified Data.Map as Map import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate 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 import Crypto.Random (getRandomBytes) import Data.List (genericLength) testdataDir :: FilePath testdataDir = "testdata" insertFile :: ( HasFileReference fRef, PersistRecordBackend fRef SqlBackend ) => FileReferenceResidual fRef -> FilePath -> DB (Key fRef) insertFile residual fileTitle = do fileContent <- liftIO . fmap Just . BS.readFile $ testdataDir fileTitle fileModified <- liftIO getCurrentTime sinkFile' File{..} residual >>= insert fillDb :: DB () fillDb = do AppSettings{ appUserDefaults = UserDefaultConf{..} } <- getsYesod $ view appSettings now <- liftIO getCurrentTime let insert' :: (PersistRecordBackend r (YesodPersistBackend UniWorX), AtLeastOneUniqueKey r) => r -> YesodDB UniWorX (Key r) insert' = fmap (either entityKey id) . insertBy (currentYear, currentMonth, _) = toGregorian $ utctDay now currentTerm | 4 <= currentMonth , currentMonth <= 9 = TermIdentifier currentYear Summer | otherwise = TermIdentifier (pred currentYear) Winter nextTerm = succ currentTerm prevTerm = pred currentTerm prevPrevTerm = pred prevTerm seasonTerm next wSeason | wSeason == season currentTerm , next = currentTerm | wSeason == season currentTerm = prevPrevTerm | next = nextTerm | otherwise = prevTerm termTime :: Bool -- ^ Next term? -> Season -> Rational -> Bool -- ^ Relative to end of semester? -> WeekDay -> (Day -> UTCTime) -> UTCTime termTime next gSeason weekOffset fromEnd day = ($ utctDay) where utctDay = fromWeekDate wYear wWeek $ fromEnum day (wYear, wWeek, _) = toWeekDate . addDays (round $ 7 * weekOffset) $ fromGregorian gYear rMonth rDay gYear = year $ seasonTerm next gSeason (rMonth, rDay) | Winter <- gSeason , True <- fromEnd = (03, 31) | Winter <- gSeason , False <- fromEnd = (10, 01) | True <- fromEnd = (09, 30) | otherwise = (04, 01) gkleen <- insert User { userIdent = "G.Kleen@campus.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Just now , userTokensIssuedAfter = Just now , userMatrikelnummer = Nothing , userEmail = "G.Kleen@campus.lmu.de" , userDisplayEmail = "gregor.kleen@ifi.lmu.de" , userDisplayName = "Gregor Kleen" , userSurname = "Kleen" , userFirstName = "Gregor Julius Arthur" , userTitle = Nothing , userMaxFavourites = 6 , userMaxFavouriteTerms = 1 , userTheme = ThemeDefault , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Just $ Languages ["en"] , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userCsvOptions = def { csvFormat = csvPreset # CsvPresetRFC } , userSex = Just SexMale , userShowSex = userDefaultShowSex } fhamann <- insert User { userIdent = "felix.hamann@campus.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "felix.hamann@campus.lmu.de" , userDisplayEmail = "felix.hamann@campus.lmu.de" , userDisplayName = "Felix Hamann" , userSurname = "Hamann" , userFirstName = "Felix" , userTitle = Nothing , userMaxFavourites = userDefaultMaxFavourites , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms , userTheme = ThemeDefault , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userCsvOptions = def { csvFormat = csvPreset # CsvPresetExcel } , userSex = Just SexMale , userShowSex = userDefaultShowSex } jost <- insert User { userIdent = "jost@tcs.ifi.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "jost@tcs.ifi.lmu.de" , userDisplayEmail = "jost@tcs.ifi.lmu.de" , userDisplayName = "Steffen Jost" , userSurname = "Jost" , userFirstName = "Steffen" , userTitle = Just "Dr." , userMaxFavourites = 14 , userMaxFavouriteTerms = 4 , userTheme = ThemeMossGreen , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userSex = Just SexMale , userCsvOptions = def , userShowSex = userDefaultShowSex } maxMuster <- insert User { userIdent = "max@campus.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Just now , userTokensIssuedAfter = Nothing , userMatrikelnummer = Just "1299" , userEmail = "max@campus.lmu.de" , userDisplayEmail = "max@max.com" , userDisplayName = "Max Musterstudent" , userSurname = "Musterstudent" , userFirstName = "Max" , userTitle = Nothing , userMaxFavourites = 7 , userTheme = ThemeAberdeenReds , userDateTimeFormat = userDefaultDateTimeFormat , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Just $ Languages ["de"] , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userCsvOptions = def , userSex = Just SexMale , userShowSex = userDefaultShowSex } tinaTester <- insert $ User { userIdent = "tester@campus.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Just "999" , userEmail = "tester@campus.lmu.de" , userDisplayEmail = "tina@tester.example" , userDisplayName = "Tina Tester" , userSurname = "vön Tërrör¿" , userFirstName = "Sabrina" , userTitle = Just "Magister" , userMaxFavourites = 5 , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms , userTheme = ThemeAberdeenReds , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Just $ Languages ["sn"] , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userCsvOptions = def , userSex = Just SexNotApplicable , userShowSex = userDefaultShowSex } svaupel <- insert User { userIdent = "vaupel.sarah@campus.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "vaupel.sarah@campus.lmu.de" , userDisplayEmail = "vaupel.sarah@campus.lmu.de" , userDisplayName = "Sarah Vaupel" , userSurname = "Vaupel" , userFirstName = "Sarah" , userTitle = Nothing , userMaxFavourites = 14 , userMaxFavouriteTerms = 4 , userTheme = ThemeMossGreen , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userCsvOptions = def , userSex = Just SexFemale , userShowSex = userDefaultShowSex } let firstNames = [ "James", "John", "Robert", "Michael" , "William", "David", "Mary", "Richard" , "Joseph", "Thomas", "Charles", "Daniel" , "Matthew", "Patricia", "Jennifer", "Linda" , "Elizabeth", "Barbara", "Anthony", "Donald" , "Mark", "Paul", "Steven", "Andrew" , "Kenneth", "Joshua", "George", "Kevin" , "Brian", "Edward", "Susan", "Ronald" ] surnames = [ "Smith", "Johnson", "Williams", "Brown" , "Jones", "Miller", "Davis", "Garcia" , "Rodriguez", "Wilson", "Martinez", "Anderson" , "Taylor", "Thomas", "Hernandez", "Moore" , "Martin", "Jackson", "Thompson", "White" , "Lopez", "Lee", "Gonzalez", "Harris" , "Clark", "Lewis", "Robinson", "Walker" , "Perez", "Hall", "Young", "Allen" ] middlenames = [ Nothing, Just "Jamesson" ] toMatrikel :: [Int] -> [Text] toMatrikel ns | (cs, rest) <- splitAt 8 ns , length cs == 8 = foldMap tshow cs : toMatrikel rest | otherwise = [] manyUser (firstName, middleName, userSurname) (Just -> userMatrikelnummer) = User { userIdent , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer , userEmail = userIdent , userDisplayEmail = userIdent , userDisplayName = case middleName of Just middleName' -> [st|#{firstName} #{middleName'} #{userSurname}|] Nothing -> [st|#{firstName} #{userSurname}|] , userSurname , userFirstName = maybe id (\m f -> f <> " " <> m) middleName firstName , userTitle = Nothing , userMaxFavourites = userDefaultMaxFavourites , userMaxFavouriteTerms = userDefaultMaxFavourites , userTheme = userDefaultTheme , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userCsvOptions = def , userSex = Nothing , userShowSex = userDefaultShowSex } where userIdent :: IsString t => t 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 <*> middlenames <*> surnames) <*> ZipList matrikel forM_ [prevPrevTerm, prevTerm, currentTerm, nextTerm] $ \term@TermIdentifier{..} -> case season of Summer -> let (wYearStart, wWeekStart, _) = toWeekDate $ fromGregorian year 04 01 termLectureStart = fromWeekDate wYearStart (wWeekStart + 2) 1 termLectureEnd = fromWeekDate wYearStart (wWeekStart + 16) 5 in void . repsert (TermKey term) $ Term { termName = term , termStart = fromGregorian year 04 01 , termEnd = fromGregorian year 09 30 , termHolidays = [] , termLectureStart , termLectureEnd , termActive = term >= currentTerm } Winter -> let (wYearStart, wWeekStart, _) = toWeekDate $ fromGregorian year 10 01 termLectureStart = fromWeekDate wYearStart (wWeekStart + 2) 1 (fromIntegral -> wYearOffset, wWeekEnd) = (wWeekStart + 18) `divMod` bool 53 54 longYear termLectureEnd = fromWeekDate (wYearStart + wYearOffset) (bool id succ (wYearOffset /= 0) wWeekEnd) 5 longYear = case toWeekDate $ fromOrdinalDate wYearStart 365 of (_, 53, _) -> True _other -> False in void . repsert (TermKey term) $ Term { termName = term , termStart = fromGregorian year 10 01 , termEnd = fromGregorian (succ year) 03 31 , termHolidays = [] , termLectureStart , termLectureEnd , termActive = term >= currentTerm } ifi <- insert' $ School "Institut für Informatik" "IfI" mi <- insert' $ School "Institut für Mathematik" "MI" void . insert' $ UserFunction gkleen ifi SchoolAdmin void . insert' $ UserFunction gkleen mi SchoolAdmin void . insert' $ UserFunction fhamann ifi SchoolAdmin void . insert' $ UserFunction jost ifi SchoolAdmin void . insert' $ UserFunction jost mi SchoolAdmin void . insert' $ UserFunction svaupel ifi SchoolAdmin void . insert' $ UserFunction svaupel mi SchoolAdmin void . insert' $ UserFunction gkleen ifi SchoolLecturer void . insert' $ UserFunction fhamann ifi SchoolLecturer void . insert' $ UserFunction jost ifi SchoolLecturer void . insert' $ UserFunction svaupel ifi SchoolLecturer void . insert' $ UserFunction gkleen ifi SchoolAllocation for_ [gkleen, fhamann, jost, maxMuster, svaupel] $ \uid -> void . insert' $ UserSchool uid ifi False for_ [gkleen, tinaTester] $ \uid -> void . insert' $ UserSchool uid mi False let sdBsc = StudyDegreeKey' 82 sdMst = StudyDegreeKey' 88 sdLAR = StudyDegreeKey' 33 sdLAG = StudyDegreeKey' 35 repsert sdBsc $ StudyDegree 82 (Just "BSc") (Just "Bachelor" ) repsert sdMst $ StudyDegree 88 (Just "MSc") (Just "Master" ) repsert sdLAR $ StudyDegree 33 (Just "LAR") Nothing -- intentionally left unknown repsert sdLAG $ StudyDegree 35 Nothing Nothing -- intentionally left unknown let sdInf = StudyTermsKey' 79 sdMath = StudyTermsKey' 105 sdMedi = StudyTermsKey' 121 sdPhys = StudyTermsKey' 128 sdBioI1 = StudyTermsKey' 221 sdBioI2 = StudyTermsKey' 228 sdBiol = StudyTermsKey' 26 sdChem1 = StudyTermsKey' 61 sdChem2 = StudyTermsKey' 113 sdBWL = StudyTermsKey' 21 sdDeut = StudyTermsKey' 103 repsert sdInf $ StudyTerms 79 (Just "Inf") (Just "Informatikk") Nothing Nothing repsert sdMath $ StudyTerms 105 (Just "Math" ) (Just "Mathematik") Nothing Nothing repsert sdMedi $ StudyTerms 121 Nothing (Just "Fehler hier") Nothing Nothing repsert sdPhys $ StudyTerms 128 Nothing Nothing Nothing Nothing -- intentionally left unknown repsert sdBioI1 $ StudyTerms 221 Nothing Nothing Nothing Nothing -- intentionally left unknown repsert sdBioI2 $ StudyTerms 228 Nothing Nothing Nothing Nothing -- intentionally left unknown repsert sdBiol $ StudyTerms 26 Nothing Nothing Nothing Nothing -- intentionally left unknown repsert sdChem1 $ StudyTerms 61 Nothing Nothing Nothing Nothing -- intentionally left unknown repsert sdChem2 $ StudyTerms 113 Nothing Nothing Nothing Nothing -- intentionally left unknown repsert sdBWL $ StudyTerms 21 Nothing Nothing Nothing Nothing -- intentionally left unknown repsert sdDeut $ StudyTerms 103 Nothing Nothing Nothing Nothing -- intentionally left unknown incidence1 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence1 221 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence1 221 "Mathematik" void . insert $ StudyTermNameCandidate incidence1 105 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence1 105 "Mathematik" incidence2 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence2 221 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence2 221 "Chemie" void . insert $ StudyTermNameCandidate incidence2 61 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence2 61 "Chemie" incidence3 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence3 113 "Chemie" incidence4 <- liftIO getRandom -- ambiguous incidence void . insert $ StudyTermNameCandidate incidence4 221 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence4 221 "Chemie" void . insert $ StudyTermNameCandidate incidence4 221 "Biologie" void . insert $ StudyTermNameCandidate incidence4 61 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence4 61 "Chemie" void . insert $ StudyTermNameCandidate incidence4 61 "Biologie" void . insert $ StudyTermNameCandidate incidence4 61 "Chemie" void . insert $ StudyTermNameCandidate incidence4 26 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence4 26 "Chemie" void . insert $ StudyTermNameCandidate incidence4 26 "Biologie" incidence5 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence5 228 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence5 228 "Physik" void . insert $ StudyTermNameCandidate incidence5 128 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence5 128 "Physik" incidence6 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence6 228 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence6 228 "Physik" void . insert $ StudyTermNameCandidate incidence6 128 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence6 128 "Physik" incidence7 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence7 228 "Physik" void . insert $ StudyTermNameCandidate incidence7 228 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence7 128 "Physik" void . insert $ StudyTermNameCandidate incidence7 128 "Bioinformatik" incidence8 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence8 128 "Physik" void . insert $ StudyTermNameCandidate incidence8 128 "Medieninformatik" void . insert $ StudyTermNameCandidate incidence8 121 "Physik" void . insert $ StudyTermNameCandidate incidence8 121 "Medieninformatik" incidence9 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence9 79 "Informatik" incidence10 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence10 103 "Deutsch" void . insert $ StudyTermNameCandidate incidence10 103 "Betriebswirtschaftslehre" void . insert $ StudyTermNameCandidate incidence10 21 "Deutsch" void . insert $ StudyTermNameCandidate incidence10 21 "Betriebswirtschaftslehre" incidence11 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence11 221 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence11 221 "Chemie" void . insert $ StudyTermNameCandidate incidence11 221 "Biologie" void . insert $ StudyTermNameCandidate incidence11 61 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence11 61 "Chemie" void . insert $ StudyTermNameCandidate incidence11 61 "Biologie" void . insert $ StudyTermNameCandidate incidence11 26 "Bioinformatik" void . insert $ StudyTermNameCandidate incidence11 26 "Chemie" void . insert $ StudyTermNameCandidate incidence11 26 "Biologie" incidence12 <- liftIO getRandom void . insert $ StudyTermNameCandidate incidence12 103 "Deutsch" void . insert $ StudyTermNameCandidate incidence12 103 "Betriebswirtschaftslehre" void . insert $ StudyTermNameCandidate incidence12 21 "Deutsch" void . insert $ StudyTermNameCandidate incidence12 21 "Betriebswirtschaftslehre" sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here maxMuster sdBsc sdInf Nothing FieldPrimary 2 now True sfMMs <- insert $ StudyFeatures maxMuster sdBsc sdMath Nothing FieldSecondary 2 now True _sfTTa <- insert $ StudyFeatures tinaTester sdBsc sdInf Nothing FieldPrimary 4 now False sfTTb <- insert $ StudyFeatures tinaTester sdLAG sdPhys Nothing FieldPrimary 1 now True sfTTc <- insert $ StudyFeatures tinaTester sdLAR sdMedi Nothing FieldPrimary 7 now True _sfTTd <- insert $ StudyFeatures tinaTester sdMst sdMath Nothing FieldPrimary 3 now True -- FFP let nbrs :: [Int] nbrs = [1,2,3,27,7,1] ffp <- insert' Course { courseName = "Fortgeschrittene Funktionale Programmierung" , courseDescription = Just [shamlet|

It is fun!

Come to where the functional is!

Functional programming can be done in Haskell!

This is not a joke, this is serious!

Consider some numbers
    $forall n <- nbrs
  • Number #{n} |] , courseLinkExternal = Nothing , courseShorthand = "FFP" , courseTerm = TermKey $ seasonTerm True Summer , courseSchool = ifi , courseCapacity = Just 20 , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Just $ termTime True Summer (-2) False Monday toMidnight , courseRegisterTo = Just $ termTime True Summer 0 True Sunday beforeMidnight , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = True } insert_ $ CourseEdit jost now ffp void . insert $ DegreeCourse ffp sdBsc sdInf void . insert $ DegreeCourse ffp sdMst sdInf -- void . insert $ Lecturer jost ffp CourseLecturer void . insert $ Lecturer gkleen ffp CourseAssistant adhoc <- insert Sheet { sheetCourse = ffp , sheetName = "Adhoc-Gruppen" , sheetDescription = Nothing , sheetType = NotGraded , sheetGrouping = Arbitrary 3 , sheetMarkingText = Nothing , sheetVisibleFrom = Just $ termTime True Summer 0 False Monday toMidnight , sheetActiveFrom = Just $ termTime True Summer 1 False Monday toMidnight , sheetActiveTo = Just $ termTime True Summer 2 False Sunday beforeMidnight , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing , sheetHintFrom = Nothing , sheetSolutionFrom = Nothing , sheetAutoDistribute = False , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True } insert_ $ SheetEdit gkleen now adhoc feste <- insert Sheet { sheetCourse = ffp , sheetName = "Feste Gruppen" , sheetDescription = Nothing , sheetType = NotGraded , sheetGrouping = RegisteredGroups , sheetMarkingText = Nothing , sheetVisibleFrom = Just $ termTime True Summer 1 False Monday toMidnight , sheetActiveFrom = Just $ termTime True Summer 2 False Monday toMidnight , sheetActiveTo = Just $ termTime True Summer 3 False Sunday beforeMidnight , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing , sheetHintFrom = Nothing , sheetSolutionFrom = Nothing , sheetAutoDistribute = False , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True } insert_ $ SheetEdit gkleen now feste keine <- insert Sheet { sheetCourse = ffp , sheetName = "Keine Gruppen" , sheetDescription = Nothing , sheetType = NotGraded , sheetGrouping = NoGroups , sheetMarkingText = Nothing , sheetVisibleFrom = Just $ termTime True Summer 2 False Monday toMidnight , sheetActiveFrom = Just $ termTime True Summer 3 False Monday toMidnight , sheetActiveTo = Just $ termTime True Summer 4 False Sunday beforeMidnight , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing , sheetHintFrom = Nothing , sheetSolutionFrom = Nothing , sheetAutoDistribute = False , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True } insert_ $ SheetEdit gkleen now keine void . insertMany $ map (\(u,sf) -> CourseParticipant ffp u now sf Nothing CourseParticipantActive) [(fhamann , Nothing) ,(maxMuster , Just sfMMs) ,(tinaTester, Just sfTTc) ] examFFP <- insert' $ Exam { examCourse = ffp , examName = "Klausur" , examGradingRule = Nothing , examBonusRule = Nothing , examOccurrenceRule = ExamRoomManual , examExamOccurrenceMapping = Nothing , examVisibleFrom = Just $ termTime True Summer (-4) True Monday toMidnight , examRegisterFrom = Just $ termTime True Summer (-4) True Monday toMidnight , examRegisterTo = Just $ termTime True Summer 1 True Sunday beforeMidnight , examDeregisterUntil = Just $ termTime True Summer 2 True Wednesday beforeMidnight , examPublishOccurrenceAssignments = Just $ termTime True Summer 3 True Monday toMidnight , examStart = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 10 0 0) , examEnd = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 12 0 0) , examFinished = Just $ termTime True Summer 3 True Wednesday (toTimeOfDay 22 0 0) , examClosed = Nothing , examPublicStatistics = True , examGradingMode = ExamGradingGrades , examDescription = Nothing } void . insertMany $ map (\u -> ExamRegistration examFFP u Nothing now) [ fhamann , maxMuster , tinaTester ] -- EIP eip <- insert' Course { courseName = "Einführung in die Programmierung" , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "EIP" , courseTerm = TermKey $ seasonTerm False Winter , courseSchool = ifi , courseCapacity = Just 20 , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Just $ termTime False Winter (-4) False Monday toMidnight , courseRegisterTo = Nothing , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = False } insert_ $ CourseEdit fhamann now eip void . insert' $ DegreeCourse eip sdBsc sdInf void . insert' $ Lecturer fhamann eip CourseLecturer -- interaction design ixd <- insert' Course { courseName = "Interaction Design (User Experience Design I & II)" , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "IXD" , courseTerm = TermKey $ seasonTerm True Summer , courseSchool = ifi , courseCapacity = Just 20 , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Just $ termTime True Summer 0 False Monday toMidnight , courseRegisterTo = Just $ termTime True Summer (-2) True Sunday beforeMidnight , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = False } insert_ $ CourseEdit fhamann now ixd void . insert' $ DegreeCourse ixd sdBsc sdInf void . insert' $ Lecturer fhamann ixd CourseAssistant -- concept development ux3 <- insert' Course { courseName = "Concept Development (User Experience Design III)" , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "UX3" , courseTerm = TermKey $ seasonTerm True Winter , courseSchool = ifi , courseCapacity = Just 30 , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Nothing , courseRegisterTo = Nothing , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = False } insert_ $ CourseEdit fhamann now ux3 void . insert' $ DegreeCourse ux3 sdBsc sdInf void . insert' $ Lecturer fhamann ux3 CourseAssistant -- promo pmo <- insert' Course { courseName = "Programmierung und Modellierung" , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "ProMo" , courseTerm = TermKey $ seasonTerm True Summer , courseSchool = ifi , courseCapacity = Just 50 , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Just $ termTime True Summer (-2) False Monday toMidnight , courseRegisterTo = Nothing , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = False } insert_ $ CourseEdit jost now pmo void . insert $ DegreeCourse pmo sdBsc sdInf void . insert $ Lecturer jost pmo CourseAssistant void . insertMany $ map (\(u,sf) -> CourseParticipant pmo u now sf Nothing CourseParticipantActive) [(fhamann , Nothing) ,(maxMuster , Just sfMMp) ,(tinaTester, Just sfTTb) ] let shTypes = NotGraded : [ shType g | g <- shGradings, shType <- [ Normal, Bonus, Informational ] ] where shGradings = [ Points 6, PassPoints 3 6, PassBinary, PassAlways ] shGroupings = [ Arbitrary 3, RegisteredGroups, NoGroups ] shSubModes = do corrector <- universeF [ SubmissionMode corrector Nothing , SubmissionMode corrector $ Just NoUpload , SubmissionMode corrector $ Just UploadSpecific { specificFiles = impureNonNull $ Set.fromList [ UploadSpecificFile "Aufgabe 1" "exercise_2.1.hs" False Nothing , UploadSpecificFile "Aufgabe 2" "exercise_2.2.hs" False Nothing , UploadSpecificFile "Erklärung der Eigenständigkeit" "erklärung.txt" True (Just 42) ] } ] ++ [ SubmissionMode corrector $ Just UploadAny{..} | unpackZips <- universeF , extensionRestriction <- [ Nothing, Just . impureNonNull $ Set.fromList ["pdf", "txt", "jpeg", "hs"] ] ] sheetCombinations = ((,,) <$> shTypes <*> shGroupings <*> shSubModes) forM_ (zip [0..] sheetCombinations) $ \(shNr, (sheetType, sheetGrouping, sheetSubmissionMode)) -> do MsgRenderer mr <- getMsgRenderer let sheetSubmissionModeDescr | Just userMode <- sheetSubmissionMode ^? _submissionModeUser . _Just = let extra = catMaybes [ guardOn (fromMaybe False $ userMode ^? _unpackZips) $ mr MsgAutoUnzip , guardOn (maybe False (is _Just) $ userMode ^? _extensionRestriction) $ mr MsgUploadModeExtensionRestriction ] in mr (classifySubmissionMode sheetSubmissionMode) <> " (" <> Text.intercalate ", " (mr (classifyUploadMode userMode) : extra) <> ")" | Just userMode <- sheetSubmissionMode ^? _submissionModeUser . _Just = mr (classifySubmissionMode sheetSubmissionMode) <> " (" <> mr (classifyUploadMode userMode) <> ")" | otherwise = mr (classifySubmissionMode sheetSubmissionMode) sheetGroupingDescr = case sheetGrouping of Arbitrary{} -> mr Arbitrary' RegisteredGroups -> mr RegisteredGroups' NoGroups -> mr NoGroups' sheetTypeDescr | Just g <- sheetType ^? _grading = let sheetGrading' = case g of Points{} -> Points' PassPoints{} -> PassPoints' PassBinary{} -> PassBinary' PassAlways{} -> PassAlways' in mr sheetType' <> " (" <> mr sheetGrading' <> ")" | otherwise = mr sheetType' where sheetType' = case sheetType of NotGraded -> NotGraded' Normal{} -> Normal' Bonus{} -> Bonus' Informational{} -> Informational' prog = 14 * (shNr % genericLength sheetCombinations) -- liftIO . hPutStrLn stderr $ Text.intercalate ", " [sheetTypeDescr, sheetGroupingDescr, sheetSubmissionModeDescr] -- liftIO . hPutStrLn stderr $ tshow (sheetType, sheetGrouping, sheetSubmissionMode) shId <- insert Sheet { sheetCourse = pmo , sheetName = CI.mk $ tshow shNr <> ": " <> Text.intercalate ", " [sheetTypeDescr, sheetGroupingDescr, sheetSubmissionModeDescr] , sheetDescription = Nothing , sheetType, sheetGrouping, sheetSubmissionMode , sheetMarkingText = Nothing , sheetVisibleFrom = Just $ termTime True Summer prog False Monday toMidnight , sheetActiveFrom = Just $ termTime True Summer (prog + 1) False Monday toMidnight , sheetActiveTo = Just $ termTime True Summer (prog + 2) False Sunday beforeMidnight , sheetHintFrom = Just $ termTime True Summer (prog + 1) False Sunday beforeMidnight , sheetSolutionFrom = Just $ termTime True Summer (prog + 2) False Sunday beforeMidnight , sheetAutoDistribute = True , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True } void . insert $ SheetEdit jost now shId when (submissionModeCorrector sheetSubmissionMode) $ 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 $ insertFile (SheetFileResidual shId SheetHint) "H10-2.hs" void $ insertFile (SheetFileResidual shId SheetSolution) "H10-3.hs" void $ insertFile (SheetFileResidual shId SheetExercise) "ProMo_Uebung10.pdf" forM_ [fhamann, maxMuster, tinaTester] $ \uid -> do subId <- insert $ Submission { submissionSheet = shId , submissionRatingPoints = Nothing , submissionRatingComment = Nothing , submissionRatingBy = Nothing , submissionRatingAssigned = Nothing , submissionRatingTime = Nothing } void . insert $ SubmissionEdit (Just uid) now subId void . insert $ SubmissionUser uid subId void $ insertFile (SubmissionFileResidual subId False False) "AbgabeH10-1.hs" tut1 <- insert Tutorial { tutorialName = "Di08" , tutorialCourse = pmo , tutorialType = "Tutorium" , tutorialCapacity = Just 30 , tutorialRoom = Just "Hilbert-Raum" , tutorialTime = Occurrences { occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 08 15 00) (TimeOfDay 10 00 00) , occurrencesExceptions = Set.empty } , tutorialRegGroup = Just "tutorium" , tutorialRegisterFrom = Just $ termTime True Summer 0 False Monday toMidnight , tutorialRegisterTo = Nothing , tutorialDeregisterUntil = Nothing , tutorialLastChanged = now , tutorialTutorControlled = True } void . insert $ Tutor tut1 gkleen void . insert $ TutorialParticipant tut1 fhamann tut2 <- insert Tutorial { tutorialName = "Di10" , tutorialCourse = pmo , tutorialType = "Tutorium" , tutorialCapacity = Just 30 , tutorialRoom = Just "Hilbert-Raum" , tutorialTime = Occurrences { occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 10 15 00) (TimeOfDay 12 00 00) , occurrencesExceptions = Set.empty } , tutorialRegGroup = Just "tutorium" , tutorialRegisterFrom = Just $ termTime True Summer 0 False Monday toMidnight , tutorialRegisterTo = Nothing , tutorialDeregisterUntil = Nothing , tutorialLastChanged = now , tutorialTutorControlled = False } void . insert $ Tutor tut2 gkleen -- datenbanksysteme dbs <- insert' Course { courseName = "Datenbanksysteme" , courseDescription = Just "Datenbanken banken Daten damit die Daten nicht wanken. Die Datenschützer danken!" , courseLinkExternal = Nothing , courseShorthand = "DBS" , courseTerm = TermKey $ seasonTerm False Winter , courseSchool = ifi , courseCapacity = Just 50 , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Nothing , courseRegisterTo = Nothing , courseDeregisterUntil = Nothing , courseRegisterSecret = Just "dbs" , courseMaterialFree = False , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = False } insert_ $ CourseEdit gkleen now dbs void . insert' $ DegreeCourse dbs sdBsc sdInf void . insert' $ DegreeCourse dbs sdBsc sdMath void . insert' $ Lecturer gkleen dbs CourseLecturer void . insert' $ Lecturer jost dbs CourseAssistant testMsg <- insert SystemMessage { systemMessageNewsOnly = False , systemMessageFrom = Just now , systemMessageTo = Nothing , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Success , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten werden angezeigt" , systemMessageSummary = Nothing , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } void . insert $ SystemMessageTranslation testMsg "en" "System messages may be translated" Nothing void $ insert SystemMessage { systemMessageNewsOnly = False , systemMessageFrom = Just now , systemMessageTo = Nothing , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Info , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten können längeren Inhalt enthalten" , systemMessageSummary = Just "System-Nachricht Zusammenfassung" , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } void $ insert SystemMessage { systemMessageNewsOnly = False , systemMessageFrom = Just now , systemMessageTo = Just now , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Info , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten haben Ablaufdaten" , systemMessageSummary = Nothing , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } void $ insert SystemMessage { systemMessageNewsOnly = False , systemMessageFrom = Nothing , systemMessageTo = Nothing , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Error , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten können Inaktiv sein" , systemMessageSummary = Nothing , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } void $ insert SystemMessage { systemMessageNewsOnly = True , systemMessageFrom = Just now , systemMessageTo = Nothing , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Error , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten können nur auf \"Aktuelles\" angezeigt werden" , systemMessageSummary = Nothing , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } aSeedFunc <- liftIO $ getRandomBytes 40 funAlloc <- insert' Allocation { allocationName = "Funktionale Zentralanmeldung" , allocationShorthand = "fun" , allocationTerm = TermKey $ seasonTerm True Summer , allocationSchool = ifi , allocationDescription = Nothing , allocationStaffDescription = Nothing , allocationStaffRegisterFrom = Just now , allocationStaffRegisterTo = Just $ 300 `addUTCTime` now , allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now , allocationStaffAllocationTo = Just $ 900 `addUTCTime` now , allocationRegisterFrom = Just $ 300 `addUTCTime` now , allocationRegisterTo = Just $ 600 `addUTCTime` now , allocationRegisterByStaffFrom = Nothing , allocationRegisterByStaffTo = Nothing , allocationRegisterByCourse = Nothing , allocationOverrideDeregister = Just $ termTime True Summer 1 False Monday toMidnight , allocationMatchingSeed = aSeedFunc } insert_ $ AllocationCourse funAlloc pmo 100 insert_ $ AllocationCourse funAlloc ffp 2 void . insertMany $ map (\(u, pState) -> CourseParticipant ffp u now Nothing (Just funAlloc) pState) [ (svaupel, CourseParticipantInactive False) , (jost, CourseParticipantActive) ] -- void $ insertFile "H10-2.hs" -- unreferenced -- -- betriebssysteme bs <- insert' Course { courseName = "Betriebssystem" , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "BS" , courseTerm = TermKey $ seasonTerm False Winter , courseSchool = ifi , courseCapacity = Just 50 , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Nothing , courseRegisterTo = Nothing , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = False , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = False } insert_ $ CourseEdit gkleen now bs void . insert' $ Lecturer gkleen bs CourseLecturer void . insertMany $ do uid <- take 1024 manyUsers return $ CourseParticipant bs uid now Nothing Nothing CourseParticipantActive forM_ [1..14] $ \shNr -> do shId <- insert Sheet { sheetCourse = bs , sheetName = CI.mk [st|Blatt #{tshow shNr}|] , sheetDescription = Nothing , sheetType = Normal $ PassPoints 12 6 , sheetGrouping = Arbitrary 3 , sheetMarkingText = Nothing , sheetVisibleFrom = Just $ termTime False Winter (fromInteger shNr) False Monday toMidnight , sheetActiveFrom = Just $ termTime False Winter (fromInteger $ succ shNr) False Monday toMidnight , sheetActiveTo = Just $ termTime False Winter (fromInteger $ succ shNr) False Sunday beforeMidnight , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing , sheetHintFrom = Nothing , sheetSolutionFrom = Nothing , sheetAutoDistribute = False , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True } manyUsers' <- shuffleM $ take 1024 manyUsers groupSizes <- getRandomRs (1, 3) let groups = go groupSizes manyUsers' where go [] _ = [] go (s:ss) us | (grp, rest) <- splitAt s us , length grp == s = grp : go ss rest | otherwise = pure us forM_ groups $ \grpUsers-> case grpUsers of pUid : _ -> do sub <- insert Submission { submissionSheet = shId , submissionRatingPoints = Nothing , submissionRatingComment = Nothing , submissionRatingBy = Nothing , submissionRatingAssigned = Nothing , submissionRatingTime = Nothing } forM_ grpUsers $ void . insert . flip SubmissionUser sub void . insert $ SubmissionEdit (Just pUid) now sub _other -> return () forM_ ([1..100] :: [Int]) $ \n -> do csh <- pack . take 3 <$> getRandomRs ('A', 'Z') cid <- insert' Course { courseName = CI.mk [st|Test Kurs #{n} (#{csh})|] , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = CI.mk csh , courseTerm = TermKey $ seasonTerm False Winter , courseSchool = ifi , courseCapacity = Just 50 , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Nothing , courseRegisterTo = Nothing , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = False } insert_ $ CourseEdit gkleen now cid -- void . insert' $ Lecturer gkleen cid CourseLecturer participants <- getRandomR (0, 50) manyUsers' <- shuffleM $ take 1024 manyUsers forM_ (take participants manyUsers') $ \uid -> void . insertUnique $ CourseParticipant cid uid now Nothing Nothing CourseParticipantActive aSeedBig <- liftIO $ getRandomBytes 40 bigAlloc <- insert' Allocation { allocationName = "Große Zentralanmeldung" , allocationShorthand = "big" , allocationTerm = TermKey $ seasonTerm True Summer , allocationSchool = ifi , allocationDescription = Nothing , allocationStaffDescription = Nothing , allocationStaffRegisterFrom = Just now , allocationStaffRegisterTo = Just $ 300 `addUTCTime` now , allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now , allocationStaffAllocationTo = Just $ 900 `addUTCTime` now , allocationRegisterFrom = Just $ 300 `addUTCTime` now , allocationRegisterTo = Just $ 600 `addUTCTime` now , allocationRegisterByStaffFrom = Nothing , allocationRegisterByStaffTo = Nothing , allocationRegisterByCourse = Nothing , allocationOverrideDeregister = Just $ termTime True Summer 1 False Monday toMidnight , allocationMatchingSeed = aSeedBig } bigAllocCourses <- forM ([1..40] :: [Int]) $ \n -> do csh <- ("ZA-" <>) . 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 , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Nothing , courseRegisterTo = Nothing , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = 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