1489 lines
62 KiB
Haskell
1489 lines
62 KiB
Haskell
module Database.Fill
|
|
( fillDb
|
|
) where
|
|
|
|
import "uniworx" Import hiding (Option(..), currentYear)
|
|
import Handler.Utils.Form (SheetGrading'(..), SheetGroup'(..))
|
|
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
import qualified Data.Text as Text
|
|
-- import Data.Text.IO (hPutStrLn)
|
|
|
|
import qualified Data.Set as Set
|
|
import qualified Data.Map as Map
|
|
|
|
-- import Data.Time.Calendar.OrdinalDate
|
|
import Data.Time.Calendar.WeekDate
|
|
import Utils.Holidays
|
|
|
|
import Control.Applicative (ZipList(..))
|
|
|
|
import Handler.Utils.DateTime
|
|
import Handler.Utils.AuthorshipStatement (insertAuthorshipStatement)
|
|
|
|
import Control.Monad.Random.Class (weighted)
|
|
import System.Random.Shuffle (shuffleM)
|
|
|
|
import qualified Data.CaseInsensitive as CI
|
|
|
|
import qualified Data.Csv as Csv
|
|
|
|
import Crypto.Random (getRandomBytes)
|
|
import Data.List (genericLength)
|
|
import qualified Data.List as List (splitAt)
|
|
|
|
import qualified Data.Conduit.Combinators as C
|
|
|
|
import System.Directory (getModificationTime, doesDirectoryExist)
|
|
import System.FilePath.Glob (glob)
|
|
|
|
import Paths_uniworx (getDataFileName)
|
|
|
|
testdataFile :: MonadIO m => FilePath -> m FilePath
|
|
testdataFile = liftIO . getDataFileName . ("testdata" </>)
|
|
|
|
insertFile :: ( HasFileReference fRef, PersistRecordBackend fRef SqlBackend ) => FileReferenceResidual fRef -> FilePath -> DB (Key fRef)
|
|
insertFile residual fileTitle = do
|
|
filepath <- testdataFile fileTitle
|
|
let fileContent = Just $ C.sourceFile filepath
|
|
fileModified <- liftIO getCurrentTime
|
|
sinkFile' File{..} residual >>= insert
|
|
|
|
fillDb :: DB ()
|
|
fillDb = do
|
|
AppSettings{ appUserDefaults = UserDefaultConf{..} } <- getsYesod $ view appSettings
|
|
now <- liftIO getCurrentTime
|
|
let
|
|
insert' :: (PersistRecordBackend r (YesodPersistBackend UniWorX), AtLeastOneUniqueKey r) => r -> YesodDB UniWorX (Key r)
|
|
insert' = fmap (either entityKey id) . insertBy
|
|
|
|
addBDays = addBusinessDays Fraport -- holiday area to use
|
|
currentTerm = TermIdentifier $ utctDay now
|
|
(currentYear, currentMonth, currentDay) = toGregorian $ getTermDay currentTerm
|
|
nextTerm n = TermIdentifier $ addBDays n $ getTermDay currentTerm
|
|
|
|
termTime :: Integer -- ^ Term Offset to current Term (i.e. Days)
|
|
-> Integer -- ^ Days Offset from Start/End of Term
|
|
-> Bool -- ^ Relative to end of Term?
|
|
-> Maybe WeekDay -- ^ Move to weekday
|
|
-> (Day -> UTCTime) -- ^ Add time to day
|
|
-> UTCTime
|
|
termTime next doff fromEnd mbWeekDay = ($ utctDay)
|
|
where
|
|
gTid = nextTerm next
|
|
gDay | fromEnd = addBDays (negate doff) $ guessDay gTid TermDayLectureEnd
|
|
| otherwise = addBDays doff $ guessDay gTid TermDayLectureStart
|
|
utctDay = maybe gDay (`firstDayOfWeekOnAfter` gDay) mbWeekDay
|
|
|
|
gkleen <- insert User
|
|
{ userIdent = "G.Kleen@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Just now
|
|
, userTokensIssuedAfter = Just now
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "G.Kleen@campus.lmu.de"
|
|
, userDisplayEmail = "gregor.kleen@ifi.lmu.de"
|
|
, userDisplayName = "Gregor Kleen"
|
|
, userSurname = "Kleen"
|
|
, userFirstName = "Gregor Julius Arthur"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = 6
|
|
, userMaxFavouriteTerms = 1
|
|
, userTheme = ThemeDefault
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Just $ Languages ["en"]
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def { csvFormat = csvPreset # CsvPresetRFC }
|
|
, userSex = Just SexMale
|
|
, userShowSex = userDefaultShowSex
|
|
}
|
|
fhamann <- insert User
|
|
{ userIdent = "felix.hamann@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "felix.hamann@campus.lmu.de"
|
|
, userDisplayEmail = "felix.hamann@campus.lmu.de"
|
|
, userDisplayName = "Felix Hamann"
|
|
, userSurname = "Hamann"
|
|
, userFirstName = "Felix"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = userDefaultMaxFavourites
|
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
|
, userTheme = ThemeDefault
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Nothing
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def { csvFormat = csvPreset # CsvPresetExcel }
|
|
, userSex = Just SexMale
|
|
, userShowSex = userDefaultShowSex
|
|
}
|
|
jost <- insert User
|
|
{ userIdent = "jost@tcs.ifi.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "jost@tcs.ifi.lmu.de"
|
|
, userDisplayEmail = "jost@tcs.ifi.lmu.de"
|
|
, userDisplayName = "Steffen Jost"
|
|
, userSurname = "Jost"
|
|
, userFirstName = "Steffen"
|
|
, userTitle = Just "Dr."
|
|
, userMaxFavourites = 14
|
|
, userMaxFavouriteTerms = 4
|
|
, userTheme = userDefaultTheme
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Nothing
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userSex = Just SexMale
|
|
, userCsvOptions = def
|
|
, userShowSex = userDefaultShowSex
|
|
}
|
|
maxMuster <- insert User
|
|
{ userIdent = "max@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Just now
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Just "1299"
|
|
, userEmail = "max@campus.lmu.de"
|
|
, userDisplayEmail = "max@max.com"
|
|
, userDisplayName = "Max Musterstudent"
|
|
, userSurname = "Musterstudent"
|
|
, userFirstName = "Max"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = 7
|
|
, userTheme = ThemeAberdeenReds
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Just $ Languages ["de"]
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def
|
|
, userSex = Just SexMale
|
|
, userShowSex = userDefaultShowSex
|
|
}
|
|
tinaTester <- insert $ User
|
|
{ userIdent = "tester@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Just "999"
|
|
, userEmail = "tester@campus.lmu.de"
|
|
, userDisplayEmail = "tina@tester.example"
|
|
, userDisplayName = "Tina Tester"
|
|
, userSurname = "vön Tërrör¿"
|
|
, userFirstName = "Sabrina"
|
|
, userTitle = Just "Magister"
|
|
, userMaxFavourites = 5
|
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
|
, userTheme = ThemeAberdeenReds
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Just $ Languages ["sn"]
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def
|
|
, userSex = Just SexNotApplicable
|
|
, userShowSex = userDefaultShowSex
|
|
}
|
|
svaupel <- insert User
|
|
{ userIdent = "vaupel.sarah@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "vaupel.sarah@campus.lmu.de"
|
|
, userDisplayEmail = "vaupel.sarah@campus.lmu.de"
|
|
, userDisplayName = "Sarah Vaupel"
|
|
, userSurname = "Vaupel"
|
|
, userFirstName = "Sarah"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = 14
|
|
, userMaxFavouriteTerms = 4
|
|
, userTheme = ThemeMossGreen
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Nothing
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def
|
|
, userSex = Just SexFemale
|
|
, userShowSex = userDefaultShowSex
|
|
}
|
|
sbarth <- insert User
|
|
{ userIdent = "Stephan.Barth@campus.lmu.de"
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer = Nothing
|
|
, userEmail = "Stephan.Barth@lmu.de"
|
|
, userDisplayEmail = "stephan.barth@ifi.lmu.de"
|
|
, userDisplayName = "Stephan Barth"
|
|
, userSurname = "Barth"
|
|
, userFirstName = "Stephan"
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = userDefaultMaxFavourites
|
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
|
, userTheme = ThemeMossGreen
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Nothing
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def
|
|
, userSex = Just SexMale
|
|
, userShowSex = userDefaultShowSex
|
|
}
|
|
|
|
let
|
|
firstNames = [ "James", "John", "Robert", "Michael"
|
|
, "William", "David", "Mary", "Richard"
|
|
, "Joseph", "Thomas", "Charles", "Daniel"
|
|
, "Matthew", "Patricia", "Jennifer", "Linda"
|
|
, "Elizabeth", "Barbara", "Anthony", "Donald"
|
|
, "Mark", "Paul", "Steven", "Andrew"
|
|
, "Kenneth", "Joshua", "George", "Kevin"
|
|
, "Brian", "Edward", "Susan", "Ronald"
|
|
]
|
|
surnames = [ "Smith", "Johnson", "Williams", "Brown"
|
|
, "Jones", "Miller", "Davis", "Garcia"
|
|
, "Rodriguez", "Wilson", "Martinez", "Anderson"
|
|
, "Taylor", "Thomas", "Hernandez", "Moore"
|
|
, "Martin", "Jackson", "Thompson", "White"
|
|
, "Lopez", "Lee", "Gonzalez", "Harris"
|
|
, "Clark", "Lewis", "Robinson", "Walker"
|
|
, "Perez", "Hall", "Young", "Allen"
|
|
]
|
|
middlenames = [ Nothing, Just "Jamesson" ]
|
|
toMatrikel :: [Int] -> [Text]
|
|
toMatrikel ns
|
|
| (cs, rest) <- splitAt 8 ns
|
|
, length cs == 8
|
|
= foldMap tshow cs : toMatrikel rest
|
|
| otherwise
|
|
= []
|
|
manyUser (firstName, middleName, userSurname) (Just -> userMatrikelnummer) = User
|
|
{ userIdent
|
|
, userAuthentication = AuthLDAP
|
|
, userLastAuthentication = Nothing
|
|
, userTokensIssuedAfter = Nothing
|
|
, userMatrikelnummer
|
|
, userEmail = userIdent
|
|
, userDisplayEmail = userIdent
|
|
, userDisplayName = case middleName of
|
|
Just middleName' -> [st|#{firstName} #{middleName'} #{userSurname}|]
|
|
Nothing -> [st|#{firstName} #{userSurname}|]
|
|
, userSurname
|
|
, userFirstName = maybe id (\m f -> f <> " " <> m) middleName firstName
|
|
, userTitle = Nothing
|
|
, userMaxFavourites = userDefaultMaxFavourites
|
|
, userMaxFavouriteTerms = userDefaultMaxFavourites
|
|
, userTheme = userDefaultTheme
|
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
|
, userDateFormat = userDefaultDateFormat
|
|
, userTimeFormat = userDefaultTimeFormat
|
|
, userDownloadFiles = userDefaultDownloadFiles
|
|
, userWarningDays = userDefaultWarningDays
|
|
, userLanguages = Nothing
|
|
, userNotificationSettings = def
|
|
, userCreated = now
|
|
, userLastLdapSynchronisation = Nothing
|
|
, userLdapPrimaryKey = Nothing
|
|
, userCsvOptions = def
|
|
, userSex = Nothing
|
|
, userShowSex = userDefaultShowSex
|
|
}
|
|
where
|
|
userIdent :: IsString t => t
|
|
userIdent = fromString $ case middleName of
|
|
Just middleName' -> repack [st|#{firstName}.#{middleName'}.#{userSurname}@example.invalid|]
|
|
Nothing -> repack [st|#{firstName}.#{userSurname}@example.invalid|]
|
|
matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)
|
|
manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel
|
|
|
|
terms <- forM [-7..31*6] $ \nr -> do
|
|
let tid = nextTerm nr tid
|
|
term = Term { termName = termToText' tid
|
|
, termStart = guessDay tid TermDayStart
|
|
, termEnd = guessDay tid TermDayEnd
|
|
, termHolidays = bankHolidaysArea Fraport
|
|
, termLectureStart = guessDay tid TermDayLectureStart
|
|
, termLectureEnd = guessDay tid TermDayLectureEnd
|
|
}
|
|
void $ repsert (TermKey tid) term
|
|
insert $ TermActive (TermKey tid) (toMidnight $ addDays (-60) $ termStart term) (Just . beforeMidnight $ addDays 60 $ termEnd term) Nothing
|
|
|
|
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.
|
|
|]
|
|
}
|
|
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 "Fahrschule" "AVN-A" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True
|
|
void . insert' $ UserFunction jost avn SchoolAdmin
|
|
void . insert' $ UserFunction gkleen ifi SchoolAdmin
|
|
void . insert' $ UserFunction gkleen mi SchoolAdmin
|
|
void . insert' $ UserFunction fhamann ifi SchoolAdmin
|
|
void . insert' $ UserFunction jost ifi SchoolAdmin
|
|
void . insert' $ UserFunction jost mi SchoolAdmin
|
|
void . insert' $ UserFunction svaupel ifi SchoolAdmin
|
|
void . insert' $ UserFunction svaupel mi SchoolAdmin
|
|
void . insert' $ UserFunction gkleen ifi SchoolLecturer
|
|
void . insert' $ UserFunction fhamann ifi SchoolLecturer
|
|
void . insert' $ UserFunction jost ifi SchoolLecturer
|
|
void . insert' $ UserFunction svaupel ifi SchoolLecturer
|
|
void . insert' $ UserFunction gkleen ifi SchoolAllocation
|
|
void . insert' $ UserFunction sbarth ifi SchoolLecturer
|
|
void . insert' $ UserFunction sbarth ifi SchoolExamOffice
|
|
for_ [gkleen, fhamann, maxMuster, svaupel] $ \uid ->
|
|
void . insert' $ UserSchool uid ifi False
|
|
for_ [gkleen, tinaTester] $ \uid ->
|
|
void . insert' $ UserSchool uid mi False
|
|
for_ [jost] $ \uid ->
|
|
void . insert' $ UserSchool uid avn False
|
|
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
|
|
fdf <- insert' Course
|
|
{ courseName = "F - 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
|
|
|]
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = "F"
|
|
, courseTerm = TermKey currentTerm
|
|
, courseSchool = avn
|
|
, courseCapacity = Nothing
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Just $ termTime True (season currentTerm) (-2) False Monday toMidnight
|
|
, courseRegisterTo = Just $ termTime True (season currentTerm) 0 True Saturday beforeMidnight
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = True
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = True
|
|
}
|
|
insert_ $ CourseEdit jost now fdf
|
|
void $ insert Sheet
|
|
{ sheetCourse = fdf
|
|
, sheetName = "Sehtest"
|
|
, sheetDescription = Just $ htmlToStoredMarkup [shamlet|Bitte einen Scan ihres Sehtest hochladen!|]
|
|
, sheetType = NotGraded
|
|
, sheetGrouping = Arbitrary 3
|
|
, sheetMarkingText = Nothing
|
|
, sheetVisibleFrom = Just $ termTime True (season currentTerm) (-2) False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime True (season currentTerm) (-2) False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime True (season currentTerm) 0 True Saturday beforeMidnight
|
|
, 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
|
|
}
|
|
forM_ [(Monday)..Thursday] $ \td -> do
|
|
forM_ [(1::Int)..(4*4)] $ \tw -> do
|
|
let firstTT = termTime True (season currentTerm) (toRational $ tw - 1) False td toMorning
|
|
secondTT = termTime True (season currentTerm) (toRational $ tw - 1) False (succ td) toMorning
|
|
regFrom = termTime True (season currentTerm) (toRational $ tw - 8) False td toMorning
|
|
regTo = termTime True (season currentTerm) (toRational $ tw - 2) False td toMorning
|
|
tut1 <- insert Tutorial
|
|
{ tutorialName = CI.mk $ Text.pack $ "KW" ++ show (snd3 $ toWeekDate $ utctDay firstTT) ++ take 3 (show td)
|
|
, tutorialCourse = fdf
|
|
, tutorialType = "Schulung"
|
|
, tutorialCapacity = Just 16
|
|
, tutorialRoom = Just $ case tw `mod` 4 of
|
|
1 -> "A380"
|
|
2 -> "B747"
|
|
3 -> "MD11"
|
|
_ -> "B777"
|
|
, tutorialRoomHidden = False
|
|
, tutorialTime = Occurrences
|
|
{ occurrencesScheduled = Set.empty
|
|
, occurrencesExceptions = Set.fromList
|
|
[ ExceptOccur
|
|
{ exceptDay = utctDay firstTT
|
|
, exceptStart = TimeOfDay 8 30 0
|
|
, exceptEnd = TimeOfDay 16 0 0
|
|
}
|
|
, ExceptOccur
|
|
{ exceptDay = utctDay secondTT
|
|
, exceptStart = TimeOfDay 9 0 0
|
|
, exceptEnd = TimeOfDay 16 0 0
|
|
}
|
|
]
|
|
}
|
|
, tutorialRegGroup = Just "schulung"
|
|
, tutorialRegisterFrom = Just regFrom
|
|
, tutorialRegisterTo = Just regTo
|
|
, tutorialDeregisterUntil = Nothing
|
|
, tutorialLastChanged = now
|
|
, tutorialTutorControlled = True
|
|
}
|
|
void . insert $ Tutor tut1 jost
|
|
void . insert' $ Exam
|
|
{ examCourse = fdf
|
|
, examName = "Theorie"
|
|
, examGradingRule = Nothing
|
|
, examBonusRule = Nothing
|
|
, examOccurrenceRule = ExamRoomManual
|
|
, examExamOccurrenceMapping = Nothing
|
|
, examVisibleFrom = Just regFrom
|
|
, examRegisterFrom = Just firstTT
|
|
, examRegisterTo = Just $ toMidday $ utctDay secondTT
|
|
, examDeregisterUntil = Nothing
|
|
, examPublishOccurrenceAssignments = Nothing
|
|
, examStart = Just $ toTimeOfDay 15 30 0 $ utctDay secondTT
|
|
, examEnd = Just $ toTimeOfDay 16 30 0 $ utctDay secondTT
|
|
, 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
|
|
}
|
|
|
|
-- FFP
|
|
let nbrs :: [Int]
|
|
nbrs = [1,2,3,27,7,1]
|
|
ffp <- insert' Course
|
|
{ courseName = "Fortgeschrittene Funktionale Programmierung"
|
|
, courseDescription = Just $ htmlToStoredMarkup [shamlet|
|
|
<h2>It is fun!
|
|
<p>Come to where the functional is!
|
|
<section>
|
|
<h3>Functional programming can be done in Haskell!
|
|
<p>This is not a joke, this is serious!
|
|
<section>
|
|
<h3>Consider some numbers
|
|
<ul>
|
|
$forall n <- nbrs
|
|
<li>Number #{n}
|
|
|]
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = "FFP"
|
|
, courseTerm = TermKey $ seasonTerm True Q1
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 20
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Just $ termTime True Q1 (-2) False Monday toMidnight
|
|
, courseRegisterTo = Just $ termTime True Q1 0 True Sunday beforeMidnight
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = True
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = True
|
|
}
|
|
insert_ $ CourseEdit jost now ffp
|
|
void . insert $ DegreeCourse ffp sdBsc sdInf
|
|
void . insert $ DegreeCourse ffp sdMst sdInf
|
|
-- void . insert $ Lecturer jost ffp CourseLecturer
|
|
void . insert $ Lecturer gkleen ffp CourseAssistant
|
|
adhoc <- insert Sheet
|
|
{ sheetCourse = ffp
|
|
, sheetName = "Adhoc-Gruppen"
|
|
, sheetDescription = Nothing
|
|
, sheetType = NotGraded
|
|
, sheetGrouping = Arbitrary 3
|
|
, sheetMarkingText = Nothing
|
|
, sheetVisibleFrom = Just $ termTime True Q1 0 False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime True Q1 1 False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime True Q1 2 False Sunday beforeMidnight
|
|
, 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
|
|
}
|
|
insert_ $ SheetEdit gkleen now adhoc
|
|
feste <- insert Sheet
|
|
{ sheetCourse = ffp
|
|
, sheetName = "Feste Gruppen"
|
|
, sheetDescription = Nothing
|
|
, sheetType = NotGraded
|
|
, sheetGrouping = RegisteredGroups
|
|
, sheetMarkingText = Nothing
|
|
, sheetVisibleFrom = Just $ termTime True Q1 1 False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime True Q1 2 False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime True Q1 3 False Sunday beforeMidnight
|
|
, 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
|
|
}
|
|
insert_ $ SheetEdit gkleen now feste
|
|
keine <- insert Sheet
|
|
{ sheetCourse = ffp
|
|
, sheetName = "Keine Gruppen"
|
|
, sheetDescription = Nothing
|
|
, sheetType = NotGraded
|
|
, sheetGrouping = NoGroups
|
|
, sheetMarkingText = Nothing
|
|
, sheetVisibleFrom = Just $ termTime True Q1 2 False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime True Q1 3 False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime True Q1 4 False Sunday beforeMidnight
|
|
, 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
|
|
}
|
|
insert_ $ SheetEdit gkleen now keine
|
|
void . insertMany $ map (\u -> CourseParticipant ffp u now Nothing CourseParticipantActive)
|
|
[ fhamann
|
|
, maxMuster
|
|
, tinaTester
|
|
]
|
|
|
|
examFFP <- insert' $ Exam
|
|
{ examCourse = ffp
|
|
, examName = "Klausur"
|
|
, examGradingRule = Nothing
|
|
, examBonusRule = Nothing
|
|
, examOccurrenceRule = ExamRoomManual
|
|
, examExamOccurrenceMapping = Nothing
|
|
, examVisibleFrom = Just $ termTime True Q1 (-4) True Monday toMidnight
|
|
, examRegisterFrom = Just $ termTime True Q1 (-4) True Monday toMidnight
|
|
, examRegisterTo = Just $ termTime True Q1 1 True Sunday beforeMidnight
|
|
, examDeregisterUntil = Just $ termTime True Q1 2 True Wednesday beforeMidnight
|
|
, examPublishOccurrenceAssignments = Just $ termTime True Q1 3 True Monday toMidnight
|
|
, examStart = Just $ termTime True Q1 3 True Tuesday (toTimeOfDay 10 0 0)
|
|
, examEnd = Just $ termTime True Q1 3 True Tuesday (toTimeOfDay 12 0 0)
|
|
, examFinished = Just $ termTime True Q1 3 True Wednesday (toTimeOfDay 22 0 0)
|
|
, examPartsFrom = Just $ termTime True Q1 (-4) True Monday toMidnight
|
|
, examClosed = Nothing
|
|
, examPublicStatistics = True
|
|
, examGradingMode = ExamGradingGrades
|
|
, examDescription = Nothing
|
|
, examExamMode = ExamMode
|
|
{ examAids = Just $ ExamAidsPreset ExamClosedBook
|
|
, examOnline = Just $ ExamOnlinePreset ExamOffline
|
|
, examSynchronicity = Just $ ExamSynchronicityPreset ExamSynchronous
|
|
, examRequiredEquipment = Just $ ExamRequiredEquipmentPreset ExamRequiredEquipmentNone
|
|
}
|
|
, examStaff = Just "Hofmann"
|
|
, examAuthorshipStatement = Nothing
|
|
}
|
|
_ <- insert' Material
|
|
{ materialCourse = ffp
|
|
, materialName = "Material 1"
|
|
, materialType = Just "Typ 1"
|
|
, materialDescription = Just $ htmlToStoredMarkup [shamlet|<i>Folien</i> für die Zentralübung|]
|
|
, materialVisibleFrom = Just now
|
|
, materialLastEdit = now
|
|
}
|
|
|
|
_ <- insert' Material
|
|
{ materialCourse = ffp
|
|
, materialName = "Material 2"
|
|
, materialType = Just "Typ 2"
|
|
, materialDescription = Just $ htmlToStoredMarkup [shamlet|<i>Videos</i> für die Vorlesung|]
|
|
, materialVisibleFrom = Just now
|
|
, materialLastEdit = now
|
|
}
|
|
|
|
void . insertMany $ map (\u -> ExamRegistration examFFP u Nothing now)
|
|
[ fhamann
|
|
, maxMuster
|
|
, tinaTester
|
|
]
|
|
|
|
-- EIP
|
|
eip <- insert' Course
|
|
{ courseName = "Einführung in die Programmierung"
|
|
, courseDescription = Nothing
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = "EIP"
|
|
, courseTerm = TermKey $ seasonTerm False Q4
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 20
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Just $ termTime False Q4 (-4) False Monday toMidnight
|
|
, courseRegisterTo = Nothing
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = True
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = False
|
|
}
|
|
insert_ $ CourseEdit fhamann now eip
|
|
void . insert' $ DegreeCourse eip sdBsc sdInf
|
|
void . insert' $ Lecturer fhamann eip CourseLecturer
|
|
-- interaction design
|
|
ixd <- insert' Course
|
|
{ courseName = "Interaction Design (User Experience Design I & II)"
|
|
, courseDescription = Nothing
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = "IXD"
|
|
, courseTerm = TermKey $ seasonTerm True Q1
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 20
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Just $ termTime True Q1 0 False Monday toMidnight
|
|
, courseRegisterTo = Just $ termTime True Q1 (-2) True Sunday beforeMidnight
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = True
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = False
|
|
}
|
|
insert_ $ CourseEdit fhamann now ixd
|
|
void . insert' $ DegreeCourse ixd sdBsc sdInf
|
|
void . insert' $ Lecturer fhamann ixd CourseAssistant
|
|
-- concept development
|
|
ux3 <- insert' Course
|
|
{ courseName = "Concept Development (User Experience Design III)"
|
|
, courseDescription = Nothing
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = "UX3"
|
|
, courseTerm = TermKey $ seasonTerm True Q4
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 30
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Nothing
|
|
, courseRegisterTo = Nothing
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = True
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = False
|
|
}
|
|
insert_ $ CourseEdit fhamann now ux3
|
|
void . insert' $ DegreeCourse ux3 sdBsc sdInf
|
|
void . insert' $ Lecturer fhamann ux3 CourseAssistant
|
|
-- promo
|
|
pmo <- insert' Course
|
|
{ courseName = "Programmierung und Modellierung"
|
|
, courseDescription = Nothing
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = "ProMo"
|
|
, courseTerm = TermKey $ seasonTerm True Q1
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 50
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Just $ termTime True Q1 (-2) False Monday toMidnight
|
|
, courseRegisterTo = Nothing
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = True
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = False
|
|
}
|
|
insert_ $ CourseEdit jost now pmo
|
|
void . insert $ DegreeCourse pmo sdBsc sdInf
|
|
void . insert $ Lecturer jost pmo CourseAssistant
|
|
void . insertMany $ map (\u -> CourseParticipant pmo u now Nothing CourseParticipantActive)
|
|
[ fhamann
|
|
, maxMuster
|
|
, tinaTester
|
|
]
|
|
|
|
let shTypes = NotGraded : [ shType g | g <- shGradings, shType <- [ Normal, Bonus, Informational ] ]
|
|
where shGradings = [ Points 6, PassPoints 3 6, PassBinary, PassAlways ]
|
|
shGroupings = [ Arbitrary 3, RegisteredGroups, NoGroups ]
|
|
shSubModes = do
|
|
corrector <- universeF
|
|
[ SubmissionMode corrector Nothing
|
|
, SubmissionMode corrector $ Just NoUpload
|
|
, SubmissionMode corrector $ Just UploadSpecific
|
|
{ uploadSpecificFiles = impureNonNull $ Set.fromList
|
|
[ UploadSpecificFile "Aufgabe 1" "exercise_2.1.hs" False False Nothing
|
|
, UploadSpecificFile "Aufgabe 2" "exercise_2.2.hs" False False Nothing
|
|
, UploadSpecificFile "Erklärung der Eigenständigkeit" "erklärung.txt" True True (Just 42)
|
|
]
|
|
}
|
|
] ++ [ SubmissionMode corrector $ Just UploadAny{..}
|
|
| uploadUnpackZips <- universeF
|
|
, uploadExtensionRestriction <- [ Nothing, Just . impureNonNull $ Set.fromList ["pdf", "txt", "jpeg", "hs"] ]
|
|
, let uploadEmptyOk = False
|
|
]
|
|
|
|
sheetCombinations = (,,) <$> shTypes <*> shGroupings <*> shSubModes
|
|
|
|
forM_ (zip [0..] sheetCombinations) $ \(shNr, (sheetType, sheetGrouping, sheetSubmissionMode)) -> do
|
|
MsgRenderer mr <- getMsgRenderer
|
|
|
|
let sheetSubmissionModeDescr
|
|
| Just userMode <- sheetSubmissionMode ^? _submissionModeUser . _Just
|
|
= let
|
|
extra = catMaybes
|
|
[ guardOn (fromMaybe False $ userMode ^? _uploadUnpackZips) $ mr MsgAutoUnzip
|
|
, guardOn (maybe False (is _Just) $ userMode ^? _uploadExtensionRestriction) $ mr MsgUploadModeExtensionRestriction
|
|
]
|
|
in mr (classifySubmissionMode sheetSubmissionMode) <> " (" <> Text.intercalate ", " (mr (classifyUploadMode userMode) : extra) <> ")"
|
|
| Just userMode <- sheetSubmissionMode ^? _submissionModeUser . _Just
|
|
= mr (classifySubmissionMode sheetSubmissionMode) <> " (" <> mr (classifyUploadMode userMode) <> ")"
|
|
| otherwise
|
|
= mr (classifySubmissionMode sheetSubmissionMode)
|
|
sheetGroupingDescr = case sheetGrouping of
|
|
Arbitrary{} -> mr Arbitrary'
|
|
RegisteredGroups -> mr RegisteredGroups'
|
|
NoGroups -> mr NoGroups'
|
|
sheetTypeDescr
|
|
| Just g <- sheetType ^? _grading
|
|
= let sheetGrading' = case g of
|
|
Points{} -> Points'
|
|
PassPoints{} -> PassPoints'
|
|
PassBinary{} -> PassBinary'
|
|
PassAlways{} -> PassAlways'
|
|
in mr sheetType' <> " (" <> mr sheetGrading' <> ")"
|
|
| otherwise
|
|
= mr sheetType'
|
|
where
|
|
sheetType' = classifySheetType sheetType
|
|
|
|
prog = 14 * (shNr % genericLength sheetCombinations)
|
|
|
|
-- liftIO . hPutStrLn stderr $ Text.intercalate ", " [sheetTypeDescr, sheetGroupingDescr, sheetSubmissionModeDescr]
|
|
-- liftIO . hPutStrLn stderr $ tshow (sheetType, sheetGrouping, sheetSubmissionMode)
|
|
|
|
shId <- insert Sheet
|
|
{ sheetCourse = pmo
|
|
, sheetName = CI.mk $ tshow shNr <> ": " <> Text.intercalate ", " [sheetTypeDescr, sheetGroupingDescr, sheetSubmissionModeDescr]
|
|
, sheetDescription = Nothing
|
|
, sheetType, sheetGrouping, sheetSubmissionMode
|
|
, sheetMarkingText = Nothing
|
|
, sheetVisibleFrom = Just $ termTime True Q1 prog False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime True Q1 (prog + 1) False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime True Q1 (prog + 2) False Sunday beforeMidnight
|
|
, sheetHintFrom = Just $ termTime True Q1 (prog + 1) False Sunday beforeMidnight
|
|
, sheetSolutionFrom = Just $ termTime True Q1 (prog + 2) False Sunday beforeMidnight
|
|
, sheetAutoDistribute = True
|
|
, sheetAnonymousCorrection = True
|
|
, sheetRequireExamRegistration = Nothing
|
|
, sheetAllowNonPersonalisedSubmission = True
|
|
, sheetAuthorshipStatementMode = SheetAuthorshipStatementModeExam
|
|
, sheetAuthorshipStatementExam = Nothing
|
|
, sheetAuthorshipStatement = Nothing
|
|
}
|
|
void . insert $ SheetEdit jost now shId
|
|
when (submissionModeCorrector sheetSubmissionMode) $
|
|
forM_ [fhamann, maxMuster, tinaTester] $ \uid -> do
|
|
p <- liftIO getRandom
|
|
void . insert $ SheetPseudonym shId p uid
|
|
void . insert $ SheetCorrector jost shId (Load (Just True) 0 1) CorrectorNormal
|
|
void . insert $ SheetCorrector gkleen shId (Load (Just True) 1 1) CorrectorNormal
|
|
void . insert $ SheetCorrector svaupel shId (Load (Just True) 1 1) CorrectorNormal
|
|
void $ insertFile (SheetFileResidual shId SheetHint) "H10-2.hs"
|
|
void $ insertFile (SheetFileResidual shId SheetSolution) "H10-3.hs"
|
|
void $ insertFile (SheetFileResidual shId SheetExercise) "ProMo_Uebung10.pdf"
|
|
|
|
forM_ [fhamann, maxMuster, tinaTester] $ \uid -> do
|
|
subId <- insert $ Submission
|
|
{ submissionSheet = shId
|
|
, submissionRatingPoints = Nothing
|
|
, submissionRatingComment = Nothing
|
|
, submissionRatingBy = Nothing
|
|
, submissionRatingAssigned = Nothing
|
|
, submissionRatingTime = Nothing
|
|
}
|
|
void . insert $ SubmissionEdit (Just uid) now subId
|
|
void . insert $ SubmissionUser uid subId
|
|
void $ insertFile (SubmissionFileResidual subId False False) "AbgabeH10-1.hs"
|
|
tut1 <- insert Tutorial
|
|
{ tutorialName = "Di08"
|
|
, tutorialCourse = pmo
|
|
, tutorialType = "Tutorium"
|
|
, tutorialCapacity = Just 30
|
|
, tutorialRoom = Just "Hilbert-Raum"
|
|
, tutorialRoomHidden = True
|
|
, tutorialTime = Occurrences
|
|
{ occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 08 15 00) (TimeOfDay 10 00 00)
|
|
, occurrencesExceptions = Set.empty
|
|
}
|
|
, tutorialRegGroup = Just "tutorium"
|
|
, tutorialRegisterFrom = Just $ termTime True Q1 0 False Monday toMidnight
|
|
, tutorialRegisterTo = Nothing
|
|
, tutorialDeregisterUntil = Nothing
|
|
, tutorialLastChanged = now
|
|
, tutorialTutorControlled = True
|
|
}
|
|
void . insert $ Tutor tut1 gkleen
|
|
void . insert $ TutorialParticipant tut1 fhamann
|
|
tut2 <- insert Tutorial
|
|
{ tutorialName = "Di10"
|
|
, tutorialCourse = pmo
|
|
, tutorialType = "Tutorium"
|
|
, tutorialCapacity = Just 30
|
|
, tutorialRoom = Just "Hilbert-Raum"
|
|
, tutorialRoomHidden = True
|
|
, tutorialTime = Occurrences
|
|
{ occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 10 15 00) (TimeOfDay 12 00 00)
|
|
, occurrencesExceptions = Set.empty
|
|
}
|
|
, tutorialRegGroup = Just "tutorium"
|
|
, tutorialRegisterFrom = Just $ termTime True Q1 0 False Monday toMidnight
|
|
, tutorialRegisterTo = Nothing
|
|
, tutorialDeregisterUntil = Nothing
|
|
, tutorialLastChanged = now
|
|
, tutorialTutorControlled = False
|
|
}
|
|
void . insert $ Tutor tut2 gkleen
|
|
-- datenbanksysteme
|
|
dbs <- insert' Course
|
|
{ courseName = "Datenbanksysteme"
|
|
, courseDescription = Just "Datenbanken banken Daten damit die Daten nicht wanken. Die Datenschützer danken!"
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = "DBS"
|
|
, courseTerm = TermKey $ seasonTerm False Q4
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 50
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Nothing
|
|
, courseRegisterTo = Nothing
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Just "dbs"
|
|
, courseMaterialFree = False
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = False
|
|
}
|
|
insert_ $ CourseEdit gkleen now dbs
|
|
void . insert' $ DegreeCourse dbs sdBsc sdInf
|
|
void . insert' $ DegreeCourse dbs sdBsc sdMath
|
|
void . insert' $ Lecturer gkleen dbs CourseLecturer
|
|
void . insert' $ Lecturer jost dbs CourseAssistant
|
|
|
|
testMsg <- insert SystemMessage
|
|
{ systemMessageNewsOnly = False
|
|
, systemMessageFrom = Just now
|
|
, systemMessageTo = Nothing
|
|
, systemMessageAuthenticatedOnly = False
|
|
, systemMessageSeverity = Success
|
|
, systemMessageManualPriority = Nothing
|
|
, systemMessageDefaultLanguage = "de"
|
|
, systemMessageContent = "System-Nachrichten werden angezeigt"
|
|
, systemMessageSummary = Nothing
|
|
, systemMessageCreated = now
|
|
, systemMessageLastChanged = now
|
|
, systemMessageLastUnhide = now
|
|
}
|
|
void . insert $ SystemMessageTranslation testMsg "en" "System messages may be translated" Nothing
|
|
void $ insert SystemMessage
|
|
{ systemMessageNewsOnly = False
|
|
, systemMessageFrom = Just now
|
|
, systemMessageTo = Nothing
|
|
, systemMessageAuthenticatedOnly = False
|
|
, systemMessageSeverity = Info
|
|
, systemMessageManualPriority = Nothing
|
|
, systemMessageDefaultLanguage = "de"
|
|
, systemMessageContent = "System-Nachrichten können längeren Inhalt enthalten"
|
|
, systemMessageSummary = Just "System-Nachricht Zusammenfassung"
|
|
, systemMessageCreated = now
|
|
, systemMessageLastChanged = now
|
|
, systemMessageLastUnhide = now
|
|
}
|
|
void $ insert SystemMessage
|
|
{ systemMessageNewsOnly = False
|
|
, systemMessageFrom = Just now
|
|
, systemMessageTo = Just now
|
|
, systemMessageAuthenticatedOnly = False
|
|
, systemMessageSeverity = Info
|
|
, systemMessageManualPriority = Nothing
|
|
, systemMessageDefaultLanguage = "de"
|
|
, systemMessageContent = "System-Nachrichten haben Ablaufdaten"
|
|
, systemMessageSummary = Nothing
|
|
, systemMessageCreated = now
|
|
, systemMessageLastChanged = now
|
|
, systemMessageLastUnhide = now
|
|
}
|
|
void $ insert SystemMessage
|
|
{ systemMessageNewsOnly = False
|
|
, systemMessageFrom = Nothing
|
|
, systemMessageTo = Nothing
|
|
, systemMessageAuthenticatedOnly = False
|
|
, systemMessageSeverity = Error
|
|
, systemMessageManualPriority = Nothing
|
|
, systemMessageDefaultLanguage = "de"
|
|
, systemMessageContent = "System-Nachrichten können Inaktiv sein"
|
|
, systemMessageSummary = Nothing
|
|
, systemMessageCreated = now
|
|
, systemMessageLastChanged = now
|
|
, systemMessageLastUnhide = now
|
|
}
|
|
void $ insert SystemMessage
|
|
{ systemMessageNewsOnly = True
|
|
, systemMessageFrom = Just now
|
|
, systemMessageTo = Nothing
|
|
, systemMessageAuthenticatedOnly = False
|
|
, systemMessageSeverity = Error
|
|
, systemMessageManualPriority = Nothing
|
|
, systemMessageDefaultLanguage = "de"
|
|
, systemMessageContent = "System-Nachrichten können nur auf \"Aktuelles\" angezeigt werden"
|
|
, systemMessageSummary = Nothing
|
|
, systemMessageCreated = now
|
|
, systemMessageLastChanged = now
|
|
, systemMessageLastUnhide = now
|
|
}
|
|
|
|
|
|
aSeedFunc <- liftIO $ getRandomBytes 40
|
|
funAlloc <- insert' Allocation
|
|
{ allocationName = "Funktionale Zentralanmeldung"
|
|
, allocationShorthand = "fun"
|
|
, allocationTerm = TermKey currentTerm
|
|
, allocationSchool = ifi
|
|
, allocationLegacyShorthands = []
|
|
, allocationDescription = Nothing
|
|
, allocationStaffDescription = Nothing
|
|
, allocationStaffRegisterFrom = Just now
|
|
, allocationStaffRegisterTo = Just $ 300 `addUTCTime` now
|
|
, allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now
|
|
, allocationStaffAllocationTo = Just $ 900 `addUTCTime` now
|
|
, allocationRegisterFrom = Just $ 300 `addUTCTime` now
|
|
, allocationRegisterTo = Just $ 600 `addUTCTime` now
|
|
, allocationRegisterByStaffFrom = Nothing
|
|
, allocationRegisterByStaffTo = Nothing
|
|
, allocationRegisterByCourse = Nothing
|
|
, allocationOverrideDeregister = Just $ termTime True Q1 1 False Monday toMidnight
|
|
, allocationMatchingSeed = aSeedFunc
|
|
}
|
|
insert_ $ AllocationCourse funAlloc pmo 100 Nothing Nothing
|
|
insert_ $ AllocationCourse funAlloc ffp 2 (Just $ 2300 `addUTCTime` now) Nothing
|
|
|
|
void . insertMany $ map (\(u, pState) -> CourseParticipant ffp u now (Just funAlloc) pState)
|
|
[ (svaupel, CourseParticipantInactive False)
|
|
, (jost, CourseParticipantActive)
|
|
]
|
|
|
|
-- void $ insertFile "H10-2.hs" -- unreferenced
|
|
|
|
-- -- betriebssysteme
|
|
bs <- insert' Course
|
|
{ courseName = "Betriebssystem"
|
|
, courseDescription = Nothing
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = "BS"
|
|
, courseTerm = TermKey $ seasonTerm False Q4
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 50
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Nothing
|
|
, courseRegisterTo = Nothing
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = False
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = False
|
|
}
|
|
insert_ $ CourseEdit gkleen now bs
|
|
void . insert' $ Lecturer gkleen bs CourseLecturer
|
|
void . insertMany $ do
|
|
uid <- take 1024 manyUsers
|
|
return $ CourseParticipant bs uid now Nothing CourseParticipantActive
|
|
forM_ [1..14] $ \shNr -> do
|
|
shId <- insert Sheet
|
|
{ sheetCourse = bs
|
|
, sheetName = CI.mk [st|Blatt #{tshow shNr}|]
|
|
, sheetDescription = Nothing
|
|
, sheetType = Normal $ PassPoints 12 6
|
|
, sheetGrouping = Arbitrary 3
|
|
, sheetMarkingText = Nothing
|
|
, sheetVisibleFrom = Just $ termTime False Q4 (fromInteger shNr) False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime False Q4 (fromInteger $ succ shNr) False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime False Q4 (fromInteger $ succ shNr) False Sunday beforeMidnight
|
|
, 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
|
|
}
|
|
manyUsers' <- shuffleM $ take 1024 manyUsers
|
|
groupSizes <- getRandomRs (1, 3)
|
|
let groups = go groupSizes manyUsers'
|
|
where go [] _ = []
|
|
go (s:ss) us
|
|
| (grp, rest) <- splitAt s us
|
|
, length grp == s
|
|
= grp : go ss rest
|
|
| otherwise
|
|
= pure us
|
|
forM_ groups $ \grpUsers-> case grpUsers of
|
|
pUid : _ -> do
|
|
sub <- insert Submission
|
|
{ submissionSheet = shId
|
|
, submissionRatingPoints = Nothing
|
|
, submissionRatingComment = Nothing
|
|
, submissionRatingBy = Nothing
|
|
, submissionRatingAssigned = Nothing
|
|
, submissionRatingTime = Nothing
|
|
}
|
|
forM_ grpUsers $ void . insert . flip SubmissionUser sub
|
|
void . insert $ SubmissionEdit (Just pUid) now sub
|
|
_other -> return ()
|
|
|
|
forM_ ([1..100] :: [Int]) $ \n -> do
|
|
csh <- pack . take 3 <$> getRandomRs ('A', 'Z')
|
|
|
|
cid <- insert' Course
|
|
{ courseName = CI.mk [st|Test Kurs #{n} (#{csh})|]
|
|
, courseDescription = Nothing
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = CI.mk csh
|
|
, courseTerm = TermKey $ seasonTerm False Q4
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 50
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Nothing
|
|
, courseRegisterTo = Nothing
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = True
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = False
|
|
}
|
|
insert_ $ CourseEdit gkleen now cid
|
|
-- void . insert' $ Lecturer gkleen cid CourseLecturer
|
|
|
|
participants <- getRandomR (0, 50)
|
|
manyUsers' <- shuffleM $ take 1024 manyUsers
|
|
forM_ (take participants manyUsers') $ \uid ->
|
|
void . insertUnique $ CourseParticipant cid uid now Nothing CourseParticipantActive
|
|
|
|
aSeedBig <- liftIO $ getRandomBytes 40
|
|
bigAlloc <- insert' Allocation
|
|
{ allocationName = "Große Zentralanmeldung"
|
|
, allocationShorthand = "big"
|
|
, allocationTerm = TermKey $ seasonTerm True Q1
|
|
, allocationSchool = ifi
|
|
, allocationLegacyShorthands = []
|
|
, allocationDescription = Nothing
|
|
, allocationStaffDescription = Nothing
|
|
, allocationStaffRegisterFrom = Just now
|
|
, allocationStaffRegisterTo = Just $ 300 `addUTCTime` now
|
|
, allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now
|
|
, allocationStaffAllocationTo = Just $ 900 `addUTCTime` now
|
|
, allocationRegisterFrom = Just $ 300 `addUTCTime` now
|
|
, allocationRegisterTo = Just $ 600 `addUTCTime` now
|
|
, allocationRegisterByStaffFrom = Nothing
|
|
, allocationRegisterByStaffTo = Nothing
|
|
, allocationRegisterByCourse = Nothing
|
|
, allocationOverrideDeregister = Just $ termTime True Q1 1 False Monday toMidnight
|
|
, allocationMatchingSeed = aSeedBig
|
|
}
|
|
bigAllocShorthands <-
|
|
let go xs = let (csh, xs') = List.splitAt 3 xs
|
|
in pack csh : go xs'
|
|
in take 40 . nubOrd . go <$> getRandomRs ('A', 'Z')
|
|
bigAllocCourses <- forM (zip [1..] bigAllocShorthands) $ \(n :: Natural, csh) -> do
|
|
cap <- getRandomR (10,50)
|
|
|
|
minCap <- round . (* fromIntegral cap) <$> getRandomR (0, 0.5 :: Double)
|
|
|
|
substitutesUntil <- (`addUTCTime` now) . fromInteger <$> getRandomR (900,2300)
|
|
|
|
cid <- insert' Course
|
|
{ courseName = CI.mk [st|Zentralanmeldungskurs #{n} (#{csh})|]
|
|
, courseDescription = Nothing
|
|
, courseLinkExternal = Nothing
|
|
, courseShorthand = CI.mk csh
|
|
, courseTerm = TermKey $ seasonTerm False Q4
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just cap
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Nothing
|
|
, courseRegisterTo = Nothing
|
|
, courseDeregisterUntil = Nothing
|
|
, courseRegisterSecret = Nothing
|
|
, courseMaterialFree = True
|
|
, courseApplicationsRequired = False
|
|
, courseApplicationsInstructions = Nothing
|
|
, courseApplicationsText = False
|
|
, courseApplicationsFiles = NoUpload
|
|
, courseApplicationsRatingsVisible = False
|
|
, courseDeregisterNoShow = False
|
|
}
|
|
insert_ $ CourseEdit gkleen now cid
|
|
void . insert' $ AllocationCourse bigAlloc cid minCap (Just substitutesUntil) Nothing
|
|
-- void . insert' $ Lecturer gkleen cid CourseLecturer
|
|
return cid
|
|
|
|
forM_ manyUsers $ \uid -> do
|
|
totalCourses <- weighted $ do
|
|
n <- [1..10]
|
|
return (n, fromIntegral $ (1 - 10) ^ 2 - (1 - n) ^ 2)
|
|
|
|
void . insert $ AllocationUser bigAlloc uid (fromIntegral totalCourses) Nothing
|
|
|
|
appliedCourses <- weighted $ do
|
|
n <- [totalCourses - 2..totalCourses + 5]
|
|
return (n, fromIntegral $ (totalCourses + 1 - totalCourses - 5) ^ 2 - (totalCourses + 1 - n) ^ 2)
|
|
|
|
appliedCourses' <- take appliedCourses <$> shuffleM bigAllocCourses
|
|
|
|
forM_ (zip [0..] appliedCourses') $ \(prio, cid) -> do
|
|
rating <- weighted . Map.toList . Map.fromListWith (+) $ do
|
|
veto <- universeF :: [Bool]
|
|
grade <- universeF :: [ExamGrade]
|
|
rated <- universeF
|
|
|
|
return ( bool Nothing (Just (veto, grade)) rated
|
|
, bool 5 1 veto * bool 5 1 rated
|
|
)
|
|
|
|
void $ insert CourseApplication
|
|
{ courseApplicationCourse = cid
|
|
, courseApplicationUser = uid
|
|
, courseApplicationText = Nothing
|
|
, courseApplicationRatingVeto = maybe False (view _1) rating
|
|
, courseApplicationRatingPoints = view _2 <$> rating
|
|
, courseApplicationRatingComment = Nothing
|
|
, courseApplicationAllocation = Just bigAlloc
|
|
, courseApplicationAllocationPriority = Just prio
|
|
, courseApplicationTime = now
|
|
, courseApplicationRatingTime = now <$ rating
|
|
}
|
|
|
|
numericPriorities <- flip foldMapM manyUsers $ \uid -> do
|
|
uRec <- get uid
|
|
case uRec of
|
|
Just User{ userMatrikelnummer = Just matr } -> do
|
|
prios <- replicateM 3 $ getRandomR (0, 300)
|
|
return . pure . AllocationPriorityNumericRecord matr . fromList $ sortOn Down prios
|
|
_other -> return mempty
|
|
|
|
ordinalPriorities <- do
|
|
manyUsers' <- shuffleM manyUsers
|
|
flip foldMapM manyUsers' $ \uid -> do
|
|
uRec <- get uid
|
|
case uRec of
|
|
Just User{ userMatrikelnummer = Just matr } ->
|
|
return . pure $ Csv.Only matr
|
|
_other -> return mempty
|
|
|
|
liftIO . handle (\(_ :: IOException) -> return ()) $ do
|
|
haveTestdata <- doesDirectoryExist "testdata"
|
|
LBS.writeFile (bool id ("testdata" </>) haveTestdata "bigAlloc_numeric.csv") $ Csv.encode numericPriorities
|
|
LBS.writeFile (bool id ("testdata" </>) haveTestdata "bigAlloc_ordinal.csv") $ Csv.encode ordinalPriorities
|
|
|
|
forM_ universeF $ \changelogItem -> do
|
|
let ptn = "templates/i18n/changelog/" <> unpack (toPathPiece changelogItem) <> ".*"
|
|
files <- liftIO $ glob ptn
|
|
mTime <- fmap minimum . fromNullable <$> mapM (liftIO . getModificationTime) files
|
|
whenIsJust mTime $ \(utctDay -> firstSeen) -> do
|
|
oldFirstSeen <- selectMaybe [ ChangelogItemFirstSeenItem ==. changelogItem ] [ Asc ChangelogItemFirstSeenFirstSeen ]
|
|
case oldFirstSeen of
|
|
Just (Entity firstSeenId oldEntry)
|
|
| changelogItemFirstSeenFirstSeen oldEntry > firstSeen
|
|
-> update firstSeenId [ ChangelogItemFirstSeenFirstSeen =. firstSeen ]
|
|
Just _
|
|
-> return ()
|
|
Nothing
|
|
-> insert_ $ ChangelogItemFirstSeen changelogItem firstSeen
|