diff --git a/package.yaml b/package.yaml
index e5af6ee7f..71c0af7ef 100644
--- a/package.yaml
+++ b/package.yaml
@@ -227,6 +227,8 @@ library:
- -ddump-splices
- -ddump-to-file
cpp-options: -DDEVELOPMENT
+ ghc-prof-options:
+ - -fprof-auto
else:
ghc-options:
- -O2
@@ -249,7 +251,8 @@ executables:
source-dirs: test
dependencies:
- uniworx
- other-modules: []
+ other-modules:
+ - Database.Fill
when:
- condition: flag(library-only)
buildable: false
diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs
index 64afdc7ef..59bb82141 100644
--- a/src/Handler/Utils/DateTime.hs
+++ b/src/Handler/Utils/DateTime.hs
@@ -1,6 +1,7 @@
module Handler.Utils.DateTime
( utcToLocalTime, utcToZonedTime
, localTimeToUTC, TZ.LocalToUTCResult(..)
+ , toTimeOfDay
, toMidnight, beforeMidnight, toMidday, toMorning
, formatDiffDays
, formatTime'
@@ -44,19 +45,22 @@ localTimeToUTC = TZ.localTimeToUTCFull appTZ
-- | Local midnight of given day
toMidnight :: Day -> UTCTime
-toMidnight d = localTimeToUTCTZ appTZ $ LocalTime d midnight
+toMidnight = toTimeOfDay 0 0 0
--- | Local midnight of given day
+-- | Local midday of given day
toMidday :: Day -> UTCTime
-toMidday d = localTimeToUTCTZ appTZ $ LocalTime d midday
+toMidday = toTimeOfDay 12 0 0
-- | One second before the end of day
beforeMidnight :: Day -> UTCTime
-beforeMidnight d = localTimeToUTCTZ appTZ $ LocalTime d $ TimeOfDay 23 59 59
+beforeMidnight = toTimeOfDay 23 59 59
-- | 6am in the morning
toMorning :: Day -> UTCTime
-toMorning d = localTimeToUTCTZ appTZ $ LocalTime d $ TimeOfDay 6 0 0
+toMorning = toTimeOfDay 6 0 0
+
+toTimeOfDay :: Int -> Int -> Pico -> Day -> UTCTime
+toTimeOfDay todHour todMin todSec d = localTimeToUTCTZ appTZ $ LocalTime d TimeOfDay{..}
class FormatTime t => HasLocalTime t where
diff --git a/test/Database.hs b/test/Database.hs
index 976bf95b1..8644d0df7 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -1,7 +1,7 @@
module Database
( main
- , fillDb
, truncateDb
+ , module Database.Fill
) where
import "uniworx" Import hiding (Option(..))
@@ -16,18 +16,17 @@ import System.Console.GetOpt
import System.Exit (exitWith, ExitCode(..))
import System.IO (hPutStrLn)
-import qualified Data.ByteString as BS
-
-import qualified Data.Set as Set
-
import Database.Persist.Sql.Raw.QQ
+import Database.Fill (fillDb)
+
data DBAction = DBClear
| DBTruncate
| DBMigrate
| DBFill
+
argsDescr :: [OptDescr DBAction]
argsDescr =
[ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user"
@@ -66,743 +65,3 @@ truncateDb = do
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
- , examExamOccurrenceMapping = 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
- , examGradingMode = ExamGradingGrades
- , 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
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
new file mode 100644
index 000000000..928f92b18
--- /dev/null
+++ b/test/Database/Fill.hs
@@ -0,0 +1,976 @@
+module Database.Fill
+ ( fillDb
+ ) where
+
+import "uniworx" Import hiding (Option(..), currentYear)
+
+import qualified Data.ByteString as BS
+
+import qualified Data.Set as Set
+
+import Data.Time.Calendar.OrdinalDate
+import Data.Time.Calendar.WeekDate
+
+import Control.Applicative (ZipList(..))
+
+import Handler.Utils.DateTime
+
+import System.Random.Shuffle (shuffleM)
+
+import qualified Data.CaseInsensitive as CI
+
+
+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
+
+ (currentYear, currentMonth, _) = toGregorian $ utctDay now
+ currentTerm
+ | 4 <= currentMonth
+ , currentMonth <= 9
+ = TermIdentifier currentYear Summer
+ | otherwise
+ = TermIdentifier (pred currentYear) Winter
+ nextTerm = succ currentTerm
+ prevTerm = pred currentTerm
+ prevPrevTerm = pred prevTerm
+
+ seasonTerm next wSeason
+ | wSeason == season currentTerm
+ , next = currentTerm
+ | wSeason == season currentTerm
+ = prevPrevTerm
+ | next
+ = nextTerm
+ | otherwise
+ = prevTerm
+
+ termTime :: Bool -- ^ Next term?
+ -> Season
+ -> Integer
+ -> Bool -- ^ Relative to end of semester?
+ -> WeekDay
+ -> (Day -> UTCTime)
+ -> UTCTime
+ termTime next gSeason weekOffset fromEnd day = ($ utctDay)
+ where
+ utctDay = fromWeekDate wYear wWeek $ fromEnum day
+ (wYear, wWeek, _) = toWeekDate . addDays (7 * weekOffset) $ fromGregorian gYear rMonth rDay
+ gYear = year $ seasonTerm next gSeason
+ (rMonth, rDay)
+ | Winter <- gSeason
+ , True <- fromEnd
+ = (03, 31)
+ | Winter <- gSeason
+ , False <- fromEnd
+ = (10, 01)
+ | True <- fromEnd
+ = (09, 30)
+ | otherwise
+ = (04, 01)
+
+ 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
+ }
+
+ let
+ firstNames = [ "James", "John", "Robert", "Michael"
+ , "William", "David", "Mary", "Richard"
+ , "Joseph", "Thomas", "Charles", "Daniel"
+ , "Matthew", "Patricia", "Jennifer", "Linda"
+ , "Elizabeth", "Barbara", "Anthony", "Donald"
+ , "Mark", "Paul", "Steven", "Andrew"
+ , "Kenneth", "Joshua", "George", "Kevin"
+ , "Brian", "Edward", "Susan", "Ronald"
+ ]
+ surnames = [ "Smith", "Johnson", "Williams", "Brown"
+ , "Jones", "Miller", "Davis", "Garcia"
+ , "Rodriguez", "Wilson", "Martinez", "Anderson"
+ , "Taylor", "Thomas", "Hernandez", "Moore"
+ , "Martin", "Jackson", "Thompson", "White"
+ , "Lopez", "Lee", "Gonzalez", "Harris"
+ , "Clark", "Lewis", "Robinson", "Walker"
+ , "Perez", "Hall", "Young", "Allen"
+ ]
+ toMatrikel :: [Int] -> [Text]
+ toMatrikel ns
+ | (cs, rest) <- splitAt 8 ns
+ , length cs == 8
+ = foldMap tshow cs : toMatrikel rest
+ | otherwise
+ = []
+ manyUser (userFirstName, userSurname) (Just -> userMatrikelnummer) = User
+ { userIdent
+ , userAuthentication = AuthLDAP
+ , userLastAuthentication = Nothing
+ , userTokensIssuedAfter = Nothing
+ , userMatrikelnummer
+ , userEmail = userIdent
+ , userDisplayEmail = userIdent
+ , userDisplayName = [st|#{userFirstName} #{userSurname}|]
+ , userSurname
+ , userFirstName
+ , userTitle = Nothing
+ , userMaxFavourites = userDefaultMaxFavourites
+ , userMaxFavouriteTerms = userDefaultMaxFavourites
+ , userTheme = userDefaultTheme
+ , userDateTimeFormat = userDefaultDateTimeFormat
+ , userDateFormat = userDefaultDateFormat
+ , userTimeFormat = userDefaultTimeFormat
+ , userDownloadFiles = userDefaultDownloadFiles
+ , userWarningDays = userDefaultWarningDays
+ , userLanguages = Nothing
+ , userNotificationSettings = def
+ , userCreated = now
+ , userLastLdapSynchronisation = Nothing
+ , userCsvOptions = def
+ , userSex = Nothing
+ , userShowSex = userDefaultShowSex
+ }
+ where
+ userIdent :: IsString t => t
+ userIdent = fromString $ repack [st|#{userFirstName}.#{userSurname}@campus.lmu.de|]
+ matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)
+ manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,) <$> firstNames <*> surnames) <*> ZipList matrikel
+
+ forM_ [prevPrevTerm, prevTerm, currentTerm, nextTerm] $ \term@TermIdentifier{..} -> case season of
+ Summer -> let (wYearStart, wWeekStart, _) = toWeekDate $ fromGregorian year 04 01
+ termLectureStart = fromWeekDate wYearStart (wWeekStart + 2) 1
+ termLectureEnd = fromWeekDate wYearStart (wWeekStart + 16) 5
+ in void . repsert (TermKey term) $ Term
+ { termName = term
+ , termStart = fromGregorian year 04 01
+ , termEnd = fromGregorian year 09 30
+ , termHolidays = []
+ , termLectureStart
+ , termLectureEnd
+ , termActive = term >= currentTerm
+ }
+ Winter -> let (wYearStart, wWeekStart, _) = toWeekDate $ fromGregorian year 10 01
+ termLectureStart = fromWeekDate wYearStart (wWeekStart + 2) 1
+ (fromIntegral -> wYearOffset, wWeekEnd) = (wWeekStart + 18) `divMod` bool 53 54 longYear
+ termLectureEnd = fromWeekDate (wYearStart + wYearOffset) (bool id succ (wYearOffset /= 0) wWeekEnd) 5
+ longYear = case toWeekDate $ fromOrdinalDate wYearStart 365 of
+ (_, 53, _) -> True
+ _other -> False
+ in void . repsert (TermKey term) $ Term
+ { termName = term
+ , termStart = fromGregorian year 10 01
+ , termEnd = fromGregorian (succ year) 03 31
+ , termHolidays = []
+ , termLectureStart
+ , termLectureEnd
+ , termActive = term >= currentTerm
+ }
+ 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
+ void . insert' $ UserFunction gkleen ifi SchoolAllocation
+ 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 $ seasonTerm True Summer
+ , courseSchool = ifi
+ , courseCapacity = Just 20
+ , courseRegisterFrom = Just $ termTime True Summer (-2) False Monday toMidnight
+ , courseRegisterTo = Just $ termTime True Summer 0 True Sunday beforeMidnight
+ , 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
+ { sheetCourse = ffp
+ , sheetName = "Adhoc-Gruppen"
+ , sheetDescription = Nothing
+ , sheetType = NotGraded
+ , sheetGrouping = Arbitrary 3
+ , sheetMarkingText = Nothing
+ , sheetVisibleFrom = Just $ termTime True Summer 0 False Monday toMidnight
+ , sheetActiveFrom = Just $ termTime True Summer 1 False Monday toMidnight
+ , sheetActiveTo = Just $ termTime True Summer 2 False Sunday beforeMidnight
+ , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing
+ , sheetHintFrom = Nothing
+ , sheetSolutionFrom = Nothing
+ , sheetAutoDistribute = False
+ }
+ insert_ $ SheetEdit gkleen now adhoc
+ feste <- insert Sheet
+ { sheetCourse = ffp
+ , sheetName = "Feste Gruppen"
+ , sheetDescription = Nothing
+ , sheetType = NotGraded
+ , sheetGrouping = RegisteredGroups
+ , sheetMarkingText = Nothing
+ , sheetVisibleFrom = Just $ termTime True Summer 1 False Monday toMidnight
+ , sheetActiveFrom = Just $ termTime True Summer 2 False Monday toMidnight
+ , sheetActiveTo = Just $ termTime True Summer 3 False Sunday beforeMidnight
+ , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing
+ , sheetHintFrom = Nothing
+ , sheetSolutionFrom = Nothing
+ , sheetAutoDistribute = False
+ }
+ insert_ $ SheetEdit gkleen now feste
+ keine <- insert Sheet
+ { sheetCourse = ffp
+ , sheetName = "Keine Gruppen"
+ , sheetDescription = Nothing
+ , sheetType = NotGraded
+ , sheetGrouping = NoGroups
+ , sheetMarkingText = Nothing
+ , sheetVisibleFrom = Just $ termTime True Summer 2 False Monday toMidnight
+ , sheetActiveFrom = Just $ termTime True Summer 3 False Monday toMidnight
+ , sheetActiveTo = Just $ termTime True Summer 4 False Sunday beforeMidnight
+ , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing
+ , sheetHintFrom = Nothing
+ , sheetSolutionFrom = Nothing
+ , sheetAutoDistribute = 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
+ , examExamOccurrenceMapping = Nothing
+ , examVisibleFrom = Just $ termTime True Summer (-4) True Monday toMidnight
+ , examRegisterFrom = Just $ termTime True Summer (-4) True Monday toMidnight
+ , examRegisterTo = Just $ termTime True Summer 1 True Sunday beforeMidnight
+ , examDeregisterUntil = Just $ termTime True Summer 2 True Wednesday beforeMidnight
+ , examPublishOccurrenceAssignments = Just $ termTime True Summer 3 True Monday toMidnight
+ , examStart = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 10 0 0)
+ , examEnd = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 12 0 0)
+ , examFinished = Just $ termTime True Summer 3 True Wednesday (toTimeOfDay 22 0 0)
+ , examClosed = Nothing
+ , examPublicStatistics = True
+ , examGradingMode = ExamGradingGrades
+ , 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 $ seasonTerm False Winter
+ , courseSchool = ifi
+ , courseCapacity = Just 20
+ , courseRegisterFrom = Just $ termTime False Winter (-4) False Monday toMidnight
+ , 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 $ seasonTerm True Summer
+ , courseSchool = ifi
+ , courseCapacity = Just 20
+ , courseRegisterFrom = Just $ termTime True Summer 0 False Monday toMidnight
+ , courseRegisterTo = Just $ termTime True Summer (-2) True Sunday beforeMidnight
+ , 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 $ seasonTerm True Winter
+ , 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 $ seasonTerm True Summer
+ , courseSchool = ifi
+ , courseCapacity = Just 50
+ , courseRegisterFrom = Just $ termTime True Summer (-2) False Monday toMidnight
+ , 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 $ termTime True Summer 0 False Monday toMidnight
+ , sheetActiveFrom = Just $ termTime True Summer 1 False Monday toMidnight
+ , sheetActiveTo = Just $ termTime True Summer 2 False Sunday beforeMidnight
+ , 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 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 $ termTime True Summer 1 False Monday toMidnight
+ , sheetActiveFrom = Just $ termTime True Summer 2 False Monday toMidnight
+ , sheetActiveTo = Just $ termTime True Summer 3 False Sunday beforeMidnight
+ , 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 $ termTime True Summer 2 False Monday toMidnight
+ , sheetActiveFrom = Just $ termTime True Summer 3 False Monday toMidnight
+ , sheetActiveTo = Just $ termTime True Summer 4 False Sunday beforeMidnight
+ , 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 $ termTime True Summer 3 False Monday toMidnight
+ , sheetActiveFrom = Just $ termTime True Summer 4 False Monday toMidnight
+ , sheetActiveTo = Just $ termTime True Summer 5 False Sunday beforeMidnight
+ , 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 $ termTime True Summer 0 False Monday toMidnight
+ , 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 $ termTime True Summer 0 False Monday toMidnight
+ , 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 $ seasonTerm False Winter
+ , 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
+
+ testMsg <- insert $ SystemMessage (Just now) Nothing False Success "de" "System-Nachrichten werden angezeigt" Nothing
+ void . insert $ SystemMessageTranslation testMsg "en" "System messages may be translated" 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 $ seasonTerm True Summer
+ , 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 $ termTime True Summer 1 False Monday toMidnight
+ }
+ insert_ $ AllocationCourse funAlloc pmo 100
+ insert_ $ AllocationCourse funAlloc ffp 2
+
+ void $ insertFile "H10-2.hs" -- unreferenced
+
+ -- -- betriebssysteme
+ bs <- insert' Course
+ { courseName = "Betriebssystem"
+ , courseDescription = Nothing
+ , courseLinkExternal = Nothing
+ , courseShorthand = "BS"
+ , courseTerm = TermKey $ seasonTerm False Winter
+ , courseSchool = ifi
+ , courseCapacity = Just 50
+ , courseRegisterFrom = Nothing
+ , courseRegisterTo = Nothing
+ , courseDeregisterUntil = Nothing
+ , courseRegisterSecret = Nothing
+ , courseMaterialFree = False
+ , courseApplicationsRequired = False
+ , courseApplicationsInstructions = Nothing
+ , courseApplicationsText = False
+ , courseApplicationsFiles = NoUpload
+ , courseApplicationsRatingsVisible = False
+ }
+ insert_ $ CourseEdit gkleen now bs
+ void . insert' $ Lecturer gkleen bs CourseLecturer
+ void . insertMany $ do
+ uid <- manyUsers
+ return $ CourseParticipant bs uid now Nothing Nothing
+ forM_ [1..5] $ \shNr -> do
+ shId <- insert Sheet
+ { sheetCourse = bs
+ , sheetName = CI.mk [st|Blatt #{tshow shNr}|]
+ , sheetDescription = Nothing
+ , sheetType = Normal $ PassPoints 12 6
+ , sheetGrouping = Arbitrary 3
+ , sheetMarkingText = Nothing
+ , sheetVisibleFrom = Just $ termTime False Winter shNr False Monday toMidnight
+ , sheetActiveFrom = Just $ termTime False Winter (succ shNr) False Monday toMidnight
+ , sheetActiveTo = Just $ termTime False Winter (succ shNr) False Sunday beforeMidnight
+ , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing
+ , sheetHintFrom = Nothing
+ , sheetSolutionFrom = Nothing
+ , sheetAutoDistribute = False
+ }
+ manyUsers' <- shuffleM manyUsers
+ groupSizes <- getRandomRs (1, 3)
+ let groups = go groupSizes manyUsers'
+ where go [] _ = []
+ go (s:ss) us
+ | (grp, rest) <- splitAt s us
+ , length grp == s
+ = grp : go ss rest
+ | otherwise
+ = pure us
+ forM_ groups $ \grpUsers-> case grpUsers of
+ pUid : _ -> do
+ sub <- insert Submission
+ { submissionSheet = shId
+ , submissionRatingPoints = Nothing
+ , submissionRatingComment = Nothing
+ , submissionRatingBy = Nothing
+ , submissionRatingAssigned = Nothing
+ , submissionRatingTime = Nothing
+ }
+ forM_ grpUsers $ void . insert . flip SubmissionUser sub
+ void . insert $ SubmissionEdit pUid now sub
+ _other -> return ()