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..14] $ \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 ()
forM_ ([1..100] :: [Int]) $ \n -> do
csh <- pack . take 3 <$> getRandomRs ('A', 'Z')
cid <- insert' Course
{ courseName = CI.mk [st|Test Kurs #{n} (#{csh})|]
, courseDescription = Nothing
, courseLinkExternal = Nothing
, courseShorthand = CI.mk csh
, courseTerm = TermKey $ seasonTerm False Winter
, courseSchool = ifi
, courseCapacity = Just 50
, courseRegisterFrom = Nothing
, courseRegisterTo = Nothing
, courseDeregisterUntil = Nothing
, courseRegisterSecret = Nothing
, courseMaterialFree = True
, courseApplicationsRequired = False
, courseApplicationsInstructions = Nothing
, courseApplicationsText = False
, courseApplicationsFiles = NoUpload
, courseApplicationsRatingsVisible = False
}
insert_ $ CourseEdit gkleen now cid
void . insert' $ Lecturer gkleen cid CourseLecturer
participants <- getRandomR (0, 50)
manyUsers' <- shuffleM manyUsers
forM_ (take participants manyUsers') $ \uid ->
void . insert $ CourseParticipant cid uid now Nothing Nothing