#!/usr/bin/env stack -- stack runghc {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE LambdaCase #-} import "uniworx" Import hiding (Option(..)) import "uniworx" Application (db, getAppDevSettings) import Database.Persist.Postgresql import Database.Persist.Sql import Control.Monad.Logger import System.Console.GetOpt import System.Exit (exitWith, ExitCode(..)) import System.IO (hPutStrLn, stderr) import Data.Time data DBAction = DBClear | DBFill argsDescr :: [OptDescr DBAction] argsDescr = [ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user" , 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 rawExecute "drop owned by current_user;" [] DBFill -> db $ fillDb (_, _, errs) -> do forM_ errs $ hPutStrLn stderr hPutStrLn stderr $ usageInfo "db.hs" argsDescr exitWith $ ExitFailure 2 fillDb :: DB () fillDb = do defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings now <- liftIO getCurrentTime let summer2017 = TermIdentifier 2017 Summer winter2017 = TermIdentifier 2017 Winter summer2018 = TermIdentifier 2018 Summer gkleen <- insert User { userPlugin = "LDAP" , userIdent = "G.Kleen@campus.lmu.de" , userMatrikelnummer = Nothing , userEmail = "G.Kleen@campus.lmu.de" , userDisplayName = "Gregor Kleen" , userMaxFavourites = 6 , userTheme = AberdeenReds } fhamann <- insert User { userPlugin = "LDAP" , userIdent = "felix.hamann@campus.lmu.de" , userMatrikelnummer = Nothing , userEmail = "felix.hamann@campus.lmu.de" , userDisplayName = "Felix Hamann" , userMaxFavourites = defaultFavourites , userTheme = Default } jost <- insert User { userPlugin = "LDAP" , userIdent = "jost@tcs.ifi.lmu.de" , userMatrikelnummer = Nothing , userEmail = "jost@tcs.ifi.lmu.de" , userDisplayName = "Steffen Jost" , userMaxFavourites = 14 , userTheme = MossGreen } void . insert $ User { userPlugin = "LDAP" , userIdent = "max@campus.lmu.de" , userMatrikelnummer = Nothing , userEmail = "max@campus.lmu.de" , userDisplayName = "Max Musterstudent" , userMaxFavourites = 7 , userTheme = AberdeenReds } void . insert $ 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 . insert $ 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 . insert $ 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 $ UserAdmin gkleen ifi void . insert $ UserAdmin gkleen mi void . insert $ UserAdmin fhamann ifi void . insert $ UserAdmin jost ifi void . insert $ UserAdmin jost mi void . insert $ UserLecturer gkleen ifi void . insert $ UserLecturer fhamann ifi void . insert $ UserLecturer jost ifi sdBsc <- insert $ StudyDegree 82 (Just "BSc") (Just "Bachelor" ) sdMst <- insert $ StudyDegree 88 (Just "MSc") (Just "Master" ) sdInf <- insert $ StudyTerms 79 (Just "Inf") (Just "Informatik") sdMath <- insert $ StudyTerms 105 (Just "M" ) (Just "Mathematik") -- FFP ffp <- insert Course { courseName = "Fortgeschrittene Funktionale Programmierung" , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "FFP" , courseTerm = TermKey summer2018 , courseSchool = ifi , courseCapacity = Just 20 , courseRegisterFrom = Just now , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now ) , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True } insert_ $ CourseEdit jost now ffp void . insert $ DegreeCourse ffp sdBsc sdInf void . insert $ DegreeCourse ffp sdMst sdInf void . insert $ Lecturer jost ffp void . insert $ Lecturer gkleen ffp sheetkey <- insert $ Sheet ffp "AdHoc-Gruppen" Nothing NotGraded (Arbitrary 3) Nothing Nothing now now Nothing Nothing insert_ $ SheetEdit gkleen now sheetkey sheetkey <- insert $ Sheet ffp "Feste Gruppen" Nothing NotGraded RegisteredGroups Nothing Nothing now now Nothing Nothing insert_ $ SheetEdit gkleen now sheetkey sheetkey <- insert $ Sheet ffp "Keine Gruppen" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing insert_ $ SheetEdit gkleen now sheetkey -- 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 } insert_ $ CourseEdit fhamann now eip void . insert $ DegreeCourse eip sdBsc sdInf void . insert $ Lecturer fhamann eip -- 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 ((3600 * 24 * 60) `addUTCTime` now ) , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True } insert_ $ CourseEdit fhamann now ixd void . insert $ DegreeCourse ixd sdBsc sdInf void . insert $ Lecturer fhamann ixd -- 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 } insert_ $ CourseEdit fhamann now ux3 void . insert $ DegreeCourse ux3 sdBsc sdInf void . insert $ Lecturer fhamann ux3 -- promo pmo <- insert Course { courseName = "Programmierung und Modellierung" , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "ProMo" , courseTerm = TermKey summer2017 , courseSchool = ifi , courseCapacity = Just 50 , courseRegisterFrom = Nothing , courseRegisterTo = Nothing , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True } insert_ $ CourseEdit jost now pmo void . insert $ DegreeCourse pmo sdBsc sdInf void . insert $ Lecturer jost pmo -- datenbanksysteme dbs <- insert Course { courseName = "Datenbanksysteme" , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "DBS" , courseTerm = TermKey summer2018 , courseSchool = ifi , courseCapacity = Just 50 , courseRegisterFrom = Nothing , courseRegisterTo = Nothing , courseDeregisterUntil = Nothing , courseRegisterSecret = Nothing , courseMaterialFree = True } insert_ $ CourseEdit gkleen now dbs void . insert $ DegreeCourse dbs sdBsc sdInf void . insert $ DegreeCourse dbs sdBsc sdMath void . insert $ Lecturer gkleen dbs void . insert $ Lecturer jost dbs