fraport/fradrive-old
Archived
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

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

@ -41,17 +41,18 @@ type TutorialType = CI Text
defaultTutorialType :: TutorialType defaultTutorialType :: TutorialType
defaultTutorialType = "Schulung" defaultTutorialType = "Schulung"
tutorialTypeSeparator :: Text tutorialTypeSeparator :: TutorialType
tutorialTypeSeparator = "___" tutorialTypeSeparator = "___"
tutorialTemplateNames :: Maybe TutorialType -> [TutorialType] tutorialTemplateNames :: Maybe TutorialType -> [TutorialType]
tutorialTemplateNames Nothing = ["Vorlage", "Template"] 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 :: Maybe TutorialType -> Day -> TutorialName
-- tutorialDefaultName Nothing = tutorialDefaultName $ Just defaultTutorialType tutorialDefaultName Nothing = CI.mk . tshow -- Don't use user date display setting, so that tutorial default names conform to all users
tutorialDefaultName _ = 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 data ButtonCourseRegisterMode = BtnCourseRegisterConfirm | BtnCourseRegisterAbort
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
@ -165,7 +166,12 @@ handleAddUserR tid ssh csh tdesc ttyp = do
-- ((\pfx -> E.val pfx `E.isPrefixOf_` tutorial E.^. TutorialType) (tutorialTemplateNames Nothing)) -- ((\pfx -> E.val pfx `E.isPrefixOf_` tutorial E.^. TutorialType) (tutorialTemplateNames Nothing))
E.orderBy [E.asc tuTyp] E.orderBy [E.asc tuTyp]
return tuTyp return tuTyp
return (cid, E.unValue <$> tutTypes) 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 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 redirect $ CourseR tid ssh csh CUsersR
((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do ((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) tutDefType = ttyp >>= (\ty -> if ty `elem` tutTypes then Just ty else Nothing)
auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
auReqTutorial <- optionalActionW auReqTutorial <- optionalActionW
@ -320,7 +326,7 @@ upsertNewTutorial cid newTutorialName newTutorialType newFirstDay = runDB $ do
newTime = normalizeOccurrences $ occurrencesAddBusinessDays term (oldFirstDay, moveDay) tutorialTime newTime = normalizeOccurrences $ occurrencesAddBusinessDays term (oldFirstDay, moveDay) tutorialTime
dayDiff = maybe 0 (diffDays moveDay) tutorialFirstDay dayDiff = maybe 0 (diffDays moveDay) tutorialFirstDay
mvTime = fmap $ addLocalDays dayDiff 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 newType = if newType0 `elem` tutorialTemplateNames Nothing
then fromMaybe defaultTutorialType newTutorialType then fromMaybe defaultTutorialType newTutorialType
else newType0 else newType0