-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen ,Sarah Vaupel ,Steffen Jost ,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.List as List 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 -} -- | Apply a function @n@ times to a given value. From GHC.Utils.Misc nTimes :: Int -> (a -> a) -> (a -> a) nTimes 0 _ = id nTimes 1 f = f nTimes n f = f . nTimes (n-1) f 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 nowaday = utctDay now n_day n = addBDays n nowaday n_day' n = now { utctDay = n_day n } (currentYear, _currentMonth, _currentDay) = toGregorian nowaday 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 = Just "99" , 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 = Just "1234.5" , userPostAddress = Just $ markdownToStoredMarkup ("Büro 127 \nMathematisches Institut der Ludwig-Maximilians-Universität München \nTheresienstr. 39 \nD-80333 München"::Text) , 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 = "AVSNO:123456" , 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 = Just "tomatenmarmelade" , userPostAddress = Just $ markdownToStoredMarkup ("Erdbeerweg 24 \n12345 Schlumpfhausen \nTraumland"::Text) , userPostLastUpdate = Nothing , userPrefersPostal = True , 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 = Just "12345678" , userEmail = "S.Jost@Fraport.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 , 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 = False , 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 = Just "365" , 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 } _stranger1 <- insert User { userIdent = "AVSID:996699" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "E996699@fraport.de" , userDisplayEmail = "" , userDisplayName = "Stranger One" , userSurname = "One" , userFirstName = "Stranger" , 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 = Just "E996699" , userCompanyDepartment = Just "AVN-Strange" , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = False , userExamOfficeGetSynced = False , userExamOfficeGetLabels = True } _stranger2 <- insert User { userIdent = "AVSID:669966" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "E669966@fraport.de" , userDisplayEmail = "" , userDisplayName = "Stranger Two" , userSurname = "Stranger" , userFirstName = "Two" , 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 = Just "669966" , userCompanyDepartment = Just "AVN-Strange" , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing , userPrefersPostal = False , userExamOfficeGetSynced = False , userExamOfficeGetLabels = True } _stranger3 <- insert User { userIdent = "AVSID:6969" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "E6969@fraport.de" , userDisplayEmail = "" , userDisplayName = "Stranger 3 Three" , userSurname = "Three" , userFirstName = "Stranger" , 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 = Just "E996699" , userCompanyDepartment = Just "AVN-Strange" , userPinPassword = Nothing , userPostAddress = Just $ markdownToStoredMarkup ("Kartoffelweg 12 \n666 Höllensumpf \nFreiland"::Text) , 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" , "Nico", "Pascal", "Danielle", "Brendon" , "Winston", "Luke", "Jeff", "Ben" , "Asis", "Janika", "Claudio", "Frank" , "Anna", "Ivo", "Merlin", "Fabienne" , "Angela", "Alissa", "Fredrik", "Sharlee" , "René", "Tuval", "Dom", "Fabian" , "Steve", "Bruce", "Adrian", "Nicko" , "Joakim", "Ylva", "Mats", "Emil" , "Angus", "Seeb", "Thalia", "Manu" ] 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" , "Loomis", "Amott", "Gluz", "Erlandsson" , "Glanzmann", "Murphy", "Henzi", "Sutter" , "Nasseri", "Wolf", "Quarta", "Fuhrmann" , "McCall", "Kilpatrick", "Ling", "Gordon" , "Sallach", "Ratajczak", "Friedrich", "Schillo" , "Völkl", "Dahn", "Berthiaume", "Crey" , "Murray", "Dickinson", "McBrain", "Gers" , "Nilsson", "Eriksson", "Fehrm", "Grahn" , "Winkler", "Levermann", "Bellazecca", "Lotter" ] middlenames = [ Nothing, Just "Jamesson", Just "Theresa", Just "Ally", Just "Tiberius", Just "Maria" ] manyUser (firstName, middleName, userSurname) userMatrikelnummer' = User { userIdent , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Just userMatrikelnummer' , userEmail = userEmail' , userDisplayEmail = userDisplayEmail' , 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 = bool Nothing (Just "E123" ) (even $ length firstName) , userCompanyDepartment = bool Nothing (Just "AVN-A") (even $ length userSurname) , 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|] userEmail' :: CI Text userEmail' = CI.mk $ case firstName of "James" -> userIdent "John" -> userIdent "Elizabeth" -> "AVSID:" <> userMatrikelnummer' _ -> "E" <> userMatrikelnummer' <> "@fraport.de" userDisplayEmail' :: CI Text userDisplayEmail' = CI.mk $ case userSurname of "Walker" -> "AVSNO:" <> userMatrikelnummer' "Clark" -> "E" <> userMatrikelnummer' <> "@fraport.de" "Jackson" -> "" _ -> userIdent -- toMatrikel :: [Int] -> [Text] -- toMatrikel ns -- | (cs, rest) <- splitAt 10 ns -- , length cs == 10 -- = foldMap tshow cs : toMatrikel rest -- | otherwise -- = [] -- matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int) baseMatrikel <- getRandomR (10000 :: Int, 999999 :: Int) let matrikel = tshow <$> [baseMatrikel..] List.\\ [6969, 669966, 996699] manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel matUsers <- selectList [UserMatrikelnummer !=. Nothing] [] insertMany_ [UserAvs (AvsPersonId n) uid n now Nothing Nothing Nothing Nothing | 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 True (Just $ markdownToStoredMarkup ("Frankfurt Airport Services Worldwide\n60547 Frankfurt am Main"::Text)) (Just "fraport@fraport.de") fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH" "FraGround" 2 True (Just $ markdownToStoredMarkup ("Sauerbierstraße 772 \nBürokomplex 80/C/1\n112233 Nieder-Tupfing-Hohen-Kreisingen\nTöpferbezirk"::Text)) Nothing nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" 33 False (Just $ markdownToStoredMarkup ("69 Nevermore Blvd.\nHarlaemn\nNew York\nUSA"::Text)) (Just "badguy@nice.com") ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" 44 False Nothing $ Just "gcs@gcs.com" bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" 5555 False Nothing Nothing _noone <- insert' $ Company "Vollautomaten GmbH" "NoOne" 3 True Nothing Nothing randComps <- insertMany [Company rcName rcShort n neven Nothing Nothing | n <- [1001..2002] , let neven = even n , let rcName = CI.mk $ "Random Corp " <> tshow n <> bool "" " GmbH" (even n) , let rcShort = CI.mk $ "RC" <> tshow n ] void . insert' $ UserCompany jost fraportAg True True 0 False $ Just $ tshow SupervisorReasonAvsSuperior void . insert' $ UserCompany svaupel nice True False 2 False $ Just $ tshow SupervisorReasonAvsSuperior void . insert' $ UserCompany svaupel ffacil False False 1 False $ Just "Irgendwas" void . insert' $ UserCompany svaupel bpol True False 2 False $ Just "Irgendwas" void . insert' $ UserCompany svaupel fraGround True False 1 False $ Just "Irgendwas" void . insert' $ UserCompany gkleen nice False False 1 True $ Just "Winterdienst" void . insert' $ UserCompany gkleen fraGround False True 2 False $ Just "Irgendwas" void . insert' $ UserCompany gkleen bpol False True 1 False $ Just $ tshow SupervisorReasonAvsSuperior void . insert' $ UserCompany fhamann bpol False False 1 True $ Just "Irgendwas" void . insert' $ UserCompany fhamann ffacil True True 2 True $ Just "Irgendwas" void . insert' $ UserCompany fhamann nice False False 3 False $ Just "Winterdienst" void . insert' $ UserCompany sbarth nice False False 3 False $ Just "Winterdienst" void . insert' $ UserCompany sbarth bpol True True 1 True $ Just "Irgendwas" -- need more tests insertMany_ [UserCompany uid fraGround False False 0 True Nothing | Entity uid User{userFirstName = "John"} <- matUsers] insertMany_ [UserCompany uid bpol False False 0 False Nothing | Entity uid User{userFirstName = "Elizabeth"} <- matUsers] insertMany_ [UserCompany uid bpol True True 0 True Nothing | Entity uid User{userFirstName = "Clark", userSurname = dn} <- matUsers, dn == "Walker" || dn == "Robinson"] insertMany_ [UserCompany uid ffacil False False 0 False Nothing | Entity uid User{userSurname = "Walker"} <- matUsers] insertMany_ [UserCompany uid rckey issuper False 0 True Nothing | rckey <- randComps , Just n <- [readMay $ drop 2 $ unpack $ CI.original $ unCompanyKey rckey] , Entity uid User{userSurname = uSurname} <- take (n `div` 20) $ drop (2*n) matUsers , uSurname /= "Jackson", uSurname /= "Lee" , let issuper = uSurname == "Wolf" ] -- 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 (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior) , UserSupervisor jost svaupel False (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior) , UserSupervisor jost sbarth False (Just fraportAg) (Just "Staff") , UserSupervisor jost tinaTester True (Just fraportAg) (Just "Staff") , UserSupervisor jost jost True (Just fraportAg) (Just "Staff") , UserSupervisor svaupel gkleen False (Just nice) (Just "Staff") , UserSupervisor svaupel fhamann True (Just nice) (Just "Staff") , UserSupervisor sbarth tinaTester True (Just nice) (Just $ tshow SupervisorReasonAvsSuperior) , UserSupervisor gkleen fhamann False (Just fraGround) (Just "Staff") , UserSupervisor gkleen gkleen True (Just fraGround) (Just "Staff") , UserSupervisor tinaTester tinaTester False Nothing (Just "Staff") ] ++ take 444 [ UserSupervisor fhamann uid True Nothing (Just $ tshow SupervisorReasonCompanyDefault) | Entity uid _ <- matUsers, uid /= jost] ++ take 123 [ UserSupervisor gkleen uid True Nothing Nothing | Entity uid _ <- drop 369 matUsers ] ++ take 11 [ UserSupervisor jost uid False (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior) | Entity uid _ <- drop 501 matUsers ] upsertManyWhere supvs [] [] [] -- insertMany_ supvs -- NOTE: multiple calls like this throw a runtime error! -- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok -- upsertManyWhere (supvs ++ take 5 (drop 12 [ UserSupervisor jost uid False | Entity uid _ <- drop 501 matUsers ])) -- no duplicates within first argument allowed! (runtime error: ON CONFLICT DO UPDATE command cannot affect row a second time) -- [copyField UserSupervisorRerouteNotifications] [UserSupervisorRerouteNotifications =. True] [UserSupervisorSupervisor ==. jost, UserSupervisorUser <-. [uid | Entity uid _ <- take 3 $ drop 504 matUsers ]] -- does not work! -- let changeSome usr@(UserSupervisor s u _) -- | s == jost, u `elem` take 14 [ uid | Entity uid _ <- drop 501 matUsers ] = UserSupervisor s u True -- | otherwise = usr -- upsertManyWhere (changeSome <$> (supvs ++ take 5 (drop 12 [ UserSupervisor jost uid False | Entity uid _ <- drop 501 matUsers ]))) -- no duplicates within first argument allowed! (runtime error: ON CONFLICT DO UPDATE command cannot affect row a second time) -- [copyField UserSupervisorRerouteNotifications] [] [UserSupervisorSupervisor ==. jost, UserSupervisorUser <-. [uid | Entity uid _ <- take 3 $ drop 504 matUsers ]] -- probably does the same as the above -- OBSERVATIONS: -- - use the 2. argument with `copyField` to overwrite an existing field with the new record value provided in the 1. argument in case of an update -- - use the 3. argument to update a field indepently from the provided records or for computations involving previous values, eg. +=. -- - use the 4. argument to filter both the application of the 2. and 3. argument 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 (n_day' $ -12) (Just "Some Message here") Nothing Nothing Nothing void . insert' $ UserAvs (AvsPersonId 99) svaupel 99 (n_day' $ -22) Nothing Nothing Nothing (readAvsFullCardNo "444444.4") void . insert' $ UserAvs (AvsPersonId 3) gkleen 3 (n_day' $ -32) Nothing Nothing Nothing (readAvsFullCardNo "5555.5") void . insert' $ UserAvs (AvsPersonId 4) sbarth 4 now Nothing Nothing Nothing Nothing void . insert' $ UserAvs (AvsPersonId 5) fhamann 5 now (Just "another message from avs synch") Nothing Nothing (readAvsFullCardNo "77777.7") void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77 now Nothing Nothing Nothing Nothing 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 8) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True (Just 5) Nothing True (Just AvsLicenceVorfeld) $ Just "F4466" qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False Nothing Nothing False (Just AvsLicenceRollfeld) $ Just "R2801" qid_rp <- insert' $ Qualification avn "R+" "Rollfeldführerschein-Plus" r_descr (Just 12) (Just 4) (Just $ CalendarDiffDays 2 3) Nothing False False Nothing (Just qid_r) False (Just AvsLicenceRollfeld) $ Just "R2802" qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing True False Nothing Nothing True Nothing Nothing qfjost <- insert' $ QualificationUser jost qid_f (n_day 11) (n_day $ -1) (n_day $ -22) True (n_day' $ -9) -- TODO: better dates! void . insert $ QualificationUserBlock qfjost False (n_day' $ -6) "First block" (Just svaupel) void . insert $ QualificationUserBlock qfjost True (n_day' $ -5) "Second unblock" (Just gkleen) void . insert $ QualificationUserBlock qfjost False (n_day' $ -4) "Third block" Nothing void . insert $ QualificationUserBlock qfjost True (n_day' $ -3) "Fourth unblock" (Just sbarth) void . insert $ QualificationUserBlock qfjost False (n_day' $ -1) "Fifth block" (Just svaupel) void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) True (n_day' $ -9) -- TODO: better dates! void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) True (n_day' $ -9) -- TODO: better dates! void . insert' $ QualificationUser jost qid_rp (n_day 999) (n_day $ -111) (n_day $ -2222) True (n_day' $ -9) -- TODO: better dates! qfkleen <- insert' $ QualificationUser gkleen qid_f (n_day 10) (n_day $ -40) (n_day $ -120) True (n_day' $ -20) void . insert $ QualificationUserBlock qfkleen False (n_day' 1) "Future block" (Just svaupel) void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8) False (n_day' $ -1) qfvaupel <- insert' $ QualificationUser svaupel qid_f (n_day 2) (n_day $ -1) (n_day $ -2) True (n_day' $ -9) void . insert $ QualificationUserBlock qfvaupel False (n_day' 0) "SameTimeBlock" (Just jost) void . insert $ QualificationUserBlock qfvaupel True ( n_day' 0) "SameTimeUnblock" (Just jost) void . insert' $ QualificationUser sbarth qid_f (n_day 400) (n_day $ -40) (n_day $ -1200) True (n_day' $ -2) qftest <- insert' $ QualificationUser tinaTester qid_f (n_day 3) (n_day $ -60) (n_day $ -250) False (n_day' $ -9) void . insert $ QualificationUserBlock qftest False (n_day' $ -7) "Some longer explanation for the block, which explains what has happened here, but is probably to long to be shown inline!" (Just jost) void . insert' $ QualificationUser tinaTester qid_r (n_day 3) (n_day $ -60) (n_day $ -250) False (n_day' $ -3) qrkleen <- insert' $ QualificationUser gkleen qid_r (n_day 44) (n_day $ -2) (n_day $ -9) True (n_day' $ -4) void . insert $ QualificationUserBlock qrkleen True (n_day' $ -7) "Granted by lottery win" (Just jost) void . insert' $ QualificationUser maxMuster qid_r (n_day 1) (n_day $ -1) (n_day $ -2) False (n_day' $ -6) -- void . insert' $ QualificationUser fhamann qid_r (n_day $ -3) (n_day $ -1) (n_day $ -2) True (n_day' $ -9) void . insert' $ QualificationUser svaupel qid_l (n_day 1) (n_day $ -1) (n_day $ -2) True (n_day' $ -7) void . insert' $ QualificationUser gkleen qid_l (n_day 9) (n_day $ -1) (n_day $ -7) True (n_day' $ -8) qidfUsers <- Set.fromAscList . fmap (qualificationUserUser . entityVal) <$> selectList [QualificationUserQualification ==. qid_f] [Asc QualificationUserUser] insertMany_ [QualificationUser uid qid_f (n_day (fromIntegral (length udn) - 12)) (n_day $ -42) (n_day $ -365) True (n_day' $ -11) | Entity uid User{userDisplayName=udn} <- take 200 $ drop 2 matUsers, uid `Set.notMember` qidfUsers] insertMany_ [LmsUser qid_f uid (LmsIdent udn) "123456" False now astatus astatusDay now (Just now) (Just now) Nothing False False | Entity uid User{userDisplayName=udn} <- take 200 $ drop 22 matUsers, uid `Set.notMember` qidfUsers , let selsome = odd $ length udn, let astatus = bool Nothing (Just LmsBlocked) selsome, let astatusDay = bool Nothing (Just now) selsome] void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing Nothing now Nothing (Just $ n_day' (-7)) (Just $ n_day' (-5)) False False void . insert' $ LmsUser qid_f svaupel (LmsIdent "bcdefg") "abc" False now (Just LmsSuccess) (Just $ n_day' 1) (n_day' (-1)) (Just now) (Just $ n_day' 0) Nothing True False void . insert' $ LmsUser qid_f gkleen (LmsIdent "hiklmn") "@#!" True now (Just LmsBlocked) (Just now) (n_day' (-2)) (Just now) (Just $ n_day' (-4)) Nothing False True void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just LmsSuccess) (Just $ n_day' (-22)) (n_day' (-3)) (Just $ n_day' (-1)) (Just $ n_day' (-1)) Nothing True True void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just LmsBlocked) (Just $ n_day' (-11)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing True True void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing Nothing now Nothing Nothing Nothing False False void . insert $ PrintJob "TestJob1" "AckTestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing void . insert $ PrintJob "TestJob2" "AckTestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing Nothing (Just qid_f) (Just $ LmsIdent "ijk") void . insert $ PrintJob "TestJob3" "AckTestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing Nothing void . insert $ PrintJob "TestJob4" "AckTestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing Nothing (Just $ LmsIdent "qwvu") void . insert $ PrintJob "TestJob5" "AckTestJob5" "job5" "No Text herein." (n_day' (-9)) Nothing (Just jost) Nothing (Just svaupel) Nothing (Just qid_r) (Just $ LmsIdent "qwvu") void . insert $ PrintJob "TestJob6" "AckTestJob6" "job6" "No Text herein." (n_day' (-7)) Nothing (Just svaupel) (Just gkleen) Nothing Nothing (Just qid_r) Nothing void . insert $ PrintJob "TestJob7" "AckTestJob7" "job7" "No Text herein." (n_day' (-6)) (Just $ n_day' (-8)) (Just svaupel) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") void . insert $ PrintJob "TestJob8" "AckTestJob8" "job8" "No Text herein." (n_day' (-2)) (Just $ n_day' (-6)) (Just svaupel) (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") void . insert $ PrintJob "TestJob9" "AckTestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") void . insert $ PrintJob "TestJob0" "AckTestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "hijklmn") insert_ $ ProblemLog now (toJSON $ AdminProblemNewCompany fraportAg) Nothing Nothing insert_ $ ProblemLog now (toJSON $ AdminProblemNewCompany ffacil ) Nothing Nothing insert_ $ ProblemLog now (toJSON $ AdminProblemSupervisorNewCompany fhamann fraportAg ffacil True ) Nothing Nothing insert_ $ ProblemLog now (toJSON $ AdminProblemSupervisorNewCompany gkleen ffacil fraGround False) Nothing Nothing insert_ $ ProblemLog now (toJSON $ AdminProblemCompanySuperiorChange jost fraportAg (Just gkleen)) Nothing Nothing insert_ $ ProblemLog now (toJSON $ AdminProblemCompanySuperiorChange fhamann fraGround Nothing) Nothing Nothing insert_ $ ProblemLog now (toJSON $ AdminProblemUnknown "This is a test problem only.") Nothing Nothing 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 -- 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 1 Nothing toMidnight , courseVisibleTo = jtt TermDayEnd 10 Nothing beforeMidnight , courseRegisterFrom = jtt TermDayLectureStart 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 == currentYear) $ insert_ $ CourseQualification c qid_r 4 when (tyear == currentYear) $ insert_ $ CourseQualification c qid_rp 44 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 , tutorialRoomHidden = False , tutorialTime = JSONB $ Occurrences { occurrencesScheduled = Set.fromList [ ScheduleWeekly { scheduleDayOfWeek = Thursday , scheduleStart = TimeOfDay 11 11 0 , scheduleEnd = TimeOfDay 12 22 0 , scheduleRoom = Just $ RoomReferenceSimple "B777" } , ScheduleWeekly { scheduleDayOfWeek = Friday , scheduleStart = TimeOfDay 13 33 0 , scheduleEnd = TimeOfDay 14 44 0 , scheduleRoom = Just $ RoomReferenceSimple "A320neo" } , ScheduleWeekly { scheduleDayOfWeek = Friday , scheduleStart = TimeOfDay 15 55 0 , scheduleEnd = TimeOfDay 16 16 0 , scheduleRoom = Just $ RoomReferenceSimple "A340" } , ScheduleWeekly { scheduleDayOfWeek = Sunday , scheduleStart = TimeOfDay 15 55 0 , scheduleEnd = TimeOfDay 16 06 0 , scheduleRoom = Nothing } ] , occurrencesExceptions = Set.fromList [ ExceptOccur { exceptDay = nTimes 7 succ firstDay , exceptStart = TimeOfDay 8 30 30 , exceptEnd = TimeOfDay 16 0 30 , exceptRoom = Just $ RoomReferenceSimple "A380" } , ExceptOccur { exceptDay = nTimes 8 succ secondDay , exceptStart = TimeOfDay 9 0 0 , exceptEnd = TimeOfDay 16 0 0 , exceptRoom = Nothing } , ExceptOccur { exceptDay = nowaday , exceptStart = TimeOfDay 9 10 0 , exceptEnd = TimeOfDay 12 10 0 , exceptRoom = Just $ RoomReferenceSimple "B747" } , ExceptOccur { exceptDay = nowaday , exceptStart = TimeOfDay 13 11 0 , exceptEnd = TimeOfDay 16 11 0 , exceptRoom = Just $ RoomReferenceSimple "B747" } ] } , 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 , tutorialFirstDay = Just firstDay } insert_ $ Tutor tut1 jost tut2 <- insert Tutorial { tutorialName = mkName "Vorlage" , tutorialCourse = c , tutorialType = "Vorlage" , tutorialCapacity = capacity , tutorialRoomHidden = False , tutorialTime = JSONB $ Occurrences { occurrencesScheduled = Set.empty , occurrencesExceptions = Set.fromList [ ExceptOccur { exceptDay = firstDay , exceptStart = TimeOfDay 8 30 0 , exceptEnd = TimeOfDay 16 0 0 , exceptRoom = Nothing } , ExceptOccur { exceptDay = succ firstDay , exceptStart = TimeOfDay 9 0 0 , exceptEnd = TimeOfDay 16 0 0 , exceptRoom = Nothing } , ExceptOccur { exceptDay = secondDay , exceptStart = TimeOfDay 10 12 0 , exceptEnd = TimeOfDay 12 13 0 , exceptRoom = Nothing } , ExceptOccur { exceptDay = nowaday , exceptStart = TimeOfDay 17 10 0 , exceptEnd = TimeOfDay 18 10 0 , exceptRoom = Just $ RoomReferenceSimple "A380" } ] } , 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 , tutorialFirstDay = Just firstDay } tut3 <- insert Tutorial { tutorialName = mkName "Sondertutoriumsvorlage" , tutorialCourse = c , tutorialType = "Vorlage_Sondertutorium" , tutorialCapacity = capacity , tutorialRoomHidden = True , tutorialTime = JSONB $ Occurrences { occurrencesScheduled = Set.empty , occurrencesExceptions = Set.fromList [ ExceptOccur { exceptDay = succ $ succ firstDay , exceptStart = TimeOfDay 8 25 0 , exceptEnd = TimeOfDay 16 25 0 , exceptRoom = Just $ RoomReferenceSimple "E175" } , ExceptOccur { exceptDay = succ $ succ $ succ $ succ firstDay , exceptStart = TimeOfDay 9 20 0 , exceptEnd = TimeOfDay 16 20 0 , exceptRoom = Just $ RoomReferenceSimple "LJ45" } , ExceptOccur { exceptDay = succ $ succ secondDay , exceptStart = TimeOfDay 10 12 0 , exceptEnd = TimeOfDay 12 13 0 , exceptRoom = Nothing } ] } , tutorialRegGroup = Just "sondertutorium" , tutorialRegisterFrom = jtt TermDayStart 0 Nothing toMidnight , tutorialRegisterTo = jtt TermDayLectureStart (-1) Nothing toMidnight , tutorialDeregisterUntil = jtt TermDayLectureStart (-5) (Just Monday) toMidnight , tutorialLastChanged = now , tutorialTutorControlled = True , tutorialFirstDay = Just $ succ $ succ firstDay } insert_ $ CourseParticipant c jost now CourseParticipantActive insert_ $ CourseParticipant c gkleen now $ CourseParticipantInactive True insert_ $ CourseParticipant c fhamann now $ CourseParticipantInactive False insert_ $ CourseParticipant c svaupel now CourseParticipantActive insert_ $ TutorialParticipant tut1 svaupel Nothing Nothing Nothing Nothing insert_ $ TutorialParticipant tut2 svaupel (Just fraGround) (Just UserDrivingPermitB01) (Just UserEyeExamS01) (Just "Testnote") when (odd tyear) $ insert_ $ TutorialParticipant tut3 svaupel (Just fraGround) Nothing Nothing Nothing insert_ $ TutorialParticipant tut1 gkleen (Just nice) (Just UserDrivingPermitB) (Just UserEyeExamSX) (Just "Note test") insert_ $ TutorialParticipant tut2 fhamann (Just bpol) (Just UserDrivingPermitB) (Just UserEyeExamSX) (Just "All ok") when (even tyear) $ insert_ $ TutorialParticipant tut3 jost (Just fraportAg) (Just UserDrivingPermitB01) (Just UserEyeExamSX) (Just "Eye test suspicious") insert_ $ TutorialParticipantDay tut2 svaupel nowaday True $ Just "Was on time" insert_ $ TutorialParticipantDay tut2 fhamann nowaday False $ Just "Missing" when (odd tyear) $ 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 } insert_ $ UserDay svaupel nowaday True insert_ $ UserDay fhamann nowaday False 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