fix(course-edit): show old allocation

Fixes #450

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) => {
+    this.childInputs.forEach((el) => this._updateChildVisibility(el, active));
-      el.disabled = !active;
+  }
 
-      // disable input for flatpickrs added input as well if exists
+  _updateChildVisibility(el, active) {
-      if (el._flatpickr) {
+    el.disabled = !active;
-        el._flatpickr.altInput.disabled = !active;
+    
-      }
+    if (active) {
-    });
+      delete el.dataset.interactiveFieldsetHidden;
+    } else {
+      el.dataset.interactiveFieldsetHidden = true;
+    }
   }
 
   _matchesConditionalValue() {

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)
+          allocationEnabled (Entity _ Allocation{..})
-                                                     && NTop (Just now) <= NTop allocationStaffRegisterTo
+            = NTop allocationStaffRegisterFrom <= NTop (Just now)
-          availableAllocations = filter allocationEnabled availableAllocations'
+           && 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
+          currentAllocationAvailable = (\alloc -> any ((== alloc) . entityKey) availableAllocations) . acfAllocation <$> (template >>= cfAllocation)
-          [] -> wforced (convertField (const Nothing) (const False) checkBoxField) (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseNoAllocationsAvailable) Nothing
+
+        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
+              userAdmin = not $ null adminSchools
-                <$> apreq (selectField' Nothing $ return allocationOptions) (fslI MsgCourseAllocation) (fmap acfAllocation $ template >>= cfAllocation)
+              mayChange = fromMaybe True $ (|| userAdmin) <$> currentAllocationAvailable
-                <*> apreq (natFieldI MsgCourseAllocationMinCapacityMustBeNonNegative) (fslI MsgCourseAllocationMinCapacity & setTooltip MsgCourseAllocationMinCapacityTip) (fmap acfMinCapacity $ template >>= cfAllocation)
+              
-            
+              allocationForm' =
-            optionalActionW allocationForm' (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseAllocationParticipateTip) (is _Just . cfAllocation <$> template)
+                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)

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
+optionalAction = optionalAction' mpopt
-  (doRes, doView) <- mpopt checkBoxField fs defActive
+
+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.

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