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

chore(tutorial): WIP towards tutorial templates, part 3

Browse Source
This commit is contained in:
Steffen Jost 2023-05-24 16:45:34 +00:00
parent 314e661108
commit a0e37fb153
1 changed files with 14 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,7 +22,7 @@ import Data.Map ((!))
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Time.Zones as TZ import qualified Data.Time.Zones as TZ
import qualified Data.Set as Set import qualified Data.Set as Set
-- import qualified Data.Text as Text import qualified Data.Text as Text
import Control.Monad.Except (MonadError(..)) import Control.Monad.Except (MonadError(..))
@ -40,9 +40,12 @@ type TutorialType = CI Text
defaultTutorialType :: TutorialType defaultTutorialType :: TutorialType
defaultTutorialType = "Schulung" defaultTutorialType = "Schulung"
tutorialTypeSeparator :: Text
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, name]] tutorialTemplateNames (Just name) = [prefixes <> suffixes | prefixes <- tutorialTemplateNames Nothing, suffixes <- [mempty, CI.mk tutorialTypeSeparator <> name]]
data ButtonCourseRegisterMode = BtnCourseRegisterConfirm | BtnCourseRegisterAbort data ButtonCourseRegisterMode = BtnCourseRegisterConfirm | BtnCourseRegisterAbort
@ -173,7 +176,7 @@ postTAddUserR tid ssh csh tut = do
registerTutorialMembers tutId registeredUsers registerTutorialMembers tutId registeredUsers
if if
| Just tutName <- actTutorial | Just tutName <- actTutorial -- CONTINUE HERE
, Set.size tutActs == Set.size confirmedActs , Set.size tutActs == Set.size confirmedActs
-> redirect $ CTutorialR tid ssh csh tutName TUsersR -> redirect $ CTutorialR tid ssh csh tutName TUsersR
| otherwise | otherwise
@ -308,14 +311,18 @@ upsertNewTutorial cid newTutorialName newTutorialType anchorDay = runDB $ do
Course{..} <- get404 cid Course{..} <- get404 cid
term <- get404 courseTerm term <- get404 courseTerm
let oldFirstDay = fromMaybe newFirstDay $ tutorialFirstDay <|> fst (occurrencesBounds term tutorialTime) let oldFirstDay = fromMaybe newFirstDay $ tutorialFirstDay <|> fst (occurrencesBounds term tutorialTime)
newTime = occurrencesAddBusinessDays term (oldFirstDay, newFirstDay) tutorialTime newTime = occurrencesAddBusinessDays term (oldFirstDay, newFirstDay) tutorialTime
dayDiff = maybe 0 (diffDays newFirstDay) tutorialFirstDay dayDiff = maybe 0 (diffDays newFirstDay) tutorialFirstDay
mvTime = fmap $ addLocalDays dayDiff mvTime = fmap $ addLocalDays dayDiff
newType0 = CI.mk . snd . Text.breakOnEnd tutorialTypeSeparator $ CI.original tutorialType
newType = if newType0 `elem` tutorialTemplateNames Nothing
then fromMaybe defaultTutorialType newTutorialType
else newType0
Entity tutId _ <- upsert Entity tutId _ <- upsert
Tutorial Tutorial
{ tutorialName = newTutorialName { tutorialName = newTutorialName
, tutorialCourse = cid , tutorialCourse = cid
, tutorialType = fromMaybe defaultTutorialType newTutorialType , tutorialType = newType
, tutorialFirstDay = anchorDay , tutorialFirstDay = anchorDay
, tutorialTime = newTime , tutorialTime = newTime
, tutorialRegisterFrom = mvTime tutorialRegisterFrom , tutorialRegisterFrom = mvTime tutorialRegisterFrom