From fc53497aa330e50dc6c61a864cd417e0bb0c5b30 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 4 Sep 2019 11:36:16 +0200 Subject: [PATCH] fix(course-edit): show old allocation Fixes #450 --- .../src/utils/form/interactive-fieldset.js | 21 ++++---- src/Handler/Course/Edit.hs | 53 ++++++++++++++----- src/Handler/Utils/Form.hs | 30 +++++++++-- src/Utils/Form.hs | 16 ++++++ 4 files changed, 94 insertions(+), 26 deletions(-) diff --git a/frontend/src/utils/form/interactive-fieldset.js b/frontend/src/utils/form/interactive-fieldset.js index 9c080e04f..0f6a7a395 100644 --- a/frontend/src/utils/form/interactive-fieldset.js +++ b/frontend/src/utils/form/interactive-fieldset.js @@ -60,7 +60,7 @@ export class InteractiveFieldset { // add event listener const observer = new MutationObserver(() => this._updateVisibility()); - observer.observe(this.conditionalInput, { attributes: true, attributeFilter: ['disabled'] }); + observer.observe(this.conditionalInput, { attributes: true, attributeFilter: ['data-interactive-fieldset-hidden'] }); this.conditionalInput.addEventListener('input', () => this._updateVisibility()); // initial visibility update @@ -76,18 +76,21 @@ export class InteractiveFieldset { } _updateVisibility() { - const active = this._matchesConditionalValue() && !this.conditionalInput.disabled; + const active = this._matchesConditionalValue() && !this.conditionalInput.dataset.interactiveFieldsetHidden; this.target.classList.toggle('hidden', !active); - this.childInputs.forEach((el) => { - el.disabled = !active; + this.childInputs.forEach((el) => this._updateChildVisibility(el, active)); + } - // disable input for flatpickrs added input as well if exists - if (el._flatpickr) { - el._flatpickr.altInput.disabled = !active; - } - }); + _updateChildVisibility(el, active) { + el.disabled = !active; + + if (active) { + delete el.dataset.interactiveFieldsetHidden; + } else { + el.dataset.interactiveFieldsetHidden = true; + } } _matchesConditionalValue() { diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index a6a1e4159..d99c5d6a4 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -20,6 +20,7 @@ import qualified Data.Map as Map import Control.Monad.Trans.Writer (execWriterT) import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Utils as E import Jobs.Queue @@ -105,7 +106,12 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do MsgRenderer mr <- getMsgRenderer uid <- liftHandlerT requireAuthId - userSchools <- liftHandlerT . runDB $ map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin, SchoolLecturer]] [] + (lecturerSchools, adminSchools) <- liftHandlerT . runDB $ do + lecturerSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolLecturer]] [] + protoAdminSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin]] [] + adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools + return (lecturerSchools, adminSchools) + let userSchools = nub $ lecturerSchools ++ adminSchools termsField <- case template of -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin @@ -197,32 +203,53 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do allocationForm = wFormToAForm $ do availableAllocations' <- liftHandlerT . runDB . E.select . E.from $ \(allocation `E.InnerJoin` term) -> do E.on $ allocation E.^. AllocationTerm E.==. term E.^. TermId + + let alreadyParticipates = flip (maybe E.false) (template >>= cfCourseId) $ \cid -> + E.exists . E.from $ \allocationCourse -> + E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. E.val cid + E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId + E.where_ $ term E.^. TermActive - return allocation + E.||. alreadyParticipates + return (allocation, alreadyParticipates) now <- liftIO getCurrentTime let allocationEnabled :: Entity Allocation -> Bool - allocationEnabled (Entity _ Allocation{..}) = NTop allocationStaffRegisterFrom <= NTop (Just now) - && NTop (Just now) <= NTop allocationStaffRegisterTo - availableAllocations = filter allocationEnabled availableAllocations' + allocationEnabled (Entity _ Allocation{..}) + = NTop allocationStaffRegisterFrom <= NTop (Just now) + && NTop (Just now) <= NTop allocationStaffRegisterTo + availableAllocations = availableAllocations' ^.. folded . filtered (allocationEnabled . view _1) . _1 + activeAllocations = availableAllocations' ^.. folded . filtered ((&&) <$> (not <$> allocationEnabled . view _1) <*> view (_2 . _Value)) . _1 mkAllocationOption :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX) => Entity Allocation -> m (Option AllocationId) mkAllocationOption (Entity aId Allocation{..}) = liftHandlerT $ do cID <- encrypt aId :: Handler CryptoUUIDAllocation return . Option (mr . MsgCourseAllocationOption (mr . ShortTermIdentifier $ unTermKey allocationTerm) $ CI.original allocationName) aId $ toPathPiece cID - case availableAllocations of - [] -> wforced (convertField (const Nothing) (const False) checkBoxField) (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseNoAllocationsAvailable) Nothing + currentAllocationAvailable = (\alloc -> any ((== alloc) . entityKey) availableAllocations) . acfAllocation <$> (template >>= cfAllocation) + + case (currentAllocationAvailable, availableAllocations) of + (Nothing, []) -> wforced (convertField (const Nothing) (const False) checkBoxField) (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseNoAllocationsAvailable) Nothing _ -> do - allocationOptions <- mkOptionList <$> mapM mkAllocationOption availableAllocations + allocationOptions <- mkOptionList <$> mapM mkAllocationOption (availableAllocations ++ activeAllocations) let - allocationForm' = AllocationCourseForm - <$> apreq (selectField' Nothing $ return allocationOptions) (fslI MsgCourseAllocation) (fmap acfAllocation $ template >>= cfAllocation) - <*> apreq (natFieldI MsgCourseAllocationMinCapacityMustBeNonNegative) (fslI MsgCourseAllocationMinCapacity & setTooltip MsgCourseAllocationMinCapacityTip) (fmap acfMinCapacity $ template >>= cfAllocation) - - optionalActionW allocationForm' (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseAllocationParticipateTip) (is _Just . cfAllocation <$> template) + userAdmin = not $ null adminSchools + mayChange = fromMaybe True $ (|| userAdmin) <$> currentAllocationAvailable + + allocationForm' = + let ainp :: Field Handler a -> FieldSettings UniWorX -> Maybe a -> AForm Handler a + ainp + | mayChange + = apreq + | otherwise + = aforcedJust + in AllocationCourseForm + <$> ainp (selectField' Nothing $ return allocationOptions) (fslI MsgCourseAllocation) (fmap acfAllocation $ template >>= cfAllocation) + <*> ainp (natFieldI MsgCourseAllocationMinCapacityMustBeNonNegative) (fslI MsgCourseAllocationMinCapacity & setTooltip MsgCourseAllocationMinCapacityTip) (fmap acfMinCapacity $ template >>= cfAllocation) + + optionalActionW' (bool mforcedJust mpopt mayChange) allocationForm' (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseAllocationParticipateTip) (is _Just . cfAllocation <$> template) (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm <$> pure (cfCourseId =<< template) diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 878dd4813..3e701a619 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -170,8 +170,15 @@ optionalAction :: AForm Handler a -> FieldSettings UniWorX -> Maybe Bool -> (Html -> MForm Handler (FormResult (Maybe a), [FieldView UniWorX])) -optionalAction justAct fs@FieldSettings{..} defActive csrf = do - (doRes, doView) <- mpopt checkBoxField fs defActive +optionalAction = optionalAction' mpopt + +optionalAction' :: (Field Handler Bool -> FieldSettings UniWorX -> Maybe Bool -> MForm Handler (FormResult Bool, FieldView UniWorX)) + -> AForm Handler a + -> FieldSettings UniWorX + -> Maybe Bool + -> (Html -> MForm Handler (FormResult (Maybe a), [FieldView UniWorX])) +optionalAction' minp justAct fs@FieldSettings{..} defActive csrf = do + (doRes, doView) <- minp checkBoxField fs defActive (actionRes, actionViews') <- over _2 ($ []) <$> aFormToForm justAct let actionViews = over (mapped . _fvInput) (\w -> $(widgetFile "widgets/multi-action/optional-action")) actionViews' @@ -182,13 +189,28 @@ optionalActionA :: AForm Handler a -> FieldSettings UniWorX -> Maybe Bool -> AForm Handler (Maybe a) -optionalActionA justAct fs defActive = formToAForm $ optionalAction justAct fs defActive mempty +optionalActionA = optionalActionA' mpopt + +optionalActionA' :: (Field Handler Bool -> FieldSettings UniWorX -> Maybe Bool -> MForm Handler (FormResult Bool, FieldView UniWorX)) + -> AForm Handler a + -> FieldSettings UniWorX + -> Maybe Bool + -> AForm Handler (Maybe a) +optionalActionA' minp justAct fs defActive = formToAForm $ optionalAction' minp justAct fs defActive mempty optionalActionW :: AForm Handler a -> FieldSettings UniWorX -> Maybe Bool -> WForm Handler (FormResult (Maybe a)) -optionalActionW justAct fs defAction = aFormToWForm $ optionalActionA justAct fs defAction +optionalActionW = optionalActionW' mpopt + + +optionalActionW' :: (Field Handler Bool -> FieldSettings UniWorX -> Maybe Bool -> MForm Handler (FormResult Bool, FieldView UniWorX)) + -> AForm Handler a + -> FieldSettings UniWorX + -> Maybe Bool + -> WForm Handler (FormResult (Maybe a)) +optionalActionW' minp justAct fs defAction = aFormToWForm $ optionalActionA' minp justAct fs defAction multiAction :: forall action a. diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 578c09217..092deaa1e 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -1079,6 +1079,22 @@ wforced :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m => Field m a -> FieldSettings site -> a -> WForm m (FormResult a) wforced field settings val = mFormToWForm $ mforced field settings val +mforcedJust :: (site ~ HandlerSite m, MonadHandler m) + => Field m a -> FieldSettings site -> Maybe a -> MForm m (FormResult a, FieldView site) +mforcedJust f fs (Just fDef) = mforced f fs fDef +mforcedJust _ _ Nothing = error "mforcedJust called with Nothing" + +aforcedJust :: (RenderMessage site FormMessage, site ~ HandlerSite m, MonadHandler m) + => Field m a -> FieldSettings site -> Maybe a -> AForm m a +aforcedJust f fs (Just fDef) = aforced f fs fDef +aforcedJust _ _ Nothing = error "aforcedJust called with Nothing" + +wforcedJust :: (RenderMessage site FormMessage, site ~ HandlerSite m, MonadHandler m) + => Field m a -> FieldSettings site -> Maybe a -> WForm m (FormResult a) +wforcedJust f fs (Just fDef) = wforced f fs fDef +wforcedJust _ _ Nothing = error "wforcedJust called with Nothing" + + mpreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m) => Field m a -> FieldSettings site -> Maybe a -> MForm m (FormResult a, FieldView site) -- ^ Pseudo required