1292 lines
63 KiB
Haskell
1292 lines
63 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
|
--
|
|
-- 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
|
|
n_day n = addBDays n $ utctDay now
|
|
n_day' n = now { utctDay = n_day n }
|
|
(currentYear, _currentMonth, _currentDay) = toGregorian $ utctDay now
|
|
currentTerm = TermIdentifier currentYear
|
|
nextTerm n = toEnum . (+n) $ fromEnum currentTerm
|
|
|
|
termTime :: TermIdentifier -- ^ Term
|
|
-> TermDay -- ^ Relative to which day?
|
|
-> Integer -- ^ Week offset from TermDayStart/End of Term (shuld be negative for TermDayEnd)
|
|
-> Maybe WeekDay -- ^ Move to weekday
|
|
-> (Day -> UTCTime) -- ^ Add time to day
|
|
-> UTCTime
|
|
termTime gTid gTD weekOffset mbWeekDay = ($ tDay)
|
|
where
|
|
gDay = addDays (7* weekOffset) $ guessDay gTid gTD
|
|
tDay = maybe gDay (`firstDayOfWeekOnAfter` gDay) mbWeekDay
|
|
|
|
gkleen <- insert User
|
|
{ userIdent = "G.Kleen@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Just now
|
|
, userTokensIssuedAfter = Just now
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "G.Kleen@campus.lmu.de"
|
|
, userDisplayEmail = "gregor.kleen@ifi.lmu.de"
|
|
, userDisplayName = "Gregor Kleen"
|
|
, userSurname = "Kleen"
|
|
, userFirstName = "Gregor Julius Arthur"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = 6
|
|
, userMaxFavouriteTerms = 1
|
|
, userTheme = ThemeDefault
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Just $ Languages ["en"]
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def { csvFormat = csvPreset # CsvPresetRFC }
|
|
, userSex = Just SexMale
|
|
, userBirthday = Nothing
|
|
, userShowSex = userDefaultShowSex
|
|
, userTelephone = Nothing
|
|
, userMobile = Nothing
|
|
, userCompanyPersonalNumber = Just "00000"
|
|
, userCompanyDepartment = Nothing
|
|
, userPinPassword = Nothing
|
|
, userPostAddress = Just $ markdownToStoredMarkup ("Büro 127 \nMathematisches Institut der Ludwig-Maximilians-Universität München \nTheresienstr. 39 \nD-80333 München"::Text)
|
|
, userPostLastUpdate = Nothing
|
|
, userPrefersPostal = True
|
|
, userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
|
|
, userExamOfficeGetLabels = userDefaultExamOfficeGetLabels
|
|
}
|
|
fhamann <- insert User
|
|
{ userIdent = "felix.hamann@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "noEmailKnown"
|
|
, userDisplayEmail = "felix.hamann@campus.lmu.de"
|
|
, userDisplayName = "Felix Hamann"
|
|
, userSurname = "Hamann"
|
|
, userFirstName = "Felix"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = userDefaultMaxFavourites
|
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
|
, userTheme = ThemeDefault
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Nothing
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def { csvFormat = csvPreset # CsvPresetExcel }
|
|
, userSex = Just SexMale
|
|
, userShowSex = userDefaultShowSex
|
|
, userBirthday = Nothing
|
|
, userMobile = Nothing
|
|
, userTelephone = Nothing
|
|
, userCompanyPersonalNumber = Nothing
|
|
, userCompanyDepartment = Nothing
|
|
, userPinPassword = 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 = True
|
|
, userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
|
|
, userExamOfficeGetLabels = userDefaultExamOfficeGetLabels
|
|
}
|
|
maxMuster <- insert User
|
|
{ userIdent = "max@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Just now
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Just "1299"
|
|
, userEmail = "max@campus.lmu.de"
|
|
, userDisplayEmail = "max@max.com"
|
|
, userDisplayName = "Max Musterstudent"
|
|
, userSurname = "Musterstudent"
|
|
, userFirstName = "Max"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = 7
|
|
, userTheme = ThemeAberdeenReds
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Just $ Languages ["de"]
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def
|
|
, userSex = Just SexMale
|
|
, userBirthday = Just $ n_day $ 27 * (-365)
|
|
, userShowSex = userDefaultShowSex
|
|
, userTelephone = Nothing
|
|
, userMobile = Nothing
|
|
, userCompanyPersonalNumber = Nothing
|
|
, userCompanyDepartment = Nothing
|
|
, userPinPassword = Nothing
|
|
, userPostAddress = Nothing
|
|
, userPostLastUpdate = Nothing
|
|
, userPrefersPostal = False
|
|
, userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
|
|
, userExamOfficeGetLabels = userDefaultExamOfficeGetLabels
|
|
}
|
|
tinaTester <- insert $ User
|
|
{ userIdent = "tester@campus.lmu.de"
|
|
, userAuthentication = AuthNoLogin
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Just "999"
|
|
, userEmail = "tester@campus.lmu.de"
|
|
, userDisplayEmail = "tina@tester.example"
|
|
, userDisplayName = "Tina Tester"
|
|
, userSurname = "vön Tërrör¿"
|
|
, userFirstName = "Sabrina"
|
|
, userTitle = Just "Magister"
|
|
, userMaxFavourites = 5
|
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
|
, userTheme = ThemeAberdeenReds
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Just $ Languages ["sn"]
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def
|
|
, userSex = Just SexNotApplicable
|
|
, userBirthday = Just $ n_day 3
|
|
, userShowSex = userDefaultShowSex
|
|
, userTelephone = Nothing
|
|
, userMobile = Nothing
|
|
, userCompanyPersonalNumber = Just "12345"
|
|
, userCompanyDepartment = Nothing
|
|
, userPinPassword = Nothing
|
|
, userPostAddress = Nothing
|
|
, userPostLastUpdate = Nothing
|
|
, userPrefersPostal = False
|
|
, userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
|
|
, userExamOfficeGetLabels = userDefaultExamOfficeGetLabels
|
|
}
|
|
svaupel <- insert User
|
|
{ userIdent = "vaupel.sarah@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "vaupel.sarah@campus.lmu.de"
|
|
, userDisplayEmail = "vaupel.sarah@campus.lmu.de"
|
|
, userDisplayName = "Sarah Vaupel"
|
|
, userSurname = "Vaupel"
|
|
, userFirstName = "Sarah"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = 14
|
|
, userMaxFavouriteTerms = 4
|
|
, userTheme = ThemeMossGreen
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Nothing
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def
|
|
, userSex = Just SexFemale
|
|
, userBirthday = Nothing
|
|
, userShowSex = userDefaultShowSex
|
|
, userTelephone = Nothing
|
|
, userMobile = Nothing
|
|
, userCompanyPersonalNumber = Nothing
|
|
, userCompanyDepartment = Nothing
|
|
, userPinPassword = Nothing
|
|
, userPostAddress = Nothing
|
|
, userPostLastUpdate = Nothing
|
|
, userPrefersPostal = False
|
|
, userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
|
|
, userExamOfficeGetLabels = userDefaultExamOfficeGetLabels
|
|
}
|
|
sbarth <- insert User
|
|
{ userIdent = "Stephan.Barth@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "Stephan.Barth@lmu.de"
|
|
, userDisplayEmail = "stephan.barth@ifi.lmu.de"
|
|
, userDisplayName = "Stephan Barth"
|
|
, userSurname = "Barth"
|
|
, userFirstName = "Stephan"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = userDefaultMaxFavourites
|
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
|
, userTheme = ThemeMossGreen
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Nothing
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def
|
|
, userSex = Just SexMale
|
|
, userBirthday = Nothing
|
|
, userShowSex = userDefaultShowSex
|
|
, userTelephone = Nothing
|
|
, userMobile = Nothing
|
|
, userCompanyPersonalNumber = Nothing
|
|
, userCompanyDepartment = Nothing
|
|
, userPinPassword = Nothing
|
|
, userPostAddress = Nothing
|
|
, userPostLastUpdate = Nothing
|
|
, userPrefersPostal = False
|
|
, userExamOfficeGetSynced = False
|
|
, userExamOfficeGetLabels = True
|
|
}
|
|
_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 | 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
|
|
<strong>
|
|
Erklärung über die eigenständige Bearbeitung
|
|
<p>
|
|
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
|
|
<strong>
|
|
Statement of Authorship
|
|
<p>
|
|
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
|
|
void . insert' $ UserCompany svaupel nice True False
|
|
void . insert' $ UserCompany gkleen nice False False
|
|
void . insert' $ UserCompany gkleen fraGround False True
|
|
void . insert' $ UserCompany fhamann bpol False False
|
|
void . insert' $ UserCompany fhamann ffacil True True
|
|
void . insert' $ UserCompany fhamann nice False False
|
|
-- need more tests
|
|
insertMany_ [UserCompany uid fraGround False False| Entity uid User{userFirstName = "John"} <- matUsers]
|
|
insertMany_ [UserCompany uid bpol False False| Entity uid User{userFirstName = "Elizabeth"} <- matUsers]
|
|
insertMany_ [UserCompany uid bpol True True| Entity uid User{userFirstName = "Clark", userSurname = dn} <- matUsers, dn == "Walker" || dn == "Robinson"]
|
|
insertMany_ [UserCompany uid ffacil False False| Entity uid User{userSurname = "Walker"} <- matUsers]
|
|
insertMany_ [UserCompany uid rckey issuper False
|
|
| 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
|
|
, UserSupervisor jost svaupel False
|
|
, UserSupervisor jost sbarth False
|
|
, UserSupervisor jost tinaTester True
|
|
, UserSupervisor jost jost True
|
|
, UserSupervisor svaupel gkleen False
|
|
, UserSupervisor svaupel fhamann True
|
|
, UserSupervisor sbarth tinaTester True
|
|
, UserSupervisor gkleen fhamann False
|
|
, UserSupervisor gkleen gkleen True
|
|
, UserSupervisor tinaTester tinaTester False
|
|
]
|
|
++ take 444 [ UserSupervisor fhamann uid True | Entity uid _ <- matUsers, uid /= jost]
|
|
++ take 123 [ UserSupervisor gkleen uid True | Entity uid _ <- drop 369 matUsers ]
|
|
++ take 11 [ UserSupervisor jost uid False | 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")
|
|
void . insert' $ UserAvs (AvsPersonId 2) svaupel 2 (n_day' $ -22) Nothing
|
|
void . insert' $ UserAvs (AvsPersonId 3) gkleen 3 (n_day' $ -32) Nothing
|
|
void . insert' $ UserAvs (AvsPersonId 4) sbarth 4 now Nothing
|
|
void . insert' $ UserAvs (AvsPersonId 5) fhamann 5 now (Just "another message from avs synch")
|
|
void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77 now Nothing
|
|
insert_ $ UserAvsCard (AvsPersonId 12345678) (AvsFullCardNo (AvsCardNo "1234") "4") (AvsDataPersonCard True Nothing Nothing AvsCardColorGelb (Set.fromList ['F']) Nothing Nothing Nothing Nothing (AvsCardNo "1234") "4") now
|
|
insert_ $ UserAvsCard (AvsPersonId 2) (AvsFullCardNo (AvsCardNo "3344") "1") (AvsDataPersonCard True Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "3344") "1") now
|
|
insert_ $ UserAvsCard (AvsPersonId 3) (AvsFullCardNo (AvsCardNo "7788") "1") (AvsDataPersonCard False Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "7788") "1") now
|
|
insert_ $ UserAvsCard (AvsPersonId 4) (AvsFullCardNo (AvsCardNo "9999") "4") (AvsDataPersonCard True Nothing Nothing AvsCardColorGelb (Set.fromList ['F']) Nothing Nothing Nothing Nothing (AvsCardNo "9999") "4") now
|
|
|
|
let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
|
|
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
|
|
let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
|
|
|
|
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True 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 (Just AvsLicenceRollfeld) $ Just "R2801"
|
|
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing False 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!
|
|
qfkleen <- insert' $ QualificationUser gkleen qid_f (n_day 33) (n_day $ -4) (n_day $ -20) True (n_day' $ -9)
|
|
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 (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 (Just qid_f) (Just $ LmsIdent "ijk")
|
|
void . insert $ PrintJob "TestJob3" "AckTestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing
|
|
void . insert $ PrintJob "TestJob4" "AckTestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "qwvu")
|
|
void . insert $ PrintJob "TestJob5" "AckTestJob5" "job5" "No Text herein." (n_day' (-9)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r) (Just $ LmsIdent "qwvu")
|
|
void . insert $ PrintJob "TestJob6" "AckTestJob6" "job6" "No Text herein." (n_day' (-7)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) Nothing
|
|
void . insert $ PrintJob "TestJob7" "AckTestJob7" "job7" "No Text herein." (n_day' (-6)) (Just $ n_day' (-8)) (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) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
|
|
void . insert $ PrintJob "TestJob9" "AckTestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
|
|
void . insert $ PrintJob "TestJob0" "AckTestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing Nothing Nothing Nothing (Just $ LmsIdent "hijklmn")
|
|
|
|
|
|
let
|
|
examLabels = Map.fromList
|
|
[ ( sbarth
|
|
, [ ("In Bearbeitung" , Success , 4)
|
|
, ("Sonderfall" , Warning , 1)
|
|
, ("Zu überprüfen" , Error , 1)
|
|
, ("Weiterzuleiten" , Info , 3)
|
|
, ("Nicht zu bearbeiten" , Nonactive , -1)
|
|
]
|
|
)
|
|
]
|
|
for_ (Map.toList examLabels) $ \(examOfficeLabelUser, labels) ->
|
|
for_ labels $ \(examOfficeLabelName, examOfficeLabelStatus, examOfficeLabelPriority) ->
|
|
void $ insert' ExamOfficeLabel{..}
|
|
|
|
let
|
|
sdBsc = StudyDegreeKey' 82
|
|
sdMst = StudyDegreeKey' 88
|
|
sdLAR = StudyDegreeKey' 33
|
|
sdLAG = StudyDegreeKey' 35
|
|
for_ (maxMuster : tinaTester : manyUsers) $ \uid ->
|
|
void . insert' $ UserSystemFunction uid SystemStudent False False
|
|
repsert sdBsc $ StudyDegree 82 (Just "BSc") (Just "Bachelor" )
|
|
repsert sdMst $ StudyDegree 88 (Just "MSc") (Just "Master" )
|
|
repsert sdLAR $ StudyDegree 33 (Just "LAR") Nothing -- intentionally left unknown
|
|
repsert sdLAG $ StudyDegree 35 Nothing Nothing -- intentionally left unknown
|
|
let
|
|
sdInf = StudyTermsKey' 79
|
|
sdMath = StudyTermsKey' 105
|
|
sdMedi = StudyTermsKey' 121
|
|
sdPhys = StudyTermsKey' 128
|
|
sdBioI1 = StudyTermsKey' 221
|
|
sdBioI2 = StudyTermsKey' 228
|
|
sdBiol = StudyTermsKey' 26
|
|
sdChem1 = StudyTermsKey' 61
|
|
sdChem2 = StudyTermsKey' 113
|
|
sdBWL = StudyTermsKey' 21
|
|
sdDeut = StudyTermsKey' 103
|
|
repsert sdInf $ StudyTerms 79 (Just "Inf") (Just "Informatikk") Nothing Nothing
|
|
repsert sdMath $ StudyTerms 105 (Just "Math" ) (Just "Mathematik") Nothing Nothing
|
|
repsert sdMedi $ StudyTerms 121 Nothing (Just "Fehler hier") Nothing Nothing
|
|
repsert sdPhys $ StudyTerms 128 Nothing Nothing Nothing Nothing -- intentionally left unknown
|
|
repsert sdBioI1 $ StudyTerms 221 Nothing Nothing Nothing Nothing -- intentionally left unknown
|
|
repsert sdBioI2 $ StudyTerms 228 Nothing Nothing Nothing Nothing -- intentionally left unknown
|
|
repsert sdBiol $ StudyTerms 26 Nothing Nothing Nothing Nothing -- intentionally left unknown
|
|
repsert sdChem1 $ StudyTerms 61 Nothing Nothing Nothing Nothing -- intentionally left unknown
|
|
repsert sdChem2 $ StudyTerms 113 Nothing Nothing Nothing Nothing -- intentionally left unknown
|
|
repsert sdBWL $ StudyTerms 21 Nothing Nothing Nothing Nothing -- intentionally left unknown
|
|
repsert sdDeut $ StudyTerms 103 Nothing Nothing Nothing Nothing -- intentionally left unknown
|
|
incidence1 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence1 221 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence1 221 "Mathematik"
|
|
void . insert $ StudyTermNameCandidate incidence1 105 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence1 105 "Mathematik"
|
|
incidence2 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence2 221 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence2 221 "Chemie"
|
|
void . insert $ StudyTermNameCandidate incidence2 61 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence2 61 "Chemie"
|
|
incidence3 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence3 113 "Chemie"
|
|
incidence4 <- liftIO getRandom -- ambiguous incidence
|
|
void . insert $ StudyTermNameCandidate incidence4 221 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence4 221 "Chemie"
|
|
void . insert $ StudyTermNameCandidate incidence4 221 "Biologie"
|
|
void . insert $ StudyTermNameCandidate incidence4 61 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence4 61 "Chemie"
|
|
void . insert $ StudyTermNameCandidate incidence4 61 "Biologie"
|
|
void . insert $ StudyTermNameCandidate incidence4 61 "Chemie"
|
|
void . insert $ StudyTermNameCandidate incidence4 26 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence4 26 "Chemie"
|
|
void . insert $ StudyTermNameCandidate incidence4 26 "Biologie"
|
|
incidence5 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence5 228 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence5 228 "Physik"
|
|
void . insert $ StudyTermNameCandidate incidence5 128 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence5 128 "Physik"
|
|
incidence6 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence6 228 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence6 228 "Physik"
|
|
void . insert $ StudyTermNameCandidate incidence6 128 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence6 128 "Physik"
|
|
incidence7 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence7 228 "Physik"
|
|
void . insert $ StudyTermNameCandidate incidence7 228 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence7 128 "Physik"
|
|
void . insert $ StudyTermNameCandidate incidence7 128 "Bioinformatik"
|
|
incidence8 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence8 128 "Physik"
|
|
void . insert $ StudyTermNameCandidate incidence8 128 "Medieninformatik"
|
|
void . insert $ StudyTermNameCandidate incidence8 121 "Physik"
|
|
void . insert $ StudyTermNameCandidate incidence8 121 "Medieninformatik"
|
|
incidence9 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence9 79 "Informatik"
|
|
incidence10 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence10 103 "Deutsch"
|
|
void . insert $ StudyTermNameCandidate incidence10 103 "Betriebswirtschaftslehre"
|
|
void . insert $ StudyTermNameCandidate incidence10 21 "Deutsch"
|
|
void . insert $ StudyTermNameCandidate incidence10 21 "Betriebswirtschaftslehre"
|
|
incidence11 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence11 221 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence11 221 "Chemie"
|
|
void . insert $ StudyTermNameCandidate incidence11 221 "Biologie"
|
|
void . insert $ StudyTermNameCandidate incidence11 61 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence11 61 "Chemie"
|
|
void . insert $ StudyTermNameCandidate incidence11 61 "Biologie"
|
|
void . insert $ StudyTermNameCandidate incidence11 26 "Bioinformatik"
|
|
void . insert $ StudyTermNameCandidate incidence11 26 "Chemie"
|
|
void . insert $ StudyTermNameCandidate incidence11 26 "Biologie"
|
|
incidence12 <- liftIO getRandom
|
|
void . insert $ StudyTermNameCandidate incidence12 103 "Deutsch"
|
|
void . insert $ StudyTermNameCandidate incidence12 103 "Betriebswirtschaftslehre"
|
|
void . insert $ StudyTermNameCandidate incidence12 21 "Deutsch"
|
|
void . insert $ StudyTermNameCandidate incidence12 21 "Betriebswirtschaftslehre"
|
|
|
|
insert_ $ StudyFeatures -- keyword type prevents record syntax here
|
|
maxMuster
|
|
sdBsc
|
|
sdInf
|
|
Nothing
|
|
FieldPrimary
|
|
2
|
|
(Just now)
|
|
now
|
|
True
|
|
Nothing
|
|
insert_ $ StudyFeatures
|
|
maxMuster
|
|
sdBsc
|
|
sdMath
|
|
Nothing
|
|
FieldSecondary
|
|
2
|
|
(Just now)
|
|
now
|
|
True
|
|
Nothing
|
|
insert_ $ StudyFeatures
|
|
tinaTester
|
|
sdBsc
|
|
sdInf
|
|
Nothing
|
|
FieldPrimary
|
|
4
|
|
(Just now)
|
|
now
|
|
False
|
|
Nothing
|
|
insert_ $ StudyFeatures
|
|
tinaTester
|
|
sdLAG
|
|
sdPhys
|
|
Nothing
|
|
FieldPrimary
|
|
1
|
|
(Just now)
|
|
now
|
|
True
|
|
Nothing
|
|
insert_ $ StudyFeatures
|
|
tinaTester
|
|
sdLAR
|
|
sdMedi
|
|
Nothing
|
|
FieldPrimary
|
|
7
|
|
(Just now)
|
|
now
|
|
True
|
|
Nothing
|
|
insert_ $ StudyFeatures
|
|
tinaTester
|
|
sdMst
|
|
sdMath
|
|
Nothing
|
|
FieldPrimary
|
|
3
|
|
(Just now)
|
|
now
|
|
True
|
|
Nothing
|
|
|
|
|
|
-- Fahrschule F
|
|
forM_ terms $ \tk -> do
|
|
let tid = unTermKey tk
|
|
jtt = (((Just .) .) .) . termTime tid
|
|
firstDay = utctDay $ termTime tid TermDayLectureStart 0 Nothing toMidnight
|
|
secondDay = utctDay $ termTime tid TermDayLectureStart 1 Nothing toMidnight
|
|
tyear = year tid
|
|
weekDay = dayOfWeek firstDay
|
|
-- thirdDay = utctDay $ termTime tid TermDayLectureStart 2 Nothing toMidnight
|
|
capacity = Just 8
|
|
mkName = CI.mk
|
|
do
|
|
c <- insert' Course
|
|
{ courseName = mkName "Vorfeldführerschein"
|
|
, courseDescription = Just $ htmlToStoredMarkup [shamlet|
|
|
<p>
|
|
Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.
|
|
<section>
|
|
<h3>Benötigte Unterlagen
|
|
<ul>
|
|
<li>Sehtest, #
|
|
<i>bitte vorab hochladen!
|
|
<li>Regulärer Führerschein,
|
|
<i>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 >= succ currentYear) $ insert_ $ CourseQualification c qid_r 3
|
|
when (tyear >= succ (succ currentYear)) $ insert_ $ CourseQualification c qid_l 1
|
|
insert_ Sheet
|
|
{ sheetCourse = c
|
|
, sheetName = mkName "Sehtest"
|
|
, sheetDescription = Just $ htmlToStoredMarkup [shamlet|Bitte einen Scan ihres Sehtest hochladen!|]
|
|
, sheetType = NotGraded
|
|
, sheetGrouping = Arbitrary 3
|
|
, sheetMarkingText = Nothing
|
|
, sheetVisibleFrom = jtt TermDayStart 0 Nothing toMidnight
|
|
, sheetActiveFrom = jtt TermDayStart 0 Nothing toMidnight
|
|
, sheetActiveTo = jtt TermDayLectureStart 0 Nothing toMorning
|
|
, sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
|
|
, sheetHintFrom = Nothing
|
|
, sheetSolutionFrom = Nothing
|
|
, sheetAutoDistribute = False
|
|
, sheetAnonymousCorrection = True
|
|
, sheetRequireExamRegistration = Nothing
|
|
, sheetAllowNonPersonalisedSubmission = True
|
|
, sheetAuthorshipStatementMode = SheetAuthorshipStatementModeExam
|
|
, sheetAuthorshipStatementExam = Nothing
|
|
, sheetAuthorshipStatement = Nothing
|
|
}
|
|
-- TODO: Maybe split into to Tutorials with
|
|
-- occurrencesSchedule = Set.fromList [ ScheduleWeekly { scheduleDayOfWeek = weekDay, scheduleStart = TimeOfDay 8 30 0, scheduleEnd = TimeOfDay 16 0 0} ]
|
|
tut1 <- insert Tutorial
|
|
{ tutorialName = mkName "Theorieschulung"
|
|
, tutorialCourse = c
|
|
, tutorialType = "Schulung"
|
|
, tutorialCapacity = capacity
|
|
, tutorialRoom = Just $ case weekDay of
|
|
Monday -> "A380"
|
|
Tuesday -> "B747"
|
|
Wednesday -> "MD11"
|
|
Thursday -> "A380"
|
|
_ -> "B777"
|
|
, tutorialRoomHidden = False
|
|
, tutorialTime = Occurrences
|
|
{ occurrencesScheduled = Set.empty
|
|
, occurrencesExceptions = Set.fromList
|
|
[ ExceptOccur
|
|
{ exceptDay = nTimes 7 succ firstDay
|
|
, exceptStart = TimeOfDay 8 30 0
|
|
, exceptEnd = TimeOfDay 16 0 0
|
|
}
|
|
, ExceptOccur
|
|
{ exceptDay = nTimes 8 succ 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
|
|
, tutorialFirstDay = Just firstDay
|
|
}
|
|
insert_ $ Tutor tut1 jost
|
|
insert_ Tutorial
|
|
{ tutorialName = mkName "Vorlage"
|
|
, tutorialCourse = c
|
|
, tutorialType = "Vorlage"
|
|
, 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 = succ firstDay
|
|
, exceptStart = TimeOfDay 9 0 0
|
|
, exceptEnd = TimeOfDay 16 0 0
|
|
}
|
|
, ExceptOccur
|
|
{ exceptDay = secondDay
|
|
, exceptStart = TimeOfDay 10 12 0
|
|
, exceptEnd = TimeOfDay 12 13 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
|
|
, tutorialFirstDay = Just firstDay
|
|
}
|
|
insert_ Tutorial
|
|
{ tutorialName = mkName "Sondertutoriumsvorlage"
|
|
, tutorialCourse = c
|
|
, tutorialType = "Vorlage_Sondertutorium"
|
|
, 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 = succ $ succ firstDay
|
|
, exceptStart = TimeOfDay 8 25 0
|
|
, exceptEnd = TimeOfDay 16 25 0
|
|
}
|
|
, ExceptOccur
|
|
{ exceptDay = succ $ succ $ succ $ succ firstDay
|
|
, exceptStart = TimeOfDay 9 20 0
|
|
, exceptEnd = TimeOfDay 16 20 0
|
|
}
|
|
, ExceptOccur
|
|
{ exceptDay = succ $ succ secondDay
|
|
, exceptStart = TimeOfDay 10 12 0
|
|
, exceptEnd = TimeOfDay 12 13 0
|
|
}
|
|
]
|
|
}
|
|
, 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
|
|
}
|
|
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
|
|
}
|
|
|
|
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
|