fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(course-edit): show old allocation

Browse Source 
Fixes #450
This commit is contained in:
Gregor Kleen 2019-09-04 11:36:16 +02:00
parent 54049d07c6
commit fc53497aa3
4 changed files with 94 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
frontend/src/utils/form/interactive-fieldset.js
View File

@ -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() {

53
src/Handler/Course/Edit.hs
View File

@ -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)

30
src/Handler/Utils/Form.hs
View File

@ -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.

16
src/Utils/Form.hs
View File

@ -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