320 lines
11 KiB
Haskell
Executable File
320 lines
11 KiB
Haskell
Executable File
#!/usr/bin/env stack
|
|
-- stack runghc
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PackageImports #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
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 qualified Data.ByteString as BS
|
|
|
|
import Data.Time
|
|
|
|
|
|
data DBAction = DBClear
|
|
| DBMigrate
|
|
| DBFill
|
|
|
|
argsDescr :: [OptDescr DBAction]
|
|
argsDescr =
|
|
[ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user"
|
|
, 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
|
|
rawExecute "drop owned by current_user;" []
|
|
DBMigrate -> db $ return ()
|
|
DBFill -> db $ fillDb
|
|
(_, _, errs) -> do
|
|
forM_ errs $ hPutStrLn stderr
|
|
hPutStrLn stderr $ usageInfo "db.hs" argsDescr
|
|
exitWith $ ExitFailure 2
|
|
|
|
insertFile :: FilePath -> DB FileId
|
|
insertFile fileTitle = do
|
|
fileContent <- liftIO $ Just <$> BS.readFile ("testdata/" <> fileTitle)
|
|
fileModified <- liftIO getCurrentTime
|
|
insert File{..}
|
|
|
|
fillDb :: DB ()
|
|
fillDb = do
|
|
AppSettings{ appUserDefaults = UserDefaultConf{..}, .. } <- getsYesod 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"
|
|
, userSurname = "Kleen"
|
|
, userMaxFavourites = 6
|
|
, userTheme = ThemeDefault
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
}
|
|
fhamann <- insert User
|
|
{ userPlugin = "LDAP"
|
|
, userIdent = "felix.hamann@campus.lmu.de"
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "felix.hamann@campus.lmu.de"
|
|
, userDisplayName = "Felix Hamann"
|
|
, userSurname = "Hamann"
|
|
, userMaxFavourites = userDefaultMaxFavourites
|
|
, userTheme = ThemeDefault
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
}
|
|
jost <- insert User
|
|
{ userPlugin = "LDAP"
|
|
, userIdent = "jost@tcs.ifi.lmu.de"
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "jost@tcs.ifi.lmu.de"
|
|
, userDisplayName = "Steffen Jost"
|
|
, userSurname = "Jost"
|
|
, userMaxFavourites = 14
|
|
, userTheme = ThemeMossGreen
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
}
|
|
void . insert $ User
|
|
{ userPlugin = "LDAP"
|
|
, userIdent = "max@campus.lmu.de"
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "max@campus.lmu.de"
|
|
, userDisplayName = "Max Musterstudent"
|
|
, userSurname = "Musterstudent"
|
|
, userMaxFavourites = 7
|
|
, userTheme = ThemeAberdeenReds
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
}
|
|
void . insert $ User
|
|
{ userPlugin = "LDAP"
|
|
, userIdent = "tester@campus.lmu.de"
|
|
, userMatrikelnummer = Just "999"
|
|
, userEmail = "tester@campus.lmu.de"
|
|
, userDisplayName = "Tina Tester"
|
|
, userSurname = "von Terror"
|
|
, userMaxFavourites = 5
|
|
, userTheme = ThemeAberdeenReds
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
}
|
|
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 (Upload True)
|
|
insert_ $ SheetEdit gkleen now sheetkey
|
|
sheetkey <- insert $ Sheet ffp "Feste Gruppen" Nothing NotGraded RegisteredGroups Nothing Nothing now now Nothing Nothing (Upload True)
|
|
insert_ $ SheetEdit gkleen now sheetkey
|
|
sheetkey <- insert $ Sheet ffp "Keine Gruppen" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing (Upload True)
|
|
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 summer2018
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 50
|
|
, courseRegisterFrom = Just now
|
|
, courseRegisterTo = Nothing
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = True
|
|
}
|
|
insert_ $ CourseEdit jost now pmo
|
|
void . insert $ DegreeCourse pmo sdBsc sdInf
|
|
void . insert $ Lecturer jost pmo
|
|
sh1 <- insert Sheet
|
|
{ sheetCourse = pmo
|
|
, sheetName = "Blatt 1"
|
|
, sheetDescription = Nothing
|
|
, sheetType = Normal 6
|
|
, sheetGrouping = Arbitrary 3
|
|
, sheetMarkingText = Nothing
|
|
, sheetVisibleFrom = Just now
|
|
, sheetActiveFrom = now
|
|
, sheetActiveTo = (14 * nominalDay) `addUTCTime` now
|
|
, sheetUploadMode = Upload True
|
|
, sheetHintFrom = Nothing
|
|
, sheetSolutionFrom = Nothing
|
|
}
|
|
void . insert $ SheetEdit jost now sh1
|
|
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
|
|
-- 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
|