Fixes #190
This commit is contained in:
parent
bef662d162
commit
39e96e6ccd
@ -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)
|
||||
|
||||
@ -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 ]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user