807 lines
31 KiB
Haskell
Executable File
807 lines
31 KiB
Haskell
Executable File
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
|
|
, 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")
|
|
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|
|
|
<h2>It is fun!
|
|
<p>Come to where the functional is!
|
|
<section>
|
|
<h3>Functional programming can be done in Haskell!
|
|
<p>This is not a joke, this is serious!
|
|
<section>
|
|
<h3>Consider some numbers
|
|
<ul>
|
|
$forall n <- nbrs
|
|
<li>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 Nothing)
|
|
[(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 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 = 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 = 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
|