This commit is contained in:
SJost 2018-10-11 11:14:56 +02:00
parent bef662d162
commit 39e96e6ccd
2 changed files with 19 additions and 6 deletions

View File

@ -532,12 +532,17 @@ newCourseForm template = identForm FIDcourse $ \html -> do
[ map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. userId] []
, map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. userId] []
]
let termsField = case template of
--TODO: if Admin, then all
-- if allowed to delete course then allow current and all active term
-- otherwise only keep current term
(Just cform) | (Just _) <- cfCourseId cform -> termsSetField [cfTerm cform]
_allOtherCases -> termsActiveField
termsField <- liftHandlerT $ case template of
-- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
(Just cform) | (Just cid) <- cfCourseId cform -> do -- edit existing course
_courseOld@Course{..} <- runDB $ get404 cid
mayEditTerm <- isAuthorized TermEditR True
mayDelete <- isAuthorized (CourseR courseTerm courseSchool courseShorthand CDeleteR) True
return $ if
| (mayEditTerm == Authorized) || (mayDelete == Authorized) -> termsAllowedField
| otherwise -> termsSetField [cfTerm cform]
_allOtherCases -> return termsAllowedField
(result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
<$> pure (cfCourseId =<< template)
<*> areq ciField (fslI MsgCourseName) (cfName <$> template)

View File

@ -7,6 +7,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
@ -220,6 +221,13 @@ pointsField = checkBool (>= 0) MsgPointsNotPositive Field{..}
termsActiveField :: Field Handler TermId
termsActiveField = selectField $ optionsPersistKey [TermActive ==. True] [Desc TermStart] termName
termsAllowedField :: Field Handler TermId
termsAllowedField = selectField $ do
mayEditTerm <- isAuthorized TermEditR True
let termFilter | Authorized <- mayEditTerm = []
| otherwise = [TermActive ==. True]
optionsPersistKey termFilter [Desc TermStart] termName
termsSetField :: [TermId] -> Field Handler TermId
termsSetField tids = selectField $ optionsPersistKey [TermName <-. (unTermKey <$> tids)] [Desc TermStart] termName
-- termsSetField tids = selectFieldList [(unTermKey t, t)| t <- tids ]