diff --git a/.gitignore b/.gitignore
index 44f8bb6b1..932688139 100644
--- a/.gitignore
+++ b/.gitignore
@@ -24,3 +24,6 @@ uniworx.nix
.gup/
.dbsettings.yml
*.kate-swp
+src/Handler/Assist.bak
+src/Handler/Course.SnapCustom.hs
+
diff --git a/models b/models
index 38705f488..3c3bcc8fd 100644
--- a/models
+++ b/models
@@ -38,7 +38,8 @@ Course
created UTCTime
changed UTCTime
createdBy UserId
- changedBy UserId
+ changedBy UserId
+ hasRegistration Bool default=TRUE -- canRegisterNow = hasRegistration && maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
registerFrom UTCTime Maybe
registerTo UTCTime Maybe
CourseTermShort termId shorthand
@@ -46,6 +47,19 @@ Lecturer
userId UserId
courseId CourseId
UniqueLecturer userId courseId
+Corrector
+ userId UserId
+ courseId CourseId
+ load Load
+ -- SELECT submissionID FROM Tutorial, TutorialUser, Submission, Sheet
+ -- WHERE ( tutorialTutor = correctorUserId
+ -- && tutorialCourse = correctorCourseId
+ -- && tutorialUserTutorial = tutorialId
+ -- && submissionUser = tutorialUserUser
+ -- && sheetId = submissionSheetId
+ -- && sheetCourse = correctorCourseId
+ -- )
+ UniqueCorrector userId courseId
CourseParticipant
userId UserId
courseId CourseId
@@ -76,10 +90,10 @@ File
deriving Show Eq
Submission
sheetId SheetId
- ratingBy UserId Maybe
ratingPoints Points Maybe
ratingComment Text Maybe
- rated UTCTime Maybe
+ ratingBy UserId Maybe
+ ratingTime UTCTime Maybe
created UTCTime
changed UTCTime
createdBy UserId
@@ -107,6 +121,7 @@ SubmissionGroupUser
Tutorial json
name Text
tutor UserId
+ course CourseId -- ?
TutorialUser
userId UserId
tutorialId TutorialId
@@ -159,4 +174,3 @@ ExamUser
-- CONTINUE HERE: Inlcude rating in this table or seperatly?
UniqueExamUser userId examId
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
-
diff --git a/routes b/routes
index 889bead74..01b56c0be 100644
--- a/routes
+++ b/routes
@@ -16,7 +16,7 @@
!/course/edit CourseEditR GET POST
!/course/#TermIdentifier CourseListTermR GET
/course/#TermIdentifier/#Text/edit CourseEditExistR GET
-/course/#TermIdentifier/#Text/show CourseShowR GET
+/course/#TermIdentifier/#Text/show CourseShowR GET
-- For demonstration
-/course/#CryptoUUIDCourse/edit CourseEditExistIDR GET
\ No newline at end of file
+/course/#CryptoUUIDCourse/edit CourseEditExistIDR GET
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 38d1c8f53..445a26f1d 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -61,8 +61,8 @@ getCourseShowR tid csh = do
(courseEnt,(schoolMB,participants)) <- runDB $ do
courseEnt@(Entity cid course) <- getBy404 $ CourseTermShort (TermKey tid) csh
dependent <- (,)
- <$> get (courseSchoolId course)
- <*> count [CourseParticipantCourseId ==. cid]
+ <$> get (courseSchoolId course) -- join
+ <*> count [CourseParticipantCourseId ==. cid] -- join
return $ (courseEnt,dependent)
let course = entityVal courseEnt
defaultLayout $ do
@@ -95,13 +95,11 @@ courseEditHandler course = do
aid <- requireAuthId
((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course
action <- lookupPostParam "formaction"
- liftIO $ putStrLn "================" -- DEBUG
- liftIO $ print (result,action) -- DEBUG
case (result,action) of
(FormSuccess res, fAct)
| fAct == formActionDelete
, Just cid <- cfCourseId res -> do
- runDB $ delete cid -- TODO Sicherheitsabfrage einbauen!
+ runDB $ deleteCascade cid -- TODO Sicherheitsabfrage einbauen!
let cti = termToText $ cfTerm res
setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde gelöscht! |]
redirect $ CourseListTermR $ cfTerm res
@@ -127,19 +125,20 @@ courseEditHandler course = do
, Nothing <- cfCourseId res -> do
actTime <- liftIO getCurrentTime
insertOkay <- runDB $ insertUnique $ Course
- { courseName = cfName res
- , courseDescription = cfDesc res
- , courseLinkExternal = cfLink res
- , courseShorthand = cfShort res
- , courseTermId = TermKey $ cfTerm res
- , courseSchoolId = cfSchool res
- , courseCapacity = cfCapacity res
- , courseRegisterFrom = cfRegFrom res
- , courseRegisterTo = cfRegTo res
- , courseCreated = actTime
- , courseChanged = actTime
- , courseCreatedBy = aid
- , courseChangedBy = aid
+ { courseName = cfName res
+ , courseDescription = cfDesc res
+ , courseLinkExternal = cfLink res
+ , courseShorthand = cfShort res
+ , courseTermId = TermKey $ cfTerm res
+ , courseSchoolId = cfSchool res
+ , courseCapacity = cfCapacity res
+ , courseHasRegistration = cfHasReg res
+ , courseRegisterFrom = cfRegFrom res
+ , courseRegisterTo = cfRegTo res
+ , courseCreated = actTime
+ , courseChanged = actTime
+ , courseCreatedBy = aid
+ , courseChangedBy = aid
}
case insertOkay of
(Just cid) -> do
@@ -164,7 +163,7 @@ courseEditHandler course = do
data CourseForm = CourseForm
- { cfCourseId :: Maybe CourseId
+ { cfCourseId :: Maybe CourseId -- Maybe CryptoUUIDCourse
, cfName :: Text
, cfDesc :: Maybe Html
, cfLink :: Maybe Text
@@ -172,6 +171,7 @@ data CourseForm = CourseForm
, cfTerm :: TermIdentifier
, cfSchool :: SchoolId
, cfCapacity :: Maybe Int
+ , cfHasReg :: Bool
, cfRegFrom :: Maybe UTCTime
, cfRegTo :: Maybe UTCTime
}
@@ -183,36 +183,41 @@ instance Show CourseForm where
courseToForm :: Entity Course -> CourseForm
courseToForm cEntity = CourseForm
{ cfCourseId = Just $ entityKey cEntity
- , cfName = courseName course
- , cfDesc = courseDescription course
- , cfLink = courseLinkExternal course
- , cfShort = courseShorthand course
+ , cfName = courseName course
+ , cfDesc = courseDescription course
+ , cfLink = courseLinkExternal course
+ , cfShort = courseShorthand course
, cfTerm = unTermKey $ courseTermId course
- , cfSchool = courseSchoolId course
- , cfCapacity = courseCapacity course
- , cfRegFrom = courseRegisterFrom course
- , cfRegTo = courseRegisterTo course
+ , cfSchool = courseSchoolId course
+ , cfCapacity = courseCapacity course
+ , cfHasReg = courseHasRegistration course
+ , cfRegFrom = courseRegisterFrom course
+ , cfRegTo = courseRegisterTo course
}
where
course = entityVal cEntity
newCourseForm :: Maybe CourseForm -> Form CourseForm
newCourseForm template html = do
+ -- mopt hiddenField
+-- cidKey <- getsYesod appCryptoIDKey
+-- courseId <- runMaybeT $ do
+-- cid <- cfCourseId template
+-- UUID.encrypt cidKey cid
(result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ CourseForm
-- <$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work?
- <$> aopt hiddenField "courseId" (cfCourseId <$> template)
- <*> areq textField (set "Name") (cfName <$> template)
- <*> aopt htmlField (set "Beschreibung") (cfDesc <$> template)
- <*> aopt urlField (set "Homepage") (cfLink <$> template)
+ <$> aopt hiddenField "KursId" (cfCourseId <$> template)
+ <*> areq textField (set "Name") (cfName <$> template)
+ <*> aopt htmlField (set "Beschreibung") (cfDesc <$> template)
+ <*> aopt urlField (set "Homepage") (cfLink <$> template)
<*> areq textField (setToolt "Kürzel" "Muss innerhalb des Semesters eindeutig sein") (cfShort <$> template)
- <*> areq termExistsField (set "Semester") (cfTerm <$> template)
- <*> areq (selectField schools) (set "Institut") (cfSchool <$> template)
+ <*> areq termExistsField (set "Semester") (cfTerm <$> template)
+ <*> areq (selectField schools) (set "Institut") (cfSchool <$> template)
<*> aopt (natField "Kapazität") (set "Kapazität") (cfCapacity <$> template)
- <*> aopt utcTimeField (set "Anmeldung von:") (cfRegFrom <$> template)
- <*> aopt utcTimeField (set "Anmeldung bis:") (cfRegTo <$> template)
+ <*> areq checkBoxField (set "Anmeldung") (cfHasReg <$> template)
+ <*> aopt utcTimeField (set "Anmeldung von:") (cfRegFrom <$> template)
+ <*> aopt utcTimeField (set "Anmeldung bis:") (cfRegTo <$> template)
-- <* bootstrapSubmit (bsSubmit (show cid))
- liftIO $ putStrLn "++++++++++" -- DEBUG
- liftIO $ print cid -- DEBUG
return $ case result of
FormSuccess courseResult
| errorMsgs <- validateCourse courseResult
@@ -252,8 +257,21 @@ validateCourse :: CourseForm -> [Text]
validateCourse (CourseForm{..}) =
[ msg | (False, msg) <-
[
- ( cfRegFrom <= cfRegTo
- , "Ende der Anmeldungszeit muss nach dem Anfang liegen"
+ ( cfHasReg <= (cfRegFrom <= cfRegTo)
+ , "Ende des Anmeldezeitraums muss nach dem Anfang liegen"
+ )
+ ,
+-- No starting date is okay: effective immediately
+-- ( cfHasReg <= (isNothing cfRegFrom)
+-- , "Beginn der Anmeldung angeben oder Anmeldungen deaktivieren"
+-- )
+-- ,
+ ( cfHasReg <= (isNothing cfRegTo)
+ , "Ende des Anmeldezeitraums angeben oder Anmeldungen deaktivieren"
+ )
+ ,
+ ( (isJust cfRegFrom || isJust cfRegTo) <= cfHasReg
+ , "Anmeldungen aktivieren oder Anmeldezeitraum löschen"
)
] ]
diff --git a/src/Model.hs b/src/Model.hs
index 62909c626..a08615827 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -22,7 +22,7 @@ import Model.Types
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
-share [mkPersist sqlSettings, mkMigrate "migrateAll"]
+share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "models")
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index 08856e56a..3365a8351 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -53,6 +53,9 @@ data SheetFileType = SheetExercise | SheetHint | SheetSolution | SheetMarking
deriving (Show, Read, Eq, Ord, Enum, Bounded)
derivePersistField "SheetFileType"
+data Load = ByTutorial | ByProportion Double
+ deriving (Show, Read, Eq)
+derivePersistField "Load"
data Season = Summer | Winter
deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic, Typeable)
diff --git a/templates/course.hamlet b/templates/course.hamlet
index 8b2073aa2..fd8fc510d 100644
--- a/templates/course.hamlet
+++ b/templates/course.hamlet
@@ -16,7 +16,7 @@
Beschreibung
#{descr}
$maybe link <- courseLinkExternal course
-
Homepage:
+