From 42089e17a17734b5086f0e2f46f0716be020c7a5 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 3 Mar 2020 09:11:54 +0100 Subject: [PATCH] chore: better test data --- package.yaml | 5 +- src/Handler/Utils/DateTime.hs | 14 +- test/Database.hs | 749 +------------------------- test/Database/Fill.hs | 976 ++++++++++++++++++++++++++++++++++ 4 files changed, 993 insertions(+), 751 deletions(-) create mode 100644 test/Database/Fill.hs diff --git a/package.yaml b/package.yaml index e5af6ee7f..71c0af7ef 100644 --- a/package.yaml +++ b/package.yaml @@ -227,6 +227,8 @@ library: - -ddump-splices - -ddump-to-file cpp-options: -DDEVELOPMENT + ghc-prof-options: + - -fprof-auto else: ghc-options: - -O2 @@ -249,7 +251,8 @@ executables: source-dirs: test dependencies: - uniworx - other-modules: [] + other-modules: + - Database.Fill when: - condition: flag(library-only) buildable: false diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index 64afdc7ef..59bb82141 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -1,6 +1,7 @@ module Handler.Utils.DateTime ( utcToLocalTime, utcToZonedTime , localTimeToUTC, TZ.LocalToUTCResult(..) + , toTimeOfDay , toMidnight, beforeMidnight, toMidday, toMorning , formatDiffDays , formatTime' @@ -44,19 +45,22 @@ localTimeToUTC = TZ.localTimeToUTCFull appTZ -- | Local midnight of given day toMidnight :: Day -> UTCTime -toMidnight d = localTimeToUTCTZ appTZ $ LocalTime d midnight +toMidnight = toTimeOfDay 0 0 0 --- | Local midnight of given day +-- | Local midday of given day toMidday :: Day -> UTCTime -toMidday d = localTimeToUTCTZ appTZ $ LocalTime d midday +toMidday = toTimeOfDay 12 0 0 -- | One second before the end of day beforeMidnight :: Day -> UTCTime -beforeMidnight d = localTimeToUTCTZ appTZ $ LocalTime d $ TimeOfDay 23 59 59 +beforeMidnight = toTimeOfDay 23 59 59 -- | 6am in the morning toMorning :: Day -> UTCTime -toMorning d = localTimeToUTCTZ appTZ $ LocalTime d $ TimeOfDay 6 0 0 +toMorning = toTimeOfDay 6 0 0 + +toTimeOfDay :: Int -> Int -> Pico -> Day -> UTCTime +toTimeOfDay todHour todMin todSec d = localTimeToUTCTZ appTZ $ LocalTime d TimeOfDay{..} class FormatTime t => HasLocalTime t where diff --git a/test/Database.hs b/test/Database.hs index 976bf95b1..8644d0df7 100755 --- a/test/Database.hs +++ b/test/Database.hs @@ -1,7 +1,7 @@ module Database ( main - , fillDb , truncateDb + , module Database.Fill ) where import "uniworx" Import hiding (Option(..)) @@ -16,18 +16,17 @@ import System.Console.GetOpt import System.Exit (exitWith, ExitCode(..)) import System.IO (hPutStrLn) -import qualified Data.ByteString as BS - -import qualified Data.Set as Set - import Database.Persist.Sql.Raw.QQ +import Database.Fill (fillDb) + data DBAction = DBClear | DBTruncate | DBMigrate | DBFill + argsDescr :: [OptDescr DBAction] argsDescr = [ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user" @@ -66,743 +65,3 @@ truncateDb = do query = "TRUNCATE TABLE " ++ intercalate ", " escapedTables ++ " RESTART IDENTITY" protected = ["applied_migration"] rawExecute query [] - -insertFile :: FilePath -> DB FileId -insertFile fileTitle = do - fileContent <- liftIO . fmap Just . BS.readFile $ "testdata" fileTitle - fileModified <- liftIO getCurrentTime - insert File{..} - -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 - summer2017 = TermIdentifier 2017 Summer - winter2017 = TermIdentifier 2017 Winter - summer2018 = TermIdentifier 2018 Summer - 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 = "von Terror" - , 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 - } - void . repsert (TermKey summer2017) $ Term - { termName = summer2017 - , termStart = fromGregorian 2017 04 09 - , termEnd = fromGregorian 2017 07 14 - , termHolidays = [] - , termLectureStart = fromGregorian 2017 04 09 - , termLectureEnd = fromGregorian 2018 07 14 - , termActive = False - } - void . repsert (TermKey winter2017) $ Term - { termName = winter2017 - , termStart = fromGregorian 2017 10 16 - , termEnd = fromGregorian 2018 02 10 - , termHolidays = [fromGregorian 2017 12 24..fromGregorian 2018 01 06] - , termLectureStart = fromGregorian 2017 10 16 - , termLectureEnd = fromGregorian 2018 02 10 - , termActive = True - } - void . repsert (TermKey summer2018) $ Term - { termName = summer2018 - , termStart = fromGregorian 2018 04 09 - , termEnd = fromGregorian 2018 07 14 - , termHolidays = [] - , termLectureStart = fromGregorian 2018 04 09 - , termLectureEnd = fromGregorian 2018 07 14 - , termActive = True - } - 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 - 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 summer2018 - , courseSchool = ifi - , courseCapacity = Just 20 - , courseRegisterFrom = Just now - , courseRegisterTo = Just (nominalDay `addUTCTime` now ) - , courseDeregisterUntil = Nothing - , courseRegisterSecret = Nothing - , courseMaterialFree = True - , courseApplicationsRequired = False - , courseApplicationsInstructions = Nothing - , courseApplicationsText = False - , courseApplicationsFiles = NoUpload - , courseApplicationsRatingsVisible = False - } - 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 ffp "AdHoc-Gruppen" Nothing NotGraded (Arbitrary 3) Nothing Nothing (Just now) (Just now) Nothing Nothing (SubmissionMode False . Just $ UploadAny True Nothing) False - insert_ $ SheetEdit gkleen now adhoc - feste <- insert $ Sheet ffp "Feste Gruppen" Nothing NotGraded RegisteredGroups Nothing Nothing (Just now) (Just now) Nothing Nothing (SubmissionMode False . Just $ UploadAny True Nothing) False - insert_ $ SheetEdit gkleen now feste - keine <- insert $ Sheet ffp "Keine Gruppen" Nothing NotGraded NoGroups Nothing Nothing (Just now) (Just now) Nothing Nothing (SubmissionMode False . Just $ UploadAny True Nothing) False - insert_ $ SheetEdit gkleen now keine - void . insertMany $ map (\(u,sf) -> CourseParticipant ffp u now sf Nothing) - [(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 now - , examRegisterFrom = Just now - , examRegisterTo = Just $ addUTCTime (14 * nominalDay) now - , examDeregisterUntil = Just $ addUTCTime (15 * nominalDay) now - , examPublishOccurrenceAssignments = Just $ addUTCTime (15 * nominalDay) now - , examStart = Just $ addUTCTime (16 * nominalDay) now - , examEnd = Just $ addUTCTime (17 * nominalDay) now - , examFinished = Just $ addUTCTime (21 * nominalDay) now - , 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 summer2017 - , courseSchool = ifi - , courseCapacity = Just 20 - , courseRegisterFrom = Nothing - , courseRegisterTo = Nothing - , courseDeregisterUntil = Nothing - , courseRegisterSecret = Nothing - , courseMaterialFree = True - , courseApplicationsRequired = False - , courseApplicationsInstructions = Nothing - , courseApplicationsText = False - , courseApplicationsFiles = NoUpload - , courseApplicationsRatingsVisible = 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 summer2018 - , courseSchool = ifi - , courseCapacity = Just 20 - , courseRegisterFrom = Just now - , courseRegisterTo = Just (nominalDay `addUTCTime` now ) - , courseDeregisterUntil = Nothing - , courseRegisterSecret = Nothing - , courseMaterialFree = True - , courseApplicationsRequired = False - , courseApplicationsInstructions = Nothing - , courseApplicationsText = False - , courseApplicationsFiles = NoUpload - , courseApplicationsRatingsVisible = 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 winter2017 - , courseSchool = ifi - , courseCapacity = Just 30 - , courseRegisterFrom = Nothing - , courseRegisterTo = Nothing - , courseDeregisterUntil = Nothing - , courseRegisterSecret = Nothing - , courseMaterialFree = True - , courseApplicationsRequired = False - , courseApplicationsInstructions = Nothing - , courseApplicationsText = False - , courseApplicationsFiles = NoUpload - , courseApplicationsRatingsVisible = 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 summer2018 - , courseSchool = ifi - , courseCapacity = Just 50 - , courseRegisterFrom = Just now - , courseRegisterTo = Nothing - , courseDeregisterUntil = Nothing - , courseRegisterSecret = Nothing - , courseMaterialFree = True - , courseApplicationsRequired = False - , courseApplicationsInstructions = Nothing - , courseApplicationsText = False - , courseApplicationsFiles = NoUpload - , courseApplicationsRatingsVisible = 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) - [(fhamann , Nothing) - ,(maxMuster , Just sfMMp) - ,(tinaTester, Just sfTTb) - ] - sh1 <- insert Sheet - { sheetCourse = pmo - , sheetName = "Papierabgabe" - , sheetDescription = Nothing - , sheetType = Normal $ Points 6 - , sheetGrouping = Arbitrary 3 - , sheetMarkingText = Nothing - , sheetVisibleFrom = Just now - , sheetActiveFrom = Just now - , sheetActiveTo = Just $ (14 * nominalDay) `addUTCTime` now - , sheetSubmissionMode = SubmissionMode True Nothing - , sheetHintFrom = Nothing - , sheetSolutionFrom = Nothing - , sheetAutoDistribute = True - } - void . insert $ SheetEdit jost now sh1 - forM_ [fhamann, maxMuster, tinaTester] $ \u -> do - p <- liftIO getRandom - $logDebug (review _PseudonymText p) - void . insert $ SheetPseudonym sh1 p u - void . insert $ SheetCorrector jost sh1 (Load (Just True) 0) CorrectorNormal - void . insert $ SheetCorrector gkleen sh1 (Load (Just True) 1) CorrectorNormal - h102 <- insertFile "H10-2.hs" - h103 <- insertFile "H10-3.hs" - pdf10 <- insertFile "ProMo_Uebung10.pdf" - void . insert $ SheetFile sh1 h102 SheetHint - void . insert $ SheetFile sh1 h103 SheetSolution - void . insert $ SheetFile sh1 pdf10 SheetExercise - -- - sub1 <- insert $ Submission - { submissionSheet = sh1 - , submissionRatingPoints = Nothing - , submissionRatingComment = Nothing - , submissionRatingBy = Just gkleen - , submissionRatingAssigned = Just now - , submissionRatingTime = Nothing - } - void . insert $ SubmissionEdit maxMuster (nominalDay `addUTCTime` now) sub1 - void . insert $ SubmissionUser maxMuster sub1 - sub1fid1 <- insertFile "AbgabeH10-1.hs" - void . insert $ SubmissionFile sub1 sub1fid1 False False - sub2 <- insert $ Submission sh1 Nothing Nothing Nothing Nothing Nothing - void . insert $ SubmissionEdit fhamann now sub2 - void . insert $ SubmissionUser fhamann sub2 - sh2 <- insert Sheet - { sheetCourse = pmo - , sheetName = "Spezifische Abgabe" - , sheetDescription = Nothing - , sheetType = Normal $ Points 6 - , sheetGrouping = Arbitrary 3 - , sheetMarkingText = Nothing - , sheetVisibleFrom = Just now - , sheetActiveFrom = Just now - , sheetActiveTo = Just $ (14 * nominalDay) `addUTCTime` now - , sheetSubmissionMode = SubmissionMode False $ Just UploadSpecific - { specificFiles = impureNonNull $ Set.fromList - [ UploadSpecificFile "Aufgabe 1" "exercise_2.1.hs" False - , UploadSpecificFile "Aufgabe 2" "exercise_2.2.hs" False - , UploadSpecificFile "Erklärung der Eigenständigkeit" "erklärung.txt" True - ] - } - , sheetHintFrom = Nothing - , sheetSolutionFrom = Nothing - , sheetAutoDistribute = True - } - void . insert $ SheetEdit jost now sh2 - sh3 <- insert Sheet - { sheetCourse = pmo - , sheetName = "Dateiendung-eingeschränkte Abgabe" - , sheetDescription = Nothing - , sheetType = Normal $ Points 6 - , sheetGrouping = Arbitrary 3 - , sheetMarkingText = Nothing - , sheetVisibleFrom = Just now - , sheetActiveFrom = Just now - , sheetActiveTo = Just $ (14 * nominalDay) `addUTCTime` now - , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction - , sheetHintFrom = Nothing - , sheetSolutionFrom = Nothing - , sheetAutoDistribute = True - } - void . insert $ SheetEdit jost now sh3 - sh4 <- insert Sheet - { sheetCourse = pmo - , sheetName = "Uneingeschränkte Abgabe, einzelne Datei" - , sheetDescription = Nothing - , sheetType = Normal $ Points 6 - , sheetGrouping = Arbitrary 3 - , sheetMarkingText = Nothing - , sheetVisibleFrom = Just now - , sheetActiveFrom = Just now - , sheetActiveTo = Just $ (14 * nominalDay) `addUTCTime` now - , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny False Nothing - , sheetHintFrom = Nothing - , sheetSolutionFrom = Nothing - , sheetAutoDistribute = True - } - void . insert $ SheetEdit jost now sh4 - 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 now - , 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 now - , 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 summer2018 - , courseSchool = ifi - , courseCapacity = Just 50 - , courseRegisterFrom = Nothing - , courseRegisterTo = Nothing - , courseDeregisterUntil = Nothing - , courseRegisterSecret = Just "dbs" - , courseMaterialFree = False - , courseApplicationsRequired = False - , courseApplicationsInstructions = Nothing - , courseApplicationsText = False - , courseApplicationsFiles = NoUpload - , courseApplicationsRatingsVisible = 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 - - void . insert $ SystemMessage (Just now) Nothing False Success "de" "System-Nachrichten werden angezeigt" Nothing - void . insert $ SystemMessage (Just now) Nothing False Info "de" "System-Nachrichten können längeren Inhalt enthalten" (Just "System-Nachricht Zusammenfassung") - void . insert $ SystemMessage (Just now) (Just now) False Info "de" "System-Nachrichten haben Ablaufdaten" Nothing - void . insert $ SystemMessage Nothing Nothing False Error "de" "System-Nachrichten können Inaktiv sein" Nothing - - - funAlloc <- insert' Allocation - { allocationName = "Funktionale Zentralanmeldung" - , allocationShorthand = "fun" - , allocationTerm = TermKey summer2018 - , allocationSchool = ifi - , allocationDescription = Nothing - , allocationStaffDescription = Nothing - , allocationStaffRegisterFrom = Just now - , allocationStaffRegisterTo = Nothing - , allocationStaffAllocationFrom = Nothing - , allocationStaffAllocationTo = Nothing - , allocationRegisterFrom = Nothing - , allocationRegisterTo = Nothing - , allocationRegisterByStaffFrom = Nothing - , allocationRegisterByStaffTo = Nothing - , allocationRegisterByCourse = Nothing - , allocationOverrideDeregister = Just now - } - insert_ $ AllocationCourse funAlloc pmo 100 - insert_ $ AllocationCourse funAlloc ffp 2 - - void $ insertFile "H10-2.hs" -- unreferenced diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs new file mode 100644 index 000000000..928f92b18 --- /dev/null +++ b/test/Database/Fill.hs @@ -0,0 +1,976 @@ +module Database.Fill + ( fillDb + ) where + +import "uniworx" Import hiding (Option(..), currentYear) + +import qualified Data.ByteString as BS + +import qualified Data.Set as Set + +import Data.Time.Calendar.OrdinalDate +import Data.Time.Calendar.WeekDate + +import Control.Applicative (ZipList(..)) + +import Handler.Utils.DateTime + +import System.Random.Shuffle (shuffleM) + +import qualified Data.CaseInsensitive as CI + + +insertFile :: FilePath -> DB FileId +insertFile fileTitle = do + fileContent <- liftIO . fmap Just . BS.readFile $ "testdata" fileTitle + fileModified <- liftIO getCurrentTime + insert File{..} + +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 + -> Integer + -> 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 (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 = "von Terror" + , 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" + ] + toMatrikel :: [Int] -> [Text] + toMatrikel ns + | (cs, rest) <- splitAt 8 ns + , length cs == 8 + = foldMap tshow cs : toMatrikel rest + | otherwise + = [] + manyUser (userFirstName, userSurname) (Just -> userMatrikelnummer) = User + { userIdent + , userAuthentication = AuthLDAP + , userLastAuthentication = Nothing + , userTokensIssuedAfter = Nothing + , userMatrikelnummer + , userEmail = userIdent + , userDisplayEmail = userIdent + , userDisplayName = [st|#{userFirstName} #{userSurname}|] + , userSurname + , userFirstName + , 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 $ repack [st|#{userFirstName}.#{userSurname}@campus.lmu.de|] + matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int) + manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,) <$> firstNames <*> 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 + 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 + , 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 + } + 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 + } + 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 + } + 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 + } + insert_ $ SheetEdit gkleen now keine + void . insertMany $ map (\(u,sf) -> CourseParticipant ffp u now sf Nothing) + [(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 + , 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 + } + 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 + , 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 + } + 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 + , courseRegisterFrom = Nothing + , courseRegisterTo = Nothing + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Nothing + , courseMaterialFree = True + , courseApplicationsRequired = False + , courseApplicationsInstructions = Nothing + , courseApplicationsText = False + , courseApplicationsFiles = NoUpload + , courseApplicationsRatingsVisible = 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 + , 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 + } + 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) + [(fhamann , Nothing) + ,(maxMuster , Just sfMMp) + ,(tinaTester, Just sfTTb) + ] + sh1 <- insert Sheet + { sheetCourse = pmo + , sheetName = "Papierabgabe" + , sheetDescription = Nothing + , sheetType = Normal $ Points 6 + , 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 True Nothing + , sheetHintFrom = Nothing + , sheetSolutionFrom = Nothing + , sheetAutoDistribute = True + } + void . insert $ SheetEdit jost now sh1 + forM_ [fhamann, maxMuster, tinaTester] $ \u -> do + p <- liftIO getRandom + $logDebug (review _PseudonymText p) + void . insert $ SheetPseudonym sh1 p u + void . insert $ SheetCorrector jost sh1 (Load (Just True) 0) CorrectorNormal + void . insert $ SheetCorrector gkleen sh1 (Load (Just True) 1) CorrectorNormal + h102 <- insertFile "H10-2.hs" + h103 <- insertFile "H10-3.hs" + pdf10 <- insertFile "ProMo_Uebung10.pdf" + void . insert $ SheetFile sh1 h102 SheetHint + void . insert $ SheetFile sh1 h103 SheetSolution + void . insert $ SheetFile sh1 pdf10 SheetExercise + -- + sub1 <- insert $ Submission + { submissionSheet = sh1 + , submissionRatingPoints = Nothing + , submissionRatingComment = Nothing + , submissionRatingBy = Just gkleen + , submissionRatingAssigned = Just now + , submissionRatingTime = Nothing + } + void . insert $ SubmissionEdit maxMuster now sub1 + void . insert $ SubmissionUser maxMuster sub1 + sub1fid1 <- insertFile "AbgabeH10-1.hs" + void . insert $ SubmissionFile sub1 sub1fid1 False False + sub2 <- insert $ Submission sh1 Nothing Nothing Nothing Nothing Nothing + void . insert $ SubmissionEdit fhamann now sub2 + void . insert $ SubmissionUser fhamann sub2 + sh2 <- insert Sheet + { sheetCourse = pmo + , sheetName = "Spezifische Abgabe" + , sheetDescription = Nothing + , sheetType = Normal $ Points 6 + , sheetGrouping = Arbitrary 3 + , 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 UploadSpecific + { specificFiles = impureNonNull $ Set.fromList + [ UploadSpecificFile "Aufgabe 1" "exercise_2.1.hs" False + , UploadSpecificFile "Aufgabe 2" "exercise_2.2.hs" False + , UploadSpecificFile "Erklärung der Eigenständigkeit" "erklärung.txt" True + ] + } + , sheetHintFrom = Nothing + , sheetSolutionFrom = Nothing + , sheetAutoDistribute = True + } + void . insert $ SheetEdit jost now sh2 + sh3 <- insert Sheet + { sheetCourse = pmo + , sheetName = "Dateiendung-eingeschränkte Abgabe" + , sheetDescription = Nothing + , sheetType = Normal $ Points 6 + , sheetGrouping = Arbitrary 3 + , 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 defaultExtensionRestriction + , sheetHintFrom = Nothing + , sheetSolutionFrom = Nothing + , sheetAutoDistribute = True + } + void . insert $ SheetEdit jost now sh3 + sh4 <- insert Sheet + { sheetCourse = pmo + , sheetName = "Uneingeschränkte Abgabe, einzelne Datei" + , sheetDescription = Nothing + , sheetType = Normal $ Points 6 + , sheetGrouping = Arbitrary 3 + , sheetMarkingText = Nothing + , sheetVisibleFrom = Just $ termTime True Summer 3 False Monday toMidnight + , sheetActiveFrom = Just $ termTime True Summer 4 False Monday toMidnight + , sheetActiveTo = Just $ termTime True Summer 5 False Sunday beforeMidnight + , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny False Nothing + , sheetHintFrom = Nothing + , sheetSolutionFrom = Nothing + , sheetAutoDistribute = True + } + void . insert $ SheetEdit jost now sh4 + 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 + , courseRegisterFrom = Nothing + , courseRegisterTo = Nothing + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Just "dbs" + , courseMaterialFree = False + , courseApplicationsRequired = False + , courseApplicationsInstructions = Nothing + , courseApplicationsText = False + , courseApplicationsFiles = NoUpload + , courseApplicationsRatingsVisible = 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 (Just now) Nothing False Success "de" "System-Nachrichten werden angezeigt" Nothing + void . insert $ SystemMessageTranslation testMsg "en" "System messages may be translated" Nothing + void . insert $ SystemMessage (Just now) Nothing False Info "de" "System-Nachrichten können längeren Inhalt enthalten" (Just "System-Nachricht Zusammenfassung") + void . insert $ SystemMessage (Just now) (Just now) False Info "de" "System-Nachrichten haben Ablaufdaten" Nothing + void . insert $ SystemMessage Nothing Nothing False Error "de" "System-Nachrichten können Inaktiv sein" Nothing + + + funAlloc <- insert' Allocation + { allocationName = "Funktionale Zentralanmeldung" + , allocationShorthand = "fun" + , allocationTerm = TermKey $ seasonTerm True Summer + , allocationSchool = ifi + , allocationDescription = Nothing + , allocationStaffDescription = Nothing + , allocationStaffRegisterFrom = Just now + , allocationStaffRegisterTo = Nothing + , allocationStaffAllocationFrom = Nothing + , allocationStaffAllocationTo = Nothing + , allocationRegisterFrom = Nothing + , allocationRegisterTo = Nothing + , allocationRegisterByStaffFrom = Nothing + , allocationRegisterByStaffTo = Nothing + , allocationRegisterByCourse = Nothing + , allocationOverrideDeregister = Just $ termTime True Summer 1 False Monday toMidnight + } + insert_ $ AllocationCourse funAlloc pmo 100 + insert_ $ AllocationCourse funAlloc ffp 2 + + 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 + , courseRegisterFrom = Nothing + , courseRegisterTo = Nothing + , courseDeregisterUntil = Nothing + , courseRegisterSecret = Nothing + , courseMaterialFree = False + , courseApplicationsRequired = False + , courseApplicationsInstructions = Nothing + , courseApplicationsText = False + , courseApplicationsFiles = NoUpload + , courseApplicationsRatingsVisible = False + } + insert_ $ CourseEdit gkleen now bs + void . insert' $ Lecturer gkleen bs CourseLecturer + void . insertMany $ do + uid <- manyUsers + return $ CourseParticipant bs uid now Nothing Nothing + forM_ [1..5] $ \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 shNr False Monday toMidnight + , sheetActiveFrom = Just $ termTime False Winter (succ shNr) False Monday toMidnight + , sheetActiveTo = Just $ termTime False Winter (succ shNr) False Sunday beforeMidnight + , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing + , sheetHintFrom = Nothing + , sheetSolutionFrom = Nothing + , sheetAutoDistribute = False + } + manyUsers' <- shuffleM 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 pUid now sub + _other -> return ()