|
|
|
|
@ -37,32 +37,6 @@ import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications
|
|
|
|
|
import Handler.Course.Users
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- TODO: Idee: MultiAction für jedes Exam, um so die einzelnen Occurrences zu markieren!
|
|
|
|
|
-- Default muss auch entsprechend generiert werden, wenn keine Occurrences für den Tag existieren
|
|
|
|
|
-- Im Form sollten die neuen markiert werden als ungespeichert! Generell wünschenswert für MassInput!
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- | Generate multiForm with one entry for each course exam showing only day-relevant exam occurrences
|
|
|
|
|
mkExamOccurrenceForm :: [(Entity Exam, CryptoUUIDExam, Widget)] -> ExamOccurrenceMap -> Form (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm)
|
|
|
|
|
mkExamOccurrenceForm exs eom = renderAForm FormStandard maa
|
|
|
|
|
where
|
|
|
|
|
maa = multiActionA acts (fslI MsgCourseExam) Nothing
|
|
|
|
|
eid2eos = convertExamOccurrenceMap eom
|
|
|
|
|
|
|
|
|
|
acts :: Map Text (AForm Handler (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm))
|
|
|
|
|
acts = Map.fromList $ map mkAct exs
|
|
|
|
|
|
|
|
|
|
mkAct :: (Entity Exam, CryptoUUIDExam, Widget) -> (Text, AForm Handler (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm))
|
|
|
|
|
mkAct (Entity{entityKey=eId, entityVal=Exam{examName=eName, examDescription=eDescr}}, cueId, ewgt) = (ciOriginal eName,
|
|
|
|
|
let (cuEoIds, eos) = munzip $ Map.lookup eId eid2eos
|
|
|
|
|
in (,,)
|
|
|
|
|
<$ for_ eDescr (aformInfoWidget . toWgt)
|
|
|
|
|
<*> apreq hiddenField "" (Just cueId)
|
|
|
|
|
<*> apreq (mkSetField hiddenField) "" cuEoIds
|
|
|
|
|
<* aformInfoWidget ewgt
|
|
|
|
|
<*> examOccurrenceMultiForm eos -- TODO filter occurrences to cuEoIds
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
data TutorialUserAction
|
|
|
|
|
= TutorialUserAssignExam
|
|
|
|
|
| TutorialUserPrintQualification
|
|
|
|
|
@ -93,6 +67,32 @@ data TutorialUserActionData
|
|
|
|
|
}
|
|
|
|
|
deriving (Eq, Ord, Read, Show, Generic)
|
|
|
|
|
|
|
|
|
|
-- non-table form for general tutorial actions
|
|
|
|
|
data GenTutAction
|
|
|
|
|
= GenTutActOccCopy
|
|
|
|
|
| GenTutActOccEdit
|
|
|
|
|
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
|
|
|
|
deriving anyclass (Universe, Finite)
|
|
|
|
|
|
|
|
|
|
nullaryPathPiece ''GenTutAction $ camelToPathPiece' 1
|
|
|
|
|
embedRenderMessage ''UniWorX ''GenTutAction id
|
|
|
|
|
|
|
|
|
|
data GenTutActionData
|
|
|
|
|
= GenTutActOccCopyData { gtaExam :: ExamId }
|
|
|
|
|
| GenTutActOccEditData { gtaExamMb :: Maybe ExamId }
|
|
|
|
|
deriving (Eq, Ord, Show, Generic)
|
|
|
|
|
|
|
|
|
|
mkGenTutForm :: [Filter Exam] -> Form GenTutActionData
|
|
|
|
|
mkGenTutForm fltr = renderAForm FormStandard maa
|
|
|
|
|
where
|
|
|
|
|
maa = multiActionA acts (fslI MsgCourseExam) Nothing
|
|
|
|
|
|
|
|
|
|
acts :: Map GenTutAction (AForm Handler GenTutActionData)
|
|
|
|
|
acts = Map.fromList
|
|
|
|
|
[ (GenTutActOccCopy, GenTutActOccCopyData <$> areq (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing)
|
|
|
|
|
, (GenTutActOccEdit, GenTutActOccEditData <$> aopt (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing)
|
|
|
|
|
]
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler TypedContent
|
|
|
|
|
getTUsersR = postTUsersR
|
|
|
|
|
@ -222,46 +222,37 @@ postTUsersR tid ssh csh tutn = do
|
|
|
|
|
_other -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing
|
|
|
|
|
|
|
|
|
|
case tcontent of
|
|
|
|
|
Just act -> act -- execute action and return produced content
|
|
|
|
|
Nothing -> do -- no table action, continue normally
|
|
|
|
|
let (fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan
|
|
|
|
|
$logInfoS "ExamOccurrenceForm" [st|Exam from #{tshow tbegin} until #{tshow tend}.|]
|
|
|
|
|
(openExams, tutors) <- runDBRead $ (,)
|
|
|
|
|
<$> selectList ([ExamCourse ==. cid, ExamStart <=. tend] ++ ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing])) [Asc ExamName]
|
|
|
|
|
<*> E.select (do
|
|
|
|
|
(tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
|
|
|
|
|
`E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId)
|
|
|
|
|
E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
|
|
|
|
|
return user
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
let mkExamCreateBtn = linkButton mempty (msg2widget MsgMenuExamNew) [BCIsButton, BCPrimary] $ SomeRoute $ CourseR tid ssh csh CExamNewR
|
|
|
|
|
mkExamEditBtn ename = linkButton mempty (msg2widget MsgMenuExamEdit) [BCIsButton, BCDefault] $ SomeRoute $ CourseR tid ssh csh $ ExamR ename EEditR
|
|
|
|
|
examOccWgt <- if null openExams
|
|
|
|
|
then return $(i18nWidgetFile "exam-missing")
|
|
|
|
|
else do
|
|
|
|
|
openExamsUUIDs <- forM openExams $ \ent@Entity{entityKey=k, entityVal=Exam{examName}} -> (ent,,) <$> encrypt k <*> pure (mkExamEditBtn examName)
|
|
|
|
|
((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkExamOccurrenceForm openExamsUUIDs exOccs -- TODO also TODO: occurrence name auto generation
|
|
|
|
|
let gtaAnchor = "general-tutorial-action-form" :: Text
|
|
|
|
|
gtaRoute = croute :#: gtaAnchor
|
|
|
|
|
gtaForm = wrapForm gtaWgt FormSettings
|
|
|
|
|
{ formMethod = POST
|
|
|
|
|
, formAction = Just . SomeRoute $ gtaRoute
|
|
|
|
|
, formEncoding = gtaEnctype
|
|
|
|
|
, formAttrs = []
|
|
|
|
|
, formSubmit = FormSubmit
|
|
|
|
|
, formAnchor = Just gtaAnchor
|
|
|
|
|
}
|
|
|
|
|
$logInfoS "ExamOccurrenceEdit" $ tshow (Set.map (eofName &&& eofId) . trd3 <$> gtaRes)
|
|
|
|
|
formResult gtaRes $ \(cEId, cEOIds, occs) -> do -- (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm)
|
|
|
|
|
let ceoidsDelete = cEOIds `Set.difference` setMapMaybe eofId occs
|
|
|
|
|
eId <- decrypt cEId
|
|
|
|
|
eoIdsDelete <- mapM decrypt $ Set.toList ceoidsDelete
|
|
|
|
|
$logInfoS "ExamOccurrenceEdit" [st|Exam-Edit: #{length cEOIds} old occurrences, #{length eoIdsDelete} to delete, #{length $ Set.filter (isNothing . eofId) occs} to insert, #{length $ Set.filter (isJust . eofId) occs} to edit|]
|
|
|
|
|
runDB do
|
|
|
|
|
deleteWhere [ExamOccurrenceExam ==. eId, ExamOccurrenceId <-. eoIdsDelete]
|
|
|
|
|
void $ upsertExamOccurrences eId $ Set.toList occs
|
|
|
|
|
return gtaForm
|
|
|
|
|
Just act -> act -- execute action and return produced content (i.e. pdf)
|
|
|
|
|
Nothing -> do -- no table action content to return, continue normally
|
|
|
|
|
let mkExamCreateBtn = linkButton mempty (msg2widget MsgMenuExamNew) [BCIsButton, BCPrimary] $ SomeRoute $ CourseR tid ssh csh CExamNewR
|
|
|
|
|
(fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan
|
|
|
|
|
exmFltr = ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing]) ++ [ExamCourse ==. cid, ExamStart <=. tend]
|
|
|
|
|
$logInfoS "ExamOccurrenceForm" [st|Exams from #{tshow tbegin} until #{tshow tend}.|]
|
|
|
|
|
((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkGenTutForm exmFltr
|
|
|
|
|
let gtaAnchor = "general-tutorial-action-form" :: Text
|
|
|
|
|
gtaRoute = croute :#: gtaAnchor
|
|
|
|
|
gtaForm = wrapForm gtaWgt FormSettings
|
|
|
|
|
{ formMethod = POST
|
|
|
|
|
, formAction = Just . SomeRoute $ gtaRoute
|
|
|
|
|
, formEncoding = gtaEnctype
|
|
|
|
|
, formAttrs = []
|
|
|
|
|
, formSubmit = FormSubmit
|
|
|
|
|
, formAnchor = Just gtaAnchor
|
|
|
|
|
}
|
|
|
|
|
formResult gtaRes $ \case
|
|
|
|
|
GenTutActOccEditData { gtaExamMb=Nothing } -> do
|
|
|
|
|
redirect $ CourseR tid ssh csh CExamNewR
|
|
|
|
|
GenTutActOccEditData { gtaExamMb=Just eId } -> do
|
|
|
|
|
Exam{examName=ename} <- runDBRead $ get404 eId
|
|
|
|
|
redirect $ CTutorialR tid ssh csh tutn $ TExamR ename
|
|
|
|
|
GenTutActOccCopyData { gtaExam=eId } -> do
|
|
|
|
|
error "TODO"
|
|
|
|
|
tutors <- runDBRead $ E.select do
|
|
|
|
|
(tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
|
|
|
|
|
`E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId)
|
|
|
|
|
E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
|
|
|
|
|
return user
|
|
|
|
|
-- $(i18nWidgetFile "exam-missing")
|
|
|
|
|
let heading = prependCourseTitle tid ssh csh $ CI.original tutorialName
|
|
|
|
|
html <- siteLayoutMsg heading do
|
|
|
|
|
setTitleI heading
|
|
|
|
|
|
