fix(tutorial): fix #2696 template choice respects school, course, term, etc.

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -157,4 +157,4 @@ QualificationCreated qsh@Text: Qualifikation #{qsh} wurde angelegt.
 QualificationEdit qsh@Text: Qualifikation #{qsh} wurde geändert.
 QualFormErrorDuplShort qsh@Text: Es gibt bereits eine Qualifikation mit Kürzel #{qsh}!
 QualFormErrorDuplName qname@Text: Es gibt bereits eine Qualifikation mit Namen #{qname}!
-QualFormErrorSshMismatch: Qualifikationänderungsformular enthält unglültige Institutsangabe. Bitte versuchen Sie erneut, nachdem Sie Seite neu geladen haben.
+QualFormErrorSshMismatch: Qualifikationänderungsformular enthält unglültige Bereichsangabe. Bitte versuchen Sie erneut, nachdem Sie Seite neu geladen haben.

messages/uniworx/categories/qualification/en-eu.msg

@@ -157,4 +157,4 @@ QualificationCreated qsh@Text: Qualification #{qsh} created.
 QualificationEdit qsh@Text: Qualification #{qsh} edited.
 QualFormErrorDuplShort qsh@Text: There already exists a qualification with shorthand #{qsh}!
 QualFormErrorDuplName qname@Text: There already exists a qualification with name #{qname}!
-QualFormErrorSshMismatch: Qualification edit form data mismatch on institute detected. Please try again after reloading the page.
+QualFormErrorSshMismatch: Qualification edit form department mismatch. Please try again after reloading the page.

messages/uniworx/utils/navigation/menu/en-eu.msg

@@ -127,7 +127,7 @@ MenuQualificationEdit: Edit
 MenuQualificationNew: Create new qualification
 MenuLms: E‑learning
 MenuLmsUser: User Qualifications
-MenuLmsUserSchool: Institute User Qualifications
+MenuLmsUserSchool: Department User Qualifications
 MenuLmsUserAll: All User Qualifications
 MenuLmsUsers: Legacy download e‑learning users
 MenuLmsUpload: Upload

src/Database/Esqueleto/Utils.hs

@@ -517,10 +517,13 @@ allFilter fltrs needle criterias = F.foldr aux true fltrs
   where
     aux fltr acc = fltr needle criterias E.&&. acc
 
--- | Descending order of this field or SqlExpression, but with NULLS at the end.
+-- | Ascending order of this field or SqlExpression, but with NULLS at the end.
+--   For bool, just use ASC, since false < true < null
 ascNullsFirst :: PersistField a => E.SqlExpr (E.Value a) -> E.SqlExpr E.OrderBy
 ascNullsFirst = E.orderByExpr " ASC NULLS FIRST"
 
+-- | Descending order of this field or SqlExpression, but with NULLS at the end.
+--   Use this if you want the order to be true, false, null
 descNullsLast :: PersistField a => E.SqlExpr (E.Value a) -> E.SqlExpr E.OrderBy
 descNullsLast = E.orderByExpr " DESC NULLS LAST"
 
@@ -748,7 +751,7 @@ selectCountDistinct q = do
       -> error "E.countDistinct did not return exactly one result"
 
 -- DEPRECATED: use Database.Esqueleto.selectOne instead
--- selectMaybe :: (E.SqlSelect a r, MonadIO m) => E.SqlQuery a -> E.SqlReadT m (Maybe r)
+-- selectMaybe :: (E.SqlSelect a r, MonadIO m) => E.SqlQuery a -> E.SqlReadT m (Maybe r) -- aka selectFirst
 -- selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)
 
 -- | convert something that is like a text to text

src/Handler/Course/ParticipantInvite.hs

@@ -29,7 +29,7 @@ import Control.Monad.Except (MonadError(..))
 
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
--- import           Database.Esqueleto.Experimental ((:&)(..))
+import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
 import qualified Database.Esqueleto.Utils        as E
 
@@ -165,9 +165,9 @@ postTAddUserR tid ssh csh tutn = handleAddUserR tid ssh csh (Left tutn) Nothing
 
 handleAddUserR :: TermId -> SchoolId -> CourseShorthand -> Either TutorialName Day -> Maybe TutorialType -> Handler Html
 handleAddUserR tid ssh csh tdesc ttyp = do
-  (cid, tutTypes, tutNameSuggestions) <- runDB $ do
+  (cEnt@Entity{entityKey=cid}, tutTypes, tutNameSuggestions) <- runDB $ do
     let plainTemplates = tutorialTemplateNames Nothing
-    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+    cEnt@Entity{entityKey=cid} <- getBy404 $ TermSchoolCourseShort tid ssh csh
     tutTypes <- E.select $ E.distinct $ do
       tutorial <- E.from $ E.table @Tutorial
       let tuTyp = tutorial E.^. TutorialType
@@ -185,11 +185,12 @@ handleAddUserR tid ssh csh tdesc ttyp = do
       E.where_ $  tutorial E.^. TutorialCourse E.==. E.val cid
           E.&&.   E.isJust (tutorial E.^. TutorialFirstDay)
           E.&&.   E.not_ (E.any (E.hasPrefix_ (tutorial E.^. TutorialType) . E.val) plainTemplates)
-      E.orderBy [E.desc $ tutorial E.^. TutorialFirstDay, E.asc tuName]
+      E.orderBy $ [E.asc  $ tutorial E.^. TutorialName `E.hasInfix` E.val tn | tn <- tutorialTemplateNames Nothing]  -- avoid template names, if possible
+              ++  [E.desc $ tutorial E.^. TutorialFirstDay, E.asc tuName]
       E.limit 7
       return tuName
     let tutNameSuggestions = return $ mkOptionList [Option tno tn tno | etn <- tutNames, let tn = E.unValue etn, let tno = CI.original tn]
-    return (cid, Set.toAscList typeSet, tutNameSuggestions) -- Set in order to remove duplicates and sort ascending at once
+    return (cEnt, Set.toAscList typeSet, tutNameSuggestions) -- Set in order to remove duplicates and sort ascending at once
 
   currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute
 
@@ -213,7 +214,7 @@ handleAddUserR tid ssh csh tdesc ttyp = do
         registeredUsers <- registerUsers cid users
         whenIsJust actTutorial $ \(tutName,tutType,tutDay) -> do
           whenIsJust (tutName <|> fmap (tutorialDefaultName tutType) tutDay) $ \tName -> do
-            tutId <- upsertNewTutorial cid tName tutType tutDay
+            tutId <- upsertNewTutorial cEnt tName tutType tutDay
             registerTutorialMembers tutId registeredUsers
             -- when (Set.size tutActs == Set.size confirmedActs) $ -- not sure how this condition might be false at this point
             redirect $ CTutorialR tid ssh csh tName TUsersR
@@ -344,16 +345,35 @@ registerUser  cid (_avsIdent, Just uid) = exceptT return return $ do
 
   return $ mempty { aurRegisterSuccess = Set.singleton uid }
 
-upsertNewTutorial :: CourseId -> TutorialName -> Maybe TutorialType -> Maybe Day -> Handler TutorialId
+upsertNewTutorial :: Entity Course -> TutorialName -> Maybe TutorialType -> Maybe Day -> Handler TutorialId
-upsertNewTutorial cid newTutorialName newTutorialType newFirstDay = runDB $ do
+upsertNewTutorial Entity{entityKey=cid, entityVal=crse} newTutorialName newTutorialType newFirstDay = runDB $ do
   now <- liftIO getCurrentTime
   existingTut <- getBy $ UniqueTutorial cid newTutorialName
-  templateEnt <- selectFirst [TutorialType <-. tutorialTemplateNames newTutorialType] [Desc TutorialType, Asc TutorialName]
+  -- templateEnt <- selectFirst [TutorialType <-. tutorialTemplateNames newTutorialType] [Desc TutorialType, Asc TutorialName] -- current prod as of 02/2025
+  templateEnt <- E.selectOne $ do
+    (tut :& crs :& trm) <- E.from $ E.table @Tutorial
+      `E.innerJoin` E.table @Course
+      `E.on` (\(tut :& crs) -> tut E.^. TutorialCourse E.==. crs E.^. CourseId)
+      `E.innerJoin` E.table @Term
+      `E.on` (\(_ :& crs :& trm) -> trm E.^. TermId E.==. crs E.^. CourseTerm)
+    E.where_ $ crs E.^. CourseSchool E.==. E.val (crse & courseSchool)                                -- filter by School
+      -- E.&&. tut E.^. TutorialName `E.in_` E.vals (tutorialTemplateNames newTutorialType)           -- filter TutorialName being a template
+    E.orderBy $ -- NOTE: E.desc to have true before false, only works for non-nullable columns!
+      (:) (E.desc $ tut E.^. TutorialName `E.in_` E.vals (tutorialTemplateNames newTutorialType)) $   -- prefer template names above all else
+      mcons ((\ttyp -> E.desc $ tut E.^. TutorialName `E.hasInfix` E.val ttyp) <$> newTutorialType)   -- prefer ttype, if given.
+      [ E.desc $ tut E.^. TutorialCourse  E.==. E.val cid                                             -- prefer current course
+      , E.desc $ crs E.^. CourseName      E.==. E.val (crse & courseName)                             -- prefer courses with identical name
+      , E.desc $ crs E.^. CourseShorthand E.==. E.val (crse & courseShorthand)                        -- prefer courses with identical shortcut
+      , E.desc $ crs E.^. CourseTerm      E.==. E.val (crse & courseTerm)                             -- prefer courses from current term
+      , E.desc $ trm E.^. TermStart                                                                   -- prefer most recently started term
+      -- , E.desc $ tut E.^. tutorialRegisterFrom
+      , E.asc  $ tut E.^. TutorialName                                                                -- prefer tutorial name in alpahbetical order
+      ]
+    return tut
   case (existingTut, newFirstDay, templateEnt) of
     (Just Entity{entityKey=tid},_,_) -> return tid -- no need to update, we ignore the anchor day
     (Nothing, Just moveDay, Just Entity{entityVal=Tutorial{..}}) -> do
-      Course{..} <- get404 cid
+      term <- get404 $ courseTerm crse
-      term <- get404 courseTerm
       let oldFirstDay = fromMaybe moveDay $ tutorialFirstDay <|> fst (occurrencesBounds term $ unJSONB tutorialTime)
           newTime     = normalizeOccurrences $ occurrencesAddBusinessDays term (oldFirstDay, moveDay) $ unJSONB tutorialTime
           dayDiff   = maybe 0 (diffDays moveDay) tutorialFirstDay