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

chore(tutorial): template pre-selection fixed

Browse Source
This commit is contained in:
Steffen Jost 2023-06-05 16:59:33 +00:00
parent c57ab17d25
commit edc23630a7
1 changed files with 15 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/Handler/Course/ParticipantInvite.hs
View File

@ -41,17 +41,18 @@ type TutorialType = CI Text
defaultTutorialType :: TutorialType
defaultTutorialType = "Schulung"
tutorialTypeSeparator :: Text
tutorialTypeSeparator :: TutorialType
tutorialTypeSeparator = "___"
tutorialTemplateNames :: Maybe TutorialType -> [TutorialType]
tutorialTemplateNames Nothing = ["Vorlage", "Template"]
tutorialTemplateNames (Just name) = [prefixes <> suffixes | prefixes <- tutorialTemplateNames Nothing, suffixes <- [mempty, CI.mk tutorialTypeSeparator <> name]]
tutorialTemplateNames (Just name) = [prefixes <> suffixes | prefixes <- tutorialTemplateNames Nothing, suffixes <- [mempty, tutorialTypeSeparator <> name]]
tutorialDefaultName :: Maybe TutorialType -> Day -> TutorialName
-- tutorialDefaultName Nothing = tutorialDefaultName $ Just defaultTutorialType
tutorialDefaultName _ = CI.mk . tshow -- Don't use user date display setting, so that tutorial default names conform to all users
tutorialDefaultName Nothing = CI.mk . tshow -- Don't use user date display setting, so that tutorial default names conform to all users
tutorialDefaultName (Just ttyp) =
let prefix = CI.mk $ snd $ Text.breakOnEnd (CI.original tutorialTypeSeparator) $ CI.original ttyp
in ((prefix <> "_") <>) . tutorialDefaultName Nothing
data ButtonCourseRegisterMode = BtnCourseRegisterConfirm | BtnCourseRegisterAbort
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
@ -164,8 +165,13 @@ handleAddUserR tid ssh csh tdesc ttyp = do
E.&&. E.not_ (E.any (E.hasPrefix_ tuTyp . E.val) (tutorialTemplateNames Nothing))
-- ((\pfx -> E.val pfx `E.isPrefixOf_` tutorial E.^. TutorialType) (tutorialTemplateNames Nothing))
E.orderBy [E.asc tuTyp]
return tuTyp
return (cid, E.unValue <$> tutTypes)
return tuTyp
let typeSet = Set.fromList [ maybe t CI.mk $ Text.stripPrefix temp_sep $ CI.original t
| temp <- tutorialTemplateNames Nothing
, let temp_sep = CI.original (temp <> tutorialTypeSeparator)
, E.Value t <- tutTypes
]
return (cid, Set.toAscList typeSet) -- Set in order to remove duplicates and sort ascending at once
currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute
@ -186,7 +192,7 @@ handleAddUserR tid ssh csh tdesc ttyp = do
redirect $ CourseR tid ssh csh CUsersR
((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
let tutTypesMsg = [(SomeMessage tt,tt)| tt <- tutTypes]
let tutTypesMsg = [(SomeMessage tt,tt) | tt <- tutTypes]
tutDefType = ttyp >>= (\ty -> if ty `elem` tutTypes then Just ty else Nothing)
auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
auReqTutorial <- optionalActionW
@ -320,7 +326,7 @@ upsertNewTutorial cid newTutorialName newTutorialType newFirstDay = runDB $ do
newTime = normalizeOccurrences $ occurrencesAddBusinessDays term (oldFirstDay, moveDay) tutorialTime
dayDiff = maybe 0 (diffDays moveDay) tutorialFirstDay
mvTime = fmap $ addLocalDays dayDiff
newType0 = CI.mk . snd . Text.breakOnEnd tutorialTypeSeparator $ CI.original tutorialType
newType0 = CI.map (snd . Text.breakOnEnd (CI.original tutorialTypeSeparator)) tutorialType
newType = if newType0 `elem` tutorialTemplateNames Nothing
then fromMaybe defaultTutorialType newTutorialType
else newType0