refactor(sub-study-fields): reformulate as superStudyField

Fixes #531

BREAKING CHANGE: superStudyField

models/users.model

@@ -55,7 +55,7 @@ StudyFeatures  -- multiple entries possible for students pursuing several degree
     user          UserId
     degree        StudyDegreeId   -- Abschluss, i.e. Master, Bachelor, etc.
     field         StudyTermsId    -- Fach, i.e. Informatics, Philosophy, etc.
-    subField      StudyTermsId Maybe
+    superField    StudyTermsId Maybe
     type          StudyFieldType  -- Major or minor, i.e. Haupt-/Nebenfach
     semester      Int
     updated       UTCTime default=now() -- last update from LDAP

src/Foundation.hs

@@ -3461,7 +3461,10 @@ upsertCampusUser ldapData Creds{..} = do
           if
             | not $ null knownParents -> do
                 $logDebugS "Campus" [st|Applying subterm “#{tshow subterm}” to #{tshow matchingFeatures}|]
-                (++) (matchingFeatures & traverse . _studyFeaturesSubField %~ (<|> Just subterm)) <$> assimilateSubTerms subterms (unusedFeats List.\\ matchingFeatures)
+                let setSuperField sf = sf
+                      & _studyFeaturesSuperField %~ (<|> Just (sf ^. _studyFeaturesField))
+                      & _studyFeaturesField .~ subterm
+                (++) (map setSuperField matchingFeatures) <$> assimilateSubTerms subterms (unusedFeats List.\\ matchingFeatures)
             | otherwise -> do
                 $logDebugS "Campus" [st|Ignoring subterm “#{tshow subterm}”|]
                 assimilateSubTerms subterms unusedFeats
@@ -3510,7 +3513,28 @@ upsertCampusUser ldapData Creds{..} = do
   forM_ fs $ \f@StudyFeatures{..} -> do
     insertMaybe studyFeaturesDegree $ StudyDegree (unStudyDegreeKey studyFeaturesDegree) Nothing Nothing
     insertMaybe studyFeaturesField $ StudyTerms (unStudyTermsKey studyFeaturesField) Nothing Nothing Nothing Nothing
-    void $ upsert f [StudyFeaturesUpdated =. now, StudyFeaturesValid =. True, StudyFeaturesSubField =. studyFeaturesSubField]
+    oldFs <- selectKeysList
+      ([ StudyFeaturesUser ==. studyFeaturesUser
+       , StudyFeaturesDegree ==. studyFeaturesDegree
+       , StudyFeaturesType ==. studyFeaturesType
+       , StudyFeaturesSemester ==. studyFeaturesSemester
+       ] ++
+       [ StudyFeaturesField ==. studyFeaturesField
+       , StudyFeaturesSuperField ==. studyFeaturesSuperField
+       ] ||. case studyFeaturesSuperField of
+         Just sField ->
+           [ StudyFeaturesField ==. sField
+           , StudyFeaturesSuperField ==. Nothing
+           ]
+         Nothing -> []
+      ) []
+    case oldFs of
+      [oldF] -> update oldF [ StudyFeaturesUpdated =. now
+                            , StudyFeaturesValid =. True
+                            , StudyFeaturesField =. studyFeaturesField
+                            , StudyFeaturesSuperField =. studyFeaturesSuperField
+                            ]
+      _other -> insert_ f
   associateUserSchoolsByTerms userId
 
   let

src/Handler/Profile.hs

@@ -359,12 +359,9 @@ makeProfileData (Entity uid User{..}) = do
       E.on $ sheet E.^. SheetId     E.==. corrector E.^. SheetCorrectorSheet
       E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
       return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
-  studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) ->
+  studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
-    E.distinctOnOrderBy [ E.asc $ studyfeat E.^. StudyFeaturesId ] $ do
-      E.orderBy [ E.desc $ studyfeat E.^. StudyFeaturesSubField E.==. E.just (studyterms  E.^. StudyTermsId) ]
       E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
       E.on $ studyfeat E.^. StudyFeaturesField    E.==. studyterms  E.^. StudyTermsId
-       E.||. studyfeat E.^. StudyFeaturesSubField E.==. E.just (studyterms  E.^. StudyTermsId)
       E.on $ studyfeat E.^. StudyFeaturesDegree   E.==. studydegree E.^. StudyDegreeId
       return  (studyfeat, studydegree, studyterms)
   --Tables

src/Handler/Utils/StudyFeatures.hs

@@ -40,7 +40,7 @@ pStudyFeatures studyFeaturesUser studyFeaturesUpdated = do
       void $ char '!'
       studyFeaturesSemester <- decimal
       let studyFeaturesValid = True
-          studyFeaturesSubField = Nothing
+          studyFeaturesSuperField = Nothing
       return StudyFeatures{..}
 
   pStudyFeature `sepBy1` char '#'

src/Model/Migration.hs

@@ -591,6 +591,14 @@ customMigrations = Map.fromListWith (>>)
     , whenM (tableExists "exam_part_corrector") $
         tableDropEmpty "exam_part_corrector"
     )
+  , ( AppliedMigrationKey [migrationVersion|28.0.0|] [version|29.0.0|]
+    , whenM (tableExists "study_features") $
+        [executeQQ|
+          ALTER TABLE "study_features" ADD COLUMN "super_field" bigint;
+          UPDATE "study_features" SET "super_field" = "field", "field" = "sub_field" WHERE NOT ("sub_field" IS NULL);
+          ALTER TABLE "study_features" DROP COLUMN "sub_field";
+        |]
+    )
   ]