chore(exams): connect exam authorship statement form part to model
This commit is contained in:
parent
57a259d8a2
commit
b6a72d9a45
@ -20,7 +20,7 @@ Exam
|
|||||||
examMode ExamMode
|
examMode ExamMode
|
||||||
staff Text Maybe
|
staff Text Maybe
|
||||||
partsFrom UTCTime Maybe
|
partsFrom UTCTime Maybe
|
||||||
-- authorshipStatement AuthorshipStatementDefinitionId Maybe
|
authorshipStatement AuthorshipStatementDefinitionId Maybe
|
||||||
UniqueExam course name
|
UniqueExam course name
|
||||||
deriving Generic
|
deriving Generic
|
||||||
ExamPart
|
ExamPart
|
||||||
|
|||||||
@ -40,6 +40,19 @@ postEEditR tid ssh csh examn = do
|
|||||||
|
|
||||||
editExamAct <- formResultMaybe editExamResult $ \ExamForm{..} -> do
|
editExamAct <- formResultMaybe editExamResult $ \ExamForm{..} -> do
|
||||||
res <- trySql @ExamEditException $ do
|
res <- trySql @ExamEditException $ do
|
||||||
|
mAuthorshipStatementId <- case efAuthorshipStatement of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just newStatementContent -> do
|
||||||
|
mPreviousStatement <- maybe (pure Nothing) getEntity (oldExam ^. _examAuthorshipStatement)
|
||||||
|
if
|
||||||
|
| Just (Entity previousStatementId AuthorshipStatementDefinition{authorshipStatementDefinitionContent=previousStatementContent}) <- mPreviousStatement
|
||||||
|
, newStatementContent == previousStatementContent
|
||||||
|
-> return $ Just previousStatementId
|
||||||
|
| Just (Entity previousStatementId _) <- mPreviousStatement
|
||||||
|
-> update previousStatementId [ AuthorshipStatementDefinitionContent =. newStatementContent ] >> return (Just previousStatementId)
|
||||||
|
| otherwise
|
||||||
|
-> fmap Just $ insert AuthorshipStatementDefinition { authorshipStatementDefinitionContent = newStatementContent }
|
||||||
|
|
||||||
insertRes <- myReplaceUnique eId Exam
|
insertRes <- myReplaceUnique eId Exam
|
||||||
{ examCourse = cid
|
{ examCourse = cid
|
||||||
, examName = efName
|
, examName = efName
|
||||||
@ -60,9 +73,9 @@ postEEditR tid ssh csh examn = do
|
|||||||
, examGradingMode = efGradingMode
|
, examGradingMode = efGradingMode
|
||||||
, examDescription = efDescription
|
, examDescription = efDescription
|
||||||
, examExamMode = efExamMode
|
, examExamMode = efExamMode
|
||||||
-- , examAuthorshipStatement = Nothing -- TODO
|
|
||||||
, examStaff = efStaff
|
, examStaff = efStaff
|
||||||
, examPartsFrom = efPartsFrom
|
, examPartsFrom = efPartsFrom
|
||||||
|
, examAuthorshipStatement = mAuthorshipStatementId
|
||||||
}
|
}
|
||||||
|
|
||||||
when (is _Just insertRes) $
|
when (is _Just insertRes) $
|
||||||
|
|||||||
@ -29,6 +29,8 @@ postCExamNewR tid ssh csh = do
|
|||||||
newExamAct <- formResultMaybe newExamResult $ \ExamForm{..} -> do
|
newExamAct <- formResultMaybe newExamResult $ \ExamForm{..} -> do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
|
|
||||||
|
mAuthorshipStatementId <- maybe (return Nothing) (fmap Just . insert . AuthorshipStatementDefinition) efAuthorshipStatement
|
||||||
|
|
||||||
insertRes <- insertUnique Exam
|
insertRes <- insertUnique Exam
|
||||||
{ examName = efName
|
{ examName = efName
|
||||||
, examCourse = cid
|
, examCourse = cid
|
||||||
@ -49,9 +51,9 @@ postCExamNewR tid ssh csh = do
|
|||||||
, examPublicStatistics = efPublicStatistics
|
, examPublicStatistics = efPublicStatistics
|
||||||
, examDescription = efDescription
|
, examDescription = efDescription
|
||||||
, examExamMode = efExamMode
|
, examExamMode = efExamMode
|
||||||
-- , examAuthorshipStatement = Nothing -- TODO
|
|
||||||
, examStaff = efStaff
|
, examStaff = efStaff
|
||||||
, examPartsFrom = efPartsFrom
|
, examPartsFrom = efPartsFrom
|
||||||
|
, examAuthorshipStatement = mAuthorshipStatementId
|
||||||
}
|
}
|
||||||
whenIsJust insertRes $ \examid -> do
|
whenIsJust insertRes $ \examid -> do
|
||||||
insertMany_
|
insertMany_
|
||||||
|
|||||||
@ -734,6 +734,7 @@ fillDb = do
|
|||||||
}
|
}
|
||||||
-- , examAuthorshipStatement = Nothing
|
-- , examAuthorshipStatement = Nothing
|
||||||
, examStaff = Just "Hofmann"
|
, examStaff = Just "Hofmann"
|
||||||
|
, examAuthorshipStatement = Nothing
|
||||||
}
|
}
|
||||||
_ <- insert' Material
|
_ <- insert' Material
|
||||||
{ materialCourse = ffp
|
{ materialCourse = ffp
|
||||||
|
|||||||
Reference in New Issue
Block a user