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), 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 , 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 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