This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/test/Database/Fill.hs

1228 lines
57 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.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"
]
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) 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"
"Elizabeth" -> ""
_ -> userIdent
matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)
manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel
matUsers <- selectList [UserMatrikelnummer !=. Nothing] []
insertMany_ [UserAvs (AvsPersonId n) uid n now | 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 False Nothing
fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH" "FraGround" 2 False Nothing -- TODO: better testcases
nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" 33 False Nothing
ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" 44 False Nothing
bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" 5555 False Nothing
void . insert' $ UserCompany jost fraportAg True True
void . insert' $ UserCompany svaupel nice True False
void . insert' $ UserCompany gkleen nice False False
void . insert' $ UserCompany gkleen fraGround False True
void . insert' $ UserCompany fhamann bpol False False
void . insert' $ UserCompany fhamann ffacil True True
void . insert' $ UserCompany fhamann nice False False
-- void . insert' $ UserSupervisor jost gkleen True
-- void . insert' $ UserSupervisor jost svaupel False
-- void . insert' $ UserSupervisor jost sbarth False
-- void . insert' $ UserSupervisor jost tinaTester True
-- void . insert' $ UserSupervisor svaupel gkleen False
-- void . insert' $ UserSupervisor svaupel fhamann True
-- void . insert' $ UserSupervisor sbarth tinaTester True
let supvs = [ UserSupervisor jost gkleen True
, UserSupervisor jost svaupel False
, UserSupervisor jost sbarth False
, UserSupervisor jost tinaTester True
, UserSupervisor svaupel gkleen False
, UserSupervisor svaupel fhamann True
, UserSupervisor sbarth tinaTester True
, UserSupervisor gkleen fhamann False
]
++ take 333 [ UserSupervisor fhamann uid False | Entity uid _ <- matUsers ]
++ take 111 [ UserSupervisor gkleen uid False | Entity uid _ <- drop 300 matUsers ]
upsertManyWhere supvs [] [] []
-- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok
-- insertMany_ supvs -- NOTE: multiple calls like this throw an error!
ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional (Just ifiAuthorshipStatement) True SchoolAuthorshipStatementModeRequired (Just ifiAuthorshipStatement) False
mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True
avn <- insert' $ School "Fahrerausbildung" "FA" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True
void . insert' $ UserFunction jost avn SchoolAdmin
void . insert' $ UserFunction gkleen ifi SchoolAdmin
void . insert' $ UserFunction gkleen mi SchoolAdmin
-- void . insert' $ UserFunction fhamann ifi SchoolAdmin -- goto-example for non-admin supervisor
void . insert' $ UserFunction jost ifi SchoolAdmin
void . insert' $ UserFunction jost mi SchoolAdmin
void . insert' $ UserFunction svaupel ifi SchoolAdmin
void . insert' $ UserFunction svaupel mi SchoolAdmin
void . insert' $ UserFunction gkleen ifi SchoolLecturer
-- void . insert' $ UserFunction fhamann ifi SchoolLecturer -- goto-example for non-admin supervisor
void . insert' $ UserFunction jost ifi SchoolLecturer
void . insert' $ UserFunction svaupel ifi SchoolLecturer
void . insert' $ UserFunction sbarth ifi SchoolLecturer
void . insert' $ UserFunction sbarth ifi SchoolExamOffice
for_ [gkleen, fhamann, maxMuster, svaupel] $ \uid ->
void . insert' $ UserSchool uid ifi False
for_ [gkleen, tinaTester] $ \uid ->
void . insert' $ UserSchool uid mi False
for_ [jost] $ \uid ->
void . insert' $ UserSchool uid avn False
void . insert' $ UserAvs (AvsPersonId 12345678) jost 87654321 (n_day' $ -12)
void . insert' $ UserAvs (AvsPersonId 2) svaupel 2 (n_day' $ -22)
void . insert' $ UserAvs (AvsPersonId 3) gkleen 3 (n_day' $ -32)
void . insert' $ UserAvs (AvsPersonId 4) sbarth 4 now
void . insert' $ UserAvs (AvsPersonId 5) fhamann 5 now
void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77 now
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) True True (Just AvsLicenceVorfeld) $ Just "F4466"
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) False False (Just AvsLicenceRollfeld) $ Just "R2801"
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing True False Nothing Nothing
void . insert' $ QualificationUser jost qid_f (n_day 9) (n_day $ -1) (n_day $ -22) (Just $ QualificationBlocked (n_day $ -5) "LMS") True (n_day' $ -9) -- TODO: better dates!
void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) Nothing True (n_day' $ -9) -- TODO: better dates!
void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) Nothing True (n_day' $ -9) -- TODO: better dates!
void . insert' $ QualificationUser gkleen qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20) Nothing True (n_day' $ -9)
void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8) Nothing False (n_day' $ -1)
void . insert' $ QualificationUser svaupel qid_f (n_day 1) (n_day $ -1) (n_day $ -2) Nothing True (n_day' $ -9)
void . insert' $ QualificationUser sbarth qid_f (n_day 400) (n_day $ -40) (n_day $ -1200) Nothing True (n_day' $ -2)
void . insert' $ QualificationUser tinaTester qid_f (n_day 3) (n_day $ -60) (n_day $ -250) (Just $ QualificationBlocked (n_day $ -7) "Some long explanation for the block!") False (n_day' $ -9)
void . insert' $ QualificationUser tinaTester qid_r (n_day 3) (n_day $ -60) (n_day $ -250) Nothing False (n_day' $ -3)
void . insert' $ QualificationUser gkleen qid_r (n_day $ -7) (n_day $ -2) (n_day $ -9) Nothing True (n_day' $ -4)
void . insert' $ QualificationUser maxMuster qid_r (n_day 1) (n_day $ -1) (n_day $ -2) Nothing False (n_day' $ -6)
-- void . insert' $ QualificationUser fhamann qid_r (n_day $ -3) (n_day $ -1) (n_day $ -2) Nothing True (n_day' $ -9)
void . insert' $ QualificationUser svaupel qid_l (n_day 1) (n_day $ -1) (n_day $ -2) Nothing True (n_day' $ -7)
void . insert' $ QualificationUser gkleen qid_l (n_day 9) (n_day $ -1) (n_day $ -7) Nothing True (n_day' $ -8)
qidfUsers <- Set.fromAscList . fmap (qualificationUserUser . entityVal)
<$> selectList [QualificationUserQualification ==. qid_f] [Asc QualificationUserUser]
insertMany_ [QualificationUser uid qid_f (n_day 42) (n_day $ -42) (n_day $ -365) Nothing True (n_day' $ -11)| Entity uid _ <- take 200 matUsers, uid `Set.notMember` qidfUsers]
void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (n_day (-1)) now
void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (n_day (-2)) now
void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (n_day (-3)) now
void . insert' $ LmsUserlist qid_f (LmsIdent "hijklmn") False now
void . insert' $ LmsUserlist qid_f (LmsIdent "abcdefg") True now
void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now
void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing now Nothing (Just $ n_day' (-7)) (Just $ n_day' (-5))
void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False now (Just $ LmsSuccess $ n_day 1) (n_day' (-1)) (Just now) (Just $ n_day' 0) Nothing
void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just $ LmsBlocked $ utctDay now) (n_day' (-2)) (Just now) (Just $ n_day' (-4)) Nothing
void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just $ LmsSuccess $ n_day (-22)) (n_day' (-3)) (Just $ n_day' (-1)) (Just $ n_day' (-1)) Nothing
void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-11)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing
void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing now Nothing Nothing Nothing
void . insert $ PrintJob "TestJob1" "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
}
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