Merge branch '623-kursassoziierte-studienfacher-abschaffen' into 'master'

Resolve "Kursassoziierte Studienfächer abschaffen"

Closes #623

See merge request uni2work/uni2work!23

messages/uniworx/de-de-formal.msg

@@ -879,6 +879,8 @@ SubmissionReplace: Abgabe ersetzen
 SubmissionCreated: Abgabe erfolgreich angelegt
 SubmissionUpdated: Abgabe erfolgreich ersetzt
 
+ColumnStudyFeatures: Studiendaten
+
 AdminFeaturesHeading: Studiengänge
 StudyTerms: Studiengänge
 StudyTerm: Studiengang
@@ -1997,7 +1999,7 @@ CsvColumnUserName: Voller Name des Teilnehmers
 CsvColumnUserMatriculation: Matrikelnummer des Teilnehmers
 CsvColumnUserSex: Geschlecht
 CsvColumnUserEmail: E-Mail-Adresse des Teilnehmers
-CsvColumnUserStudyFeatures: Alle aktiven Studiendaten des Teilnehmers als Semikolon (;) separierte Liste
+CsvColumnUserStudyFeatures: Alle relevanten Studiendaten des Teilnehmers als Semikolon (;) separierte Liste
 CsvColumnUserField: Studienfach, mit dem der Teilnehmer seine Kursanmeldung assoziiert hat
 CsvColumnUserDegree: Abschluss, den der Teilnehmer im assoziierten Studienfach anstrebt
 CsvColumnUserSemester: Fachsemester des Teilnehmers im assoziierten Studienfach
@@ -2023,6 +2025,11 @@ CsvColumnApplicationsVeto: Bewerber mit Veto werden garantiert nicht dem Kurs zu
 CsvColumnApplicationsRating: Bewertung der Bewerbung; "1.0", "1.3", "1.7", ..., "4.0", "5.0" (Leer wird behandelt wie eine Note zwischen 2.3 und 2.7)
 CsvColumnApplicationsComment: Kommentar zur Bewerbung; je nach Kurs-Einstellungen entweder nur als Notiz für die Kursverwalter oder Feedback für den Bewerber
 
+ApplicationGeneratedColumns: Stammdaten
+ApplicationGeneratedColumnsTip: Stammdaten eines Bewerbers sind Daten, welche dem System zu diesem Benutzer bekannt sind und welche der Benutzer im Zuge der Bewerbung nicht beeinflussen kann.
+ApplicationUserColumns: Bewerbung
+ApplicationRatingColumns: Bewertung
+
 Action: Aktion
 ActionNoUsersSelected: Keine Benutzer ausgewählt
 

messages/uniworx/en-eu.msg

@@ -876,6 +876,8 @@ SubmissionReplace: Replace submission
 SubmissionCreated: Successfully created submission
 SubmissionUpdated: Successfully replaced submission
 
+ColumnStudyFeatures: Features of study
+
 AdminFeaturesHeading: Features of study
 StudyTerms: Fields of study
 StudyTerm: Field of study
@@ -1996,7 +1998,7 @@ CsvColumnUserName: Participant's full name
 CsvColumnUserMatriculation: Participant's matriculation
 CsvColumnUserSex: Participant's sex
 CsvColumnUserEmail: Participant's email address
-CsvColumnUserStudyFeatures: All active fields of study for the participant, separated by semicolon (;)
+CsvColumnUserStudyFeatures: All relevant features of study for the participant, separated by semicolon (;)
 CsvColumnUserField: Field of study the participant specified when enrolling for the course
 CsvColumnUserDegree: Degree the participant pursues in their associated field of study
 CsvColumnUserSemester: Semester the participant is in wrt. to their associated field of study
@@ -2022,6 +2024,11 @@ CsvColumnApplicationsVeto: Vetoed applicants are never assigned to the course; "
 CsvColumnApplicationsRating: Application grading; Any number grade ("1.0", "1.3", "1.7", ..., "4.0", "5.0"); Empty cells will be treated as if they contained a grade between 2.3 and 2.7
 CsvColumnApplicationsComment: Application comment; depending on course settings this might purely be a note for course administrators or be feedback for the applicant
 
+ApplicationGeneratedColumns: Master data
+ApplicationGeneratedColumnsTip: An applicant's master data is data which is known to the system about this user and which the user cannot modify when applying for the course.
+ApplicationUserColumns: Application
+ApplicationRatingColumns: Rating
+
 Action: Action
 ActionNoUsersSelected: No users selected
 

models/courses.model

@@ -56,7 +56,7 @@ CourseParticipant                      -- course enrolement
     course       CourseId
     user         UserId
     registration UTCTime               -- time of last enrolement for this course
-    field        StudyFeaturesId Maybe -- associated degree course, user-defined; required for communicating grades
+    field        StudyFeaturesId Maybe MigrationOnly
     allocated    AllocationId Maybe    -- participant was centrally allocated
     state        CourseParticipantState
     UniqueParticipant user course

models/courses/applications.model

@@ -1,7 +1,7 @@
 CourseApplication
     course              CourseId
     user                UserId
-    field               StudyFeaturesId Maybe -- associated degree course, user-defined; required for communicating grades
+    field               StudyFeaturesId Maybe MigrationOnly
     text                Text            Maybe -- free text entered by user
     ratingVeto          Bool                  default=false
     ratingPoints        ExamGrade       Maybe

models/users.model

@@ -58,8 +58,9 @@ StudyFeatures  -- multiple entries possible for students pursuing several degree
     superField    StudyTermsId Maybe
     type          StudyFieldType  -- Major or minor, i.e. Haupt-/Nebenfach
     semester      Int
-    updated       UTCTime default=now() -- last update from LDAP
+    firstObserved UTCTime Maybe
-    valid         Bool default=true       -- marked as active in LDAP (students may switch, but LDAP never forgets)
+    lastObserved  UTCTime default=now() -- last update from LDAP
+    valid         Bool default=true
     UniqueStudyFeatures user degree field type semester
     deriving Eq Show
     -- UniqueUserSubject ubuser degree field -- There exists a counterexample

src/Database/Esqueleto/Utils.hs

@@ -8,6 +8,7 @@ module Database.Esqueleto.Utils
   , isInfixOf, hasInfix
   , or, and
   , any, all
+  , subSelectAnd, subSelectOr
   , mkExactFilter, mkExactFilterWith
   , mkContainsFilter, mkContainsFilterWith
   , mkExistsFilter
@@ -21,16 +22,18 @@ module Database.Esqueleto.Utils
   , maybe, maybeEq, unsafeCoalesce
   , bool
   , max, min
+  , abs
   , SqlProject(..)
   , (->.)
   , fromSqlKey
   , selectCountRows
   , selectMaybe
+  , day, diffDays
   , module Database.Esqueleto.Utils.TH
   ) where
 
 
-import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust, maybe, bool, max, min)
+import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust, maybe, bool, max, min, abs)
 import Data.Universe
 import qualified Data.Set as Set
 import qualified Data.List as List
@@ -107,6 +110,10 @@ any test = or . map test . otoList
 all :: MonoFoldable f => (Element f -> E.SqlExpr (E.Value Bool)) -> f -> E.SqlExpr (E.Value Bool)
 all test = and . map test . otoList
 
+subSelectAnd, subSelectOr :: E.SqlQuery (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
+subSelectAnd q = E.subSelectUnsafe $ E.unsafeSqlFunction "bool_and" <$> q
+subSelectOr q = E.subSelectUnsafe $ E.unsafeSqlFunction "bool_or" <$> q
+
 
 -- Allow usage of Tuples as DbtRowKey, i.e. SqlIn instances for tuples
 $(sqlInTuples [2..16])
@@ -289,6 +296,11 @@ max, min :: PersistField a
 max a b = bool a b $ b E.>. a
 min a b = bool a b $ b E.<. a
 
+abs :: (PersistField a, Num a)
+    => E.SqlExpr (E.Value a)
+    -> E.SqlExpr (E.Value a)
+abs x = bool (E.val 0 E.-. x) x $ x E.>. E.val 0
+
 unsafeCoalesce :: E.PersistField a => [E.SqlExpr (E.Value (Maybe a))] -> E.SqlExpr (E.Value a)
 unsafeCoalesce = E.veryUnsafeCoerceSqlExprValue . E.coalesce
 
@@ -325,3 +337,13 @@ selectCountRows q = do
 
 selectMaybe :: (E.SqlSelect a r, MonadIO m) => E.SqlQuery a -> E.SqlReadT m (Maybe r)
 selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)
+
+
+day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day)
+day = E.unsafeSqlCastAs "date"
+
+infixl 6 `diffDays`
+  
+diffDays :: E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Day) -> E.SqlExpr (E.Value Int)
+-- ^ PostgreSQL is weird.
+diffDays a b = E.veryUnsafeCoerceSqlExprValue $ a E.-. b

src/Foundation/Yesod/Auth.hs

@@ -321,7 +321,7 @@ upsertCampusUser plugin ldapData = do
           , Just defType   <- studyTermsDefaultType
             -> do
               $logDebugS "Campus" [st|Applying default for standalone study term “#{tshow subterm}”|]
-              (:) (StudyFeatures userId defDegree subterm Nothing defType subSemester now True) <$> assimilateSubTerms subterms unusedFeats
+              (:) (StudyFeatures userId defDegree subterm Nothing defType subSemester (Just now) now True) <$> assimilateSubTerms subterms unusedFeats
         Nothing
           | [] <- unusedFeats -> do
               $logDebugS "Campus" [st|Saw subterm “#{tshow subterm}” when no fos-terms remain|]
@@ -389,26 +389,11 @@ upsertCampusUser plugin ldapData = do
   forM_ fs $ \f@StudyFeatures{..} -> do
     insertMaybe studyFeaturesDegree $ StudyDegree (unStudyDegreeKey studyFeaturesDegree) Nothing Nothing
     insertMaybe studyFeaturesField $ StudyTerms (unStudyTermsKey studyFeaturesField) Nothing Nothing Nothing Nothing
-    oldFs <- selectKeysList
+    void $ upsert f
-      [ StudyFeaturesUser ==. studyFeaturesUser
+      [ StudyFeaturesLastObserved =. now
-       , StudyFeaturesDegree ==. studyFeaturesDegree
+      , StudyFeaturesValid =. True
-       , StudyFeaturesField ==. studyFeaturesField
+      , StudyFeaturesSuperField =. studyFeaturesSuperField
-       , StudyFeaturesType ==. studyFeaturesType
+      ]
-       , StudyFeaturesSemester ==. studyFeaturesSemester
-       ]
-      []
-    case oldFs of
-      [oldF] -> update oldF
-        [ StudyFeaturesUpdated =. now
-        , StudyFeaturesValid =. True
-        , StudyFeaturesField =. studyFeaturesField
-        , StudyFeaturesSuperField =. studyFeaturesSuperField
-        ]
-      _other -> void $ upsert f
-        [ StudyFeaturesUpdated =. now
-        , StudyFeaturesValid =. True
-        , StudyFeaturesSuperField =. studyFeaturesSuperField
-        ]
   associateUserSchoolsByTerms userId
 
   let

src/Handler/Allocation/Application.hs

@@ -44,7 +44,6 @@ data ApplicationFormView = ApplicationFormView
 
 data ApplicationForm = ApplicationForm
   { afPriority      :: Maybe Natural
-  , afField         :: Maybe StudyFeaturesId
   , afText          :: Maybe Text
   , afFiles         :: Maybe FileUploads
   , afRatingVeto    :: Bool
@@ -118,12 +117,6 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
     (False, _    , _    , _      )
       -> pure (FormSuccess Nothing, Nothing)
 
-  (fieldRes, fieldView') <- if
-    | afmApplicantEdit || afmLecturer
-      -> mreq (studyFeaturesFieldFor Nothing False [] $ Just uid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) (courseApplicationField . entityVal <$> mApp)
-    | otherwise
-      -> mforced (studyFeaturesFieldFor Nothing True (maybeToList $ mApp >>= courseApplicationField . entityVal) $ Just uid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) (mApp >>= courseApplicationField . entityVal)
-
   let textField' = convertField (Text.strip . unTextarea) Textarea textareaField
       textFs
         | is _Just courseApplicationsInstructions
@@ -216,7 +209,6 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
 
   return ( ApplicationForm
            <$> prioRes
-           <*> fieldRes
            <*> textRes
            <*> filesRes
            <*> vetoRes
@@ -226,8 +218,7 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
          , ApplicationFormView
            { afvPriority = prioView
            , afvForm = catMaybes $
-             [ Just fieldView'
+             [ textView
-             , textView
              , filesLinkView
              , filesWarningView
              ] ++ maybe [] (map Just) filesView ++
@@ -274,7 +265,6 @@ editApplicationR maId uid cid mAppId afMode allowAction postAction = do
           appId <- insert CourseApplication
             { courseApplicationCourse             = cid
             , courseApplicationUser               = uid
-            , courseApplicationField              = afField
             , courseApplicationText               = afText
             , courseApplicationRatingVeto         = afRatingVeto
             , courseApplicationRatingPoints       = afRatingPoints
@@ -303,8 +293,7 @@ editApplicationR maId uid cid mAppId afMode allowAction postAction = do
 
           oldApp <- get404 appId
           let newApp = oldApp
-                { courseApplicationField              = afField
+                { courseApplicationText               = afText
-                , courseApplicationText               = afText
                 , courseApplicationRatingVeto         = afRatingVeto
                 , courseApplicationRatingPoints       = afRatingPoints
                 , courseApplicationRatingComment      = afRatingComment
@@ -323,8 +312,7 @@ editApplicationR maId uid cid mAppId afMode allowAction postAction = do
                 ]
 
               appChanged = any (\f -> f oldApp newApp)
-                [ (/=) `on` courseApplicationField
+                [ (/=) `on` courseApplicationText
-                , (/=) `on` courseApplicationText
                 , \_ _ -> not $ Set.null changes
                 ]
 

src/Handler/Course/Application/List.hs

@@ -25,6 +25,7 @@ import qualified Data.Map as Map
 import qualified Data.Conduit.List as C
 
 import Handler.Course.ParticipantInvite
+import Handler.Utils.StudyFeatures
 
 import Jobs.Queue
 
@@ -33,53 +34,38 @@ type CourseApplicationsTableExpr = (              E.SqlExpr (Entity CourseApplic
                                     `E.InnerJoin` E.SqlExpr (Entity User)
                                    )
                  `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity Allocation))
-                 `E.LeftOuterJoin` (              E.SqlExpr (Maybe (Entity StudyFeatures))
-                                    `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
-                                    `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
-                                   )
                  `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseParticipant))
 type CourseApplicationsTableData = DBRow ( Entity CourseApplication
                                          , Entity User
                                          , Bool -- hasFiles
                                          , Maybe (Entity Allocation)
-                                         , Maybe (Entity StudyFeatures)
-                                         , Maybe (Entity StudyTerms)
-                                         , Maybe (Entity StudyDegree)
                                          , Bool -- isParticipant
+                                         , UserTableStudyFeatures
                                          )
 
 courseApplicationsIdent :: Text
 courseApplicationsIdent = "applications"
 
 queryCourseApplication :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity CourseApplication))
-queryCourseApplication = to $ $(sqlIJproj 2 1) . $(sqlLOJproj 4 1)
+queryCourseApplication = to $ $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
 
 queryUser :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity User))
-queryUser = to $ $(sqlIJproj 2 2) . $(sqlLOJproj 4 1)
+queryUser = to $ $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
 
 queryHasFiles :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool))
-queryHasFiles = to $ hasFiles . $(sqlIJproj 2 1) . $(sqlLOJproj 4 1)
+queryHasFiles = to $ hasFiles . $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
   where
     hasFiles appl = E.exists . E.from $ \courseApplicationFile ->
       E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. appl E.^. CourseApplicationId
 
 queryAllocation :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity Allocation)))
-queryAllocation = to $(sqlLOJproj 4 2)
+queryAllocation = to $(sqlLOJproj 3 2)
-
-queryStudyFeatures :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyFeatures)))
-queryStudyFeatures = to $ $(sqlIJproj 3 1) . $(sqlLOJproj 4 3)
-
-queryStudyTerms :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyTerms)))
-queryStudyTerms = to $ $(sqlIJproj 3 2) . $(sqlLOJproj 4 3)
-
-queryStudyDegree :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyDegree)))
-queryStudyDegree = to $ $(sqlIJproj 3 3) . $(sqlLOJproj 4 3)
 
 queryCourseParticipant :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity CourseParticipant)))
-queryCourseParticipant = to $(sqlLOJproj 4 4)
+queryCourseParticipant = to $(sqlLOJproj 3 3)
 
 queryIsParticipant :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool))
-queryIsParticipant = to $ E.not_ . E.isNothing . (E.?. CourseParticipantId) . $(sqlLOJproj 4 4)
+queryIsParticipant = to $ E.not_ . E.isNothing . (E.?. CourseParticipantId) . $(sqlLOJproj 3 3)
 
 resultCourseApplication :: Lens' CourseApplicationsTableData (Entity CourseApplication)
 resultCourseApplication = _dbrOutput . _1
@@ -93,17 +79,11 @@ resultHasFiles = _dbrOutput . _3
 resultAllocation :: Traversal' CourseApplicationsTableData (Entity Allocation)
 resultAllocation = _dbrOutput . _4 . _Just
 
-resultStudyFeatures :: Traversal' CourseApplicationsTableData (Entity StudyFeatures)
-resultStudyFeatures = _dbrOutput . _5 . _Just
-
-resultStudyTerms :: Traversal' CourseApplicationsTableData (Entity StudyTerms)
-resultStudyTerms = _dbrOutput . _6 . _Just
-
-resultStudyDegree :: Traversal' CourseApplicationsTableData (Entity StudyDegree)
-resultStudyDegree = _dbrOutput . _7 . _Just
-
 resultIsParticipant :: Lens' CourseApplicationsTableData Bool
-resultIsParticipant = _dbrOutput . _8
+resultIsParticipant = _dbrOutput . _5
+
+resultStudyFeatures :: Lens' CourseApplicationsTableData UserTableStudyFeatures
+resultStudyFeatures = _dbrOutput . _6
 
 
 newtype CourseApplicationsTableVeto = CourseApplicationsTableVeto Bool
@@ -127,9 +107,7 @@ data CourseApplicationsTableCsv = CourseApplicationsTableCsv
   , csvCAName :: Maybe Text
   , csvCAEmail :: Maybe UserEmail
   , csvCAMatriculation :: Maybe Text
-  , csvCAField :: Maybe Text
+  , csvCAStudyFeatures :: UserTableStudyFeatures
-  , csvCADegree :: Maybe Text
-  , csvCASemester :: Maybe Int
   , csvCAText :: Maybe Text
   , csvCAHasFiles :: Maybe Bool
   , csvCAVeto :: Maybe CourseApplicationsTableVeto
@@ -152,9 +130,7 @@ instance Csv.FromNamedRecord CourseApplicationsTableCsv where
       <*> csv .:?? "name"
       <*> csv .:?? "email"
       <*> csv .:?? "matriculation"
-      <*> csv .:?? "field"
+      <*> pure mempty
-      <*> csv .:?? "degree"
-      <*> csv .:?? "semester"
       <*> csv .:?? "text"
       <*> csv .:?? "has-files"
       <*> csv .:?? "veto"
@@ -171,9 +147,7 @@ instance CsvColumnsExplained CourseApplicationsTableCsv where
     , ('csvCAName         , MsgCsvColumnApplicationsName         )
     , ('csvCAEmail        , MsgCsvColumnApplicationsEmail        )
     , ('csvCAMatriculation, MsgCsvColumnApplicationsMatriculation)
-    , ('csvCAField        , MsgCsvColumnApplicationsField        )
+    , ('csvCAStudyFeatures, MsgCsvColumnUserStudyFeatures        )
-    , ('csvCADegree       , MsgCsvColumnApplicationsDegree       )
-    , ('csvCASemester     , MsgCsvColumnApplicationsSemester     )
     , ('csvCAText         , MsgCsvColumnApplicationsText         )
     , ('csvCAHasFiles     , MsgCsvColumnApplicationsHasFiles     )
     , ('csvCAVeto         , MsgCsvColumnApplicationsVeto         )
@@ -182,19 +156,14 @@ instance CsvColumnsExplained CourseApplicationsTableCsv where
     ]
 
 data CourseApplicationsTableCsvActionClass
-  = CourseApplicationsTableCsvSetField
+  = CourseApplicationsTableCsvSetVeto
-  | CourseApplicationsTableCsvSetVeto
   | CourseApplicationsTableCsvSetRating
   | CourseApplicationsTableCsvSetComment
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 embedRenderMessage ''UniWorX ''CourseApplicationsTableCsvActionClass id
 
 data CourseApplicationsTableCsvAction
-  = CourseApplicationsTableCsvSetFieldData
+  = CourseApplicationsTableCsvSetVetoData
-    { caCsvActApplication :: CourseApplicationId
-    , caCsvActField :: Maybe StudyFeaturesId
-    }
-  | CourseApplicationsTableCsvSetVetoData
     { caCsvActApplication :: CourseApplicationId
     , caCsvActVeto :: Bool
     }
@@ -284,18 +253,12 @@ postCApplicationsR tid ssh csh = do
         hasFiles <- view queryHasFiles
         user <- view queryUser
         allocation <- view queryAllocation
-        studyFeatures <- view queryStudyFeatures
-        studyTerms <- view queryStudyTerms
-        studyDegree <- view queryStudyDegree
         courseParticipant <- view queryCourseParticipant
 
         lift $ do
           E.on $ E.just (user E.^. UserId) E.==. courseParticipant E.?. CourseParticipantUser
            E.&&. courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val cid)
            E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
-          E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
-          E.on $ studyTerms E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
-          E.on $ studyFeatures E.?. StudyFeaturesId E.==. courseApplication E.^. CourseApplicationField
           E.on $ courseApplication E.^. CourseApplicationAllocation E.==. allocation E.?. AllocationId
           E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser
            E.&&. courseApplication E.^. CourseApplicationCourse E.==. E.val cid
@@ -306,34 +269,38 @@ postCApplicationsR tid ssh csh = do
                , user
                , hasFiles
                , allocation
-               , studyFeatures
-               , studyTerms
-               , studyDegree
                , E.not_ . E.isNothing $ courseParticipant E.?. CourseParticipantId
                )
 
       dbtProj :: DBRow _ -> DB CourseApplicationsTableData
-      dbtProj = traverse $ return . over _3 E.unValue . over _8 E.unValue
+      dbtProj = traverse $ \(application, user, E.Value hasFiles, allocation, E.Value isParticipant) -> do
+        feats <- courseUserStudyFeatures (application ^. _entityVal . _courseApplicationCourse) (user ^. _entityKey)
+        return (application, user, hasFiles, allocation, isParticipant, feats)
 
       dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId)
 
-      dbtColonnade :: Colonnade Sortable _ _
+      dbtColonnade :: Cornice Sortable ('Cap 'Base) _ _
       dbtColonnade = mconcat
-        [ sortable (Just "participant") (i18nCell MsgCourseApplicationIsParticipant) $ bool mempty (cell $ toWidget iconOK) . view resultIsParticipant
+        [ cap (Sortable Nothing generatedColumnsHeader) $ mconcat
-        , emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand)
+          [ sortable (Just "participant") (i18nCell MsgCourseApplicationIsParticipant) $ bool mempty (cell $ toWidget iconOK) . view resultIsParticipant
-        , anchorColonnadeM (views (resultCourseApplication . _entityKey) applicationLink) $ colApplicationId (resultCourseApplication . _entityKey)
+          , emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand)
-        , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
+          , anchorColonnadeM (views (resultCourseApplication . _entityKey) applicationLink) $ colApplicationId (resultCourseApplication . _entityKey)
-        , lmap (view $ resultUser . _entityVal) colUserEmail
+          , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
-        , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
+          , lmap (view $ resultUser . _entityVal) colUserEmail
-        , emptyOpticColonnade (resultStudyTerms . _entityVal) colStudyTerms
+          , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
-        , emptyOpticColonnade (resultStudyDegree . _entityVal) colStudyDegree
+          , colStudyFeatures resultStudyFeatures
-        , emptyOpticColonnade (resultStudyFeatures . _entityVal . _studyFeaturesSemester) colStudyFeaturesSemester
+          ]
-        , colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText)
+        , cap (Sortable Nothing $ i18nCell MsgApplicationUserColumns) $ mconcat
-        , lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusG 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles))
+          [ colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText)
-        , colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto)
+          , lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusG 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles))
-        , colApplicationRatingPoints (resultCourseApplication . _entityVal . _courseApplicationRatingPoints)
+          ]
-        , colApplicationRatingComment (resultCourseApplication . _entityVal . _courseApplicationRatingComment)
+        , cap (Sortable Nothing $ i18nCell MsgApplicationRatingColumns) $ mconcat
+          [ colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto)
+          , colApplicationRatingPoints (resultCourseApplication . _entityVal . _courseApplicationRatingPoints)
+          , colApplicationRatingComment (resultCourseApplication . _entityVal . _courseApplicationRatingComment)
+          ]
         ]
+        where generatedColumnsHeader = cell $ i18n MsgApplicationGeneratedColumns <> (messageTooltip =<< messageI Info MsgApplicationGeneratedColumnsTip)
 
       dbtSorting = mconcat
         [ singletonMap "participant" . SortColumn $ view queryIsParticipant
@@ -341,9 +308,6 @@ postCApplicationsR tid ssh csh = do
         , sortUserName' $ $(multifocusG 2) (queryUser . to (E.^. UserDisplayName)) (queryUser . to (E.^. UserSurname))
         , uncurry singletonMap . sortUserEmail $ view queryUser
         , sortUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
-        , sortStudyTerms queryStudyTerms
-        , sortStudyDegree queryStudyDegree
-        , sortStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester)
         , sortApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
         , sortApplicationFiles queryHasFiles
         , sortApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
@@ -356,28 +320,37 @@ postCApplicationsR tid ssh csh = do
         , fltrUserName' $ queryUser . to (E.^. UserDisplayName)
         , uncurry singletonMap . fltrUserEmail $ view queryUser
         , fltrUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
-        , fltrStudyTerms queryStudyTerms
-        , fltrStudyDegree queryStudyDegree
-        , fltrStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester)
         , fltrApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
         , fltrApplicationFiles queryHasFiles
         , fltrApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
         , fltrApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints)
         , fltrApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment)
+        , fltrRelevantStudyFeaturesTerms (to $
+            \t -> ( E.val courseTerm
+                  , views queryUser (E.^. UserId) t
+                  ))
+        , fltrRelevantStudyFeaturesDegree (to $
+            \t -> ( E.val courseTerm
+                  , views queryUser (E.^. UserId) t
+                  ))
+        , fltrRelevantStudyFeaturesSemester (to $
+            \t -> ( E.val courseTerm
+                  , views queryUser (E.^. UserId) t
+                  ))
         ]
       dbtFilterUI = mconcat
         [ fltrAllocationUI
         , fltrUserNameUI'
         , fltrUserMatriculationUI
         , fltrUserEmailUI
-        , fltrStudyTermsUI
-        , fltrStudyDegreeUI
-        , fltrStudyFeaturesSemesterUI
         , fltrApplicationTextUI
         , fltrApplicationFilesUI
         , fltrApplicationVetoUI
         , fltrApplicationRatingPointsUI
         , fltrApplicationRatingCommentUI
+        , fltrRelevantStudyFeaturesTermsUI
+        , fltrRelevantStudyFeaturesDegreeUI
+        , fltrRelevantStudyFeaturesSemesterUI
         ]
 
       dbtStyle = def
@@ -391,9 +364,7 @@ postCApplicationsR tid ssh csh = do
         <*> preview (resultUser . _entityVal . _userDisplayName)
         <*> preview (resultUser . _entityVal . _userEmail)
         <*> preview (resultUser . _entityVal . _userMatrikelnummer . _Just)
-        <*> preview (resultStudyTerms . _entityVal . (_studyTermsName . _Just <> _studyTermsShorthand . _Just <> to (tshow . studyTermsKey)))
+        <*> view resultStudyFeatures
-        <*> preview (resultStudyDegree . _entityVal . (_studyDegreeName . _Just <> _studyDegreeShorthand . _Just <> to (tshow . studyDegreeKey)))
-        <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
         <*> preview (resultCourseApplication . _entityVal . _courseApplicationText . _Just)
         <*> preview resultHasFiles
         <*> preview (resultCourseApplication . _entityVal . _courseApplicationRatingVeto . re _CourseApplicationsTableVeto)
@@ -416,10 +387,6 @@ postCApplicationsR tid ssh csh = do
             DBCsvDiffExisting{..} -> do
               let appId = dbCsvOld ^. resultCourseApplication . _entityKey
 
-              newFeatures <- lift $ lookupStudyFeatures dbCsvNew
-              when (newFeatures /= dbCsvOld ^? resultStudyFeatures . _entityKey) $
-                yield $ CourseApplicationsTableCsvSetFieldData appId newFeatures
-
               let mVeto = dbCsvNew ^? _csvCAVeto . _Just . _CourseApplicationsTableVeto
               whenIsJust mVeto $ \veto ->
                 when (veto /= dbCsvOld ^. resultCourseApplication . _entityVal . _courseApplicationRatingVeto) $
@@ -431,18 +398,12 @@ postCApplicationsR tid ssh csh = do
               when (dbCsvNew ^. _csvCAComment /= dbCsvOld ^. resultCourseApplication . _entityVal . _courseApplicationRatingComment) $
                 yield $ CourseApplicationsTableCsvSetCommentData appId (dbCsvNew ^. _csvCAComment)
         , dbtCsvClassifyAction = \case
-            CourseApplicationsTableCsvSetFieldData{}   -> CourseApplicationsTableCsvSetField
             CourseApplicationsTableCsvSetVetoData{}    -> CourseApplicationsTableCsvSetVeto
             CourseApplicationsTableCsvSetRatingData{}  -> CourseApplicationsTableCsvSetRating
             CourseApplicationsTableCsvSetCommentData{} -> CourseApplicationsTableCsvSetComment
         , dbtCsvCoarsenActionClass = const DBCsvActionExisting
         , dbtCsvExecuteActions = do
             C.mapM_ $ \case
-              CourseApplicationsTableCsvSetFieldData{..} -> do
-                CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationField =. caCsvActField
-                                                                       , CourseApplicationTime =. now
-                                                                       ]
-                audit $ TransactionCourseApplicationEdit cid courseApplicationUser caCsvActApplication
               CourseApplicationsTableCsvSetVetoData{..} -> do
                 CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationRatingVeto =. caCsvActVeto
                                                                        , CourseApplicationRatingTime =. Just now
@@ -460,15 +421,6 @@ postCApplicationsR tid ssh csh = do
                 audit $ TransactionCourseApplicationEdit cid courseApplicationUser caCsvActApplication
             return $ CourseR tid ssh csh CApplicationsR
         , dbtCsvRenderKey = \(existingApplicantName -> existingApplicantName') -> \case
-            CourseApplicationsTableCsvSetFieldData{..} ->
-              [whamlet|
-                $newline never
-                ^{existingApplicantName' caCsvActApplication}
-                $maybe features <- caCsvActField
-                  , ^{studyFeaturesWidget features}
-                $nothing
-                  , _{MsgCourseStudyFeatureNone}
-              |]
             CourseApplicationsTableCsvSetVetoData{..} ->
               [whamlet|
                 $newline never
@@ -538,59 +490,6 @@ postCApplicationsR tid ssh csh = do
             where
               Entity _ User{..} = existing ^. singular (ix appId . resultUser)
 
-          lookupStudyFeatures :: CourseApplicationsTableCsv -> DB (Maybe StudyFeaturesId)
-          lookupStudyFeatures csv@CourseApplicationsTableCsv{..} = do
-            appRes <- guessUser csv
-            (uid, oldFeatures) <- case appRes of
-              Left  uid   -> (uid, ) <$> selectList [ CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid ] []
-              Right appId -> (courseApplicationUser . entityVal &&& pure) <$> getJustEntity appId
-            studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) ->
-              E.distinctOnOrderBy [ E.asc (studyFeatures E.^. StudyFeaturesField)
-                                  , E.asc (studyFeatures E.^. StudyFeaturesDegree)
-                                  , E.asc (studyFeatures E.^. StudyFeaturesSemester)] $ do
-                E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
-                E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
-                E.where_ . E.and $ catMaybes
-                  [ do
-                      field <- csvCAField
-                      return . E.or $ catMaybes
-                        [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
-                        , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
-                        , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
-                        ]
-                  , do
-                      degree <- csvCADegree
-                      return . E.or $ catMaybes
-                        [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
-                        , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
-                        , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
-                        ]
-                  , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvCASemester
-                  ]
-                E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
-                let isActiveOrPrevious = E.or
-                      $ (studyFeatures E.^. StudyFeaturesValid)
-                      : [ E.val sfid E.==. studyFeatures E.^. StudyFeaturesId
-                        | Entity _ CourseApplication{ courseApplicationField = Just sfid } <- oldFeatures
-                        ]
-                E.where_ isActiveOrPrevious -- either active studyFeature or the one previously associated with this course
-                E.orderBy [E.desc isActiveOrPrevious, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)]
-                return $ studyFeatures E.^. StudyFeaturesId
-            case studyFeatures of
-              [E.Value fid] -> return $ Just fid
-              _other
-                | is _Nothing csvCAField
-                , is _Nothing csvCADegree
-                , is _Nothing csvCASemester
-                -> return Nothing
-              _other
-                | [Entity _ CourseApplication{..}] <- oldFeatures
-                , Just sfid <- courseApplicationField
-                , E.Value sfid `elem` studyFeatures
-                -> return $ Just sfid
-              _other        -> throwM CourseApplicationsTableCsvExceptionNoMatchingStudyFeatures
-
-
       dbtIdent = courseApplicationsIdent
 
       psValidator :: PSValidator _ _

src/Handler/Course/ParticipantInvite.hs

@@ -40,7 +40,6 @@ instance IsInvitableJunction CourseParticipant where
   type InvitationFor CourseParticipant = Course
   data InvitableJunction CourseParticipant = JunctionParticipant
     { jParticipantRegistration :: UTCTime
-    , jParticipantField        :: Maybe StudyFeaturesId
     , jParticipantAllocated    :: Maybe AllocationId
     , jParticipantState        :: CourseParticipantState
     } deriving (Eq, Ord, Read, Show, Generic, Typeable)
@@ -53,8 +52,8 @@ instance IsInvitableJunction CourseParticipant where
     deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
   _InvitableJunction = iso
-    (\CourseParticipant{..} -> (courseParticipantUser, courseParticipantCourse, JunctionParticipant courseParticipantRegistration courseParticipantField courseParticipantAllocated courseParticipantState))
+    (\CourseParticipant{..} -> (courseParticipantUser, courseParticipantCourse, JunctionParticipant courseParticipantRegistration courseParticipantAllocated courseParticipantState))
-    (\(courseParticipantUser, courseParticipantCourse, JunctionParticipant courseParticipantRegistration courseParticipantField courseParticipantAllocated courseParticipantState) -> CourseParticipant{..})
+    (\(courseParticipantUser, courseParticipantCourse, JunctionParticipant courseParticipantRegistration courseParticipantAllocated courseParticipantState) -> CourseParticipant{..})
 
 instance ToJSON (InvitableJunction CourseParticipant) where
   toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
@@ -92,11 +91,9 @@ participantInvitationConfig = InvitationConfig{..}
       itAuthority <- HashSet.singleton . Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
-    invitationForm _ _ uid = hoistAForm lift . wFormToAForm $ do
+    invitationForm _ _ _ = hoistAForm lift . wFormToAForm $ do
       now <- liftIO getCurrentTime
-      studyFeatures <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid)
+      return . pure . (, ()) $ JunctionParticipant now Nothing CourseParticipantActive
-          (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) Nothing
-      return . fmap (, ()) $ JunctionParticipant now <$> studyFeatures <*> pure Nothing <*> pure CourseParticipantActive
     invitationInsertHook _ _ (_, InvTokenDataParticipant{..}) CourseParticipant{..} _ act = do
       deleteBy $ UniqueParticipant courseParticipantUser courseParticipantCourse -- there are no foreign key references to @{CourseParticipant}; therefor we can delete and recreate to simulate upsert
       res <- act -- insertUnique
@@ -109,7 +106,6 @@ participantInvitationConfig = InvitationConfig{..}
 
 data AddParticipantsResult = AddParticipantsResult
   { aurAlreadyRegistered
-  , aurNoUniquePrimaryField
   , aurSuccess              :: Set UserId
   } deriving (Read, Show, Generic, Typeable)
 
@@ -169,20 +165,14 @@ addParticipantsResultMessages :: (MonadHandler m, HandlerSite m ~ UniWorX)
                               => AddParticipantsResult
                               -> ReaderT (YesodPersistBackend UniWorX) m [Message]
 addParticipantsResultMessages AddParticipantsResult{..} = execWriterT $ do
-  (aurAlreadyRegistered', aurNoUniquePrimaryField') <-
+  aurAlreadyRegistered' <-
-    (,) <$> fmap sort (lift . mapM (fmap userEmail . getJust) $ Set.toList aurAlreadyRegistered)
+    fmap sort (lift . mapM (fmap userEmail . getJust) $ Set.toList aurAlreadyRegistered)
-        <*> fmap sort (lift . mapM (fmap userEmail . getJust) $ Set.toList aurNoUniquePrimaryField)
 
   unless (null aurAlreadyRegistered) $ do
     let modalTrigger = [whamlet|_{MsgCourseParticipantsAlreadyRegistered (length aurAlreadyRegistered)}|]
         modalContent = $(widgetFile "messages/courseInvitationAlreadyRegistered")
     tell . pure <=< messageWidget Info $ msgModal modalTrigger (Right modalContent)
 
-  unless (null aurNoUniquePrimaryField) $ do
-    let modalTrigger = [whamlet|_{MsgCourseParticipantsRegisteredWithoutField (length aurNoUniquePrimaryField)}|]
-        modalContent = $(widgetFile "messages/courseInvitationRegisteredWithoutField")
-    tell . pure <=< messageWidget Warning $ msgModal modalTrigger (Right modalContent)
-
   unless (null aurSuccess) $
     tell . pure <=< messageI Success . MsgCourseParticipantsRegistered $ length aurSuccess
 
@@ -200,18 +190,6 @@ registerUser' cid uid mbGrp = exceptT tell tell $ do
   whenM (lift . lift $ exists [CourseParticipantCourse ==. cid, CourseParticipantUser ==. uid, CourseParticipantState ==. CourseParticipantActive]) $
     throwError $ mempty { aurAlreadyRegistered = Set.singleton uid }
 
-  features <- lift . lift $ selectKeysList [ StudyFeaturesUser ==. uid, StudyFeaturesValid ==. True, StudyFeaturesType ==. FieldPrimary ] []
-  applications <- lift . lift $ selectList [ CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
-
-  let courseParticipantField
-        | [f] <- features
-        = Just f
-        | [f'] <- nub $ mapMaybe (courseApplicationField . entityVal) applications
-        , f' `elem` features
-        = Just f'
-        | otherwise
-        = Nothing
-
   courseParticipantRegistration <- liftIO getCurrentTime
   void . lift . lift $ upsert
     CourseParticipant
@@ -222,7 +200,6 @@ registerUser' cid uid mbGrp = exceptT tell tell $ do
       , ..
       }
     [ CourseParticipantRegistration =. courseParticipantRegistration
-    , CourseParticipantField =. courseParticipantField
     , CourseParticipantAllocated =. Nothing
     , CourseParticipantState =. CourseParticipantActive
     ]
@@ -231,9 +208,7 @@ registerUser' cid uid mbGrp = exceptT tell tell $ do
 
   void . lift . lift $ setUserSubmissionGroup cid uid mbGrp
 
-  return $ case courseParticipantField of
+  return $ mempty { aurSuccess = Set.singleton uid }
-    Nothing -> mempty { aurNoUniquePrimaryField = Set.singleton uid }
-    Just _  -> mempty { aurSuccess              = Set.singleton uid }
 
 
 getCInviteR, postCInviteR :: TermId -> SchoolId -> CourseShorthand -> Handler Html

src/Handler/Course/Register.hs

@@ -42,8 +42,7 @@ instance Button UniWorX ButtonCourseRegister where
 
 
 data CourseRegisterForm = CourseRegisterForm
-  { crfStudyFeatures    :: Maybe StudyFeaturesId
+  { crfApplicationText  :: Maybe Text
-  , crfApplicationText  :: Maybe Text
   , crfApplicationFiles :: Maybe FileUploads
   }
 
@@ -83,17 +82,6 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
       | otherwise
         -> return $ FormSuccess ()
 
-    fieldRes <- if
-      | is _Nothing muid
-        -> return $ FormSuccess Nothing
-      | is _Just muid
-      , isRegistered
-      , Just mFeature <- courseApplicationField . entityVal <$> application
-                     <|> courseParticipantField . entityVal <$> registration
-        -> wforced (studyFeaturesFieldFor Nothing True  (maybeToList mFeature) muid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) mFeature
-      | otherwise
-        -> wreq    (studyFeaturesFieldFor Nothing False []                     muid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) Nothing
-
     appTextRes <- let fs | courseApplicationsRequired
                          , is _Just courseApplicationsInstructions
                          = fslI MsgCourseApplicationText & setTooltip MsgCourseApplicationFollowInstructions
@@ -168,7 +156,6 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
 
     return $ CourseRegisterForm
       <$  secretRes
-      <*> fieldRes
       <*> appTextRes
       <*> appFilesRes
 
@@ -201,7 +188,7 @@ postCRegisterR tid ssh csh = do
         = void <$> do
             appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
             appRes <- case appIds of
-              [] -> insertUnique $ CourseApplication cid uid crfStudyFeatures crfApplicationText False Nothing Nothing Nothing Nothing cTime Nothing
+              [] -> insertUnique $ CourseApplication cid uid crfApplicationText False Nothing Nothing Nothing Nothing cTime Nothing
               (prevId:ps) -> do
                 forM_ ps $ \appId -> do
                   deleteApplicationFiles appId
@@ -209,7 +196,7 @@ postCRegisterR tid ssh csh = do
                   audit $ TransactionCourseApplicationDeleted cid uid appId
 
                 deleteApplicationFiles prevId
-                update prevId [ CourseApplicationField =. crfStudyFeatures, CourseApplicationText =. crfApplicationText, CourseApplicationTime =. cTime ]
+                update prevId [ CourseApplicationText =. crfApplicationText, CourseApplicationTime =. cTime ]
 
                 return $ Just prevId
 
@@ -223,9 +210,8 @@ postCRegisterR tid ssh csh = do
       mkRegistration = do
         audit $ TransactionCourseParticipantEdit cid uid
         entityKey <$> upsert
-          (CourseParticipant cid uid cTime crfStudyFeatures Nothing CourseParticipantActive)
+          (CourseParticipant cid uid cTime Nothing CourseParticipantActive)
           [ CourseParticipantRegistration =. cTime
-          , CourseParticipantField =. crfStudyFeatures
           , CourseParticipantAllocated =. Nothing
           , CourseParticipantState =. CourseParticipantActive
           ]

src/Handler/Course/User.hs

@@ -22,6 +22,8 @@ import Jobs.Queue
 
 import Handler.Submission.List
 
+import Handler.Utils.StudyFeatures
+
 import qualified Data.Map as Map
 import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI
@@ -93,36 +95,15 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex =
 
   (mRegistration, studies) <- lift . runDB $ do
     registration <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
-    studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
+    studies <- E.select $ E.from $ \(course `E.InnerJoin` studyfeat `E.InnerJoin` studydegree `E.InnerJoin` studyterms) -> do
-      E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
       E.on $ studyfeat E.^. StudyFeaturesField  E.==. studyterms  E.^. StudyTermsId
       E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
+      E.on $ isCourseStudyFeature course studyfeat
+      E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
+      E.where_ $ course E.^. CourseId E.==. E.val cid
       return  (studyfeat, studydegree, studyterms)
     return (registration, studies)
 
-  ((regFieldRes, regFieldView), regFieldEnctype) <- lift . runFormPost . identifyForm FIDcRegField $ \csrf ->
-    let currentField :: Maybe (Maybe StudyFeaturesId)
-        currentField = courseParticipantField . entityVal <$> mRegistration
-     in over _2 ((toWidget csrf <>) . fvWidget) <$> mreq (studyFeaturesFieldFor Nothing True (maybeToList $ join currentField) $ Just uid) ("" & addAutosubmit) currentField
-
-  let registrationFieldFrag :: Text
-      registrationFieldFrag = "registration-field"
-      regFieldWidget = wrapForm regFieldView FormSettings
-        { formMethod = POST
-        , formAction = Just . SomeRoute $ currentRoute :#: registrationFieldFrag
-        , formEncoding = regFieldEnctype
-        , formAttrs = []
-        , formSubmit = FormAutoSubmit
-        , formAnchor = Just registrationFieldFrag
-        }
-  for_ mRegistration $ \(Entity pId CourseParticipant{}) ->
-    formResult regFieldRes $ \courseParticipantField' -> do
-      lift . runDB $ do
-        update pId [ CourseParticipantField =. courseParticipantField' ]
-        audit $ TransactionCourseParticipantEdit cid uid
-        addMessageI Success MsgCourseStudyFeatureUpdated
-      redirect $ currentRoute :#: registrationFieldFrag
-
   mayRegister <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CAddUserR
   let regButton
         | is _Just mRegistration = BtnCourseDeregister
@@ -179,16 +160,10 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex =
         -> invalidArgs ["User not registered"]
     (BtnCourseRegister, _) -> do
       now <- liftIO getCurrentTime
-      let field
-            | [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesValid) studies
-            = Just featId
-            | otherwise
-            = Nothing
       lift . runDBJobs $ do
         void $ upsert
-          (CourseParticipant cid uid now field Nothing CourseParticipantActive)
+          (CourseParticipant cid uid now Nothing CourseParticipantActive)
           [ CourseParticipantRegistration =. now
-          , CourseParticipantField =. field
           , CourseParticipantAllocated =. Nothing
           , CourseParticipantState =. CourseParticipantActive
           ]

src/Handler/Course/Users.hs

@@ -4,7 +4,7 @@ module Handler.Course.Users
   ( queryUser
   , makeCourseUserTable
   , postCUsersR, getCUsersR
-  , colUserDegreeShort, colUserField, colUserSemester, colUserSex'
+  , colUserSex', _userStudyFeatures
   ) where
 
 import Import
@@ -16,6 +16,7 @@ import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
 
 import Handler.Course.Register (deregisterParticipant)
+import Handler.Utils.StudyFeatures
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
@@ -39,10 +40,6 @@ type UserTableExpr   = (               E.SqlExpr (Entity User)
                          `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)
                        )
      `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
-     `E.LeftOuterJoin` (               E.SqlExpr (Maybe (Entity StudyFeatures))
-                         `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
-                         `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
-                       )
      `E.LeftOuterJoin` (               E.SqlExpr (Maybe (Entity SubmissionGroup))
                          `E.InnerJoin` E.SqlExpr (Maybe (Entity SubmissionGroupUser))
                        )
@@ -53,54 +50,43 @@ type UserTableExpr   = (               E.SqlExpr (Entity User)
 -- Sql-Getters for this query, used for sorting and filtering (cannot be lenses due to being Esqueleto expressions)
 -- This ought to ease refactoring the query
 queryUser :: UserTableExpr -> E.SqlExpr (Entity User)
-queryUser = $(sqlIJproj 2 1) . $(sqlLOJproj 4 1)
+queryUser = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
 
 queryParticipant :: UserTableExpr -> E.SqlExpr (Entity CourseParticipant)
-queryParticipant = $(sqlIJproj 2 2) . $(sqlLOJproj 4 1)
+queryParticipant = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
 
 queryUserNote ::  UserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote))
-queryUserNote = $(sqlLOJproj 4 2)
+queryUserNote = $(sqlLOJproj 3 2)
-
-queryFeaturesStudy ::  UserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures))
-queryFeaturesStudy  = $(sqlIJproj 3 1) . $(sqlLOJproj 4 3)
-
-queryFeaturesDegree :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree))
-queryFeaturesDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 4 3)
-
-queryFeaturesField :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms))
-queryFeaturesField  = $(sqlIJproj 3 3) . $(sqlLOJproj 4 3)
 
 querySubmissionGroup :: UserTableExpr -> E.SqlExpr (Maybe (Entity SubmissionGroup))
-querySubmissionGroup = $(sqlIJproj 2 1) . $(sqlLOJproj 4 4)
+querySubmissionGroup = $(sqlIJproj 2 1) . $(sqlLOJproj 3 3)
 
 
 userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User)
                                                           , E.SqlExpr (Entity CourseParticipant)
                                                           , E.SqlExpr (E.Value (Maybe (Key CourseUserNote)))
-                                                          , StudyFeaturesDescription'
                                                           , E.SqlExpr (Maybe (Entity SubmissionGroup))
                                                           )
-userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures `E.LeftOuterJoin` (subGroup `E.InnerJoin` subGroupUser)) = do
+userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` (subGroup `E.InnerJoin` subGroupUser)) = do
   -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis
   E.on $ subGroup E.?. SubmissionGroupId E.==. subGroupUser E.?. SubmissionGroupUserSubmissionGroup
   E.on $ subGroupUser E.?. SubmissionGroupUserUser E.==. E.just (user E.^. UserId)
    E.&&. subGroup E.?. SubmissionGroupCourse E.==. E.just (E.val cid)
-  features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures
   E.on $  (note E.?. CourseUserNoteUser   E.==. E.just (participant E.^. CourseParticipantUser))
     E.&&. (note E.?. CourseUserNoteCourse E.==. E.just (E.val cid))
   E.on $     participant E.^. CourseParticipantUser   E.==. user E.^. UserId
   E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
-  return (user, participant, note E.?. CourseUserNoteId, features, subGroup)
+  return (user, participant, note E.?. CourseUserNoteId, subGroup)
 
 
 type UserTableData = DBRow ( Entity User
                            , Entity CourseParticipant
                            , Maybe CourseUserNoteId
-                           , (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms)
                            , ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial)))
                            , [Entity Exam]
                            , Maybe (Entity SubmissionGroup)
                            , Map SheetName (SheetType, Maybe Points)
+                           , UserTableStudyFeatures
                            )
 
 instance HasEntity UserTableData User where
@@ -118,23 +104,20 @@ _userTableRegistration = _userTableParticipant . _entityVal . _courseParticipant
 _userTableNote :: Lens' UserTableData (Maybe CourseUserNoteId)
 _userTableNote = _dbrOutput . _3
 
-_userTableFeatures :: Lens' UserTableData (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms)
-_userTableFeatures = _dbrOutput . _4
-
-_rowUserSemester :: Traversal' UserTableData Int
-_rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester
-
 _userTutorials :: Lens' UserTableData ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial)))
-_userTutorials = _dbrOutput . _5
+_userTutorials = _dbrOutput . _4
 
 _userExams :: Lens' UserTableData [Entity Exam]
-_userExams = _dbrOutput . _6
+_userExams = _dbrOutput . _5
 
 _userSubmissionGroup :: Traversal' UserTableData (Entity SubmissionGroup)
-_userSubmissionGroup = _dbrOutput . _7 . _Just
+_userSubmissionGroup = _dbrOutput . _6 . _Just
 
 _userSheets :: Lens' UserTableData (Map SheetName (SheetType, Maybe Points))
-_userSheets = _dbrOutput . _8
+_userSheets = _dbrOutput . _7
+
+_userStudyFeatures :: Lens' UserTableData UserTableStudyFeatures
+_userStudyFeatures = _dbrOutput . _8
 
 
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
@@ -161,26 +144,6 @@ colUserExams tid ssh csh = sortable (Just "exams") (i18nCell MsgCourseUserExams)
           (\(Entity _ Exam{..}) -> CExamR tid ssh csh examName EUsersR)
           (examName . entityVal)
 
-colUserSemester :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserSemester = sortable (Just "semesternr") (i18nCell MsgStudyFeatureAge) $
-    foldMap numCell . preview _rowUserSemester
-
-colUserField :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserField = sortable (Just "field") (i18nCell MsgCourseStudyFeature) $
-    foldMap i18nCell . view (_userTableFeatures . _3)
-
--- colUserFieldShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
--- colUserFieldShort = sortable (Just "field-short") (i18nCell MsgCourseStudyFeature) $
---     foldMap (i18nCell . ShortStudyTerms) . view (_userTableFeatures . _3)
-
--- colUserDegree :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
--- colUserDegree = sortable (Just "degree") (i18nCell MsgStudyFeatureDegree) $
---     foldMap i18nCell . preview (_userTableFeatures . _2 . _Just)
-
-colUserDegreeShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserDegreeShort = sortable (Just "degree-short") (i18nCell MsgStudyFeatureDegree) $
-    foldMap (i18nCell . ShortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
-
 colUserSex' :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserSex' = colUserSex $ hasUser . _userSex
 
@@ -203,20 +166,12 @@ colUserSheets shns = cap (Sortable Nothing caption) $ foldMap userSheetCol shns
       _other -> mempty
 
 
-data UserTableCsvStudyFeature = UserTableCsvStudyFeature
-  { csvUserField :: Text
-  , csvUserDegree :: Text
-  , csvUserSemester :: Int
-  , csvUserType :: StudyFieldType
-  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
-makeLenses_ ''UserTableCsvStudyFeature
-
 data UserTableCsv = UserTableCsv
   { csvUserName :: Text
   , csvUserSex :: Maybe Sex
   , csvUserMatriculation :: Maybe Text
   , csvUserEmail :: CI Email
-  , csvUserStudyFeatures :: Either (Maybe UserTableCsvStudyFeature) (Set UserTableCsvStudyFeature)
+  , csvUserStudyFeatures :: UserTableStudyFeatures
   , csvUserSubmissionGroup :: Maybe SubmissionGroupName
   , csvUserRegistration :: UTCTime
   , csvUserNote :: Maybe Html
@@ -232,20 +187,8 @@ instance Csv.ToNamedRecord UserTableCsv where
     , "sex" Csv..= csvUserSex
     , "matriculation" Csv..= csvUserMatriculation
     , "email" Csv..= csvUserEmail
-    ] ++ case csvUserStudyFeatures of
+    , "study-features" Csv..= csvUserStudyFeatures
-           Left feats
+    , "submission-group" Csv..= csvUserSubmissionGroup
-             -> [ "field"    Csv..= (csvUserField    <$> feats)
-                , "degree"   Csv..= (csvUserDegree   <$> feats)
-                , "semester" Csv..= (csvUserSemester <$> feats)
-                ]
-           Right feats
-             -> let featsStr = Text.intercalate "; " . flip map (Set.toList feats) $ \UserTableCsvStudyFeature{..}
-                      -> let csvUserType' = renderMessage (error "no foundation needed" :: UniWorX) [] $ ShortStudyFieldType csvUserType
-                          in [st|#{csvUserField} #{csvUserDegree} (#{csvUserType'} #{tshow csvUserSemester})|]
-                 in [ "study-features" Csv..= featsStr
-                    ]
-      ++
-    [ "submission-group" Csv..= csvUserSubmissionGroup
     ] ++
     [ let tutsStr = Text.intercalate "; " . map CI.original $ csvUserTutorials ^. _1
        in "tutorial" Csv..= tutsStr
@@ -270,9 +213,6 @@ instance CsvColumnsExplained UserTableCsv where
     , single "matriculation"       MsgCsvColumnUserMatriculation
     , single "email"               MsgCsvColumnUserEmail
     , single "study-features"      MsgCsvColumnUserStudyFeatures
-    , single "field"               MsgCsvColumnUserField
-    , single "degree"              MsgCsvColumnUserDegree
-    , single "semester"            MsgCsvColumnUserSemester
     , single "submission-group"    MsgCsvColumnUserSubmissionGroup
     , single "tutorial"            MsgCsvColumnUserTutorial
     , single "exams"               MsgCsvColumnUserExam
@@ -283,19 +223,17 @@ instance CsvColumnsExplained UserTableCsv where
       single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget
       single k v = singletonMap k [whamlet|_{v}|]
 
-data UserCsvExportData = UserCsvExportData
+newtype UserCsvExportData = UserCsvExportData
-  { csvUserSimplifiedFeaturesOfStudy :: Bool
+  { csvUserIncludeSheets :: Bool
-  , csvUserIncludeSheets :: Bool
   } deriving (Eq, Ord, Read, Show, Generic, Typeable)
 instance Default UserCsvExportData where
-  def = UserCsvExportData True False
+  def = UserCsvExportData False
 
 userTableCsvHeader :: Bool -> [Entity Tutorial] -> [Entity Sheet] -> UserCsvExportData -> Csv.Header
 userTableCsvHeader showSex tuts sheets UserCsvExportData{..} = Csv.header $
   [ "name" ] ++
   [ "sex" | showSex ] ++
-  [ "matriculation", "email"
+  [ "matriculation", "email", "study-features"] ++
-  ] ++ bool (pure "study-features") ["field", "degree", "semester"] csvUserSimplifiedFeaturesOfStudy ++
   [ "tutorial" | hasEmptyRegGroup ] ++
   map (encodeUtf8 . CI.foldedCase) regGroups ++
   [ "exams", "registration" ] ++
@@ -376,7 +314,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
         dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
         dbtSQLQuery q = userTableQuery cid q <* E.where_ (restrict q)
         dbtRowKey    = queryUser >>> (E.^. UserId)
-        dbtProj      = traverse $ \(user, participant, E.Value userNoteId, (feature,degree,terms), subGroup) -> do
+        dbtProj      = traverse $ \(user, participant, E.Value userNoteId, subGroup) -> do
           tuts'' <- selectList [ TutorialParticipantUser ==. entityKey user, TutorialParticipantTutorial <-. map entityKey tutorials ] []
           exams' <- selectList [ ExamRegistrationUser ==. entityKey user ] []
           subs' <- E.select . E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do
@@ -389,13 +327,14 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
                      , submission
                      )
                    )
+          feats <- courseUserStudyFeatures (participant ^. _entityVal . _courseParticipantCourse) (participant ^. _entityVal . _courseParticipantUser)
           let
             regGroups = setOf (folded . _entityVal . _tutorialRegGroup . _Just) tutorials
             tuts' = filter (\(Entity tutId _) -> any ((== tutId) . tutorialParticipantTutorial . entityVal) tuts'') tutorials
             tuts = foldr (\tut@(Entity _ Tutorial{..}) -> maybe (over _1 $ cons tut) (over _2 . flip (Map.insertWith (<|>)) (Just tut)) tutorialRegGroup) ([], Map.fromSet (const Nothing) regGroups) tuts'
             exs = filter (\(Entity eId _) -> any ((== eId) . examRegistrationExam . entityVal) exams') exams
             subs = Map.fromList $ map (over (_2 . _2) (views _entityVal submissionRatingPoints <=< assertM (views _entityVal submissionRatingDone)) . over _1 E.unValue . over (_2 . _1) E.unValue) subs'
-          return (user, participant, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms), tuts, exs, subGroup, subs)
+          return (user, participant, userNoteId, tuts, exs, subGroup, subs, feats)
         dbtColonnade = colChoices
         dbtSorting   = mconcat
           [ single $ sortUserNameLink    queryUser -- slower sorting through clicking name column header
@@ -404,11 +343,6 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
           , single $ sortUserEmail       queryUser
           , single $ sortUserMatriclenr  queryUser
           , sortUserSex (to queryUser . to (E.^. UserSex))
-          , single ("degree"      , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
-          , single ("degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
-          , single ("field"       , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsName))
-          , single ("field-short" , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsShorthand))
-          , single ("semesternr"  , SortColumn $ queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
           , single ("registration", SortColumn $ queryParticipant    >>> (E.^. CourseParticipantRegistration))
           , single ("note"        , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
                 E.subSelectMaybe . E.from $ \edit -> do
@@ -450,20 +384,6 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
           , single $ fltrUserMatriclenr  queryUser
           , single $ fltrUserNameEmail   queryUser
           , fltrUserSex (to queryUser . to (E.^. UserSex))
-          , single ("field-name"  , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsName))
-          , single ("field-short" , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsShorthand))
-          , single ("field-key"   , FilterColumn $ E.mkExactFilter    $ queryFeaturesField >>> (E.?. StudyTermsKey))
-          , single ("field"       , FilterColumn $ E.anyFilter
-                                        [ E.mkContainsFilterWith Just $ queryFeaturesField >>> E.joinV . (E.?. StudyTermsName)
-                                        , E.mkContainsFilterWith Just $ queryFeaturesField >>> E.joinV . (E.?. StudyTermsShorthand)
-                                        , E.mkExactFilterWith readMay $ queryFeaturesField >>> (E.?. StudyTermsKey)
-                                        ] )
-          , single ("degree"      , FilterColumn $ E.anyFilter
-                                        [ E.mkContainsFilterWith Just $ queryFeaturesDegree >>> E.joinV . (E.?. StudyDegreeName)
-                                        , E.mkContainsFilterWith Just $ queryFeaturesDegree >>> E.joinV . (E.?. StudyDegreeShorthand)
-                                        , E.mkExactFilterWith readMay $ queryFeaturesDegree >>> (E.?. StudyDegreeKey)
-                                        ] )
-          , single ("semesternr"  , FilterColumn $ E.mkExactFilter    $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
           , single ("tutorial"    , FilterColumn $ E.mkExistsFilter   $ \row criterion ->
                          E.from $ \(tutorial `E.InnerJoin` tutorialParticipant) -> do
                            E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
@@ -489,6 +409,18 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
                           E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
                                E.&&. sheet E.^. SheetName E.==. E.val shn
                    )
+          , fltrRelevantStudyFeaturesTerms (to $
+              \t -> ( E.subSelectForeign (queryParticipant t) CourseParticipantCourse (E.^. CourseTerm)
+                    , queryUser t E.^. UserId
+                    ))
+          , fltrRelevantStudyFeaturesDegree (to $
+              \t -> ( E.subSelectForeign (queryParticipant t) CourseParticipantCourse (E.^. CourseTerm)
+                    , queryUser t E.^. UserId
+                    ))
+          , fltrRelevantStudyFeaturesSemester (to $
+              \t -> ( E.subSelectForeign (queryParticipant t) CourseParticipantCourse (E.^. CourseTerm)
+                    , queryUser t E.^. UserId
+                    ))
           ]
           where single = uncurry Map.singleton
         dbtFilterUI mPrev = mconcat $
@@ -497,11 +429,12 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
           , fltrUserMatriclenrUI mPrev
           ] ++
           [ fltrUserSexUI mPrev | showSex ] ++
-          [ prismAForm (singletonFilter "degree")   mPrev $ aopt textField (fslI MsgStudyFeatureDegree)
+          [ prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgSubmissionGroup)
-          , prismAForm (singletonFilter "field")    mPrev $ aopt textField (fslI MsgCourseStudyFeature)
-          , prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgSubmissionGroup)
           , prismAForm (singletonFilter "tutorial") mPrev $ aopt textField (fslI MsgCourseUserTutorial)
           , prismAForm (singletonFilter "exam")     mPrev $ aopt textField (fslI MsgCourseUserExam)
+          , fltrRelevantStudyFeaturesDegreeUI mPrev
+          , fltrRelevantStudyFeaturesTermsUI mPrev
+          , fltrRelevantStudyFeaturesSemesterUI mPrev
           ] ++
           [ prismAForm (singletonFilter "has-personalised-sheet-files". maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgNoFilter) . optionsF $ map E.unValue personalisedSheets) (fslI MsgCourseUserHasPersonalisedSheetFilesFilter)
           | not $ null personalisedSheets
@@ -523,44 +456,14 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
           csvColumns' <- csvColumns
           return $ DBTCsvEncode
             { dbtCsvExportForm = UserCsvExportData
-                <$> apopt checkBoxField (fslI MsgUserSimplifiedFeaturesOfStudyCsv & setTooltip MsgUserSimplifiedFeaturesOfStudyCsvTip) (Just $ csvUserSimplifiedFeaturesOfStudy def)
+                <$> apopt checkBoxField (fslI MsgCourseUserCsvIncludeSheets & setTooltip MsgCourseUserCsvIncludeSheetsTip) (Just $ csvUserIncludeSheets def)
-                <*> apopt checkBoxField (fslI MsgCourseUserCsvIncludeSheets & setTooltip MsgCourseUserCsvIncludeSheetsTip) (Just $ csvUserIncludeSheets def)
+            , dbtCsvDoEncode = \UserCsvExportData{} -> C.mapM $ \(_, row) -> flip runReaderT row $
-            , dbtCsvDoEncode = \UserCsvExportData{..} -> C.mapM $ \(E.Value uid, row) -> flip runReaderT row $
                 UserTableCsv
                   <$> view (hasUser . _userDisplayName)
                   <*> view (hasUser . _userSex)
                   <*> view (hasUser . _userMatrikelnummer)
                   <*> view (hasUser . _userEmail)
-                  <*> if
+                  <*> view _userStudyFeatures
-                        | csvUserSimplifiedFeaturesOfStudy -> fmap Left . runMaybeT $
-                            UserTableCsvStudyFeature
-                              <$> MaybeT (preview $   _userTableFeatures . _3 . _Just . _studyTermsName . _Just
-                                                   <> _userTableFeatures . _3 . _Just . _studyTermsKey . to tshow
-                                         )
-                              <*> MaybeT (preview $   _userTableFeatures . _2 . _Just . _studyDegreeName . _Just
-                                                   <> _userTableFeatures . _2 . _Just . _studyDegreeKey . to tshow
-                                         )
-                              <*> MaybeT (preview $ _userTableFeatures . _1 . _Just . _studyFeaturesSemester)
-                              <*> MaybeT (preview $ _userTableFeatures . _1 . _Just . _studyFeaturesType)
-                        | otherwise -> Right <$> do
-                            feats <- lift . E.select . E.from $ \(feat `E.InnerJoin` terms `E.InnerJoin` degree) -> do
-                              E.on $ degree E.^. StudyDegreeId E.==. feat E.^. StudyFeaturesDegree
-                              E.on $ terms E.^. StudyTermsId E.==. feat E.^. StudyFeaturesField
-                              let registered = E.exists . E.from $ \participant ->
-                                    E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
-                                         E.&&. participant E.^. CourseParticipantUser E.==. E.val uid
-                                         E.&&. participant E.^. CourseParticipantField E.==. E.just (feat E.^. StudyFeaturesId)
-                              E.where_ $ registered
-                                   E.||. feat E.^. StudyFeaturesValid
-                              E.where_ $ feat E.^. StudyFeaturesUser E.==. E.val uid
-                              return (terms, degree, feat)
-                            return . Set.fromList . flip map feats $ \(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) ->
-                              UserTableCsvStudyFeature
-                                { csvUserField = fromMaybe (tshow studyTermsKey) studyTermsName
-                                , csvUserDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName
-                                , csvUserSemester = studyFeaturesSemester
-                                , csvUserType = studyFeaturesType
-                                }
                   <*> preview (_userSubmissionGroup . _entityVal . _submissionGroupName)
                   <*> view _userTableRegistration
                   <*> userNote
@@ -636,9 +539,7 @@ postCUsersR tid ssh csh = do
           , guardOn showSex . cap' $ colUserSex'
           , pure . cap' $ colUserEmail
           , pure . cap' $ colUserMatriclenr
-          , pure . cap' $ colUserDegreeShort
+          , pure . cap' $ colStudyFeatures _userStudyFeatures
-          , pure . cap' $ colUserField
-          , pure . cap' $ colUserSemester
           , guardOn hasSubmissionGroups $ cap' colUserSubmissionGroup
           , guardOn hasTutorials . cap' $ colUserTutorials tid ssh csh
           , guardOn hasExams . cap' $ colUserExams tid ssh csh

src/Handler/Exam/AddUser.hs

@@ -22,7 +22,6 @@ import Generics.Deriving.Monoid
 
 data AddRecipientsResult = AddRecipientsResult
   { aurAlreadyRegistered
-  , aurNoUniquePrimaryField
   , aurNoCourseRegistration
   , aurSuccess
   , aurSuccessCourse        :: [UserEmail]
@@ -101,11 +100,6 @@ postEAddUserR tid ssh csh examn = do
       unless (null aurSuccess) $
         tell . pure <=< messageI Success . MsgExamRegistrationParticipantsRegistered $ length aurSuccess
 
-      unless (null aurNoUniquePrimaryField) $ do
-        let modalTrigger = [whamlet|_{MsgExamRegistrationRegisteredWithoutField (length aurNoUniquePrimaryField)}|]
-            modalContent = $(widgetFile "messages/examRegistrationInvitationRegisteredWithoutField")
-        tell . pure <=< messageWidget Warning $ msgModal modalTrigger (Right modalContent)
-
       unless (null aurNoCourseRegistration) $ do
         let modalTrigger = [whamlet|_{MsgExamRegistrationNotRegisteredWithoutCourse (length aurNoCourseRegistration)}|]
             modalContent = $(widgetFile "messages/examRegistrationInvitationNotRegisteredWithoutCourse")
@@ -137,11 +131,6 @@ postEAddUserR tid ssh csh examn = do
 
       guardAuthResult =<< lift (lift $ evalAccessDB (CourseR tid ssh csh CAddUserR) True)
 
-      features <- lift . lift $ selectKeysList [ StudyFeaturesUser ==. uid, StudyFeaturesValid ==. True, StudyFeaturesType ==. FieldPrimary ] []
-
-      let courseParticipantField
-            | [f] <- features = Just f
-            | otherwise       = Nothing
 
       lift . lift . void $ upsert
         CourseParticipant
@@ -154,15 +143,12 @@ postEAddUserR tid ssh csh examn = do
           }
         [ CourseParticipantRegistration =. now
         , CourseParticipantAllocated =. Nothing
-        , CourseParticipantField =. courseParticipantField
         , CourseParticipantState =. CourseParticipantActive
         ]
       lift . lift . audit $ TransactionCourseParticipantEdit cid uid
       lift . lift . queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid
       lift $ lift examRegister
 
-      return $ case courseParticipantField of
+      return $ mempty { aurSuccessCourse = pure userEmail }
-        Nothing -> mempty { aurNoUniquePrimaryField = pure userEmail }
-        Just _  -> mempty { aurSuccessCourse        = pure userEmail }
 
 

src/Handler/Exam/RegistrationInvite.hs

@@ -95,16 +95,13 @@ examRegistrationInvitationConfig = InvitationConfig{..}
 
       case (isRegistered, invDBExamRegistrationCourseRegister) of
         (False, False) -> permissionDeniedI MsgUnauthorizedParticipant
-        (False, True ) -> do
+        (False, True ) -> return $ pure (JunctionExamRegistration invDBExamRegistrationOccurrence now, True)
-          fieldRes <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid) (fslI MsgCourseStudyFeature) Nothing
+        (True , _    ) -> return $ pure (JunctionExamRegistration invDBExamRegistrationOccurrence now, False)
-          return $ (JunctionExamRegistration invDBExamRegistrationOccurrence now, ) . Just <$> fieldRes
+    invitationInsertHook _ (Entity eid Exam{..}) _ ExamRegistration{..} doReg act = do
-        (True , _    ) -> return $ pure (JunctionExamRegistration invDBExamRegistrationOccurrence now, Nothing)
+      when doReg $ do
-    invitationInsertHook _ (Entity eid Exam{..}) _ ExamRegistration{..} mField act = do
-      whenIsJust mField $ \cpField -> do
         void $ upsert
-          (CourseParticipant examCourse examRegistrationUser examRegistrationTime cpField Nothing CourseParticipantActive)
+          (CourseParticipant examCourse examRegistrationUser examRegistrationTime Nothing CourseParticipantActive)
           [ CourseParticipantRegistration =. examRegistrationTime
-          , CourseParticipantField =. cpField
           , CourseParticipantAllocated =. Nothing
           , CourseParticipantState =. CourseParticipantActive
           ]

src/Handler/Exam/Users.hs

@@ -10,6 +10,7 @@ import Handler.Utils
 import Handler.Utils.Exam
 import Handler.Utils.Users
 import Handler.Utils.Csv
+import Handler.Utils.StudyFeatures
 
 import Handler.Exam.AutoOccurrence (examAutoOccurrenceCalculateWidget)
 
@@ -47,25 +48,18 @@ type ExamUserTableExpr = (              E.SqlExpr (Entity ExamRegistration)
                           `E.InnerJoin` E.SqlExpr (Entity User)
                          )
        `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOccurrence))
-       `E.LeftOuterJoin` (                  E.SqlExpr (Maybe (Entity CourseParticipant))
+       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseParticipant))
-                          `E.LeftOuterJoin` (              E.SqlExpr (Maybe (Entity StudyFeatures))
-                                             `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
-                                             `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
-                                            )
-                         )
        `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamBonus))
        `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamResult))
        `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
 type ExamUserTableData = DBRow ( Entity ExamRegistration
                                , Entity User
                                , Maybe (Entity ExamOccurrence)
-                               , Maybe (Entity StudyFeatures)
-                               , Maybe (Entity StudyDegree)
-                               , Maybe (Entity StudyTerms)
                                , Maybe (Entity ExamBonus)
                                , Maybe (Entity ExamResult)
                                , Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult))
                                , Maybe (Entity CourseUserNote)
+                               , UserTableStudyFeatures
                                )
 
 instance HasEntity ExamUserTableData User where
@@ -87,16 +81,7 @@ queryExamOccurrence :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity ExamOccurre
 queryExamOccurrence = $(sqlLOJproj 6 2)
 
 queryCourseParticipant :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity CourseParticipant))
-queryCourseParticipant = $(sqlLOJproj 2 1) . $(sqlLOJproj 6 3)
+queryCourseParticipant = $(sqlLOJproj 6 3)
-
-queryStudyFeatures :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures))
-queryStudyFeatures = $(sqlIJproj 3 1) . $(sqlLOJproj 2 2) . $(sqlLOJproj 6 3)
-
-queryStudyDegree :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree))
-queryStudyDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 2 2) . $(sqlLOJproj 6 3)
-
-queryStudyField :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms))
-queryStudyField = $(sqlIJproj 3 3) . $(sqlLOJproj 2 2) . $(sqlLOJproj 6 3)
 
 queryExamBonus :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity ExamBonus))
 queryExamBonus = $(sqlLOJproj 6 4)
@@ -130,38 +115,32 @@ resultExamRegistration = _dbrOutput . _1
 resultUser :: Lens' ExamUserTableData (Entity User)
 resultUser = _dbrOutput . _2
 
-resultStudyFeatures :: Traversal' ExamUserTableData (Entity StudyFeatures)
-resultStudyFeatures = _dbrOutput . _4 . _Just
-
-resultStudyDegree :: Traversal' ExamUserTableData (Entity StudyDegree)
-resultStudyDegree = _dbrOutput . _5 . _Just
-
-resultStudyField :: Traversal' ExamUserTableData (Entity StudyTerms)
-resultStudyField = _dbrOutput . _6 . _Just
-
 resultExamOccurrence :: Traversal' ExamUserTableData (Entity ExamOccurrence)
 resultExamOccurrence = _dbrOutput . _3 . _Just
 
 resultExamBonus :: Traversal' ExamUserTableData (Entity ExamBonus)
-resultExamBonus = _dbrOutput . _7 . _Just
+resultExamBonus = _dbrOutput . _4 . _Just
 
 resultExamResult :: Traversal' ExamUserTableData (Entity ExamResult)
-resultExamResult = _dbrOutput . _8 . _Just
+resultExamResult = _dbrOutput . _5 . _Just
 
 resultExamParts :: IndexedTraversal' ExamPartId ExamUserTableData (ExamPart, Maybe (Entity ExamPartResult))
-resultExamParts = _dbrOutput . _9 . itraversed
+resultExamParts = _dbrOutput . _6 . itraversed
 
 -- resultExamParts' :: Traversal' ExamUserTableData (Entity ExamPart)
 -- resultExamParts' = (resultExamParts <. _1) . withIndex . from _Entity
 
 resultExamPartResult :: ExamPartId -> Lens' ExamUserTableData (Maybe (Entity ExamPartResult))
-resultExamPartResult epId = _dbrOutput . _9 . unsafeSingular (ix epId) . _2
+resultExamPartResult epId = _dbrOutput . _6 . unsafeSingular (ix epId) . _2
 
 resultExamPartResults :: IndexedTraversal' ExamPartId ExamUserTableData (Maybe (Entity ExamPartResult))
 resultExamPartResults = resultExamParts <. _2
 
 resultCourseNote :: Traversal' ExamUserTableData (Entity CourseUserNote)
-resultCourseNote = _dbrOutput . _10 . _Just
+resultCourseNote = _dbrOutput . _7 . _Just
+
+resultStudyFeatures :: Lens' ExamUserTableData UserTableStudyFeatures
+resultStudyFeatures = _dbrOutput . _8
 
 
 resultAutomaticExamBonus :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData Points
@@ -191,9 +170,7 @@ data ExamUserTableCsv = ExamUserTableCsv
   , csvEUserFirstName :: Maybe Text
   , csvEUserName :: Maybe Text
   , csvEUserMatriculation :: Maybe Text
-  , csvEUserField :: Maybe Text
+  , csvEUserStudyFeatures :: UserTableStudyFeatures
-  , csvEUserDegree :: Maybe Text
-  , csvEUserSemester :: Maybe Int
   , csvEUserOccurrence :: Maybe (CI Text)
   , csvEUserExercisePoints :: Maybe (Maybe Points)
   , csvEUserExerciseNumPasses :: Maybe (Maybe Int)
@@ -213,9 +190,7 @@ instance ToNamedRecord ExamUserTableCsv where
     , "first-name" Csv..= csvEUserFirstName
     , "name" Csv..= csvEUserName
     , "matriculation" Csv..= csvEUserMatriculation
-    , "field" Csv..= csvEUserField
+    , "study-features" Csv..= csvEUserStudyFeatures
-    , "degree" Csv..= csvEUserDegree
-    , "semester" Csv..= csvEUserSemester
     , "occurrence" Csv..= csvEUserOccurrence
     ] ++ catMaybes
            [ fmap ("exercise-points" Csv..=) csvEUserExercisePoints
@@ -240,9 +215,7 @@ instance FromNamedRecord ExamUserTableCsv where
       <*> csv .:?? "first-name"
       <*> csv .:?? "name"
       <*> csv .:?? "matriculation"
-      <*> csv .:?? "field"
+      <*> pure mempty
-      <*> csv .:?? "degree"
-      <*> csv .:?? "semester"
       <*> csv .:?? "occurrence"
       <*> fmap Just (csv .:?? "exercise-points")
       <*> fmap Just (csv .:?? "exercise-num-passes")
@@ -263,9 +236,7 @@ instance CsvColumnsExplained ExamUserTableCsv where
     , single "first-name"              MsgCsvColumnExamUserFirstName
     , single "name"                    MsgCsvColumnExamUserName
     , single "matriculation"           MsgCsvColumnExamUserMatriculation
-    , single "field"                   MsgCsvColumnExamUserField
+    , single "study-features"          MsgCsvColumnUserStudyFeatures
-    , single "degree"                  MsgCsvColumnExamUserDegree
-    , single "semester"                MsgCsvColumnExamUserSemester
     , single "occurrence"              MsgCsvColumnExamUserOccurrence
     , single "exercise-points"         MsgCsvColumnExamUserExercisePoints
     , single "exercise-num-passes"     MsgCsvColumnExamUserExercisePasses
@@ -287,7 +258,7 @@ examUserTableCsvHeader :: ( MonoFoldable mono
 examUserTableCsvHeader allBoni doBonus pNames = Csv.header $
   [ "surname", "first-name", "name"
   , "matriculation"
-  , "field", "degree", "semester"
+  , "study-features"
   , "course-note"
   , "occurrence"
   ] ++ bool mempty ["exercise-points", "exercise-points-max"] (doBonus && showPoints)
@@ -329,7 +300,6 @@ data ExamUserCsvActionClass
   = ExamUserCsvCourseRegister
   | ExamUserCsvRegister
   | ExamUserCsvAssignOccurrence
-  | ExamUserCsvSetCourseField
   | ExamUserCsvSetPartResult
   | ExamUserCsvSetBonus
   | ExamUserCsvOverrideBonus
@@ -343,7 +313,6 @@ embedRenderMessage ''UniWorX ''ExamUserCsvActionClass id
 data ExamUserCsvAction
   = ExamUserCsvCourseRegisterData
     { examUserCsvActUser :: UserId
-    , examUserCsvActCourseField :: Maybe StudyFeaturesId
     , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
     }
   | ExamUserCsvRegisterData
@@ -354,10 +323,6 @@ data ExamUserCsvAction
     { examUserCsvActRegistration :: ExamRegistrationId
     , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
     }
-  | ExamUserCsvSetCourseFieldData
-    { examUserCsvActCourseParticipant :: CourseParticipantId
-    , examUserCsvActCourseField :: Maybe StudyFeaturesId
-    }
   | ExamUserCsvDeregisterData
     { examUserCsvActRegistration :: ExamRegistrationId
     }
@@ -404,6 +369,7 @@ getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
   (((Any computedValues, registrationResult), examUsersTable), Entity eId examVal@Exam{..}, bonus) <- runDB $ do
     exam@(Entity eid examVal@Exam{..}) <- fetchExam tid ssh csh examn
+    Course{..} <- getJust examCourse
     occurrences <- selectList [ExamOccurrenceExam ==. eid] [Asc ExamOccurrenceName]
     examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName]
     bonus <- examBonus exam
@@ -453,9 +419,6 @@ postEUsersR tid ssh csh examn = do
             user              <- asks queryUser
             occurrence        <- asks queryExamOccurrence
             courseParticipant <- asks queryCourseParticipant
-            studyFeatures     <- asks queryStudyFeatures
-            studyDegree       <- asks queryStudyDegree
-            studyField        <- asks queryStudyField
             examBonus'        <- asks queryExamBonus
             examResult        <- asks queryExamResult
             courseUserNote    <- asks queryCourseNote
@@ -467,9 +430,6 @@ postEUsersR tid ssh csh examn = do
                E.&&. examResult E.?. ExamResultExam E.==. E.just (E.val eid)
               E.on $ examBonus' E.?. ExamBonusUser E.==. E.just (user E.^. UserId)
                E.&&. examBonus' E.?. ExamBonusExam E.==. E.just (E.val eid)
-              E.on $ studyField E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
-              E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
-              E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField)
               E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
                E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
                E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
@@ -479,13 +439,14 @@ postEUsersR tid ssh csh examn = do
 
               E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eid
 
-            return (examRegistration, user, occurrence, studyFeatures, studyDegree, studyField, examBonus', examResult, courseUserNote)
+            return (examRegistration, user, occurrence, examBonus', examResult, courseUserNote)
           dbtRowKey = queryExamRegistration >>> (E.^. ExamRegistrationId)
           dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $
-            (,,,,,,,,,)
+            (,,,,,,,)
-              <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5 <*> view _6 <*> view _7 <*> view _8
+              <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5
               <*> getExamParts
-              <*> view _9
+              <*> view _6
+              <*> (lift . courseUserStudyFeatures examCourse =<< view (_2 . _entityKey))
             where
               getExamParts :: ReaderT _ DB (Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult)))
               getExamParts = do
@@ -504,9 +465,7 @@ postEUsersR tid ssh csh examn = do
             [ pure $ dbSelect (_2 . applying _2) _1 $ return . view (resultExamRegistration . _entityKey)
             , pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
             , pure   colUserMatriclenr
-            , pure $ colField            resultStudyField
+            , pure $ colStudyFeatures resultStudyFeatures
-            , pure $ colDegreeShort      resultStudyDegree
-            , pure $ colFeaturesSemester resultStudyFeatures
             , pure $ sortable (Just "occurrence") (i18nCell MsgExamOccurrence) $ maybe mempty (anchorCell' (\n -> CExamR tid ssh csh examn EShowR :#: [st|exam-occurrence__#{n}|]) id . examOccurrenceName . entityVal) . view _userTableOccurrence
             , guardOn showPasses $ sortable Nothing (i18nCell MsgAchievedPasses) $ \(view $ resultUser . _entityKey -> uid) ->
                 let SheetGradeSummary{achievedPasses} = examBonusAchieved uid bonus
@@ -528,9 +487,6 @@ postEUsersR tid ssh csh examn = do
           dbtSorting = mconcat
             [ uncurry singletonMap $ sortUserNameLink     queryUser
             , uncurry singletonMap $ sortUserMatriclenr   queryUser
-            , uncurry singletonMap $ sortField            queryStudyField
-            , uncurry singletonMap $ sortDegreeShort      queryStudyDegree
-            , uncurry singletonMap $ sortFeaturesSemester queryStudyFeatures
             , mconcat
               [ singletonMap (fromText [st|part-#{toPathPiece examPartNumber}|]) . SortColumn . queryExamPart epId $ \_ examPartResult -> return $ examPartResult E.?. ExamPartResultResult
               | Entity epId ExamPart{..} <- examParts
@@ -546,20 +502,29 @@ postEUsersR tid ssh csh examn = do
           dbtFilter = mconcat
             [ uncurry singletonMap $ fltrUserNameEmail    queryUser
             , uncurry singletonMap $ fltrUserMatriclenr   queryUser
-            , uncurry singletonMap $ fltrField            queryStudyField
-            , uncurry singletonMap $ fltrDegree           queryStudyDegree
-            , uncurry singletonMap $ fltrFeaturesSemester queryStudyFeatures
             , uncurry singletonMap   ("occurrence", FilterColumn . E.mkContainsFilterWith Just $ queryExamOccurrence >>> (E.?. ExamOccurrenceName))
             , fltrExamResultPoints (to $ queryExamResult >>> (E.?. ExamResultResult))
+            , fltrRelevantStudyFeaturesTerms (to $
+                \t -> ( E.val courseTerm
+                      , queryUser t E.^. UserId
+                      ))
+            , fltrRelevantStudyFeaturesDegree (to $
+                \t -> ( E.val courseTerm
+                      , queryUser t E.^. UserId
+                      ))
+            , fltrRelevantStudyFeaturesSemester (to $
+                \t -> ( E.val courseTerm
+                      , queryUser t E.^. UserId
+                      ))
             ]
           dbtFilterUI mPrev = mconcat $ catMaybes
             [ Just $ fltrUserNameEmailUI    mPrev
             , Just $ fltrUserMatriclenrUI   mPrev
-            , Just $ fltrFieldUI            mPrev
-            , Just $ fltrDegreeUI           mPrev
-            , Just $ fltrFeaturesSemesterUI mPrev
             , Just $ prismAForm (singletonFilter "occurrence") mPrev $ aopt (selectField' (Just $ SomeMessage MsgNoFilter) $ optionsF [CI.original examOccurrenceName | Entity _ ExamOccurrence{..} <- occurrences]) (fslI MsgExamOccurrence)
             , Just $ fltrExamResultPointsUI mPrev
+            , Just $ fltrRelevantStudyFeaturesTermsUI mPrev
+            , Just $ fltrRelevantStudyFeaturesDegreeUI mPrev
+            , Just $ fltrRelevantStudyFeaturesSemesterUI mPrev
             ]
           dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
           dbtParams = DBParamsForm
@@ -627,9 +592,7 @@ postEUsersR tid ssh csh examn = do
                 <*> view (resultUser . _entityVal . _userFirstName . to Just)
                 <*> view (resultUser . _entityVal . _userDisplayName . to Just)
                 <*> view (resultUser . _entityVal . _userMatrikelnummer)
-                <*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just)
+                <*> view resultStudyFeatures
-                <*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just)
-                <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester)
                 <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName)
                 <*> fmap (bool (const Nothing) Just showPoints) (preview $ resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _achievedPoints . _Wrapped)
                 <*> fmap (bool (const Nothing) Just showPasses) (preview $ resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _achievedPasses . _Wrapped . integral)
@@ -650,15 +613,8 @@ postEUsersR tid ssh csh examn = do
                   -> error "An UniqueExamRegistration could be found, but the ExamRegistrationKey is not among the existing keys"
                 DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
                   (isPart, uid) <- lift $ guessUser' dbCsvNew
-                  if
+                  unless isPart $ 
-                    | isPart -> do
+                    yieldM $ ExamUserCsvCourseRegisterData uid <$> lookupOccurrence dbCsvNew
-                        yieldM $ ExamUserCsvRegisterData uid <$> lookupOccurrence dbCsvNew
-                        newFeatures <- lift $ lookupStudyFeatures dbCsvNew
-                        Entity cpId CourseParticipant{ courseParticipantField = oldFeatures } <- lift . getJustBy $ UniqueParticipant uid examCourse
-                        when (newFeatures /= oldFeatures) $
-                          yield $ ExamUserCsvSetCourseFieldData cpId newFeatures
-                    | otherwise ->
-                        yieldM $ ExamUserCsvCourseRegisterData uid <$> lookupStudyFeatures dbCsvNew <*> lookupOccurrence dbCsvNew
 
                   iforMOf_ (ifolded <. _Just) (csvEUserExamPartResults dbCsvNew) $ \epNumber epRes ->
                     when (epNumber `elem` examPartNumbers) $
@@ -679,11 +635,6 @@ postEUsersR tid ssh csh examn = do
                   when (newOccurrence /= dbCsvOld ^? resultExamOccurrence . _entityKey) $
                     yield $ ExamUserCsvAssignOccurrenceData (E.unValue dbCsvOldKey) newOccurrence
 
-                  newFeatures <- lift $ lookupStudyFeatures dbCsvNew
-                  when (newFeatures /= dbCsvOld ^? resultStudyFeatures . _entityKey) $ do
-                    Entity cpId _ <- lift . getJustBy . flip UniqueParticipant examCourse $ dbCsvOld ^. resultUser . _entityKey
-                    yield $ ExamUserCsvSetCourseFieldData cpId newFeatures
-
                   let uid = dbCsvOld ^. resultUser . _entityKey
 
                   forM_ examPartNumbers $ \epNumber ->
@@ -742,7 +693,6 @@ postEUsersR tid ssh csh examn = do
                 ExamUserCsvRegisterData{}         -> ExamUserCsvRegister
                 ExamUserCsvDeregisterData{}       -> ExamUserCsvDeregister
                 ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence
-                ExamUserCsvSetCourseFieldData{}   -> ExamUserCsvSetCourseField
                 ExamUserCsvSetPartResultData{}    -> ExamUserCsvSetPartResult
                 ExamUserCsvSetBonusData{..}
                   | examUserCsvIsBonusOverride    -> ExamUserCsvOverrideBonus
@@ -765,12 +715,10 @@ postEUsersR tid ssh csh examn = do
                         { courseParticipantCourse = examCourse
                         , courseParticipantUser = examUserCsvActUser
                         , courseParticipantRegistration = now
-                        , courseParticipantField = examUserCsvActCourseField
                         , courseParticipantAllocated = Nothing
                         , courseParticipantState = CourseParticipantActive
                         }
                       [ CourseParticipantRegistration =. now
-                      , CourseParticipantField =. examUserCsvActCourseField
                       , CourseParticipantAllocated =. Nothing
                       , CourseParticipantState =. CourseParticipantActive
                       ]
@@ -794,10 +742,6 @@ postEUsersR tid ssh csh examn = do
                     audit $ TransactionExamRegister eid examUserCsvActUser
                   ExamUserCsvAssignOccurrenceData{..} ->
                     update examUserCsvActRegistration [ ExamRegistrationOccurrence =. examUserCsvActOccurrence ]
-                  ExamUserCsvSetCourseFieldData{..} -> do
-                    update examUserCsvActCourseParticipant [ CourseParticipantField =. examUserCsvActCourseField ]
-                    CourseParticipant{..} <- getJust examUserCsvActCourseParticipant
-                    audit $ TransactionCourseParticipantEdit examCourse courseParticipantUser
                   ExamUserCsvSetPartResultData{..} -> do
                     epid <- getKeyJustBy $ UniqueExamPartNumber eid examUserCsvActExamPart
                     case examUserCsvActExamPartResult of
@@ -859,10 +803,6 @@ postEUsersR tid ssh csh examn = do
                   [whamlet|
                     $newline never
                     ^{nameWidget userDisplayName userSurname}
-                    $maybe features <- examUserCsvActCourseField
-                      , ^{studyFeaturesWidget features}
-                    $nothing
-                      , _{MsgCourseStudyFeatureNone}
                     $maybe ExamOccurrence{examOccurrenceName} <- occ
                       \ (#{examOccurrenceName})
                     $nothing
@@ -888,16 +828,6 @@ postEUsersR tid ssh csh examn = do
                     $nothing
                       \ (_{MsgExamNoOccurrence})
                   |]
-                ExamUserCsvSetCourseFieldData{..} -> do
-                  User{..} <- liftHandler . runDB $ getJust . courseParticipantUser =<< getJust examUserCsvActCourseParticipant
-                  [whamlet|
-                    $newline never
-                    ^{nameWidget userDisplayName userSurname}
-                    $maybe features <- examUserCsvActCourseField
-                      , ^{studyFeaturesWidget features}
-                    $nothing
-                      , _{MsgCourseStudyFeatureNone}
-                  |]
                 ExamUserCsvSetPartResultData{..} -> do
                   (User{..}, Entity _ ExamPart{..}) <- liftHandler . runDB $
                     (,) <$> getJust examUserCsvActUser
@@ -985,56 +915,6 @@ postEUsersR tid ssh csh examn = do
                   [occId] -> return occId
                   _other  -> throwM ExamUserCsvExceptionNoMatchingOccurrence
 
-              lookupStudyFeatures :: ExamUserTableCsv -> DB (Maybe StudyFeaturesId)
-              lookupStudyFeatures csv@ExamUserTableCsv{..} = do
-                uid <- view _2 <$> guessUser' csv
-                oldFeatures <- getBy $ UniqueParticipant uid examCourse
-                studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) ->
-                  E.distinctOnOrderBy [ E.asc (studyFeatures E.^. StudyFeaturesField)
-                                      , E.asc (studyFeatures E.^. StudyFeaturesDegree)
-                                      , E.asc (studyFeatures E.^. StudyFeaturesSemester)] $ do
-                    E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
-                    E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
-                    E.where_ . E.and $ catMaybes
-                      [ do
-                          field <- csvEUserField
-                          return . E.or $ catMaybes
-                            [ Just $ studyTerms E.^. StudyTermsName `E.ciEq` E.just (E.val field)
-                            , Just $ studyTerms E.^. StudyTermsShorthand `E.ciEq` E.just (E.val field)
-                            , (studyTerms E.^. StudyTermsKey E.==.) . E.val <$> readMay field
-                            ]
-                      , do
-                          degree <- csvEUserDegree
-                          return . E.or $ catMaybes
-                            [ Just $ studyDegree E.^. StudyDegreeName `E.ciEq` E.just (E.val degree)
-                            , Just $ studyDegree E.^. StudyDegreeShorthand `E.ciEq` E.just (E.val degree)
-                            , (studyDegree E.^. StudyDegreeKey E.==.) . E.val <$> readMay degree
-                            ]
-                      , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
-                      ]
-                    E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
-                    let isActive = studyFeatures E.^. StudyFeaturesValid  E.==.  E.val True
-                        isActiveOrPrevious = case oldFeatures of
-                          Just (Entity _ CourseParticipant{courseParticipantField = Just sfid})
-                            -> isActive E.||. (E.val sfid  E.==.  studyFeatures E.^. StudyFeaturesId)
-                          _ -> isActive
-                    E.where_ isActiveOrPrevious -- either active studyFeature or the one previously associated with this course
-                    E.orderBy [E.desc isActiveOrPrevious, E.asc (E.orderByOrd $ studyFeatures E.^. StudyFeaturesType)]
-                    return $ studyFeatures E.^. StudyFeaturesId
-                case studyFeatures of
-                  [E.Value fid] -> return $ Just fid
-                  _other
-                    | is _Nothing csvEUserField
-                    , is _Nothing csvEUserDegree
-                    , is _Nothing csvEUserSemester
-                    -> return Nothing
-                  _other
-                    | Just (Entity _ CourseParticipant{..}) <- oldFeatures
-                    , Just sfid <- courseParticipantField
-                    , E.Value sfid `elem` studyFeatures
-                    -> return $ Just sfid
-                  _other        -> throwM ExamUserCsvExceptionNoMatchingStudyFeatures
-
       examUsersDBTableValidator = def & defaultSorting [SortAscBy "user-name"]
                                       & defaultPagesize PagesizeAll
 

src/Handler/ExamOffice/Exam.hs

@@ -22,6 +22,8 @@ import qualified Data.Map as Map
 import qualified Data.Conduit.List as C
 import qualified Colonnade
 
+import Handler.Utils.StudyFeatures
+
 
 data ButtonCloseExam = BtnCloseExam
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
@@ -68,21 +70,14 @@ type ExamUserTableExpr = (              E.SqlExpr (Entity ExamResult)
                          )
        `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamRegistration))
        `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOccurrence))
-       `E.LeftOuterJoin` ( E.SqlExpr (Maybe (Entity CourseParticipant))
+       `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseParticipant))
-         `E.LeftOuterJoin` ( E.SqlExpr (Maybe (Entity StudyFeatures))
-               `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
-               `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
-                           )
-                         )
 type ExamUserTableData = DBRow ( Entity ExamResult
                                , Entity User
                                , Maybe (Entity ExamOccurrence)
-                               , Maybe (Entity StudyFeatures)
-                               , Maybe (Entity StudyDegree)
-                               , Maybe (Entity StudyTerms)
                                , Maybe (Entity ExamRegistration)
                                , Bool
                                , [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
+                               , UserTableStudyFeatures
                                )
 
 queryExamRegistration :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity ExamRegistration)))
@@ -95,16 +90,7 @@ queryExamOccurrence :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity ExamOc
 queryExamOccurrence = to $(E.sqlLOJproj 4 3)
 
 queryCourseParticipant :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity CourseParticipant)))
-queryCourseParticipant = to $ $(E.sqlLOJproj 2 1) . $(E.sqlLOJproj 4 4)
+queryCourseParticipant = to $(E.sqlLOJproj 4 4)
-
-queryStudyFeatures :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity StudyFeatures)))
-queryStudyFeatures = to $ $(E.sqlIJproj 3 1) . $(E.sqlLOJproj 2 2) . $(E.sqlLOJproj 4 4)
-
-queryStudyDegree :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity StudyDegree)))
-queryStudyDegree = to $ $(E.sqlIJproj 3 2) . $(E.sqlLOJproj 2 2) . $(E.sqlLOJproj 4 4)
-
-queryStudyField :: Getter ExamUserTableExpr (E.SqlExpr (Maybe (Entity StudyTerms)))
-queryStudyField = to $ $(E.sqlIJproj 3 3) . $(E.sqlLOJproj 2 2) . $(E.sqlLOJproj 4 4)
 
 queryExamResult :: Getter ExamUserTableExpr (E.SqlExpr (Entity ExamResult))
 queryExamResult = to $ $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 4 1)
@@ -118,15 +104,6 @@ queryIsSynced authId = to $ Exam.resultIsSynced authId <$> view queryExamResult
 resultUser :: Lens' ExamUserTableData (Entity User)
 resultUser = _dbrOutput . _2
 
-resultStudyFeatures :: Traversal' ExamUserTableData (Entity StudyFeatures)
-resultStudyFeatures = _dbrOutput . _4 . _Just
-
-resultStudyDegree :: Traversal' ExamUserTableData (Entity StudyDegree)
-resultStudyDegree = _dbrOutput . _5 . _Just
-
-resultStudyField :: Traversal' ExamUserTableData (Entity StudyTerms)
-resultStudyField = _dbrOutput . _6 . _Just
-
 resultExamOccurrence :: Traversal' ExamUserTableData (Entity ExamOccurrence)
 resultExamOccurrence = _dbrOutput . _3 . _Just
 
@@ -134,19 +111,20 @@ resultExamResult :: Lens' ExamUserTableData (Entity ExamResult)
 resultExamResult = _dbrOutput . _1
 
 resultIsSynced :: Lens' ExamUserTableData Bool
-resultIsSynced = _dbrOutput . _8
+resultIsSynced = _dbrOutput . _5
 
 resultSynchronised :: Traversal' ExamUserTableData (UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)
-resultSynchronised = _dbrOutput . _9 . traverse
+resultSynchronised = _dbrOutput . _6 . traverse
+
+resultStudyFeatures :: Lens' ExamUserTableData UserTableStudyFeatures
+resultStudyFeatures = _dbrOutput . _7
 
 data ExamUserTableCsv = ExamUserTableCsv
   { csvEUserSurname         :: Text
   , csvEUserFirstName       :: Text
   , csvEUserName            :: Text
   , csvEUserMatriculation   :: Maybe Text
-  , csvEUserField           :: Maybe Text
+  , csvEUserStudyFeatures   :: UserTableStudyFeatures
-  , csvEUserDegree          :: Maybe Text
-  , csvEUserSemester        :: Maybe Int
   , csvEUserOccurrenceStart :: Maybe ZonedTime
   , csvEUserExamResult      :: ExamResultPassedGrade
   }
@@ -168,9 +146,7 @@ instance CsvColumnsExplained ExamUserTableCsv where
     , ('csvEUserFirstName           , MsgCsvColumnExamUserFirstName                 )
     , ('csvEUserName                , MsgCsvColumnExamUserName                      )
     , ('csvEUserMatriculation       , MsgCsvColumnExamUserMatriculation             )
-    , ('csvEUserField               , MsgCsvColumnExamUserField                     )
+    , ('csvEUserStudyFeatures       , MsgCsvColumnUserStudyFeatures                 )
-    , ('csvEUserDegree              , MsgCsvColumnExamUserDegree                    )
-    , ('csvEUserSemester            , MsgCsvColumnExamUserSemester                  )
     , ('csvEUserOccurrenceStart     , MsgCsvColumnExamOfficeExamUserOccurrenceStart )
     , ('csvEUserExamResult          , MsgCsvColumnExamUserResult                    )
     ]
@@ -198,6 +174,7 @@ postEGradesR tid ssh csh examn = do
   now <- liftIO getCurrentTime
   ((usersResult, examUsersTable), Entity eId _) <- runDB $ do
     exam@(Entity eid Exam{..}) <- fetchExam tid ssh csh examn
+    Course{..} <- getJust examCourse
 
     csvName <- getMessageRender <*> pure (MsgExamUserCsvName tid ssh csh examn)
     isLecturer <- hasReadAccessTo $ CExamR tid ssh csh examn EUsersR
@@ -249,16 +226,10 @@ postEGradesR tid ssh csh examn = do
             examRegistration <- view queryExamRegistration
             occurrence <- view queryExamOccurrence
             courseParticipant <- view queryCourseParticipant
-            studyFeatures <- view queryStudyFeatures
-            studyDegree <- view queryStudyDegree
-            studyField <- view queryStudyField
 
             isSynced <- view . queryIsSynced $ E.val uid
 
             lift $ do
-              E.on $ studyField E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
-              E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
-              E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField)
               E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
                E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
                E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
@@ -274,14 +245,15 @@ postEGradesR tid ssh csh examn = do
               unless isLecturer $
                 E.where_ $ Exam.examOfficeExamResultAuth (E.val uid) examResult
 
-            return (examResult, user, occurrence, studyFeatures, studyDegree, studyField, examRegistration, isSynced)
+            return (examResult, user, occurrence, examRegistration, isSynced)
           dbtRowKey = views queryExamResult (E.^. ExamResultId)
 
           dbtProj :: DBRow _ -> DB ExamUserTableData
           dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $
-            (,,,,,,,,)
+            (,,,,,,)
-              <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5 <*> view _6 <*> view _7 <*> view (_8 . _Value)
+              <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view (_5 . _Value)
               <*> getSynchronised
+              <*> (lift . courseUserStudyFeatures examCourse =<< view (_2 . _entityKey))
             where
               getSynchronised :: ReaderT _ DB [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
               getSynchronised = do
@@ -335,9 +307,7 @@ postEGradesR tid ssh csh examn = do
             , colSynced
             , imapColonnade participantAnchor . anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
             , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
-            , emptyOpticColonnade (resultStudyField . _entityVal) colStudyTerms
+            , colStudyFeatures resultStudyFeatures
-            , emptyOpticColonnade (resultStudyDegree . _entityVal) colStudyDegree
-            , emptyOpticColonnade (resultStudyFeatures . _entityVal . _studyFeaturesSemester) colStudyFeaturesSemester
             , Colonnade.singleton (fromSortable . Sortable (Just "occurrence-start") $ i18nCell MsgExamTime) $ \x -> cell . flip runReaderT x $ do
                 start <- preview $ resultExamOccurrence . _entityVal . _examOccurrenceStart <> like examStart . _Just
                 end <- preview $ resultExamOccurrence . _entityVal . _examOccurrenceEnd . _Just <> like examEnd . _Just
@@ -347,9 +317,6 @@ postEGradesR tid ssh csh examn = do
           dbtSorting = mconcat
             [ sortUserName' (queryUser . to ((,) <$> (E.^. UserDisplayName) <*> (E.^. UserSurname)))
             , sortUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
-            , sortStudyTerms queryStudyField
-            , sortStudyDegree queryStudyDegree
-            , sortStudyFeaturesSemester (queryStudyFeatures . to (E.?. StudyFeaturesSemester))
             , sortOccurrenceStart (queryExamOccurrence . to (E.maybe (E.val examStart) E.just . (E.?. ExamOccurrenceStart)))
             , maybeOpticSortColumn sortExamResult (queryExamResult . to (E.^. ExamResultResult))
             , singletonMap "is-synced" . SortColumn $ view (queryIsSynced $ E.val uid)
@@ -357,20 +324,30 @@ postEGradesR tid ssh csh examn = do
           dbtFilter = mconcat
             [ fltrUserName' (queryUser . to (E.^. UserDisplayName))
             , fltrUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
-            , fltrStudyTerms queryStudyField
-            , fltrStudyDegree queryStudyDegree
-            , fltrStudyFeaturesSemester (queryStudyFeatures . to (E.?. StudyFeaturesSemester))
             , fltrExamResultPoints (queryExamResult . to (E.^. ExamResultResult) . to E.just)
             , singletonMap "is-synced" . FilterColumn $ E.mkExactFilter (view . queryIsSynced $ E.val uid)
+            , fltrRelevantStudyFeaturesTerms (to $
+                \t -> ( E.val courseTerm
+                      , views queryUser (E.^. UserId) t
+                      ))
+            , fltrRelevantStudyFeaturesDegree (to $
+                \t -> ( E.val courseTerm
+                      , views queryUser (E.^. UserId) t
+                      ))
+            , fltrRelevantStudyFeaturesSemester (to $
+                \t -> ( E.val courseTerm
+                      , views queryUser (E.^. UserId) t
+                      ))
+
             ]
           dbtFilterUI = mconcat
             [ fltrUserNameUI'
             , fltrUserMatriculationUI
-            , fltrStudyTermsUI
-            , fltrStudyDegreeUI
-            , fltrStudyFeaturesSemesterUI
             , fltrExamResultPointsUI
             , \mPrev -> prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamUserSynchronised)
+            , fltrRelevantStudyFeaturesTermsUI
+            , fltrRelevantStudyFeaturesDegreeUI
+            , fltrRelevantStudyFeaturesSemesterUI
             ]
           dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
           dbtParams = DBParamsForm
@@ -405,9 +382,7 @@ postEGradesR tid ssh csh examn = do
                   (row ^. resultUser . _entityVal . _userFirstName)
                   (row ^. resultUser . _entityVal . _userDisplayName)
                   (row ^. resultUser . _entityVal . _userMatrikelnummer)
-                  (row ^? resultStudyField . _entityVal . to (\StudyTerms{..} -> fromMaybe (tshow studyTermsKey) $ studyTermsName <|> studyTermsShorthand))
+                  (row ^. resultStudyFeatures)
-                  (row ^? resultStudyDegree . _entityVal . to (\StudyDegree{..} -> fromMaybe (tshow studyDegreeKey) $ studyDegreeName <|> studyDegreeShorthand))
-                  (row ^? resultStudyFeatures . _entityVal . _studyFeaturesSemester)
                   (row ^? (resultExamOccurrence . _entityVal . _examOccurrenceStart <> like examStart . _Just) . to utcToZonedTime)
                   (row ^. resultExamResult . _entityVal . _examResultResult)
             , dbtCsvName = unpack csvName

src/Handler/Tutorial/Users.hs

@@ -41,17 +41,16 @@ postTUsersR tid ssh csh tutn = do
           , guardOn showSex colUserSex'
           , pure  colUserEmail
           , pure  colUserMatriclenr
-          , pure  colUserDegreeShort
+          , pure $ colStudyFeatures _userStudyFeatures
-          , pure  colUserField
-          , pure  colUserSemester
           ]
         psValidator = def
           & defaultSortingByName
-          & restrictSorting (\name _ -> none (== name) ["note", "registration", "tutorials"]) -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
+          & restrictSorting (\name _ -> none (== name) ["note", "registration", "tutorials", "exams", "submission-group", "state"]) -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
+          & restrictFilter (\name _ -> none (== name) ["tutorial", "exam", "submission-group", "active", "has-personalised-sheet-files"])
         isInTut q = E.exists . E.from $ \tutorialParticipant ->
           E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. queryUser q E.^. UserId
                E.&&. tutorialParticipant E.^. TutorialParticipantTutorial E.==. E.val tutid
-        csvColChoices = flip elem ["name", "matriculation", "email", "field", "degree", "semester", "study-features"]
+        csvColChoices = flip elem ["name", "matriculation", "email", "study-features"]
 
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
     table <- makeCourseUserTable cid (Map.fromList $ map (id &&& pure) universeF) isInTut colChoices psValidator (Just csvColChoices)

src/Handler/Utils/Allocation.hs

@@ -244,11 +244,9 @@ doAllocation :: AllocationId
              -> DB ()
 doAllocation allocId now regs =
   forM_ regs $ \(uid, cid) -> do
-    mField <- (courseApplicationField . entityVal <=< listToMaybe) <$> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Just allocId] []
     void $ upsert
-      (CourseParticipant cid uid now mField (Just allocId) CourseParticipantActive)
+      (CourseParticipant cid uid now (Just allocId) CourseParticipantActive)
       [ CourseParticipantRegistration =. now
-      , CourseParticipantField =. mField
       , CourseParticipantAllocated =. Just allocId
       , CourseParticipantState =. CourseParticipantActive
       ]

src/Handler/Utils/ExamOffice/Exam.hs

@@ -5,7 +5,10 @@ module Handler.Utils.ExamOffice.Exam
 
 import Import.NoFoundation
 
+import Handler.Utils.StudyFeatures
+
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 
 resultIsSynced :: E.SqlExpr (E.Value UserId) -- ^ office
                -> E.SqlExpr (Entity ExamResult)
@@ -33,8 +36,13 @@ examOfficeExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office
                          -> E.SqlExpr (E.Value Bool)
 examOfficeExamResultAuth authId examResult = authByUser E.||. authByField E.||. authBySchool
   where
+    cId = E.subSelectForeign examResult ExamResultExam (\exam -> E.subSelectForeign exam ExamCourse (E.^. CourseId))
+    
     authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do
       E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField
+      E.where_ . E.maybe E.false id . E.subSelectMaybe . E.from $ \course -> do
+        E.where_ $ course E.^. CourseId E.==. cId
+        return . E.just $ isCourseStudyFeature course studyFeatures
       E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. examResult E.^. ExamResultUser
            E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId
            E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField
@@ -42,12 +50,10 @@ examOfficeExamResultAuth authId examResult = authByUser E.||. authByField E.||.
            E.||. E.exists (E.from $ \userFunction ->
                              E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
                                   E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
-                                  E.&&. E.not_ (E.exists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` courseUserExamOfficeOptOut) -> do
+                                  E.&&. E.not_ (E.exists . E.from $ \courseUserExamOfficeOptOut -> do
-                                                  E.on $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutCourse E.==. course E.^. CourseId
+                                                  E.where_ $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutCourse E.==. cId
-                                                  E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
+                                                       E.&&. courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutUser E.==. examResult E.^. ExamResultUser
-                                                  E.where_ $ exam E.^. ExamId E.==. examResult E.^. ExamResultExam
+                                                       E.&&. courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutSchool E.==. userFunction E.^. UserFunctionSchool
-                                                  E.where_ $ courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutUser E.==. examResult E.^. ExamResultUser
-                                                    E.&&. courseUserExamOfficeOptOut E.^. CourseUserExamOfficeOptOutSchool E.==. userFunction E.^. UserFunctionSchool
                                                )
                           )
 

src/Handler/Utils/ExamOffice/ExternalExam.hs

@@ -4,8 +4,10 @@ module Handler.Utils.ExamOffice.ExternalExam
   ) where
 
 import Import.NoFoundation
+import Handler.Utils.StudyFeatures
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 
 
 resultIsSynced :: E.SqlExpr (E.Value UserId) -- ^ office
@@ -36,6 +38,9 @@ examOfficeExternalExamResultAuth authId eexamResult = authByUser E.||. authByFie
   where
     authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do
       E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField
+      E.where_ . E.maybe E.false id . E.subSelectMaybe . E.from $ \externalExam -> do
+        E.where_ $ externalExam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam
+        return . E.just $ isExternalExamStudyFeature externalExam studyFeatures
       E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. eexamResult E.^. ExternalExamResultUser
            E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId
            E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField

src/Handler/Utils/ExternalExam/Users.hs

@@ -29,6 +29,8 @@ import qualified Data.Conduit.List as C
 
 import Data.List (cycle)
 
+import Handler.Utils.StudyFeatures
+
 
 data ExternalExamUserMode = EEUMUsers | EEUMGrades
   deriving (Eq, Ord, Read, Show, Bounded, Enum, Generic, Typeable)
@@ -45,6 +47,7 @@ type ExternalExamUserTableData = DBRow ( Entity ExternalExamResult
                                        , Entity User
                                        , Bool
                                        , [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
+                                       , UserTableStudyFeatures
                                        )
 
 queryUser :: Getter ExternalExamUserTableExpr (E.SqlExpr (Entity User))
@@ -68,12 +71,16 @@ resultIsSynced = _dbrOutput . _3
 resultSynchronised :: Traversal' ExternalExamUserTableData (UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)
 resultSynchronised = _dbrOutput . _4 . traverse
 
+resultStudyFeatures :: Lens' ExternalExamUserTableData UserTableStudyFeatures
+resultStudyFeatures = _dbrOutput . _5
+
 
 data ExternalExamUserTableCsv = ExternalExamUserTableCsv
   { csvEUserSurname         :: Maybe Text
   , csvEUserFirstName       :: Maybe Text
   , csvEUserName            :: Maybe Text
   , csvEUserMatriculation   :: Maybe Text
+  , csvEUserStudyFeatures   :: UserTableStudyFeatures
   , csvEUserOccurrenceStart :: Maybe ZonedTime
   , csvEUserExamResult      :: ExamResultPassedGrade
   } deriving (Generic)
@@ -95,6 +102,7 @@ instance FromNamedRecord ExternalExamUserTableCsv where
       <*> csv .:?? "first-name"
       <*> csv .:?? "name"
       <*> csv .:?? "matriculation"
+      <*> pure mempty
       <*> csv .:?? "occurrence-start"
       <*> csv .:   "exam-result"
 
@@ -105,6 +113,7 @@ instance CsvColumnsExplained ExternalExamUserTableCsv where
     , ('csvEUserFirstName           , MsgCsvColumnExamUserFirstName                 )
     , ('csvEUserName                , MsgCsvColumnExamUserName                      )
     , ('csvEUserMatriculation       , MsgCsvColumnExamUserMatriculation             )
+    , ('csvEUserStudyFeatures       , MsgCsvColumnUserStudyFeatures                 )
     , ('csvEUserOccurrenceStart     , MsgCsvColumnExamOfficeExamUserOccurrenceStart )
     , ('csvEUserExamResult          , MsgCsvColumnExamUserResult                    )
     ]
@@ -209,9 +218,10 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
 
     dbtProj :: DBRow _ -> DB ExternalExamUserTableData
     dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $
-      (,,,)
+      (,,,,)
         <$> view _1 <*> view _2 <*> view (_3 . _Value)
         <*> getSynchronised
+        <*> (lift . externalExamUserStudyFeatures eeId =<< view (_2 . _entityKey))
       where
         getSynchronised :: ReaderT _ DB [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
         getSynchronised = do
@@ -265,6 +275,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
       , fromMaybe mempty . guardOn (is _EEUMGrades mode) $ colSynced
       , colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
       , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
+      , colStudyFeatures resultStudyFeatures
       , Colonnade.singleton (fromSortable . Sortable (Just "occurrence-start") $ i18nCell MsgExamTime) $ \x -> cell . flip runReaderT x $ do
           t <- view $ resultResult . _entityVal . _externalExamResultTime
           lift $ formatTimeW SelFormatDateTime t
@@ -282,6 +293,19 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
       , fltrUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
       , fltrExamResultPoints (queryResult . to (E.^. ExternalExamResultResult) . to E.just)
       , singletonMap "is-synced" . FilterColumn $ E.mkExactFilter (view . queryIsSynced $ E.val uid)
+      , fltrRelevantStudyFeaturesTerms (to $
+          \t -> ( E.val externalExamTerm
+                , views queryUser (E.^. UserId) t
+                ))
+      , fltrRelevantStudyFeaturesDegree (to $
+          \t -> ( E.val externalExamTerm
+                , views queryUser (E.^. UserId) t
+                ))
+      , fltrRelevantStudyFeaturesSemester (to $
+          \t -> ( E.val externalExamTerm
+                , views queryUser (E.^. UserId) t
+                ))
+
       ]
     dbtFilterUI = mconcat
       [ fltrUserNameUI'
@@ -291,6 +315,9 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
           EEUMGrades ->
             \mPrev -> prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamUserSynchronised)
           _other -> mempty
+      , fltrRelevantStudyFeaturesTermsUI
+      , fltrRelevantStudyFeaturesDegreeUI
+      , fltrRelevantStudyFeaturesSemesterUI
       ]
     dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
     dbtParams = DBParamsForm
@@ -345,6 +372,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
         }
       EEUMUsers ->
         let baseEncode = simpleCsvEncode csvName encodeCsv'
+            csvEUserStudyFeatures = mempty
          in baseEncode <&> \enc -> enc
             { dbtCsvExampleData = Just
                 [ ExternalExamUserTableCsv{..}
@@ -388,6 +416,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
           , csvEUserFirstName       = row ^? resultUser . _entityVal . _userFirstName
           , csvEUserName            = row ^? resultUser . _entityVal . _userDisplayName
           , csvEUserMatriculation   = row ^? resultUser . _entityVal . _userMatrikelnummer . _Just
+          , csvEUserStudyFeatures   = row ^. resultStudyFeatures
           , csvEUserOccurrenceStart = row ^? resultResult . _entityVal . _externalExamResultTime . to utcToZonedTime
           , csvEUserExamResult      = row ^. resultResult . _entityVal . _externalExamResultResult
           }

src/Handler/Utils/StudyFeatures.hs

@@ -1,68 +1,150 @@
 module Handler.Utils.StudyFeatures
-  ( parseStudyFeatures
+  ( module Handler.Utils.StudyFeatures.Parse
-  , parseSubTermsSemester
+  , UserTableStudyFeature(..)
+  , _userTableField, _userTableDegree, _userTableSemester, _userTableFieldType
+  , UserTableStudyFeatures(..)
+  , _UserTableStudyFeatures
+  , isRelevantStudyFeature
+  , isCourseStudyFeature, courseUserStudyFeatures
+  , isExternalExamStudyFeature, externalExamUserStudyFeatures
   ) where
 
-import Import.NoFoundation hiding (try, (<|>))
+import Import.NoFoundation
+import Foundation.Type
+import Foundation.I18n
 
-import Text.Parsec
+import Handler.Utils.StudyFeatures.Parse
-import Text.Parsec.Text
 
-import Auth.LDAP (ldapUserSubTermsSemester, ldapUserStudyFeatures)
+import qualified Data.Csv as Csv
-import qualified Ldap.Client as Ldap
+
+import qualified Data.ByteString as ByteString
+
+import qualified Data.Set as Set
+
+import Data.RFC5051 (compareUnicode)
+
+import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 
 
-parseStudyFeatures :: UserId -> UTCTime -> Text -> Either ParseError [StudyFeatures]
+data UserTableStudyFeature = UserTableStudyFeature
-parseStudyFeatures uId now = parse (pStudyFeatures uId now <* eof) (unpack key)
+  { userTableField
-  where
+  , userTableDegree    :: Text
-    Ldap.Attr key = ldapUserStudyFeatures
+  , userTableSemester  :: Int
+  , userTableFieldType :: StudyFieldType
+  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+makeLenses_ ''UserTableStudyFeature
 
-parseSubTermsSemester :: Text -> Either ParseError (StudyTermsId, Int)
+deriveJSON defaultOptions
-parseSubTermsSemester = parse (pLMUTermsSemester <* eof) (unpack key)
+  { fieldLabelModifier = camelToPathPiece' 2
-  where
+  } ''UserTableStudyFeature
-    Ldap.Attr key = ldapUserSubTermsSemester
+
+newtype UserTableStudyFeatures = UserTableStudyFeatures (Set UserTableStudyFeature)
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving newtype ( ToJSON, FromJSON
+                   , Semigroup, Monoid
+                   )
+makeWrapped ''UserTableStudyFeatures
+
+_UserTableStudyFeatures :: Iso' UserTableStudyFeatures [UserTableStudyFeature]
+_UserTableStudyFeatures = iso (sortBy userTableStudyFeatureSort . Set.toList . view _Wrapped) (UserTableStudyFeatures . Set.fromList)
+
+instance Csv.ToField UserTableStudyFeature where
+  toField UserTableStudyFeature{..} = encodeUtf8
+    [st|#{userTableField} #{userTableDegree} (#{userTableFieldType'} #{tshow userTableSemester})|]
+    where userTableFieldType' = renderMessage
+            (error "Foundation inspected during renderMessage" :: UniWorX)
+            [] $ ShortStudyFieldType userTableFieldType
+
+instance Csv.ToField UserTableStudyFeatures where
+  toField = ByteString.intercalate "; " . map Csv.toField . view _UserTableStudyFeatures
+
+userTableStudyFeatureSort :: UserTableStudyFeature
+                          -> UserTableStudyFeature
+                          -> Ordering
+userTableStudyFeatureSort = mconcat
+  [ compareUnicode `on` userTableDegree
+  , comparing userTableSemester
+  , comparing userTableFieldType
+  , compareUnicode `on` userTableField
+  ]
 
 
-pStudyFeatures :: UserId -> UTCTime -> Parser [StudyFeatures]
+isRelevantStudyFeature :: PersistEntity record
-pStudyFeatures studyFeaturesUser studyFeaturesUpdated = do
+                       => EntityField record TermId
-  studyFeaturesDegree <- StudyDegreeKey' <$> pKey
+                       -> E.SqlExpr (Entity record)
-  void $ string "$$"
+                       -> E.SqlExpr (Entity StudyFeatures)
+                       -> E.SqlExpr (E.Value Bool)
+isRelevantStudyFeature termField record studyFeatures
+      = (       (       overlap studyFeatures E.>. E.val 0
+                  E.||. (       E.just (studyFeatures E.^. StudyFeaturesLastObserved) E.==. studyFeatures E.^. StudyFeaturesFirstObserved
+                          E.&&. termStart E.<=. E.day (studyFeatures E.^. StudyFeaturesLastObserved)
+                          E.&&. E.day (studyFeatures E.^. StudyFeaturesLastObserved) E.<=. termEnd
+                        )
+                )
+          E.&&. E.not_ (E.exists betterOverlap)
+        )
+  E.||. ( E.subSelectForeign record termField (E.^. TermActive)
+          E.&&. E.not_ (E.exists anyOverlap)
+          E.&&. studyFeatures E.^. StudyFeaturesValid
+        )
+  where termEnd = E.subSelectForeign record termField (E.^. TermEnd)
+        termStart = E.subSelectForeign record termField (E.^. TermStart)
 
-  let
+        overlap :: E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Int)
-    pStudyFeature = do
+        overlap studyFeatures'
-      _ <- pKey -- "Fächergruppe"
+                     = E.min (E.day $ studyFeatures' E.^. StudyFeaturesLastObserved) termEnd
-      void $ char '!'
+          `E.diffDays` E.maybe termStart (E.max termStart . E.day) (studyFeatures' E.^. StudyFeaturesFirstObserved)
-      _ <- pKey -- "Studienbereich"
-      void $ char '!'
-      studyFeaturesField <- StudyTermsKey' <$> pKey
-      void $ char '!'
-      studyFeaturesType <- pType
-      void $ char '!'
-      studyFeaturesSemester <- decimal
-      let studyFeaturesValid = True
-          studyFeaturesSuperField = Nothing
-      return StudyFeatures{..}
 
-  pStudyFeature `sepBy1` char '#'
+        anyOverlap = E.from $ \studyFeatures' -> do
+          E.where_ $ studyFeatures' E.^. StudyFeaturesUser E.==. studyFeatures E.^. StudyFeaturesUser
+          E.where_ $ overlap studyFeatures' E.>. E.val 0
 
-pKey :: Parser Int
+        betterOverlap = E.from $ \studyFeatures' -> do  
-pKey = decimal
+          E.where_ $ studyFeatures' E.^. StudyFeaturesUser E.==. studyFeatures E.^. StudyFeaturesUser
+               E.&&. studyFeatures' E.^. StudyFeaturesDegree E.==. studyFeatures E.^. StudyFeaturesDegree
+               E.&&. studyFeatures' E.^. StudyFeaturesField E.==. studyFeatures E.^. StudyFeaturesField
+               E.&&. studyFeatures' E.^. StudyFeaturesSuperField `E.maybeEq` studyFeatures E.^. StudyFeaturesSuperField
+               E.&&. studyFeatures' E.^. StudyFeaturesType E.==. studyFeatures E.^. StudyFeaturesType
+          E.where_ $ E.abs (studyFeatures' E.^. StudyFeaturesSemester E.-. studyFeatures E.^. StudyFeaturesSemester) E.==. E.val 1
+               E.&&. overlap studyFeatures' E.>. overlap studyFeatures
 
-pType :: Parser StudyFieldType
+isCourseStudyFeature :: E.SqlExpr (Entity Course) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
-pType = FieldPrimary   <$ try (string "HF")
+isCourseStudyFeature = isRelevantStudyFeature CourseTerm
-    <|> FieldSecondary <$ try (string "NF")
 
-decimal :: Parser Int
+courseUserStudyFeatures :: MonadIO m => CourseId -> UserId -> SqlPersistT m UserTableStudyFeatures
-decimal = foldl' (\now next -> now * 10 + next) 0 <$> many1 digit'
+courseUserStudyFeatures cId uid = do
-  where
+  feats <- E.select . E.from $ \(course `E.InnerJoin` studyFeatures `E.InnerJoin` terms `E.InnerJoin` degree) -> do
-    digit' = dVal <$> digit
+    E.on $ degree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
-    dVal c = fromEnum c - fromEnum '0'
+    E.on $ terms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
+    E.on $ isCourseStudyFeature course studyFeatures
+    E.where_ $ course E.^. CourseId E.==. E.val cId
+    E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
+    return (terms, degree, studyFeatures)
+  return . UserTableStudyFeatures . Set.fromList . flip map feats $
+    \(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) -> UserTableStudyFeature
+      { userTableField = fromMaybe (tshow studyTermsKey) studyTermsName
+      , userTableDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName
+      , userTableSemester = studyFeaturesSemester
+      , userTableFieldType = studyFeaturesType
+      }
 
+isExternalExamStudyFeature :: E.SqlExpr (Entity ExternalExam) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
+isExternalExamStudyFeature = isRelevantStudyFeature ExternalExamTerm
 
-pLMUTermsSemester :: Parser (StudyTermsId, Int)
+externalExamUserStudyFeatures :: MonadIO m => ExternalExamId -> UserId -> SqlPersistT m UserTableStudyFeatures
-pLMUTermsSemester = do
+externalExamUserStudyFeatures eeId uid = do
-  subTermsKey <- StudyTermsKey' <$> pKey
+  feats <- E.select . E.from $ \(externalExam `E.InnerJoin` studyFeatures `E.InnerJoin` terms `E.InnerJoin` degree) -> do
-  void $ char '$'
+    E.on $ degree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
-  semester <- decimal
+    E.on $ terms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
-
+    E.on $ isExternalExamStudyFeature externalExam studyFeatures
-  return (subTermsKey, semester)
+    E.where_ $ externalExam E.^. ExternalExamId E.==. E.val eeId
+    E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
+    return (terms, degree, studyFeatures)
+  return . UserTableStudyFeatures . Set.fromList . flip map feats $
+    \(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) -> UserTableStudyFeature
+      { userTableField = fromMaybe (tshow studyTermsKey) studyTermsName
+      , userTableDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName
+      , userTableSemester = studyFeaturesSemester
+      , userTableFieldType = studyFeaturesType
+      }

src/Handler/Utils/StudyFeatures/Parse.hs

@@ -0,0 +1,70 @@
+module Handler.Utils.StudyFeatures.Parse
+  ( parseStudyFeatures
+  , parseSubTermsSemester
+  ) where
+
+import Import.NoFoundation hiding (try, (<|>))
+
+import Text.Parsec
+import Text.Parsec.Text
+
+import Auth.LDAP (ldapUserSubTermsSemester, ldapUserStudyFeatures)
+import qualified Ldap.Client as Ldap
+
+
+parseStudyFeatures :: UserId -> UTCTime -> Text -> Either ParseError [StudyFeatures]
+parseStudyFeatures uId now = parse (pStudyFeatures uId now <* eof) (unpack key)
+  where
+    Ldap.Attr key = ldapUserStudyFeatures
+
+parseSubTermsSemester :: Text -> Either ParseError (StudyTermsId, Int)
+parseSubTermsSemester = parse (pLMUTermsSemester <* eof) (unpack key)
+  where
+    Ldap.Attr key = ldapUserSubTermsSemester
+
+
+pStudyFeatures :: UserId -> UTCTime -> Parser [StudyFeatures]
+pStudyFeatures studyFeaturesUser now = do
+  studyFeaturesDegree <- StudyDegreeKey' <$> pKey
+  void $ string "$$"
+
+  let
+    pStudyFeature = do
+      _ <- pKey -- "Fächergruppe"
+      void $ char '!'
+      _ <- pKey -- "Studienbereich"
+      void $ char '!'
+      studyFeaturesField <- StudyTermsKey' <$> pKey
+      void $ char '!'
+      studyFeaturesType <- pType
+      void $ char '!'
+      studyFeaturesSemester <- decimal
+      let studyFeaturesValid = True
+          studyFeaturesSuperField = Nothing
+          studyFeaturesFirstObserved = Just now
+          studyFeaturesLastObserved = now
+      return StudyFeatures{..}
+
+  pStudyFeature `sepBy1` char '#'
+
+pKey :: Parser Int
+pKey = decimal
+
+pType :: Parser StudyFieldType
+pType = FieldPrimary   <$ try (string "HF")
+    <|> FieldSecondary <$ try (string "NF")
+
+decimal :: Parser Int
+decimal = foldl' (\now next -> now * 10 + next) 0 <$> many1 digit'
+  where
+    digit' = dVal <$> digit
+    dVal c = fromEnum c - fromEnum '0'
+
+
+pLMUTermsSemester :: Parser (StudyTermsId, Int)
+pLMUTermsSemester = do
+  subTermsKey <- StudyTermsKey' <$> pKey
+  void $ char '$'
+  semester <- decimal
+
+  return (subTermsKey, semester)

src/Handler/Utils/Table/Columns.hs

@@ -24,6 +24,7 @@ import Handler.Utils.Table.Pagination
 import Handler.Utils.Form
 import Handler.Utils.Widgets
 import Handler.Utils.DateTime
+import Handler.Utils.StudyFeatures
 
 import qualified Data.CaseInsensitive as CI
 
@@ -778,6 +779,64 @@ fltrDegreeUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map Fil
 fltrDegreeUI mPrev =
   prismAForm (singletonFilter "degree") mPrev $ aopt textField (fslI MsgDegreeName)
 
+
+colStudyFeatures :: OpticColonnade UserTableStudyFeatures
+colStudyFeatures resultFeatures = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable Nothing (i18nCell MsgColumnStudyFeatures)
+    body = views (resultFeatures . _UserTableStudyFeatures) . flip listCell $ \UserTableStudyFeature{..} -> cell $(widgetFile "table/cell/user-study-feature")
+
+fltrRelevantStudyFeaturesTerms :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId))
+fltrRelevantStudyFeaturesTerms queryTermUser = singletonMap "features-terms" . FilterColumn $ \t criterias ->
+  E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do
+    E.on $ isRelevantStudyFeature TermId term studyFeatures
+
+    let (tid, uid) = t ^. queryTermUser
+    E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. uid
+         E.&&. term E.^. TermId E.==. tid
+
+    return $ anyFilter
+      [ mkContainsFilterWith Just $ \t' -> E.subSelectForeign t' StudyFeaturesField (E.^. StudyTermsName)
+      , mkContainsFilterWith Just $ \t' -> E.subSelectForeign t' StudyFeaturesField (E.^. StudyTermsShorthand)
+      , mkExactFilterWith readMay $ \t' -> E.subSelectForeign t' StudyFeaturesField $ E.just . (E.^. StudyTermsKey)
+      ] studyFeatures criterias
+
+fltrRelevantStudyFeaturesTermsUI :: DBFilterUI
+fltrRelevantStudyFeaturesTermsUI = fltrStudyTermsUI
+  
+fltrRelevantStudyFeaturesDegree :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId))
+fltrRelevantStudyFeaturesDegree queryTermUser = singletonMap "features-degree" . FilterColumn $ \t criterias ->
+  E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do
+    E.on $ isRelevantStudyFeature TermId term studyFeatures
+
+    let (tid, uid) = t ^. queryTermUser
+    E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. uid
+         E.&&. term E.^. TermId E.==. tid
+
+    return $ anyFilter
+      [ mkContainsFilterWith Just $ \t' -> E.subSelectForeign t' StudyFeaturesDegree (E.^. StudyDegreeName)
+      , mkContainsFilterWith Just $ \t' -> E.subSelectForeign t' StudyFeaturesDegree (E.^. StudyDegreeShorthand)
+      , mkExactFilterWith readMay $ \t' -> E.subSelectForeign t' StudyFeaturesDegree $ E.just . (E.^. StudyDegreeKey)
+      ] studyFeatures criterias
+
+fltrRelevantStudyFeaturesDegreeUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrRelevantStudyFeaturesDegreeUI mPrev =
+  prismAForm (singletonFilter "features-degree") mPrev $ aopt textField (fslI MsgDegreeName)
+  
+fltrRelevantStudyFeaturesSemester :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value TermId), E.SqlExpr (E.Value UserId))
+fltrRelevantStudyFeaturesSemester queryTermUser = singletonMap "features-semester" . FilterColumn $ \t criterias ->
+  E.subSelectOr . E.from $ \(term `E.InnerJoin` studyFeatures) -> do
+    E.on $ isRelevantStudyFeature TermId term studyFeatures
+
+    let (tid, uid) = t ^. queryTermUser
+    E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. uid
+         E.&&. term E.^. TermId E.==. tid
+
+    return $ mkExactFilterWith (readMay :: Text -> Maybe Int) (E.just . (E.^. StudyFeaturesSemester)) studyFeatures criterias
+
+fltrRelevantStudyFeaturesSemesterUI :: DBFilterUI
+fltrRelevantStudyFeaturesSemesterUI = fltrFeaturesSemesterUI
+
 -----------------
 -- Allocations --
 -----------------

src/Model/Migration.hs

@@ -913,6 +913,14 @@ customMigrations = Map.fromListWith (>>)
           insert_ CronLastExec{ cronLastExecJob = toJSON $ JobQueueNotification NotificationAllocationUnratedApplications{..}, .. }
 
     )
+  , ( AppliedMigrationKey [migrationVersion|39.0.0|] [version|40.0.0|]
+    , whenM (tableExists "study_features") $ do
+        [executeQQ|
+          ALTER TABLE study_features RENAME updated TO last_observed;
+          ALTER TABLE study_features ADD COLUMN first_observed timestamp with time zone;
+          UPDATE study_features SET first_observed = (SELECT MAX(last_observed) FROM study_features as other WHERE other."user" = study_features."user" AND other.degree = study_features.degree AND other.field = study_features.field AND other.type = study_features.type AND other.semester = study_features.semester - 1);
+        |]
+    )
   ]
 
 

src/Model/Types/Misc.hs

@@ -34,10 +34,13 @@ import Web.HttpApiData
 
 data StudyFieldType = FieldPrimary | FieldSecondary
   deriving (Eq, Ord, Enum, Show, Read, Bounded, Generic)
+  deriving anyclass (Universe, Finite)
+
 derivePersistField "StudyFieldType"
-instance Universe StudyFieldType
-instance Finite   StudyFieldType
 nullaryPathPiece ''StudyFieldType $ camelToPathPiece' 1
+pathPieceJSON ''StudyFieldType
+pathPieceJSONKey ''StudyFieldType
+
 
 
 data Theme

templates/course/user/profile.hamlet

@@ -44,14 +44,15 @@ $newline never
                 <th .table__th>_{MsgStudyFeatureAge}
                 <th .table__th>_{MsgStudyFeatureValid}
                 <th .table__th>_{MsgStudyFeatureUpdate}
-              $forall ((Entity _ StudyFeatures{studyFeaturesType, studyFeaturesSemester, studyFeaturesValid, studyFeaturesUpdated}), (Entity _ degree), (Entity _ field)) <- studies
+              $forall ((Entity _ StudyFeatures{studyFeaturesType, studyFeaturesSemester, studyFeaturesValid, studyFeaturesFirstObserved, studyFeaturesLastObserved}), (Entity _ degree), (Entity _ field)) <- studies
                 <tr .table__row>
                   <td .table__td>_{field}
                   <td .table__td>_{degree}
                   <td .table__td>_{studyFeaturesType}
                   <td .table__td>#{studyFeaturesSemester}
                   <td .table__td>#{hasTickmark studyFeaturesValid}
-                  <td .table__td>^{formatTimeW SelFormatDate studyFeaturesUpdated}
+                  <td .table__td>
-      $maybe _ <- mRegistration
+                    $maybe fObs <- studyFeaturesFirstObserved
-        <dt .deflist__dt>_{MsgCourseStudyFeature}
+                      ^{formatTimeRangeW SelFormatDate fObs $ Just studyFeaturesLastObserved}
-        <dd .deflist__dd>^{regFieldWidget}
+                    $nothing
+                      ^{formatTimeW SelFormatDate studyFeaturesLastObserved}

templates/profileData.hamlet

@@ -43,14 +43,18 @@ $newline never
               <th .table__th>_{MsgStudyFeatureValid}
               <th .table__th>_{MsgStudyFeatureUpdate}
 
-            $forall ((Entity _ StudyFeatures{studyFeaturesType, studyFeaturesSemester, studyFeaturesValid, studyFeaturesUpdated}), (Entity _ degree), (Entity _ field)) <- studies
+            $forall ((Entity _ StudyFeatures{studyFeaturesType, studyFeaturesSemester, studyFeaturesValid, studyFeaturesFirstObserved, studyFeaturesLastObserved}), (Entity _ degree), (Entity _ field)) <- studies
               <tr.table__row>
                 <td .table__td>_{field}
                 <td .table__td>_{degree}
                 <td .table__td>_{studyFeaturesType}
                 <td .table__td>#{studyFeaturesSemester}
                 <td .table__td>#{hasTickmark studyFeaturesValid}
-                <td .table__td>^{formatTimeW SelFormatDateTime studyFeaturesUpdated}
+                <td .table__td>
+                  $maybe fObs <- studyFeaturesFirstObserved
+                    ^{formatTimeRangeW SelFormatDateTime fObs $ Just studyFeaturesLastObserved}
+                  $nothing
+                    ^{formatTimeW SelFormatDateTime studyFeaturesLastObserved}
 <section>
   <div .container>
     $if hasRows

templates/table/cell/user-study-feature.hamlet

@@ -0,0 +1,2 @@
+$newline never
+#{userTableField} #{userTableDegree} (_{userTableFieldType} #{userTableSemester})

test/Database/Fill.hs

@@ -473,58 +473,64 @@ fillDb = do
   void . insert $ StudyTermNameCandidate incidence12 21   "Deutsch"
   void . insert $ StudyTermNameCandidate incidence12 21   "Betriebswirtschaftslehre"
 
-  sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here
+  insert_ $ StudyFeatures -- keyword type prevents record syntax here
     maxMuster
     sdBsc
     sdInf
     Nothing
     FieldPrimary
     2
+    (Just now)
     now
     True
-  sfMMs <- insert $ StudyFeatures
+  insert_ $ StudyFeatures
     maxMuster
     sdBsc
     sdMath
     Nothing
     FieldSecondary
     2
+    (Just now)
     now
     True
-  _sfTTa <- insert $ StudyFeatures
+  insert_ $ StudyFeatures
     tinaTester
     sdBsc
     sdInf
     Nothing
     FieldPrimary
     4
+    (Just now)
     now
     False
-  sfTTb <- insert $ StudyFeatures
+  insert_ $ StudyFeatures
     tinaTester
     sdLAG
     sdPhys
     Nothing
     FieldPrimary
     1
+    (Just now)
     now
     True
-  sfTTc <- insert $ StudyFeatures
+  insert_ $ StudyFeatures
     tinaTester
     sdLAR
     sdMedi
     Nothing
     FieldPrimary
     7
+    (Just now)
     now
     True
-  _sfTTd <- insert $ StudyFeatures
+  insert_ $ StudyFeatures
     tinaTester
     sdMst
     sdMath
     Nothing
     FieldPrimary
     3
+    (Just now)
     now
     True
 
@@ -626,10 +632,10 @@ fillDb = do
     , sheetAllowNonPersonalisedSubmission = True
     }
   insert_ $ SheetEdit gkleen now keine
-  void . insertMany $ map (\(u,sf) -> CourseParticipant ffp u now sf Nothing CourseParticipantActive)
+  void . insertMany $ map (\u -> CourseParticipant ffp u now Nothing CourseParticipantActive)
-    [(fhamann   , Nothing)
+    [ fhamann
-    ,(maxMuster , Just sfMMs)
+    , maxMuster
-    ,(tinaTester, Just sfTTc)
+    , tinaTester
     ]
 
   examFFP <- insert' $ Exam
@@ -762,10 +768,10 @@ fillDb = do
   insert_ $ CourseEdit jost now pmo
   void . insert $ DegreeCourse pmo sdBsc sdInf
   void . insert $ Lecturer jost pmo CourseAssistant
-  void . insertMany $ map (\(u,sf) -> CourseParticipant pmo u now sf Nothing CourseParticipantActive)
+  void . insertMany $ map (\u -> CourseParticipant pmo u now Nothing CourseParticipantActive)
-    [(fhamann   , Nothing)
+    [ fhamann
-    ,(maxMuster , Just sfMMp)
+    , maxMuster
-    ,(tinaTester, Just sfTTb)
+    , tinaTester
     ]
 
   let shTypes = NotGraded : [ shType g | g <- shGradings, shType <- [ Normal, Bonus, Informational ] ]
@@ -1032,7 +1038,7 @@ fillDb = do
   insert_ $ AllocationCourse funAlloc pmo 100
   insert_ $ AllocationCourse funAlloc ffp 2
 
-  void . insertMany $ map (\(u, pState) -> CourseParticipant ffp u now Nothing (Just funAlloc) pState)
+  void . insertMany $ map (\(u, pState) -> CourseParticipant ffp u now (Just funAlloc) pState)
     [ (svaupel, CourseParticipantInactive False)
     , (jost, CourseParticipantActive)
     ]
@@ -1066,7 +1072,7 @@ fillDb = do
   void . insert' $ Lecturer gkleen bs CourseLecturer
   void . insertMany $ do
     uid <- take 1024 manyUsers
-    return $ CourseParticipant bs uid now Nothing Nothing CourseParticipantActive
+    return $ CourseParticipant bs uid now Nothing CourseParticipantActive
   forM_ [1..14] $ \shNr -> do
     shId <- insert Sheet
       { sheetCourse = bs
@@ -1141,7 +1147,7 @@ fillDb = do
     participants <- getRandomR (0, 50)
     manyUsers' <- shuffleM $ take 1024 manyUsers
     forM_ (take participants manyUsers') $ \uid ->
-      void . insertUnique $ CourseParticipant cid uid now Nothing Nothing CourseParticipantActive
+      void . insertUnique $ CourseParticipant cid uid now Nothing CourseParticipantActive
   
   aSeedBig <- liftIO $ getRandomBytes 40
   bigAlloc <- insert' Allocation
@@ -1223,7 +1229,6 @@ fillDb = do
       void $ insert CourseApplication
         { courseApplicationCourse = cid
         , courseApplicationUser = uid
-        , courseApplicationField = Nothing
         , courseApplicationText = Nothing
         , courseApplicationRatingVeto = maybe False (view _1) rating
         , courseApplicationRatingPoints = view _2 <$> rating

test/Handler/Sheet/PersonalisedFilesSpec.hs

@@ -61,7 +61,7 @@ spec = withApp . describe "Personalised sheet file zip encoding" $ do
       let res = res' { personalisedSheetFileResidualSheet = shid, personalisedSheetFileResidualUser = uid }
       fRef <- lift (sinkFile f :: DB FileReference)
       now <- liftIO getCurrentTime
-      void . lift . insert $ CourseParticipant cid (personalisedSheetFileResidualUser res) now Nothing Nothing CourseParticipantActive
+      void . lift . insert $ CourseParticipant cid (personalisedSheetFileResidualUser res) now Nothing CourseParticipantActive
       void . lift . insert $ _FileReference # (fRef, res)
       return (f, res)