module Database ( main , fillDb , truncateDb ) where import "uniworx" Import hiding (Option(..)) import "uniworx" Application (db, getAppDevSettings) import UnliftIO.Pool (destroyAllResources) import Database.Persist.Postgresql import Control.Monad.Logger import System.Console.GetOpt import System.Exit (exitWith, ExitCode(..)) import System.IO (hPutStrLn, stderr) import System.FilePath (()) import qualified Data.ByteString as BS import Utils.Lens (review, view) import Control.Monad.Random.Class (MonadRandom(..)) import qualified Data.Set as Set import Database.Persist.Sql.Raw.QQ data DBAction = DBClear | DBTruncate | DBMigrate | DBFill argsDescr :: [OptDescr DBAction] argsDescr = [ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user" , Option ['t'] ["truncate"] (NoArg DBTruncate) "Truncate all tables mentioned in the current schema (This cannot be run concurrently with any other activity accessing the database)" , Option ['m'] ["migrate"] (NoArg DBMigrate) "Perform database migration" , Option ['f'] ["fill"] (NoArg DBFill) "Fill database with example data" ] main :: IO () main = do args <- map unpack <$> getArgs case getOpt Permute argsDescr args of (acts@(_:_), [], []) -> forM_ acts $ \case DBClear -> runStderrLoggingT $ do -- We don't use `db` here, since we do /not/ want any migrations to run, yet settings <- liftIO getAppDevSettings withPostgresqlConn (pgConnStr $ appDatabaseConf settings) . runSqlConn $ do [executeQQ|drop owned by current_user|] :: ReaderT SqlBackend _ () DBTruncate -> db $ do foundation <- getYesod liftIO . destroyAllResources $ appConnPool foundation truncateDb DBMigrate -> db $ return () DBFill -> db $ fillDb (_, _, errs) -> do forM_ errs $ hPutStrLn stderr hPutStrLn stderr $ usageInfo "uniworxdb" argsDescr exitWith $ ExitFailure 2 truncateDb :: MonadIO m => ReaderT SqlBackend m () truncateDb = do tables <- map unSingle <$> [sqlQQ|SELECT table_name FROM information_schema.tables WHERE table_schema = 'public'|] sqlBackend <- ask let escapedTables = map (connEscapeName sqlBackend . DBName) $ filter (not . (`elem` protected)) tables 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) => 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 , userTheme = ThemeDefault , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userMailLanguages = MailLanguages ["en"] , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing } 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 , userTheme = ThemeDefault , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userMailLanguages = MailLanguages ["de"] , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing } 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 , userTheme = ThemeMossGreen , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userMailLanguages = MailLanguages ["de"] , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing } 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 , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userMailLanguages = MailLanguages ["de"] , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing } 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 , userTheme = ThemeAberdeenReds , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userMailLanguages = MailLanguages ["de"] , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing } 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 , userTheme = ThemeMossGreen , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userMailLanguages = MailLanguages ["de"] , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing } 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") repsert sdMath $ StudyTerms 105 (Just "Math" ) (Just "Mathematik") repsert sdMedi $ StudyTerms 121 Nothing (Just "Fehler hier") repsert sdPhys $ StudyTerms 128 Nothing Nothing -- intentionally left unknown repsert sdBioI1 $ StudyTerms 221 Nothing Nothing -- intentionally left unknown repsert sdBioI2 $ StudyTerms 228 Nothing Nothing -- intentionally left unknown repsert sdBiol $ StudyTerms 26 Nothing Nothing -- intentionally left unknown repsert sdChem1 $ StudyTerms 61 Nothing Nothing -- intentionally left unknown repsert sdChem2 $ StudyTerms 113 Nothing Nothing -- intentionally left unknown repsert sdBWL $ StudyTerms 21 Nothing Nothing -- intentionally left unknown repsert sdDeut $ StudyTerms 103 Nothing Nothing -- intentionally left unknown incidence1 <- liftIO getRandom void . insert $ StudyTermCandidate incidence1 221 "Bioinformatik" void . insert $ StudyTermCandidate incidence1 221 "Mathematik" void . insert $ StudyTermCandidate incidence1 105 "Bioinformatik" void . insert $ StudyTermCandidate incidence1 105 "Mathematik" incidence2 <- liftIO getRandom void . insert $ StudyTermCandidate incidence2 221 "Bioinformatik" void . insert $ StudyTermCandidate incidence2 221 "Chemie" void . insert $ StudyTermCandidate incidence2 61 "Bioinformatik" void . insert $ StudyTermCandidate incidence2 61 "Chemie" incidence3 <- liftIO getRandom void . insert $ StudyTermCandidate incidence3 113 "Chemie" incidence4 <- liftIO getRandom -- ambiguous incidence void . insert $ StudyTermCandidate incidence4 221 "Bioinformatik" void . insert $ StudyTermCandidate incidence4 221 "Chemie" void . insert $ StudyTermCandidate incidence4 221 "Biologie" void . insert $ StudyTermCandidate incidence4 61 "Bioinformatik" void . insert $ StudyTermCandidate incidence4 61 "Chemie" void . insert $ StudyTermCandidate incidence4 61 "Biologie" void . insert $ StudyTermCandidate incidence4 61 "Chemie" void . insert $ StudyTermCandidate incidence4 26 "Bioinformatik" void . insert $ StudyTermCandidate incidence4 26 "Chemie" void . insert $ StudyTermCandidate incidence4 26 "Biologie" incidence5 <- liftIO getRandom void . insert $ StudyTermCandidate incidence5 228 "Bioinformatik" void . insert $ StudyTermCandidate incidence5 228 "Physik" void . insert $ StudyTermCandidate incidence5 128 "Bioinformatik" void . insert $ StudyTermCandidate incidence5 128 "Physik" incidence6 <- liftIO getRandom void . insert $ StudyTermCandidate incidence6 228 "Bioinformatik" void . insert $ StudyTermCandidate incidence6 228 "Physik" void . insert $ StudyTermCandidate incidence6 128 "Bioinformatik" void . insert $ StudyTermCandidate incidence6 128 "Physik" incidence7 <- liftIO getRandom void . insert $ StudyTermCandidate incidence7 228 "Physik" void . insert $ StudyTermCandidate incidence7 228 "Bioinformatik" void . insert $ StudyTermCandidate incidence7 128 "Physik" void . insert $ StudyTermCandidate incidence7 128 "Bioinformatik" incidence8 <- liftIO getRandom void . insert $ StudyTermCandidate incidence8 128 "Physik" void . insert $ StudyTermCandidate incidence8 128 "Medieninformatik" void . insert $ StudyTermCandidate incidence8 121 "Physik" void . insert $ StudyTermCandidate incidence8 121 "Medieninformatik" incidence9 <- liftIO getRandom void . insert $ StudyTermCandidate incidence9 79 "Informatik" incidence10 <- liftIO getRandom void . insert $ StudyTermCandidate incidence10 103 "Deutsch" void . insert $ StudyTermCandidate incidence10 103 "Betriebswirtschaftslehre" void . insert $ StudyTermCandidate incidence10 21 "Deutsch" void . insert $ StudyTermCandidate incidence10 21 "Betriebswirtschaftslehre" incidence11 <- liftIO getRandom void . insert $ StudyTermCandidate incidence11 221 "Bioinformatik" void . insert $ StudyTermCandidate incidence11 221 "Chemie" void . insert $ StudyTermCandidate incidence11 221 "Biologie" void . insert $ StudyTermCandidate incidence11 61 "Bioinformatik" void . insert $ StudyTermCandidate incidence11 61 "Chemie" void . insert $ StudyTermCandidate incidence11 61 "Biologie" void . insert $ StudyTermCandidate incidence11 26 "Bioinformatik" void . insert $ StudyTermCandidate incidence11 26 "Chemie" void . insert $ StudyTermCandidate incidence11 26 "Biologie" incidence12 <- liftIO getRandom void . insert $ StudyTermCandidate incidence12 103 "Deutsch" void . insert $ StudyTermCandidate incidence12 103 "Betriebswirtschaftslehre" void . insert $ StudyTermCandidate incidence12 21 "Deutsch" void . insert $ StudyTermCandidate incidence12 21 "Betriebswirtschaftslehre" sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here maxMuster sdBsc sdInf FieldPrimary 2 now True sfMMs <- insert $ StudyFeatures maxMuster sdBsc sdMath FieldSecondary 2 now True _sfTTa <- insert $ StudyFeatures tinaTester sdBsc sdInf FieldPrimary 4 now False sfTTb <- insert $ StudyFeatures tinaTester sdLAG sdPhys FieldPrimary 1 now True sfTTc <- insert $ StudyFeatures tinaTester sdLAR sdMedi FieldPrimary 7 now True _sfTTd <- insert $ StudyFeatures tinaTester sdMst sdMath 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 now 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 now 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 now 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 False) [(fhamann , Nothing) ,(maxMuster , Just sfMMs) ,(tinaTester, Just sfTTc) ] examFFP <- insert' $ Exam { examCourse = ffp , examName = "Klausur" , examGradingRule = Nothing , examBonusRule = Nothing , examOccurrenceRule = 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 , examShowGrades = True , 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 False) [(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 = now , sheetActiveTo = (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 = now , sheetActiveTo = (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 = now , sheetActiveTo = (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 = now , sheetActiveTo = (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 = "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 } void . insert $ Tutor tut1 gkleen void . insert $ TutorialParticipant tut1 fhamann tut2 <- insert Tutorial { tutorialName = "Di10" , tutorialCourse = pmo , tutorialType = "Tutorium" , tutorialCapacity = Just 30 , tutorialRoom = "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 } 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