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

src/Handler/Course/ParticipantInvite.hs

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