1450 lines
60 KiB
Haskell
1450 lines
60 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 Control.Applicative (ZipList(..))
|
|
|
|
import Handler.Utils.DateTime
|
|
|
|
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 qualified Data.Yaml as Yaml
|
|
|
|
import Utils.Workflow
|
|
import Utils.Workflow.Lint
|
|
|
|
import System.Directory (getModificationTime)
|
|
import System.FilePath.Glob (glob)
|
|
|
|
import System.IO (hPutStrLn)
|
|
|
|
|
|
testdataDir :: FilePath
|
|
testdataDir = "testdata"
|
|
|
|
|
|
insertFile :: ( HasFileReference fRef, PersistRecordBackend fRef SqlBackend ) => FileReferenceResidual fRef -> FilePath -> DB (Key fRef)
|
|
insertFile residual fileTitle = do
|
|
let fileContent = Just . C.sourceFile $ testdataDir </> fileTitle
|
|
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
|
|
|
|
(currentYear, currentMonth, _) = toGregorian $ utctDay now
|
|
currentTerm
|
|
| 4 <= currentMonth
|
|
, currentMonth <= 9
|
|
= TermIdentifier currentYear Summer
|
|
| otherwise
|
|
= TermIdentifier (pred currentYear) Winter
|
|
nextTerm = succ currentTerm
|
|
prevTerm = pred currentTerm
|
|
prevPrevTerm = pred prevTerm
|
|
|
|
seasonTerm next wSeason
|
|
| wSeason == season currentTerm
|
|
, next = currentTerm
|
|
| wSeason == season currentTerm
|
|
= prevPrevTerm
|
|
| next
|
|
= nextTerm
|
|
| otherwise
|
|
= prevTerm
|
|
|
|
termTime :: Bool -- ^ Next term?
|
|
-> Season
|
|
-> Rational
|
|
-> Bool -- ^ Relative to end of semester?
|
|
-> WeekDay
|
|
-> (Day -> UTCTime)
|
|
-> UTCTime
|
|
termTime next gSeason weekOffset fromEnd d = ($ utctDay)
|
|
where
|
|
utctDay = fromWeekDate wYear wWeek $ fromEnum d
|
|
(wYear, wWeek, _) = toWeekDate . addDays (round $ 7 * weekOffset) $ fromGregorian gYear rMonth rDay
|
|
gYear = year $ seasonTerm next gSeason
|
|
(rMonth, rDay)
|
|
| Winter <- gSeason
|
|
, True <- fromEnd
|
|
= (03, 31)
|
|
| Winter <- gSeason
|
|
, False <- fromEnd
|
|
= (10, 01)
|
|
| True <- fromEnd
|
|
= (09, 30)
|
|
| otherwise
|
|
= (04, 01)
|
|
|
|
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 = ThemeMossGreen
|
|
, 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
|
|
|
|
forM_ [prevPrevTerm, prevTerm, currentTerm, nextTerm] $ \term@TermIdentifier{..} -> case season of
|
|
Summer -> do
|
|
let (wYearStart, wWeekStart, _) = toWeekDate $ fromGregorian year 04 01
|
|
termLectureStart = fromWeekDate wYearStart (wWeekStart + 2) 1
|
|
termLectureEnd = fromWeekDate wYearStart (wWeekStart + 16) 5
|
|
termStart = fromGregorian year 04 01
|
|
termEnd = fromGregorian year 09 30
|
|
void . repsert (TermKey term) $ Term
|
|
{ termName = term
|
|
, termStart
|
|
, termEnd
|
|
, termHolidays = []
|
|
, termLectureStart
|
|
, termLectureEnd
|
|
}
|
|
void . insert_ $ TermActive (TermKey term) (toMidnight $ addDays (-60) termStart) (Just . beforeMidnight $ addDays 60 termEnd) Nothing
|
|
Winter -> do
|
|
let (wYearStart, wWeekStart, _) = toWeekDate $ fromGregorian year 10 01
|
|
termLectureStart = fromWeekDate wYearStart (wWeekStart + 2) 1
|
|
(fromIntegral -> wYearOffset, wWeekEnd) = (wWeekStart + 18) `divMod` bool 53 54 longYear
|
|
termLectureEnd = fromWeekDate (wYearStart + wYearOffset) (bool id succ (wYearOffset /= 0) wWeekEnd) 5
|
|
longYear = case toWeekDate $ fromOrdinalDate wYearStart 365 of
|
|
(_, 53, _) -> True
|
|
_other -> False
|
|
termStart = fromGregorian year 10 01
|
|
termEnd = fromGregorian (succ year) 03 31
|
|
void . repsert (TermKey term) $ Term
|
|
{ termName = term
|
|
, termStart
|
|
, termEnd
|
|
, termHolidays = []
|
|
, termLectureStart
|
|
, termLectureEnd
|
|
}
|
|
void . insert_ $ TermActive (TermKey term) (toMidnight $ addDays (-60) termStart) (Just . beforeMidnight $ addDays 60 termEnd) Nothing
|
|
ifiAuthorshipStatement <- insert $ AuthorshipStatementDefinition "<strong>Erklärung über die eigenständige Bearbeitung</strong><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.</p><strong>Statement of Authorship</strong><p>TODO English version</p>"
|
|
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
|
|
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, jost, maxMuster, svaupel] $ \uid ->
|
|
void . insert' $ UserSchool uid ifi False
|
|
for_ [gkleen, tinaTester] $ \uid ->
|
|
void . insert' $ UserSchool uid mi 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
|
|
|
|
-- 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 Summer
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 20
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Just $ termTime True Summer (-2) False Monday toMidnight
|
|
, courseRegisterTo = Just $ termTime True Summer 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 Summer 0 False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime True Summer 1 False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime True Summer 2 False Sunday beforeMidnight
|
|
, sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
|
|
, sheetHintFrom = Nothing
|
|
, sheetSolutionFrom = Nothing
|
|
, sheetAutoDistribute = False
|
|
, sheetAnonymousCorrection = True
|
|
, sheetRequireExamRegistration = Nothing
|
|
, sheetAllowNonPersonalisedSubmission = True
|
|
}
|
|
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 Summer 1 False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime True Summer 2 False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime True Summer 3 False Sunday beforeMidnight
|
|
, sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
|
|
, sheetHintFrom = Nothing
|
|
, sheetSolutionFrom = Nothing
|
|
, sheetAutoDistribute = False
|
|
, sheetAnonymousCorrection = True
|
|
, sheetRequireExamRegistration = Nothing
|
|
, sheetAllowNonPersonalisedSubmission = True
|
|
}
|
|
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 Summer 2 False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime True Summer 3 False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime True Summer 4 False Sunday beforeMidnight
|
|
, sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
|
|
, sheetHintFrom = Nothing
|
|
, sheetSolutionFrom = Nothing
|
|
, sheetAutoDistribute = False
|
|
, sheetAnonymousCorrection = True
|
|
, sheetRequireExamRegistration = Nothing
|
|
, sheetAllowNonPersonalisedSubmission = True
|
|
}
|
|
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 Summer (-4) True Monday toMidnight
|
|
, examRegisterFrom = Just $ termTime True Summer (-4) True Monday toMidnight
|
|
, examRegisterTo = Just $ termTime True Summer 1 True Sunday beforeMidnight
|
|
, examDeregisterUntil = Just $ termTime True Summer 2 True Wednesday beforeMidnight
|
|
, examPublishOccurrenceAssignments = Just $ termTime True Summer 3 True Monday toMidnight
|
|
, examStart = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 10 0 0)
|
|
, examEnd = Just $ termTime True Summer 3 True Tuesday (toTimeOfDay 12 0 0)
|
|
, examFinished = Just $ termTime True Summer 3 True Wednesday (toTimeOfDay 22 0 0)
|
|
, examPartsFrom = Just $ termTime True Summer (-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"
|
|
}
|
|
_ <- 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 Winter
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 20
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Just $ termTime False Winter (-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 Summer
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 20
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Just $ termTime True Summer 0 False Monday toMidnight
|
|
, courseRegisterTo = Just $ termTime True Summer (-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 Winter
|
|
, 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 Summer
|
|
, courseSchool = ifi
|
|
, courseCapacity = Just 50
|
|
, courseVisibleFrom = Just now
|
|
, courseVisibleTo = Nothing
|
|
, courseRegisterFrom = Just $ termTime True Summer (-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 Summer prog False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime True Summer (prog + 1) False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime True Summer (prog + 2) False Sunday beforeMidnight
|
|
, sheetHintFrom = Just $ termTime True Summer (prog + 1) False Sunday beforeMidnight
|
|
, sheetSolutionFrom = Just $ termTime True Summer (prog + 2) False Sunday beforeMidnight
|
|
, sheetAutoDistribute = True
|
|
, sheetAnonymousCorrection = True
|
|
, sheetRequireExamRegistration = Nothing
|
|
, sheetAllowNonPersonalisedSubmission = True
|
|
}
|
|
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 Summer 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 Summer 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 Winter
|
|
, 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 $ seasonTerm True Summer
|
|
, 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 Summer 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 Winter
|
|
, 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 Winter (fromInteger shNr) False Monday toMidnight
|
|
, sheetActiveFrom = Just $ termTime False Winter (fromInteger $ succ shNr) False Monday toMidnight
|
|
, sheetActiveTo = Just $ termTime False Winter (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
|
|
}
|
|
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 Winter
|
|
, 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 Summer
|
|
, 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 Summer 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 . nub . 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 Winter
|
|
, 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
|
|
|
|
liftIO . LBS.writeFile (testdataDir </> "bigAlloc_numeric.csv") $ Csv.encode numericPriorities
|
|
|
|
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 . LBS.writeFile (testdataDir </> "bigAlloc_ordinal.csv") $ Csv.encode ordinalPriorities
|
|
|
|
let displayLinterIssue :: MonadIO m => WorkflowGraphLinterIssue -> m ()
|
|
displayLinterIssue = liftIO . hPutStrLn stderr . displayException
|
|
|
|
handleSql displayLinterIssue $ do
|
|
graph <- Yaml.decodeFileThrow $ testdataDir </> "workflows" </> "theses.yaml"
|
|
for_ (lintWorkflowGraph graph) $ mapM_ throwM
|
|
workflowDefinitionGraph <- insertSharedWorkflowGraph graph
|
|
let
|
|
thesesWorkflowDef = WorkflowDefinition{..}
|
|
where workflowDefinitionInstanceCategory = Just "theses"
|
|
workflowDefinitionName = "theses"
|
|
workflowDefinitionScope = WSSchool'
|
|
wdId <- insert thesesWorkflowDef
|
|
insert_ WorkflowDefinitionDescription
|
|
{ workflowDefinitionDescriptionDefinition = wdId
|
|
, workflowDefinitionDescriptionLanguage = "de-de-formal"
|
|
, workflowDefinitionDescriptionTitle = "Abschlussarbeiten"
|
|
, workflowDefinitionDescriptionDescription = Just "Erlaubt Abschlussarbeiten in Uni2work zu verwalten"
|
|
}
|
|
insert_ WorkflowDefinitionInstanceDescription
|
|
{ workflowDefinitionInstanceDescriptionDefinition = wdId
|
|
, workflowDefinitionInstanceDescriptionLanguage = "de-de-formal"
|
|
, workflowDefinitionInstanceDescriptionTitle = "Abschlussarbeiten"
|
|
, workflowDefinitionInstanceDescriptionDescription = Just "Hier können Sie Abschlussarbeiten bei der Prüfungsverwaltung angemeldet werden, der relevante Student die Arbeit digital abgeben und im Anschluss auch die Benotung an die Prüfungsverwaltung übermittelt werden."
|
|
}
|
|
let
|
|
thesesWorkflowInst = WorkflowInstance{..}
|
|
where workflowInstanceDefinition = Just wdId
|
|
workflowInstanceGraph = workflowDefinitionGraph
|
|
workflowInstanceScope = WSSchool $ unSchoolKey ifi
|
|
workflowInstanceName = workflowDefinitionName thesesWorkflowDef
|
|
workflowInstanceCategory = workflowDefinitionInstanceCategory thesesWorkflowDef
|
|
wiId <- insert thesesWorkflowInst
|
|
insert_ WorkflowInstanceDescription
|
|
{ workflowInstanceDescriptionInstance = wiId
|
|
, workflowInstanceDescriptionLanguage = "de-de-formal"
|
|
, workflowInstanceDescriptionTitle = "Abschlussarbeiten"
|
|
, workflowInstanceDescriptionDescription = Just "Hier können Sie Abschlussarbeiten bei der Prüfungsverwaltung angemeldet werden, der relevante Student die Arbeit digital abgeben und im Anschluss auch die Benotung an die Prüfungsverwaltung übermittelt werden."
|
|
}
|
|
|
|
handleSql displayLinterIssue $ do
|
|
graph <- Yaml.decodeFileThrow $ testdataDir </> "workflows" </> "recognitions-ifi.yaml"
|
|
for_ (lintWorkflowGraph graph) $ mapM_ throwM
|
|
workflowDefinitionGraph <- insertSharedWorkflowGraph graph
|
|
let
|
|
recognitionsWorkflowDef = WorkflowDefinition{..}
|
|
where workflowDefinitionInstanceCategory = Just "recognitions-ifi"
|
|
workflowDefinitionName = "recognitions-ifi"
|
|
workflowDefinitionScope = WSSchool'
|
|
wdId <- insert recognitionsWorkflowDef
|
|
insert_ WorkflowDefinitionDescription
|
|
{ workflowDefinitionDescriptionDefinition = wdId
|
|
, workflowDefinitionDescriptionLanguage = "de-de-formal"
|
|
, workflowDefinitionDescriptionTitle = "Anerkennungen"
|
|
, workflowDefinitionDescriptionDescription = Just "Erlaubt Anerkennungen von Leistungen in Uni2work zu verwalten"
|
|
}
|
|
insert_ WorkflowDefinitionInstanceDescription
|
|
{ workflowDefinitionInstanceDescriptionDefinition = wdId
|
|
, workflowDefinitionInstanceDescriptionLanguage = "de-de-formal"
|
|
, workflowDefinitionInstanceDescriptionTitle = "Anerekennungen"
|
|
, workflowDefinitionInstanceDescriptionDescription = Nothing
|
|
}
|
|
let
|
|
recognitionsWorkflowInst = WorkflowInstance{..}
|
|
where workflowInstanceDefinition = Just wdId
|
|
workflowInstanceGraph = workflowDefinitionGraph
|
|
workflowInstanceScope = WSSchool $ unSchoolKey ifi
|
|
workflowInstanceName = workflowDefinitionName recognitionsWorkflowDef
|
|
workflowInstanceCategory = workflowDefinitionInstanceCategory recognitionsWorkflowDef
|
|
wiId <- insert recognitionsWorkflowInst
|
|
insert_ WorkflowInstanceDescription
|
|
{ workflowInstanceDescriptionInstance = wiId
|
|
, workflowInstanceDescriptionLanguage = "de-de-formal"
|
|
, workflowInstanceDescriptionTitle = "Anerkennungen"
|
|
, workflowInstanceDescriptionDescription = Nothing
|
|
}
|
|
|
|
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
|