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

feat(course-visibility): now as default visibleFrom for new courses

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-06 11:18:09 +02:00
parent accf8275e4
commit 7bdf8cac88
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -106,6 +106,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
-- TODO: Refactor to avoid the four repeated calls to liftHandler and three runDBs -- TODO: Refactor to avoid the four repeated calls to liftHandler and three runDBs
-- let editCid = cfCourseId =<< template -- possible start for refactoring -- let editCid = cfCourseId =<< template -- possible start for refactoring
now <- liftIO getCurrentTime
MsgRenderer mr <- getMsgRenderer MsgRenderer mr <- getMsgRenderer
uid <- liftHandler requireAuthId uid <- liftHandler requireAuthId
@ -194,11 +195,12 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
unliftEither (Right (lid , lType )) = (Right lid , Just lType) unliftEither (Right (lid , lType )) = (Right lid , Just lType)
unliftEither (Left (lEmail, mLType)) = (Left lEmail, mLType ) unliftEither (Left (lEmail, mLType)) = (Left lEmail, mLType )
(newRegFrom,newRegTo,newDeRegUntil) <- case template of (newVisFrom,newRegFrom,newRegTo,newDeRegUntil) <- case template of
(Just cform) | (Just _cid) <- cfCourseId cform -> return (Nothing,Nothing,Nothing) (Just cform) | (Just _cid) <- cfCourseId cform -> return (Nothing,Nothing,Nothing,Nothing)
_allIOtherCases -> do _allIOtherCases -> do
mbLastTerm <- liftHandler $ runDB $ selectFirst [TermActive ==. True] [Desc TermName] mbLastTerm <- liftHandler $ runDB $ selectFirst [TermActive ==. True] [Desc TermName]
return ( (Just . toMidnight . termStart . entityVal) <$> mbLastTerm return ( Just (Just now)
, (Just . toMidnight . termStart . entityVal) <$> mbLastTerm
, (Just . beforeMidnight . termEnd . entityVal) <$> mbLastTerm , (Just . beforeMidnight . termEnd . entityVal) <$> mbLastTerm
, (Just . beforeMidnight . termEnd . entityVal) <$> mbLastTerm ) , (Just . beforeMidnight . termEnd . entityVal) <$> mbLastTerm )
@ -218,7 +220,6 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
E.||. allocation E.^. AllocationSchool `E.in_` E.valList adminSchools E.||. allocation E.^. AllocationSchool `E.in_` E.valList adminSchools
return (allocation, alreadyParticipates) return (allocation, alreadyParticipates)
now <- liftIO getCurrentTime
let let
allocationEnabled :: Entity Allocation -> Bool allocationEnabled :: Entity Allocation -> Bool
allocationEnabled (Entity _ Allocation{..}) allocationEnabled (Entity _ Allocation{..})
@ -278,7 +279,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
<*> aopt (urlField & cfStrip) (fslpI MsgCourseHomepageExternal (mr MsgCourseHomepageExternalPlaceholder)) <*> aopt (urlField & cfStrip) (fslpI MsgCourseHomepageExternal (mr MsgCourseHomepageExternalPlaceholder))
(cfLink <$> template) (cfLink <$> template)
<*> aopt utcTimeField (fslpI MsgCourseVisibleFrom (mr MsgDate) <*> aopt utcTimeField (fslpI MsgCourseVisibleFrom (mr MsgDate)
& setTooltip MsgCourseVisibleFromTip) (cfVisFrom <$> template) & setTooltip MsgCourseVisibleFromTip) (deepAlt (cfVisFrom <$> template) newVisFrom)
<*> aopt utcTimeField (fslpI MsgCourseVisibleTo (mr MsgDate) <*> aopt utcTimeField (fslpI MsgCourseVisibleTo (mr MsgDate)
& setTooltip MsgCourseVisibleToTip) (cfVisTo <$> template) & setTooltip MsgCourseVisibleToTip) (cfVisTo <$> template)
<*> apopt checkBoxField (fslI MsgMaterialFree) (cfMatFree <$> template) <*> apopt checkBoxField (fslI MsgMaterialFree) (cfMatFree <$> template)