-- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Steffen Jost ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later module Database.Fill ( fillDb ) where import "uniworx" Import hiding (Option(..), currentYear) import qualified Data.Text.Encoding as TEnc import qualified Yesod.Auth.Util.PasswordStore as PWStore import qualified Data.Set as Set import qualified Data.Map as Map import Utils.Holidays import Control.Applicative (ZipList(..)) import Handler.Utils.DateTime import Handler.Utils.AuthorshipStatement (insertAuthorshipStatement) import qualified Data.CaseInsensitive as CI import Data.List (foldl) import System.Directory (getModificationTime) import System.FilePath.Glob (glob) import Database.Persist.Postgresql {- Needed for File Tests only import qualified Data.Conduit.Combinators as C import Paths_uniworx (getDataFileName) testdataFile :: MonadIO m => FilePath -> m FilePath testdataFile = liftIO . getDataFileName . ("testdata" ) insertFile :: ( HasFileReference fRef, PersistRecordBackend fRef SqlBackend ) => FileReferenceResidual fRef -> FilePath -> DB (Key fRef) insertFile residual fileTitle = do filepath <- testdataFile fileTitle let fileContent = Just $ C.sourceFile filepath fileModified <- liftIO getCurrentTime sinkFile' File{..} residual >>= insert -} 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 addBDays = addBusinessDays Fraport -- holiday area to use n_day n = addBDays n $ utctDay now n_day' n = now { utctDay = n_day n } (currentYear, _currentMonth, _currentDay) = toGregorian $ utctDay now currentTerm = TermIdentifier currentYear nextTerm n = toEnum . (+n) $ fromEnum currentTerm termTime :: TermIdentifier -- ^ Term -> TermDay -- ^ Relative to which day? -> Integer -- ^ Week offset from TermDayStart/End of Term (shuld be negative for TermDayEnd) -> Maybe WeekDay -- ^ Move to weekday -> (Day -> UTCTime) -- ^ Add time to day -> UTCTime termTime gTid gTD weekOffset mbWeekDay = ($ tDay) where gDay = addDays (7* weekOffset) $ guessDay gTid gTD tDay = maybe gDay (`firstDayOfWeekOnAfter` gDay) mbWeekDay 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 , userLdapPrimaryKey = Nothing , userCsvOptions = def { csvFormat = csvPreset # CsvPresetRFC } , userSex = Just SexMale , userBirthday = Nothing , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Just "00000" , userCompanyDepartment = Nothing , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } fhamann <- insert User { userIdent = "felix.hamann@campus.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "noEmailKnown" , 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 , userLdapPrimaryKey = Nothing , userCsvOptions = def { csvFormat = csvPreset # CsvPresetExcel } , userSex = Just SexMale , userShowSex = userDefaultShowSex , userBirthday = Nothing , userMobile = Nothing , userTelephone = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } pwSimple <- do let pw = "123.456" PWHashConf{..} <- getsYesod $ view _appAuthPWHash pwHash <- liftIO $ PWStore.makePasswordWith pwHashAlgorithm pw pwHashStrength return $ AuthPWHash $ TEnc.decodeUtf8 pwHash jost <- insert User { userIdent = "jost@tcs.ifi.lmu.de" -- , userAuthentication = AuthLDAP , userAuthentication = pwSimple , 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 = ThemeSkyLove , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userLdapPrimaryKey = Nothing , userSex = Just SexMale , userBirthday = Just $ n_day $ 35 * (-365) , userCsvOptions = def , userShowSex = userDefaultShowSex , userTelephone = Just "+49 69 690-71706" , userMobile = Just "0173 69 99 646" , userCompanyPersonalNumber = Just "57138" , userCompanyDepartment = Just "AVN-AR2" , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = True , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } 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 , userLdapPrimaryKey = Nothing , userCsvOptions = def , userSex = Just SexMale , userBirthday = Just $ n_day $ 27 * (-365) , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } tinaTester <- insert $ User { userIdent = "tester@campus.lmu.de" , userAuthentication = AuthNoLogin , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Just "999" , userEmail = "tester@campus.lmu.de" , userDisplayEmail = "tina@tester.example" , userDisplayName = "Tina Tester" , userSurname = "vön Tërrör¿" , 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 , userLdapPrimaryKey = Nothing , userCsvOptions = def , userSex = Just SexNotApplicable , userBirthday = Just $ n_day 3 , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Just "12345" , userCompanyDepartment = Nothing , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } 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 , userLdapPrimaryKey = Nothing , userCsvOptions = def , userSex = Just SexFemale , userBirthday = Nothing , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } sbarth <- insert User { userIdent = "Stephan.Barth@campus.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "Stephan.Barth@lmu.de" , userDisplayEmail = "stephan.barth@ifi.lmu.de" , userDisplayName = "Stephan Barth" , userSurname = "Barth" , userFirstName = "Stephan" , userTitle = Nothing , userMaxFavourites = userDefaultMaxFavourites , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms , userTheme = ThemeMossGreen , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userLdapPrimaryKey = Nothing , userCsvOptions = def , userSex = Just SexMale , userBirthday = Nothing , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = False , userExamOfficeGetSynced = False , userExamOfficeGetLabels = True } 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" ] middlenames = [ Nothing, Just "Jamesson" ] toMatrikel :: [Int] -> [Text] toMatrikel ns | (cs, rest) <- splitAt 8 ns , length cs == 8 = foldMap tshow cs : toMatrikel rest | otherwise = [] manyUser (firstName, middleName, userSurname) (Just -> userMatrikelnummer) = User { userIdent , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer , userEmail = userIdent , userDisplayEmail = userIdent , userDisplayName = case middleName of Just middleName' -> [st|#{firstName} #{middleName'} #{userSurname}|] Nothing -> [st|#{firstName} #{userSurname}|] , userSurname , userFirstName = maybe id (\m f -> f <> " " <> m) middleName firstName , userTitle = Nothing , userMaxFavourites = userDefaultMaxFavourites , userMaxFavouriteTerms = userDefaultMaxFavourites , userTheme = ThemeAberdeenReds , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userLdapPrimaryKey = Nothing , userCsvOptions = def , userSex = Nothing , userBirthday = Nothing , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } where userIdent :: IsString t => t userIdent = fromString $ case middleName of Just middleName' -> repack [st|#{firstName}.#{middleName'}.#{userSurname}@example.invalid|] Nothing -> repack [st|#{firstName}.#{userSurname}@example.invalid|] matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int) manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel matUsers <- selectList [UserMatrikelnummer !=. Nothing] [] insertMany_ [UserAvs (AvsPersonId n) uid n | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers] let tmin = -1 tmax = 2 trange = [tmin..tmax] dmin = guessDay (nextTerm tmin) TermDayStart dmax = guessDay (nextTerm tmax) TermDayEnd hdys = foldl (<>) mempty $ [bankHolidaysAreaSet Fraport y | y <- [getYear dmin..getYear dmax]] terms <- forM trange $ \nr -> do let tid = nextTerm nr tk = TermKey tid tStart = guessDay tid TermDayStart tEnd = guessDay tid TermDayEnd term = Term { termName = tid , termStart = tStart , termEnd = tEnd , termHolidays = toList $ Set.filter (\d -> tStart <= d && d <= tEnd) hdys , termLectureStart = guessDay tid TermDayLectureStart , termLectureEnd = guessDay tid TermDayLectureEnd } repsert tk term insert_ $ TermActive tk (toMidnight $ termStart term) (Just . beforeMidnight $ termEnd term) Nothing return tk ifiAuthorshipStatement <- insertAuthorshipStatement I18n { i18nFallback = htmlToStoredMarkup [shamlet| $newline text Erklärung über die eigenständige Bearbeitung

Hiermit erkläre ich, dass ich die vorliegende Abgabe vollständig selbstständig angefertigt habe, bzw. dass bei einer Gruppen-Abgabe nur die bei der Abgabe benannten Personen mitgewirkt haben. Quellen und Hilfsmittel über den Rahmen der Lehrveranstaltung hinaus sind als solche markiert und angegeben. Direkte Zitate sind als solche kenntlich gemacht. Ich bin mir darüber im Klaren, dass Verstöße durch Plagiate oder Zusammenarbeit mit Dritten zum Ausschluss von der Veranstaltung führen. |] , i18nFallbackLang = Just "de-de-formal" , i18nTranslations = Map.singleton "en-eu" $ htmlToStoredMarkup [shamlet| $newline text Statement of Authorship

I hereby declare that the submission is my own unaided work or that in the case of a group submission only the group members configured in Uni2work were involved in the creation of the work. All direct and indirect sources and aids are acknowledged as sources within the work. Direct citations are made apparent as such. I am aware that violations in the form plagiarism or collaboration with third parties will lead to expulsion from the course. |] } fraportAg <- insert' $ Company "Fraport AG" "Fraport" 1 False Nothing fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH" "FraGround" 2 False Nothing -- TODO: better testcases nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" 33 False Nothing ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" 44 False Nothing bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" 5555 False Nothing void . insert' $ UserCompany jost fraportAg True True void . insert' $ UserCompany svaupel nice True False void . insert' $ UserCompany gkleen nice False False void . insert' $ UserCompany gkleen fraGround False True void . insert' $ UserCompany fhamann bpol False False void . insert' $ UserCompany fhamann ffacil True True void . insert' $ UserCompany fhamann nice False False -- void . insert' $ UserSupervisor jost gkleen True -- void . insert' $ UserSupervisor jost svaupel False -- void . insert' $ UserSupervisor jost sbarth False -- void . insert' $ UserSupervisor jost tinaTester True -- void . insert' $ UserSupervisor svaupel gkleen False -- void . insert' $ UserSupervisor svaupel fhamann True -- void . insert' $ UserSupervisor sbarth tinaTester True let supvs = [ UserSupervisor jost gkleen True , UserSupervisor jost svaupel False , UserSupervisor jost sbarth False , UserSupervisor jost tinaTester True , UserSupervisor svaupel gkleen False , UserSupervisor svaupel fhamann True , UserSupervisor sbarth tinaTester True , UserSupervisor gkleen fhamann False ] ++ take 333 [ UserSupervisor fhamann uid False | Entity uid _ <- matUsers ] ++ take 111 [ UserSupervisor gkleen uid False | Entity uid _ <- drop 300 matUsers ] upsertManyWhere supvs [] [] [] -- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok -- insertMany_ supvs -- NOTE: multiple calls like this throw an error! ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional (Just ifiAuthorshipStatement) True SchoolAuthorshipStatementModeRequired (Just ifiAuthorshipStatement) False mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True avn <- insert' $ School "Fahrerausbildung" "FA" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True void . insert' $ UserFunction jost avn SchoolAdmin void . insert' $ UserFunction gkleen ifi SchoolAdmin void . insert' $ UserFunction gkleen mi SchoolAdmin -- void . insert' $ UserFunction fhamann ifi SchoolAdmin -- goto-example for non-admin supervisor 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 -- goto-example for non-admin supervisor void . insert' $ UserFunction jost ifi SchoolLecturer void . insert' $ UserFunction svaupel ifi SchoolLecturer void . insert' $ UserFunction sbarth ifi SchoolLecturer void . insert' $ UserFunction sbarth ifi SchoolExamOffice for_ [gkleen, fhamann, maxMuster, svaupel] $ \uid -> void . insert' $ UserSchool uid ifi False for_ [gkleen, tinaTester] $ \uid -> void . insert' $ UserSchool uid mi False for_ [jost] $ \uid -> void . insert' $ UserSchool uid avn False void . insert' $ UserAvs (AvsPersonId 12345678) jost 87654321 void . insert' $ UserAvs (AvsPersonId 2) svaupel 2 void . insert' $ UserAvs (AvsPersonId 3) gkleen 3 void . insert' $ UserAvs (AvsPersonId 4) sbarth 4 void . insert' $ UserAvs (AvsPersonId 5) fhamann 5 void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77 let f_descr = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|] let r_descr = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|] let l_descr = Just $ htmlToStoredMarkup [shamlet|

für unhabilitierte|] qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True (Just AvsLicenceVorfeld) $ Just "F4466" qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) False (Just AvsLicenceRollfeld) $ Just "R2801" qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True Nothing Nothing void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) (Just $ QualificationBlocked (n_day $ -5) "LMS") True -- TODO: better dates! void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) Nothing True -- TODO: better dates! void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) Nothing True -- TODO: better dates! void . insert' $ QualificationUser gkleen qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20) Nothing True void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8) Nothing False void . insert' $ QualificationUser svaupel qid_f (n_day 1) (n_day $ -1) (n_day $ -2) Nothing True void . insert' $ QualificationUser sbarth qid_f (n_day 400) (n_day $ -40) (n_day $ -1200) Nothing True void . insert' $ QualificationUser tinaTester qid_f (n_day 3) (n_day $ -60) (n_day $ -250) Nothing False void . insert' $ QualificationUser tinaTester qid_r (n_day 3) (n_day $ -60) (n_day $ -250) Nothing False void . insert' $ QualificationUser gkleen qid_r (n_day $ -7) (n_day $ -2) (n_day $ -9) Nothing True void . insert' $ QualificationUser maxMuster qid_r (n_day 1) (n_day $ -1) (n_day $ -2) Nothing False -- void . insert' $ QualificationUser fhamann qid_r (n_day $ -3) (n_day $ -1) (n_day $ -2) Nothing True void . insert' $ QualificationUser svaupel qid_l (n_day 1) (n_day $ -1) (n_day $ -2) Nothing True void . insert' $ QualificationUser gkleen qid_l (n_day 9) (n_day $ -1) (n_day $ -7) Nothing True qidfUsers <- Set.fromAscList . fmap (qualificationUserUser . entityVal) <$> selectList [QualificationUserQualification ==. qid_f] [Asc QualificationUserUser] insertMany_ [QualificationUser uid qid_f (n_day 42) (n_day $ -42) (n_day $ -365) Nothing True | Entity uid _ <- take 200 matUsers, uid `Set.notMember` qidfUsers] void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (n_day (-1)) now void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (n_day (-2)) now void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (n_day (-3)) now void . insert' $ LmsUserlist qid_f (LmsIdent "hijklmn") False now void . insert' $ LmsUserlist qid_f (LmsIdent "abcdefg") True now void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing now Nothing (Just $ n_day' (-7)) (Just $ n_day' (-5)) void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False now (Just $ LmsSuccess $ n_day 1) (n_day' (-1)) (Just now) (Just $ n_day' 0) Nothing void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just $ LmsBlocked $ utctDay now) (n_day' (-2)) (Just now) (Just $ n_day' (-4)) Nothing void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just $ LmsSuccess $ n_day (-2)) (n_day' (-3)) (Just $ n_day' (-1)) (Just $ n_day' (-1)) Nothing void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing now Nothing Nothing Nothing void . insert $ PrintJob "TestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing void . insert $ PrintJob "TestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just $ LmsIdent "ijk") void . insert $ PrintJob "TestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing void . insert $ PrintJob "TestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "qwvu") void . insert $ PrintJob "TestJob5" "job5" "No Text herein." (n_day' (-9)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r) (Just $ LmsIdent "qwvu") void . insert $ PrintJob "TestJob6" "job6" "No Text herein." (n_day' (-7)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) Nothing void . insert $ PrintJob "TestJob7" "job7" "No Text herein." (n_day' (-6)) (Just $ n_day' (-8)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") void . insert $ PrintJob "TestJob8" "job8" "No Text herein." (n_day' (-2)) (Just $ n_day' (-6)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") void . insert $ PrintJob "TestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") void . insert $ PrintJob "TestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing Nothing Nothing Nothing (Just $ LmsIdent "hijklmn") let examLabels = Map.fromList [ ( sbarth , [ ("In Bearbeitung" , Success , 4) , ("Sonderfall" , Warning , 1) , ("Zu überprüfen" , Error , 1) , ("Weiterzuleiten" , Info , 3) , ("Nicht zu bearbeiten" , Nonactive , -1) ] ) ] for_ (Map.toList examLabels) $ \(examOfficeLabelUser, labels) -> for_ labels $ \(examOfficeLabelName, examOfficeLabelStatus, examOfficeLabelPriority) -> void $ insert' ExamOfficeLabel{..} let sdBsc = StudyDegreeKey' 82 sdMst = StudyDegreeKey' 88 sdLAR = StudyDegreeKey' 33 sdLAG = StudyDegreeKey' 35 for_ (maxMuster : tinaTester : manyUsers) $ \uid -> void . insert' $ UserSystemFunction uid SystemStudent False False 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" insert_ $ StudyFeatures -- keyword type prevents record syntax here maxMuster sdBsc sdInf Nothing FieldPrimary 2 (Just now) now True Nothing insert_ $ StudyFeatures maxMuster sdBsc sdMath Nothing FieldSecondary 2 (Just now) now True Nothing insert_ $ StudyFeatures tinaTester sdBsc sdInf Nothing FieldPrimary 4 (Just now) now False Nothing insert_ $ StudyFeatures tinaTester sdLAG sdPhys Nothing FieldPrimary 1 (Just now) now True Nothing insert_ $ StudyFeatures tinaTester sdLAR sdMedi Nothing FieldPrimary 7 (Just now) now True Nothing insert_ $ StudyFeatures tinaTester sdMst sdMath Nothing FieldPrimary 3 (Just now) now True Nothing -- Fahrschule F forM_ terms $ \tk -> do let tid = unTermKey tk jtt = (((Just .) .) .) . termTime tid firstDay = utctDay $ termTime tid TermDayLectureStart 0 Nothing toMidnight secondDay = utctDay $ termTime tid TermDayLectureStart 1 Nothing toMidnight tyear = year tid weekDay = dayOfWeek firstDay -- thirdDay = utctDay $ termTime tid TermDayLectureStart 2 Nothing toMidnight capacity = Just 8 mkName = CI.mk do c <- insert' Course { courseName = mkName "Vorfeldführerschein" , courseDescription = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.

Benötigte Unterlagen
  • Sehtest, bitte vorab hochladen!
  • Regulärer Führerschein, Bitte mitbringen. |] , courseLinkExternal = Nothing , courseShorthand = "F" , courseTerm = tk , courseSchool = avn , courseCapacity = capacity , courseVisibleFrom = jtt TermDayStart 0 Nothing toMidnight , courseVisibleTo = jtt TermDayEnd 0 Nothing beforeMidnight , courseRegisterFrom = jtt TermDayStart 0 Nothing toMidnight , courseRegisterTo = jtt TermDayLectureStart (-1) Nothing toMidnight , courseDeregisterUntil = jtt TermDayLectureStart (-5) (Just Monday) toMidnight , courseRegisterSecret = Nothing , courseMaterialFree = True } insert_ $ CourseEdit jost now c when (tyear >= currentYear) $ insert_ $ CourseQualification c qid_f 2 when (tyear >= succ currentYear) $ insert_ $ CourseQualification c qid_r 3 when (tyear >= succ (succ currentYear)) $ insert_ $ CourseQualification c qid_l 1 insert_ Sheet { sheetCourse = c , sheetName = mkName "Sehtest" , sheetDescription = Just $ htmlToStoredMarkup [shamlet|Bitte einen Scan ihres Sehtest hochladen!|] , sheetType = NotGraded , sheetGrouping = Arbitrary 3 , sheetMarkingText = Nothing , sheetVisibleFrom = jtt TermDayStart 0 Nothing toMidnight , sheetActiveFrom = jtt TermDayStart 0 Nothing toMidnight , sheetActiveTo = jtt TermDayLectureStart 0 Nothing toMorning , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False , sheetHintFrom = Nothing , sheetSolutionFrom = Nothing , sheetAutoDistribute = False , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True , sheetAuthorshipStatementMode = SheetAuthorshipStatementModeExam , sheetAuthorshipStatementExam = Nothing , sheetAuthorshipStatement = Nothing } -- TODO: Maybe split into to Tutorials with -- occurrencesSchedule = Set.fromList [ ScheduleWeekly { scheduleDayOfWeek = weekDay, scheduleStart = TimeOfDay 8 30 0, scheduleEnd = TimeOfDay 16 0 0} ] tut1 <- insert Tutorial { tutorialName = mkName "Theorieschulung" , tutorialCourse = c , tutorialType = "Schulung" , tutorialCapacity = capacity , tutorialRoom = Just $ case weekDay of Monday -> "A380" Tuesday -> "B747" Wednesday -> "MD11" Thursday -> "A380" _ -> "B777" , tutorialRoomHidden = False , tutorialTime = Occurrences { occurrencesScheduled = Set.empty , occurrencesExceptions = Set.fromList [ ExceptOccur { exceptDay = firstDay , exceptStart = TimeOfDay 8 30 0 , exceptEnd = TimeOfDay 16 0 0 } , ExceptOccur { exceptDay = secondDay , exceptStart = TimeOfDay 9 0 0 , exceptEnd = TimeOfDay 16 0 0 } ] } , tutorialRegGroup = Just "schulung" , tutorialRegisterFrom = jtt TermDayStart 0 Nothing toMidnight , tutorialRegisterTo = jtt TermDayLectureStart (-1) Nothing toMidnight , tutorialDeregisterUntil = jtt TermDayLectureStart (-5) (Just Monday) toMidnight , tutorialLastChanged = now , tutorialTutorControlled = True } insert_ $ Tutor tut1 jost void . insert' $ Exam { examCourse = c , examName = mkName "Theorieprüfung" , examGradingRule = Nothing , examBonusRule = Nothing , examOccurrenceRule = ExamRoomManual , examExamOccurrenceMapping = Nothing , examVisibleFrom = jtt TermDayStart 0 Nothing toMidnight , examRegisterFrom = jtt TermDayStart 0 Nothing toMidnight , examRegisterTo = jtt TermDayLectureStart (-1) Nothing toMidnight , examDeregisterUntil = jtt TermDayLectureStart (-5) (Just Monday) toMidnight , examPublishOccurrenceAssignments = Nothing , examStart = Just $ toTimeOfDay 16 0 0 secondDay , examEnd = Just $ toTimeOfDay 16 30 0 secondDay , examFinished = Nothing , examPartsFrom = Nothing , examClosed = Nothing , examPublicStatistics = True , examGradingMode = ExamGradingPass , examDescription = Just $ htmlToStoredMarkup [shamlet|Theoretische Prüfung mit Fragebogen|] , examExamMode = ExamMode { examAids = Just $ ExamAidsPreset ExamClosedBook , examOnline = Just $ ExamOnlinePreset ExamOffline , examSynchronicity = Just $ ExamSynchronicityPreset ExamSynchronous , examRequiredEquipment = Just $ ExamRequiredEquipmentPreset ExamRequiredEquipmentNone } , examStaff = Just "Jost" , examAuthorshipStatement = Nothing } testMsg <- insert SystemMessage { systemMessageNewsOnly = False , systemMessageFrom = Just now , systemMessageTo = Nothing , systemMessageOnVolatileClusterSettings = Set.empty , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Success , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten werden angezeigt" , systemMessageSummary = Nothing , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } void . insert $ SystemMessageTranslation testMsg "en" "System messages may be translated" Nothing void $ insert SystemMessage { systemMessageNewsOnly = False , systemMessageFrom = Just now , systemMessageTo = Nothing , systemMessageOnVolatileClusterSettings = Set.empty , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Info , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten können längeren Inhalt enthalten" , systemMessageSummary = Just "System-Nachricht Zusammenfassung" , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } void $ insert SystemMessage { systemMessageNewsOnly = False , systemMessageFrom = Just now , systemMessageTo = Just now , systemMessageOnVolatileClusterSettings = Set.empty , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Info , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten haben Ablaufdaten" , systemMessageSummary = Nothing , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } void $ insert SystemMessage { systemMessageNewsOnly = False , systemMessageFrom = Nothing , systemMessageTo = Nothing , systemMessageOnVolatileClusterSettings = Set.empty , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Error , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten können Inaktiv sein" , systemMessageSummary = Nothing , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } void $ insert SystemMessage { systemMessageNewsOnly = True , systemMessageFrom = Just now , systemMessageTo = Nothing , systemMessageOnVolatileClusterSettings = Set.empty , systemMessageAuthenticatedOnly = False , systemMessageSeverity = Error , systemMessageManualPriority = Nothing , systemMessageDefaultLanguage = "de" , systemMessageContent = "System-Nachrichten können nur auf \"Aktuelles\" angezeigt werden" , systemMessageSummary = Nothing , systemMessageCreated = now , systemMessageLastChanged = now , systemMessageLastUnhide = now } forM_ universeF $ \changelogItem -> do let ptn = "templates/i18n/changelog/" <> unpack (toPathPiece changelogItem) <> ".*" files <- liftIO $ glob ptn mTime <- fmap minimum . fromNullable <$> mapM (liftIO . getModificationTime) files whenIsJust mTime $ \(utctDay -> firstSeen) -> do oldFirstSeen <- selectMaybe [ ChangelogItemFirstSeenItem ==. changelogItem ] [ Asc ChangelogItemFirstSeenFirstSeen ] case oldFirstSeen of Just (Entity firstSeenId oldEntry) | changelogItemFirstSeenFirstSeen oldEntry > firstSeen -> update firstSeenId [ ChangelogItemFirstSeenFirstSeen =. firstSeen ] Just _ -> return () Nothing -> insert_ $ ChangelogItemFirstSeen changelogItem firstSeen