chore: better test data
This commit is contained in:
Gregor Kleen
parent
5090cca98b
commit
42089e17a1
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
749
test/Database.hs
749
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|
|
||||
<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 (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
|
||||
|
||||
976
test/Database/Fill.hs
Normal file
976
test/Database/Fill.hs
Normal file
@ -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|
|
||||
<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 $ 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 ()
|
||||
Loading…
Reference in New Issue
Block a user