fradrive/db.hs
2018-07-07 21:35:46 +02:00

251 lines
8.6 KiB
Haskell
Executable File

#!/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