module Database.Fill ( fillDb ) where import "uniworx" Import hiding (Option(..), currentYear) -- import Handler.Utils.Form (SheetGrading'(..), SheetGroup'(..)) import qualified Data.ByteString.Lazy as LBS -- import qualified Data.Text as Text import qualified Data.Text.Encoding as TEnc import qualified Yesod.Auth.Util.PasswordStore as PWStore -- import Data.Text.IO (hPutStrLn) import qualified Data.Set as Set import qualified Data.Map as Map -- import Data.Time.Calendar.OrdinalDate -- import Data.Time.Calendar.WeekDate import Utils.Holidays import Control.Applicative (ZipList(..)) import Handler.Utils.DateTime import Handler.Utils.AuthorshipStatement (insertAuthorshipStatement) -- import Control.Monad.Random.Class (weighted) import System.Random.Shuffle (shuffleM) import qualified Data.CaseInsensitive as CI import qualified Data.Csv as Csv -- import Crypto.Random (getRandomBytes) import Data.List (foldl) -- import qualified Data.List as List (splitAt) import System.Directory (getModificationTime, doesDirectoryExist) import System.FilePath.Glob (glob) {- 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 currentTerm = TermIdentifier $ utctDay now -- (currentYear, currentMonth, currentDay) = toGregorian $ getTermDay currentTerm nextTerm n = TermIdentifier $ addBDays n $ getTermDay currentTerm termTime :: TermIdentifier -- ^ Term -> TermDay -- ^ Relative to which day? -> Integer -- ^ Business Days Offset from Start/End of Term -> Maybe WeekDay -- ^ Move to weekday -> (Day -> UTCTime) -- ^ Add time to day -> UTCTime termTime gTid gTD gOff mbWeekDay = ($ utctDay) where gDay = addBDays gOff $ guessDay gTid gTD utctDay = 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 , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing } fhamann <- insert User { userIdent = "felix.hamann@campus.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "felix.hamann@campus.lmu.de" , userDisplayEmail = "felix.hamann@campus.lmu.de" , userDisplayName = "Felix Hamann" , userSurname = "Hamann" , userFirstName = "Felix" , userTitle = Nothing , userMaxFavourites = userDefaultMaxFavourites , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms , userTheme = ThemeDefault , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userLdapPrimaryKey = Nothing , userCsvOptions = def { csvFormat = csvPreset # CsvPresetExcel } , userSex = Just SexMale , userShowSex = userDefaultShowSex , userMobile = Nothing , userTelephone = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing } 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 = userDefaultTheme , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userLdapPrimaryKey = Nothing , userSex = Just SexMale , userCsvOptions = def , userShowSex = userDefaultShowSex , userTelephone = Just "+49 69 690-71706" , userMobile = Just "0173 69 99 646" , userCompanyPersonalNumber = Just "57138" , userCompanyDepartment = Just "AVN-AR2" } 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 , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing } tinaTester <- insert $ User { userIdent = "tester@campus.lmu.de" , userAuthentication = AuthLDAP , userLastAuthentication = Nothing , userTokensIssuedAfter = Nothing , userMatrikelnummer = Just "999" , userEmail = "tester@campus.lmu.de" , userDisplayEmail = "tina@tester.example" , userDisplayName = "Tina Tester" , userSurname = "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 , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing } 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 , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing } 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 , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing } 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 = userDefaultTheme , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userLanguages = Nothing , userNotificationSettings = def , userCreated = now , userLastLdapSynchronisation = Nothing , userLdapPrimaryKey = Nothing , userCsvOptions = def , userSex = Nothing , userShowSex = userDefaultShowSex , userTelephone = Nothing , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing } 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 let tmin = -8 tmax = 29*6 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 $ addDays (-60) $ termStart term) (Just . beforeMidnight $ addDays 60 $ 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. |] } 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 void . insert' $ UserFunction jost ifi SchoolAdmin void . insert' $ UserFunction jost mi SchoolAdmin void . insert' $ UserFunction svaupel ifi SchoolAdmin void . insert' $ UserFunction svaupel mi SchoolAdmin void . insert' $ UserFunction gkleen ifi SchoolLecturer void . insert' $ UserFunction fhamann ifi SchoolLecturer void . insert' $ UserFunction jost ifi SchoolLecturer void . insert' $ UserFunction svaupel ifi SchoolLecturer void . insert' $ UserFunction gkleen ifi SchoolAllocation 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 qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing True _qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing False void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (addBDays (-1) $ utctDay now) now void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (addBDays (-2) $ utctDay now) now void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (addBDays (-3) $ utctDay now) 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 Nothing now Nothing Nothing void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False (Just True) now (Just now) Nothing void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True (Just False) now (Just now) Nothing 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 weekDay = dayOfWeek $ getTermDay tid firstDay = utctDay $ termTime tid TermDayLectureStart 0 Nothing toMidnight secondDay = utctDay $ termTime tid TermDayLectureStart 1 Nothing toMidnight -- thirdDay = utctDay $ termTime tid TermDayLectureStart 2 Nothing toMidnight capacity = Just 8 mkName = CI.mk . (<> termToText2 tid) . (<> "_") if weekDay `elem` [Friday, Saturday, Sunday] then return () else 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 , courseApplicationsRequired = False , courseApplicationsInstructions = Nothing , courseApplicationsText = False , courseApplicationsFiles = NoUpload , courseApplicationsRatingsVisible = False , courseDeregisterNoShow = True } insert_ $ CourseEdit jost now c 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 , 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 , 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 , 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 , 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 , 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 } {- aSeedFunc <- liftIO $ getRandomBytes 40 funAlloc <- insert' Allocation { allocationName = "Funktionale Zentralanmeldung" , allocationShorthand = "fun" , allocationTerm = TermKey currentTerm , allocationSchool = ifi , allocationLegacyShorthands = [] , allocationDescription = Nothing , allocationStaffDescription = Nothing , allocationStaffRegisterFrom = Just now , allocationStaffRegisterTo = Just $ 300 `addUTCTime` now , allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now , allocationStaffAllocationTo = Just $ 900 `addUTCTime` now , allocationRegisterFrom = Just $ 300 `addUTCTime` now , allocationRegisterTo = Just $ 600 `addUTCTime` now , allocationRegisterByStaffFrom = Nothing , allocationRegisterByStaffTo = Nothing , allocationRegisterByCourse = Nothing , allocationOverrideDeregister = Nothing , allocationMatchingSeed = aSeedFunc } insert_ $ AllocationCourse funAlloc pmo 100 Nothing Nothing insert_ $ AllocationCourse funAlloc ffp 2 (Just $ 2300 `addUTCTime` now) Nothing void . insertMany $ map (\(u, pState) -> CourseParticipant ffp u now (Just funAlloc) pState) [ (svaupel, CourseParticipantInactive False) , (jost, CourseParticipantActive) ] -} numericPriorities <- flip foldMapM manyUsers $ \uid -> do uRec <- get uid case uRec of Just User{ userMatrikelnummer = Just matr } -> do prios <- replicateM 3 $ getRandomR (0, 300) return . pure . AllocationPriorityNumericRecord matr . fromList $ sortOn Down prios _other -> return mempty ordinalPriorities <- do manyUsers' <- shuffleM manyUsers flip foldMapM manyUsers' $ \uid -> do uRec <- get uid case uRec of Just User{ userMatrikelnummer = Just matr } -> return . pure $ Csv.Only matr _other -> return mempty liftIO . handle (\(_ :: IOException) -> return ()) $ do haveTestdata <- doesDirectoryExist "testdata" LBS.writeFile (bool id ("testdata" ) haveTestdata "bigAlloc_numeric.csv") $ Csv.encode numericPriorities LBS.writeFile (bool id ("testdata" ) haveTestdata "bigAlloc_ordinal.csv") $ Csv.encode ordinalPriorities 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