refactor: remove course-participant-field, course-application-field

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

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

@@ -33,18 +33,11 @@ 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
                                          )
 
@@ -52,34 +45,25 @@ 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 +77,8 @@ 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
 
 
 newtype CourseApplicationsTableVeto = CourseApplicationsTableVeto Bool
@@ -127,9 +102,6 @@ data CourseApplicationsTableCsv = CourseApplicationsTableCsv
   , csvCAName :: Maybe Text
   , csvCAEmail :: Maybe UserEmail
   , csvCAMatriculation :: Maybe Text
-  , csvCAField :: Maybe Text
-  , csvCADegree :: Maybe Text
-  , csvCASemester :: Maybe Int
   , csvCAText :: Maybe Text
   , csvCAHasFiles :: Maybe Bool
   , csvCAVeto :: Maybe CourseApplicationsTableVeto
@@ -152,9 +124,6 @@ instance Csv.FromNamedRecord CourseApplicationsTableCsv where
       <*> csv .:?? "name"
       <*> csv .:?? "email"
       <*> csv .:?? "matriculation"
-      <*> csv .:?? "field"
-      <*> csv .:?? "degree"
-      <*> csv .:?? "semester"
       <*> csv .:?? "text"
       <*> csv .:?? "has-files"
       <*> csv .:?? "veto"
@@ -171,9 +140,6 @@ instance CsvColumnsExplained CourseApplicationsTableCsv where
     , ('csvCAName         , MsgCsvColumnApplicationsName         )
     , ('csvCAEmail        , MsgCsvColumnApplicationsEmail        )
     , ('csvCAMatriculation, MsgCsvColumnApplicationsMatriculation)
-    , ('csvCAField        , MsgCsvColumnApplicationsField        )
-    , ('csvCADegree       , MsgCsvColumnApplicationsDegree       )
-    , ('csvCASemester     , MsgCsvColumnApplicationsSemester     )
     , ('csvCAText         , MsgCsvColumnApplicationsText         )
     , ('csvCAHasFiles     , MsgCsvColumnApplicationsHasFiles     )
     , ('csvCAVeto         , MsgCsvColumnApplicationsVeto         )
@@ -182,19 +148,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 +245,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,14 +261,11 @@ 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 $ return . over _3 E.unValue . over _5 E.unValue
 
       dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId)
 
@@ -325,9 +277,6 @@ postCApplicationsR tid ssh csh = do
         , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
         , lmap (view $ resultUser . _entityVal) colUserEmail
         , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
-        , emptyOpticColonnade (resultStudyTerms . _entityVal) colStudyTerms
-        , emptyOpticColonnade (resultStudyDegree . _entityVal) colStudyDegree
-        , emptyOpticColonnade (resultStudyFeatures . _entityVal . _studyFeaturesSemester) colStudyFeaturesSemester
         , colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText)
         , lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusG 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles))
         , colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto)
@@ -341,9 +290,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,9 +302,6 @@ 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)
@@ -370,9 +313,6 @@ postCApplicationsR tid ssh csh = do
         , fltrUserNameUI'
         , fltrUserMatriculationUI
         , fltrUserEmailUI
-        , fltrStudyTermsUI
-        , fltrStudyDegreeUI
-        , fltrStudyFeaturesSemesterUI
         , fltrApplicationTextUI
         , fltrApplicationFilesUI
         , fltrApplicationVetoUI
@@ -391,9 +331,6 @@ 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)))
-        <*> 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 +353,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 +364,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 +387,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 +456,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 . fmap (, ()) $ JunctionParticipant now <$> pure Nothing <*> pure 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

@@ -41,8 +41,7 @@ instance Button UniWorX ButtonCourseRegister where
 
 
 data CourseRegisterForm = CourseRegisterForm
-  { crfStudyFeatures    :: Maybe StudyFeaturesId
+  { crfApplicationText  :: Maybe Text
-  , crfApplicationText  :: Maybe Text
   , crfApplicationFiles :: Maybe FileUploads
   }
 
@@ -82,17 +81,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
@@ -167,7 +155,6 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
 
     return $ CourseRegisterForm
       <$  secretRes
-      <*> fieldRes
       <*> appTextRes
       <*> appFilesRes
 
@@ -200,7 +187,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
@@ -208,7 +195,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
 
@@ -222,9 +209,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

@@ -100,29 +100,6 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex =
       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 +156,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'
   ) where
 
 import Import
@@ -39,10 +39,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,50 +49,38 @@ 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)
@@ -118,23 +102,17 @@ _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
 
 
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
@@ -161,26 +139,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
 
@@ -216,7 +174,7 @@ data UserTableCsv = UserTableCsv
   , csvUserSex :: Maybe Sex
   , csvUserMatriculation :: Maybe Text
   , csvUserEmail :: CI Email
-  , csvUserStudyFeatures :: Either (Maybe UserTableCsvStudyFeature) (Set UserTableCsvStudyFeature)
+  , csvUserStudyFeatures :: Set UserTableCsvStudyFeature
   , csvUserSubmissionGroup :: Maybe SubmissionGroupName
   , csvUserRegistration :: UTCTime
   , csvUserNote :: Maybe Html
@@ -232,18 +190,11 @@ instance Csv.ToNamedRecord UserTableCsv where
     , "sex" Csv..= csvUserSex
     , "matriculation" Csv..= csvUserMatriculation
     , "email" Csv..= csvUserEmail
-    ] ++ case csvUserStudyFeatures of
+    ] ++ let featsStr = Text.intercalate "; " . flip map (Set.toList csvUserStudyFeatures) $ \UserTableCsvStudyFeature{..}
-           Left feats
+               -> let csvUserType' = renderMessage (error "no foundation needed" :: UniWorX) [] $ ShortStudyFieldType csvUserType
-             -> [ "field"    Csv..= (csvUserField    <$> feats)
+                   in [st|#{csvUserField} #{csvUserDegree} (#{csvUserType'} #{tshow csvUserSemester})|]
-                , "degree"   Csv..= (csvUserDegree   <$> feats)
+          in [ "study-features" Csv..= featsStr
-                , "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
     ] ++
@@ -270,9 +221,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
@@ -284,18 +232,18 @@ instance CsvColumnsExplained UserTableCsv where
       single k v = singletonMap k [whamlet|_{v}|]
 
 data 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"
-  ] ++ bool (pure "study-features") ["field", "degree", "semester"] csvUserSimplifiedFeaturesOfStudy ++
+  ] ++
+  ["study-features"] ++
   [ "tutorial" | hasEmptyRegGroup ] ++
   map (encodeUtf8 . CI.foldedCase) regGroups ++
   [ "exams", "registration" ] ++
@@ -376,7 +324,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
@@ -395,7 +343,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
             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)
         dbtColonnade = colChoices
         dbtSorting   = mconcat
           [ single $ sortUserNameLink    queryUser -- slower sorting through clicking name column header
@@ -404,11 +352,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 +393,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
@@ -497,9 +426,7 @@ 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)
           ] ++
@@ -523,44 +450,28 @@ 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 $ \(E.Value uid, 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
+                  <*> (do
-                        | csvUserSimplifiedFeaturesOfStudy -> fmap Left . runMaybeT $
+                          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
+                            E.where_ $ 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
-                              <$> MaybeT (preview $   _userTableFeatures . _3 . _Just . _studyTermsName . _Just
+                              { csvUserField = fromMaybe (tshow studyTermsKey) studyTermsName
-                                                   <> _userTableFeatures . _3 . _Just . _studyTermsKey . to tshow
+                              , csvUserDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName
-                                         )
+                              , csvUserSemester = studyFeaturesSemester
-                              <*> MaybeT (preview $   _userTableFeatures . _2 . _Just . _studyDegreeName . _Just
+                              , csvUserType = studyFeaturesType
-                                                   <> _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 +547,6 @@ postCUsersR tid ssh csh = do
           , guardOn showSex . cap' $ colUserSex'
           , pure . cap' $ colUserEmail
           , pure . cap' $ colUserMatriclenr
-          , pure . cap' $ colUserDegreeShort
-          , 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

@@ -154,7 +154,6 @@ postEAddUserR tid ssh csh examn = do
           }
         [ CourseParticipantRegistration =. now
         , CourseParticipantAllocated =. Nothing
-        , CourseParticipantField =. courseParticipantField
         , CourseParticipantState =. CourseParticipantActive
         ]
       lift . lift . audit $ TransactionCourseParticipantEdit cid uid

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

@@ -47,21 +47,13 @@ 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))
@@ -87,16 +79,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 +113,29 @@ 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
 
 
 resultAutomaticExamBonus :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData Points
@@ -191,9 +165,6 @@ data ExamUserTableCsv = ExamUserTableCsv
   , csvEUserFirstName :: Maybe Text
   , csvEUserName :: Maybe Text
   , csvEUserMatriculation :: Maybe Text
-  , csvEUserField :: Maybe Text
-  , csvEUserDegree :: Maybe Text
-  , csvEUserSemester :: Maybe Int
   , csvEUserOccurrence :: Maybe (CI Text)
   , csvEUserExercisePoints :: Maybe (Maybe Points)
   , csvEUserExerciseNumPasses :: Maybe (Maybe Int)
@@ -213,9 +184,6 @@ instance ToNamedRecord ExamUserTableCsv where
     , "first-name" Csv..= csvEUserFirstName
     , "name" Csv..= csvEUserName
     , "matriculation" Csv..= csvEUserMatriculation
-    , "field" Csv..= csvEUserField
-    , "degree" Csv..= csvEUserDegree
-    , "semester" Csv..= csvEUserSemester
     , "occurrence" Csv..= csvEUserOccurrence
     ] ++ catMaybes
            [ fmap ("exercise-points" Csv..=) csvEUserExercisePoints
@@ -240,9 +208,6 @@ instance FromNamedRecord ExamUserTableCsv where
       <*> csv .:?? "first-name"
       <*> csv .:?? "name"
       <*> csv .:?? "matriculation"
-      <*> csv .:?? "field"
-      <*> csv .:?? "degree"
-      <*> csv .:?? "semester"
       <*> csv .:?? "occurrence"
       <*> fmap Just (csv .:?? "exercise-points")
       <*> fmap Just (csv .:?? "exercise-num-passes")
@@ -263,9 +228,6 @@ instance CsvColumnsExplained ExamUserTableCsv where
     , single "first-name"              MsgCsvColumnExamUserFirstName
     , single "name"                    MsgCsvColumnExamUserName
     , single "matriculation"           MsgCsvColumnExamUserMatriculation
-    , single "field"                   MsgCsvColumnExamUserField
-    , single "degree"                  MsgCsvColumnExamUserDegree
-    , single "semester"                MsgCsvColumnExamUserSemester
     , single "occurrence"              MsgCsvColumnExamUserOccurrence
     , single "exercise-points"         MsgCsvColumnExamUserExercisePoints
     , single "exercise-num-passes"     MsgCsvColumnExamUserExercisePasses
@@ -287,7 +249,6 @@ examUserTableCsvHeader :: ( MonoFoldable mono
 examUserTableCsvHeader allBoni doBonus pNames = Csv.header $
   [ "surname", "first-name", "name"
   , "matriculation"
-  , "field", "degree", "semester"
   , "course-note"
   , "occurrence"
   ] ++ bool mempty ["exercise-points", "exercise-points-max"] (doBonus && showPoints)
@@ -329,7 +290,6 @@ data ExamUserCsvActionClass
   = ExamUserCsvCourseRegister
   | ExamUserCsvRegister
   | ExamUserCsvAssignOccurrence
-  | ExamUserCsvSetCourseField
   | ExamUserCsvSetPartResult
   | ExamUserCsvSetBonus
   | ExamUserCsvOverrideBonus
@@ -343,7 +303,6 @@ embedRenderMessage ''UniWorX ''ExamUserCsvActionClass id
 data ExamUserCsvAction
   = ExamUserCsvCourseRegisterData
     { examUserCsvActUser :: UserId
-    , examUserCsvActCourseField :: Maybe StudyFeaturesId
     , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
     }
   | ExamUserCsvRegisterData
@@ -354,10 +313,6 @@ data ExamUserCsvAction
     { examUserCsvActRegistration :: ExamRegistrationId
     , examUserCsvActOccurrence :: Maybe ExamOccurrenceId
     }
-  | ExamUserCsvSetCourseFieldData
-    { examUserCsvActCourseParticipant :: CourseParticipantId
-    , examUserCsvActCourseField :: Maybe StudyFeaturesId
-    }
   | ExamUserCsvDeregisterData
     { examUserCsvActRegistration :: ExamRegistrationId
     }
@@ -453,9 +408,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 +419,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 +428,13 @@ 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
             where
               getExamParts :: ReaderT _ DB (Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult)))
               getExamParts = do
@@ -504,9 +453,6 @@ 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 $ 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 +474,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,18 +489,12 @@ 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))
             ]
           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
             ]
@@ -627,9 +564,6 @@ 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)
-                <*> 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 +584,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 +606,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 +664,6 @@ postEUsersR tid ssh csh examn = do
                 ExamUserCsvRegisterData{}         -> ExamUserCsvRegister
                 ExamUserCsvDeregisterData{}       -> ExamUserCsvDeregister
                 ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence
-                ExamUserCsvSetCourseFieldData{}   -> ExamUserCsvSetCourseField
                 ExamUserCsvSetPartResultData{}    -> ExamUserCsvSetPartResult
                 ExamUserCsvSetBonusData{..}
                   | examUserCsvIsBonusOverride    -> ExamUserCsvOverrideBonus
@@ -765,12 +686,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 +713,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
@@ -864,10 +779,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
@@ -893,16 +804,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
@@ -990,56 +891,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

@@ -68,18 +68,10 @@ 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)]
@@ -95,16 +87,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 +101,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 +108,16 @@ 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
 
 data ExamUserTableCsv = ExamUserTableCsv
   { csvEUserSurname         :: Text
   , csvEUserFirstName       :: Text
   , csvEUserName            :: Text
   , csvEUserMatriculation   :: Maybe Text
-  , csvEUserField           :: Maybe Text
-  , csvEUserDegree          :: Maybe Text
-  , csvEUserSemester        :: Maybe Int
   , csvEUserOccurrenceStart :: Maybe ZonedTime
   , csvEUserExamResult      :: ExamResultPassedGrade
   }
@@ -168,9 +139,6 @@ instance CsvColumnsExplained ExamUserTableCsv where
     , ('csvEUserFirstName           , MsgCsvColumnExamUserFirstName                 )
     , ('csvEUserName                , MsgCsvColumnExamUserName                      )
     , ('csvEUserMatriculation       , MsgCsvColumnExamUserMatriculation             )
-    , ('csvEUserField               , MsgCsvColumnExamUserField                     )
-    , ('csvEUserDegree              , MsgCsvColumnExamUserDegree                    )
-    , ('csvEUserSemester            , MsgCsvColumnExamUserSemester                  )
     , ('csvEUserOccurrenceStart     , MsgCsvColumnExamOfficeExamUserOccurrenceStart )
     , ('csvEUserExamResult          , MsgCsvColumnExamUserResult                    )
     ]
@@ -249,16 +217,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,13 +236,13 @@ 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
             where
               getSynchronised :: ReaderT _ DB [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
@@ -335,9 +297,6 @@ 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
-            , 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 +306,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,18 +313,12 @@ 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)
             ]
           dbtFilterUI = mconcat
             [ fltrUserNameUI'
             , fltrUserMatriculationUI
-            , fltrStudyTermsUI
-            , fltrStudyDegreeUI
-            , fltrStudyFeaturesSemesterUI
             , fltrExamResultPointsUI
             , \mPrev -> prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamUserSynchronised)
             ]
@@ -405,9 +355,6 @@ 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 ^? 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,9 +41,6 @@ postTUsersR tid ssh csh tutn = do
           , guardOn showSex colUserSex'
           , pure  colUserEmail
           , pure  colUserMatriclenr
-          , pure  colUserDegreeShort
-          , pure  colUserField
-          , pure  colUserSemester
           ]
         psValidator = def
           & defaultSortingByName
@@ -51,7 +48,7 @@ postTUsersR tid ssh csh tutn = do
         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
       ]

templates/course/user/profile.hamlet

@@ -56,6 +56,3 @@ $newline never
                       ^{formatTimeRangeW SelFormatDate fObs $ Just studyFeaturesLastObserved}
                     $nothing
                       ^{formatTimeW SelFormatDate studyFeaturesLastObserved}
-      $maybe _ <- mRegistration
-        <dt .deflist__dt>_{MsgCourseStudyFeature}
-        <dd .deflist__dd>^{regFieldWidget}

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