fix(course): fix #148 course qualification ordering

some refactoring done along the way, fixing a bug in relation to #150 as well

src/Handler/Course/Edit.hs

@@ -92,16 +92,8 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
       oldSchool <- forM (cfCourseId =<< template) $ fmap courseSchool . getJust
       let elegibleSchools = Set.fromList $ lecturerSchools ++ adminSchools
           userSchools = Set.toList $ maybe id Set.insert oldSchool elegibleSchools
-          q2opt :: Entity Qualification -> Option QualificationId
-          q2opt (Entity qid Qualification{..}) =
-            let qsh = CI.original $ unSchoolKey qualificationSchool
-            in  Option{ optionDisplay       =        CI.original qualificationName      <> " ("  <> qsh <> ")"
-                      , optionExternalValue = "(" <> CI.original qualificationShorthand <> "___" <> qsh <> ")"
-                      , optionInternalValue = qid
-                      }
       elegibleQualifications <- selectList [QualificationSchool <-. Set.toList elegibleSchools] [Asc QualificationName, Asc QualificationSchool]
-      return (userSchools, mkOptionList (map q2opt elegibleQualifications))
+      return (userSchools, qualificationsOptionList elegibleQualifications)
-
 
     (termsField, userTerms) <- liftHandler $ case template of
       -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
@@ -469,10 +461,15 @@ upsertCourseQualifications :: UserId -> CourseId -> [(QualificationId, Int)] ->
 upsertCourseQualifications uid cid qualis = do
   let newQualis = Map.fromList qualis
   oldQualis <- Map.fromDistinctAscList . fmap (\Entity{entityKey=k, entityVal=CourseQualification{..}} -> (courseQualificationQualification, (k, courseQualificationSortOrder)))
-                <$> selectList [CourseQualificationCourse ==. cid] [Asc CourseQualificationSortOrder]
+                <$> selectList [CourseQualificationCourse ==. cid] [Asc CourseQualificationQualification]
   -- NOTE: CourseQualification allow the immediate assignment of these qualifications to any enrolled user. Hence SchoolAdmins must not be allowed to assign school-foreign qualifications, see #150
   okSchools <- Set.fromDistinctAscList . fmap (userFunctionSchool . entityVal)
                 <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin, SchoolLecturer]] [Asc UserFunctionSchool]
+  {- Some debugging due to an error caused by using fromDistinctAscList with violated precondition:
+  $logErrorS "CourseQuali" $ "OLD  Course Qualifications:" <> tshow oldQualis
+  $logErrorS "CourseQuali" $ "NEW  Course Qualifications:" <> tshow newQualis
+  $logErrorS "CourseQuali" $ "DIFF Course Qualifications:" <> tshow (newQualis Map.\\ oldQualis)
+  -}
   foldWithKeyMapM oldQualis $ \qu (k, so_old) -> case Map.lookup qu newQualis of
         Just so_new | so_new /= so_old
                 -> update k [CourseQualificationSortOrder =. so_new] -- existing CourseQualifications may be re-ordered, regardless of school association

src/Handler/Tutorial/Users.hs

@@ -86,25 +86,18 @@ postTUsersR tid ssh csh tutn = do
                E.&&. tutorialParticipant E.^. TutorialParticipantTutorial E.==. E.val tutid
         csvColChoices = flip elem ["name", "matriculation", "email", "qualifications"]
 
+        qualOptions = qualificationsOptionList qualifications
     let
-      qualOpt :: Entity Qualification -> Handler (Option QualificationId)
-      qualOpt (Entity qualId qual) = do
-        cQualId :: CryptoUUIDQualification <- encrypt qualId
-        return $ Option
-          { optionDisplay       = CI.original $ qualificationName qual
-          , optionInternalValue = qualId
-          , optionExternalValue = tshow cQualId
-          }
       acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData)
       acts = Map.fromList $
         (if null qualifications then mempty else
           [ ( TutorialUserRenewQualification
             , TutorialUserRenewQualificationData
-              <$> apopt (selectField . fmap mkOptionList $ mapM qualOpt qualifications) (fslI MsgQualificationName) Nothing            
+              <$> apopt (selectField $ pure qualOptions) (fslI MsgQualificationName) Nothing
             )
           , ( TutorialUserGrantQualification
             , TutorialUserGrantQualificationData
-              <$> apopt (selectField . fmap mkOptionList $ mapM qualOpt qualifications) (fslI MsgQualificationName) Nothing
+              <$> apopt (selectField $ pure qualOptions) (fslI MsgQualificationName) Nothing
               <*> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry
             )
           ]

src/Handler/Utils/Course.hs

@@ -118,5 +118,5 @@ getCourseQualifications cid = Ex.select $ do
     `Ex.innerJoin` Ex.table @CourseQualification
     `Ex.on` (\(qual :& courseQual) -> qual E.^. QualificationId E.==. courseQual E.^. CourseQualificationQualification)
   Ex.where_ $ courseQual E.^. CourseQualificationCourse E.==. E.val cid
-  Ex.orderBy [E.asc $ courseQual E.^. CourseQualificationSortOrder]
+  Ex.orderBy [E.asc $ courseQual E.^. CourseQualificationSortOrder, E.asc $ qual E.^. QualificationName]
   pure qual

src/Handler/Utils/Qualification.hs

@@ -289,3 +289,31 @@ qualificationUserUnblockByReason qid uids mbUnblockTime (qualificationChangeReas
         E.&&.  quserBlockAux True (E.val cutoff) (E.==. (quser E.^. QualificationUserId)) (Just (\qblock -> (qblock E.^. QualificationUserBlockReason) E.==. E.val reason))
     return $ quser E.^. QualificationUserUser
   qualificationUserBlocking qid (E.unValue <$> toUnblock) True mbUnblockTime undo_reason notify
+
+
+-----------
+-- Forms --
+-----------
+
+
+qualificationOption :: Entity Qualification -> Option QualificationId
+qualificationOption (Entity qid Qualification{..}) =
+  let qsh = ciOriginal $ unSchoolKey qualificationSchool
+  in  Option{ optionDisplay       =        ciOriginal qualificationName      <> " ("  <> qsh <> ")"
+            , optionExternalValue = "(" <> ciOriginal qualificationShorthand <> "___" <> qsh <> ")"
+            , optionInternalValue = qid
+            }
+
+qualificationsOptionList :: [Entity Qualification] -> OptionList QualificationId
+qualificationsOptionList = mkOptionList . map qualificationOption
+
+{- Should we encrypt the external value or simply rely on uniqueness?
+qualOpt :: Entity Qualification -> Handler (Option QualificationId)
+qualOpt (Entity qualId qual) = do
+  cQualId :: CryptoUUIDQualification <- encrypt qualId
+  return $ Option
+    { optionDisplay       = ciOriginal $ qualificationName qual
+    , optionInternalValue = qualId
+    , optionExternalValue = tshow cQualId
+    }
+-}