fradrive/fill-db.hs

#!/usr/bin/env stack
-- stack runghc --package uniworx

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}

import "uniworx" Import
import "uniworx" Application (db)

import Database.Persist.Sql (toSqlKey)

import Data.Time

main :: IO ()
main = db $ do
  defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings
  now <- liftIO getCurrentTime
  let
    insert' :: PersistRecordBackend r (YesodPersistBackend UniWorX) => r -> YesodDB UniWorX (Key r)
    insert' = fmap (either entityKey id) . insertBy
    summer2017 = TermIdentifier 2017 Summer
    winter2017 = TermIdentifier 2017 Winter
    summer2018 = TermIdentifier 2018 Summer
  gkleen <- insert' User
    { userPlugin = "LDAP"
    , userIdent  = "G.Kleen@campus.lmu.de"
    , userMatrikelnummer = Nothing
    , userEmail  = "G.Kleen@campus.lmu.de"
    , userDisplayName = "Gregor Kleen"
    , userMaxFavourites = 6
    }
  fhamann <- insert' User
    { userPlugin = "LDAP"
    , userIdent  = "felix.hamann@campus.lmu.de"
    , userMatrikelnummer = Nothing
    , userEmail  = "felix.hamann@campus.lmu.de"
    , userDisplayName = "Felix Hamann"
    , userMaxFavourites = defaultFavourites
    }
  jost <- insert' User
    { userPlugin = "LDAP"
    , userIdent  = "jost@tcs.ifi.lmu.de"
    , userMatrikelnummer = Nothing
    , userEmail  = "jost@tcs.ifi.lmu.de"
    , userDisplayName = "Steffen Jost"
    , userMaxFavourites = 14
    }
  void . repsert (TermKey summer2017) $ Term
    { termName     = summer2017
    , termStart    = fromGregorian 2017 04 09
    , termEnd      = fromGregorian 2017 07 14
    , termHolidays = []
    , termLectureStart = fromGregorian 2017 04 09
    , termLectureEnd   = fromGregorian 2018 07 14
    , termActive       = False
    }
  void . repsert (TermKey winter2017) $ Term
    { termName     = winter2017
    , termStart    = fromGregorian 2017 10 16
    , termEnd      = fromGregorian 2018 02 10
    , termHolidays = [fromGregorian 2017 12 24..fromGregorian 2018 01 06]
    , termLectureStart = fromGregorian 2017 10 16
    , termLectureEnd   = fromGregorian 2018 02 10
    , termActive       = True
    }
  void . repsert (TermKey summer2018) $ Term
    { termName     = summer2018
    , termStart    = fromGregorian 2018 04 09
    , termEnd      = fromGregorian 2018 07 14
    , termHolidays = []
    , termLectureStart = fromGregorian 2018 04 09
    , termLectureEnd   = fromGregorian 2018 07 14
    , termActive       = True
    }
  ifi <- insert' $ School "Institut für Informatik" "IfI"
  mi <- insert' $ School "Institut für Mathematik" "MI"
  void . insert' $ UserAdmin gkleen ifi
  void . insert' $ UserAdmin gkleen mi
  void . insert' $ UserAdmin fhamann ifi
  void . insert' $ UserAdmin jost ifi
  void . insert' $ UserAdmin jost mi
  void . insert' $ UserLecturer gkleen ifi
  void . insert' $ UserLecturer fhamann ifi
  void . insert' $ UserLecturer jost ifi
  let
    sdBsc = StudyDegreeKey' 82
    sdMst = StudyDegreeKey' 88
  repsert sdBsc  $ StudyDegree 82 (Just "BSc") (Just "Bachelor"  )
  repsert sdMst  $ StudyDegree 88 (Just "MSc") (Just "Master"    )
  let
    sdInf  = StudyTermsKey' 79
    sdMath = StudyTermsKey' 105
  repsert sdInf  $ StudyTerms  79 (Just "Inf") (Just "Informatik")
  repsert sdMath $ StudyTerms 105 (Just "M"  ) (Just "Mathematik")
  -- FFP
  ffp <- insert' Course
    { courseName = "Fortgeschrittene Funktionale Programmierung"
    , courseDescription = Nothing
    , courseLinkExternal = Nothing
    , courseShorthand = "ffp"
    , courseTermId = TermKey summer2018
    , courseSchoolId = ifi
    , courseCapacity = Just 20
    , courseHasRegistration = True
    , courseRegisterFrom = Just now
    , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now )
    , courseDeregisterUntil = Nothing
    , courseRegisterSecret  = Nothing
    , courseMaterialFree    = True
    }
  insert_ $ CourseEdit jost now ffp
  void . insert' $ DegreeCourse ffp sdBsc sdInf
  void . insert' $ DegreeCourse ffp sdMst sdInf
  void . insert' $ Lecturer jost   ffp
  void . insert' $ Lecturer gkleen ffp
  void . insert' $ Corrector gkleen ffp (ByProportion 1)
  sheetkey <- insert' $ Sheet ffp "Blatt 1" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing
  insert_ $ SheetEdit gkleen now sheetkey
  -- EIP
  eip <- insert' Course
    { courseName = "Einführung in die Programmierung"
    , courseDescription = Nothing
    , courseLinkExternal = Nothing
    , courseShorthand = "eip"
    , courseTermId = TermKey summer2017
    , courseSchoolId = ifi
    , courseCapacity = Just 20
    , courseHasRegistration = False
    , courseRegisterFrom = Nothing
    , courseRegisterTo = Nothing
    , courseDeregisterUntil = Nothing
    , courseRegisterSecret  = Nothing
    , courseMaterialFree    = True
    }
  insert_ $ CourseEdit fhamann now eip
  void . insert' $ DegreeCourse eip sdBsc sdInf
  void . insert' $ Lecturer fhamann eip
  -- interaction design
  ixd <- insert' Course
    { courseName = "Interaction Design (User Experience Design I & II)"
    , courseDescription = Nothing
    , courseLinkExternal = Nothing
    , courseShorthand = "ixd"
    , courseTermId = TermKey summer2018
    , courseSchoolId = ifi
    , courseCapacity = Just 20
    , courseHasRegistration = True
    , courseRegisterFrom = Just now
    , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now )
    , courseDeregisterUntil = Nothing
    , courseRegisterSecret  = Nothing
    , courseMaterialFree    = True
    }
  insert_ $ CourseEdit fhamann now ixd
  void . insert' $ DegreeCourse ixd sdBsc sdInf
  void . insert' $ Lecturer fhamann ixd
  -- concept development
  ux3 <- insert' Course
    { courseName = "Concept Development (User Experience Design III)"
    , courseDescription = Nothing
    , courseLinkExternal = Nothing
    , courseShorthand = "ux3"
    , courseTermId = TermKey winter2017
    , courseSchoolId = ifi
    , courseCapacity = Just 30
    , courseHasRegistration = False
    , courseRegisterFrom = Nothing
    , courseRegisterTo = Nothing
    , courseDeregisterUntil = Nothing
    , courseRegisterSecret  = Nothing
    , courseMaterialFree    = True
    }
  insert_ $ CourseEdit fhamann now ux3
  void . insert' $ DegreeCourse ux3 sdBsc sdInf
  void . insert' $ Lecturer fhamann ux3
  -- promo
  pmo <- insert' Course
    { courseName = "Programmierung und Modellierung"
    , courseDescription = Nothing
    , courseLinkExternal = Nothing
    , courseShorthand = "pmo"
    , courseTermId = TermKey summer2017
    , courseSchoolId = ifi
    , courseCapacity = Just 50
    , courseHasRegistration = False
    , courseRegisterFrom = Nothing
    , courseRegisterTo = Nothing
    , courseDeregisterUntil = Nothing
    , courseRegisterSecret  = Nothing
    , courseMaterialFree    = True
    }
  insert_ $ CourseEdit jost now pmo
  void . insert' $ DegreeCourse pmo sdBsc sdInf
  void . insert' $ Lecturer jost pmo
  -- datenbanksysteme
  dbs <- insert' Course
    { courseName = "Datenbanksysteme"
    , courseDescription = Nothing
    , courseLinkExternal = Nothing
    , courseShorthand = "dbs"
    , courseTermId = TermKey summer2018
    , courseSchoolId = ifi
    , courseCapacity = Just 50
    , courseHasRegistration = False
    , courseRegisterFrom = Nothing
    , courseRegisterTo = Nothing
    , courseDeregisterUntil = Nothing
    , courseRegisterSecret  = Nothing
    , courseMaterialFree    = True
    }
  insert_ $ CourseEdit gkleen now dbs
  void . insert' $ DegreeCourse dbs sdBsc sdInf
  void . insert' $ DegreeCourse dbs sdBsc sdMath
  void . insert' $ Lecturer gkleen dbs
  void . insert' $ Lecturer jost   dbs