From c48e1e1981a1682618a2511983f91459a3e53763 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 27 Feb 2019 13:11:40 +0100
Subject: [PATCH 01/56] StudyFields start

---
 models/courses    | 1 +
 models/users      | 1 +
 src/Foundation.hs | 3 ++-
 3 files changed, 4 insertions(+), 1 deletion(-)

diff --git a/models/courses b/models/courses
index 96bba0195..55c1daa86 100644
--- a/models/courses
+++ b/models/courses
@@ -38,6 +38,7 @@ CourseParticipant
     course       CourseId
     user         UserId
     registration UTCTime
+    field        StudyFeaturesId Maybe
     UniqueParticipant user course
 CourseUserNote
     course       CourseId
diff --git a/models/users b/models/users
index 5ac4a6a3c..94f1cb559 100644
--- a/models/users
+++ b/models/users
@@ -30,6 +30,7 @@ StudyFeatures
     field         StudyTermsId
     type          StudyFieldType
     semester      Int
+    updated       UTCTime default=now -- zuletzt als gültig gesehen
     -- UniqueUserSubject user degree field -- There exists a counterexample
 StudyDegree
     key           Int
diff --git a/src/Foundation.hs b/src/Foundation.hs
index e4de524d2..45ef28c0d 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -2018,7 +2018,8 @@ instance YesodAuth UniWorX where
               return str
 
           fs <- either (\err -> throwError . ServerError $ "Could not parse features of study: " <> err) return userStudyFeatures
-
+          -- TODO: just update StudyFeaturesUpdate in case of no-change
+          -- TODO: keep old is referenced in CourseParticipant
           lift $ deleteWhere [StudyFeaturesUser ==. userId]
 
           forM_ fs $ \StudyFeatures{..} -> do

From 4f16efcb243e705f5eb4b1df87372fceb2fae90f Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 27 Feb 2019 14:27:58 +0100
Subject: [PATCH 02/56] Minor

---
 models/courses | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/models/courses b/models/courses
index 55c1daa86..8ee384558 100644
--- a/models/courses
+++ b/models/courses
@@ -38,7 +38,7 @@ CourseParticipant
     course       CourseId
     user         UserId
     registration UTCTime
-    field        StudyFeaturesId Maybe
+    field        StudyFeaturesId Maybe 
     UniqueParticipant user course
 CourseUserNote
     course       CourseId

From 5f7b134292a318232cad683aa1add37755a71182 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 27 Feb 2019 17:29:17 +0100
Subject: [PATCH 03/56] Write StudyTermCandidates during login

---
 models/users                                |  9 +++-
 src/Database/Esqueleto/Utils.hs             | 26 +++++++----
 src/Database/Esqueleto/Utils/TH.hs          | 48 +++++++++++++++++++++
 src/Foundation.hs                           | 36 +++++++++++++---
 src/Handler/Course.hs                       |  2 +-
 src/Handler/Utils/StudyFeatures.hs          |  9 ++--
 src/Handler/Utils/Table/Pagination.hs       |  8 ++--
 src/Handler/Utils/Table/Pagination/Types.hs | 41 ------------------
 src/Model/Types.hs                          |  1 +
 9 files changed, 112 insertions(+), 68 deletions(-)
 create mode 100644 src/Database/Esqueleto/Utils/TH.hs

diff --git a/models/users b/models/users
index 94f1cb559..59f9ecb6b 100644
--- a/models/users
+++ b/models/users
@@ -30,7 +30,9 @@ StudyFeatures
     field         StudyTermsId
     type          StudyFieldType
     semester      Int
-    updated       UTCTime default=now -- zuletzt als gültig gesehen
+    updated       UTCTime default='NOW()' -- zuletzt als gültig gesehen
+    valid         Bool default=true
+    UniqueStudyFeatures user degree field type semester
     -- UniqueUserSubject user degree field -- There exists a counterexample
 StudyDegree
     key           Int
@@ -42,3 +44,8 @@ StudyTerms
     shorthand     Text Maybe
     name          Text Maybe
     Primary key
+StudyTermCandidate
+    incidence     UUID
+    key           Int
+    name          Text
+    deriving Show Eq Ord
\ No newline at end of file
diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 41464cc00..003b26168 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -1,8 +1,16 @@
-module Database.Esqueleto.Utils where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
-import ClassyPrelude.Yesod hiding (isInfixOf, (||.))
-import Data.Foldable as F
-import Database.Esqueleto as E
+module Database.Esqueleto.Utils
+  ( true, false
+  , isInfixOf, hasInfix
+  , any, all
+  , SqlIn(..)
+  ) where
+
+import ClassyPrelude.Yesod hiding (isInfixOf, (||.), any, all)
+import qualified Data.Foldable as F
+import qualified Database.Esqueleto as E
+import Database.Esqueleto.Utils.TH
 
 
 --
@@ -33,13 +41,13 @@ hasInfix = flip isInfixOf
 -- | Given a test and a set of values, check whether anyone succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether || is short curcuited (i.e. lazily evaluated)
 any :: Foldable f =>
-  (a -> SqlExpr (E.Value Bool)) -> f a -> SqlExpr (E.Value Bool)
-any test = F.foldr (\needle acc -> acc ||. test needle) false
+  (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
+any test = F.foldr (\needle acc -> acc E.||. test needle) false
 
 -- | Given a test and a set of values, check whether all succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether && is short curcuited (i.e. lazily evaluated)
 all :: Foldable f =>
-  (a -> SqlExpr (E.Value Bool)) -> f a -> SqlExpr (E.Value Bool)
-all test = F.foldr (\needle acc -> acc &&. test needle) true
-
+  (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
+all test = F.foldr (\needle acc -> acc E.&&. test needle) true
 
+$(sqlInTuples [2..16])
diff --git a/src/Database/Esqueleto/Utils/TH.hs b/src/Database/Esqueleto/Utils/TH.hs
new file mode 100644
index 000000000..7ae382959
--- /dev/null
+++ b/src/Database/Esqueleto/Utils/TH.hs
@@ -0,0 +1,48 @@
+module Database.Esqueleto.Utils.TH
+  ( SqlIn(..)
+  , sqlInTuple, sqlInTuples
+  ) where
+
+import ClassyPrelude
+
+import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect)
+
+import Database.Persist (PersistField)
+
+import Language.Haskell.TH
+
+import Data.List (foldr1, foldl)
+
+class E.SqlSelect a r => SqlIn a r | a -> r, r -> a where
+  sqlIn :: a -> [r] -> E.SqlExpr (E.Value Bool)
+
+instance PersistField a => SqlIn (E.SqlExpr (E.Value a)) (E.Value a) where
+  x `sqlIn` xs = x `E.in_` E.valList (map E.unValue xs)
+
+sqlInTuples :: [Int] -> DecsQ
+sqlInTuples = mapM sqlInTuple
+
+sqlInTuple :: Int -> DecQ
+sqlInTuple arity = do
+  tyVars <- replicateM arity $ newName "t"
+  vVs <- replicateM arity $ newName "v"
+  xVs <- replicateM arity $ newName "x"
+  xsV <- newName "xs"
+
+  let
+    matchE = lam1E (tupP $ map (\vV -> conP 'E.Value [varP vV]) vVs) (foldr1 (\e1 e2 -> [e|$(e1) E.&&. $(e2)|]) . map (\(varE -> vE, varE -> xE) -> [e|E.val $(vE) E.==. $(xE)|]) $ zip vVs xVs)
+    tupTy f = foldl (\typ v -> typ `appT` f (varT v)) (tupleT arity) tyVars
+  
+  instanceD (cxt $ map (\v -> [t|PersistField $(varT v)|]) tyVars) [t|SqlIn $(tupTy $ \v -> [t|E.SqlExpr (E.Value $(v))|]) $(tupTy $ \v -> [t|E.Value $(v)|])|]
+    [ funD 'sqlIn
+      [ clause [tupP $ map varP xVs, varP xsV]
+        ( guardedB
+          [ normalGE [e|null $(varE xsV)|] [e|E.val False|]
+          , normalGE [e|otherwise|] [e|foldr1 (E.||.) $ map $(matchE) $(varE xsV)|]
+          ]
+        ) []
+      ]
+    ]
+
+
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 45ef28c0d..d98795969 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -50,6 +50,7 @@ import Data.Conduit (($$))
 import Data.Conduit.List (sourceList)
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 
 import Control.Monad.Except (MonadError(..), runExceptT)
 import Control.Monad.Trans.Maybe (MaybeT(..))
@@ -80,6 +81,8 @@ import Data.Bits (Bits(zeroBits))
 
 import Network.Wai.Parse (lbsBackEnd)
 
+import qualified Data.UUID.V4 as UUID
+
 
 instance DisplayAble b => DisplayAble (E.CryptoID a b) where
   display = display . ciphertext
@@ -2007,9 +2010,11 @@ instance YesodAuth UniWorX where
                           ]
 
           userId <- lift $ entityKey <$> upsertBy uAuth newUser userUpdate
+          studyTermCandidateIncidence <- liftIO UUID.nextRandom
+          now <- liftIO getCurrentTime
 
           let
-            userStudyFeatures = concat <$> mapM (parseStudyFeatures userId) userStudyFeatures'
+            userStudyFeatures = fmap concat . forM userStudyFeatures' $ parseStudyFeatures userId now
             userStudyFeatures' = do
               (k, v) <- ldapData
               guard $ k == Attr "dfnEduPersonFeaturesOfStudy"
@@ -2017,16 +2022,33 @@ instance YesodAuth UniWorX where
               Right str <- return $ Text.decodeUtf8' v'
               return str
 
-          fs <- either (\err -> throwError . ServerError $ "Could not parse features of study: " <> err) return userStudyFeatures
-          -- TODO: just update StudyFeaturesUpdate in case of no-change
-          -- TODO: keep old is referenced in CourseParticipant
-          lift $ deleteWhere [StudyFeaturesUser ==. userId]
+            termNames = do
+              (k, v) <- ldapData
+              guard $ k == Attr "dfnEduPersonFieldOfStudyString"
+              v' <- v
+              Right str <- return $ Text.decodeUtf8' v'
+              return str
 
-          forM_ fs $ \StudyFeatures{..} -> do
+          fs <- either (\err -> throwError . ServerError $ "Could not parse features of study: " <> err) return userStudyFeatures
+
+          let
+            studyTermCandidates = Set.fromList $ do
+              studyTermCandidateName <- termNames
+              StudyFeatures{ studyFeaturesField = StudyTermsKey' studyTermCandidateKey } <- fs
+              return StudyTermCandidate{..}
+
+          lift . E.update $ \f -> do
+            E.set f [ StudyFeaturesValid E.=. E.false ]
+            E.where_ . E.not_ $ (f E.^. StudyFeaturesUser, f E.^. StudyFeaturesDegree, f E.^. StudyFeaturesField, f E.^. StudyFeaturesType, f E.^. StudyFeaturesSemester)
+                      `E.sqlIn` map (\StudyFeatures{..} -> (E.Value studyFeaturesUser, E.Value studyFeaturesDegree, E.Value studyFeaturesField, E.Value studyFeaturesType, E.Value studyFeaturesSemester) ) fs
+
+          lift . insertMany_ $ Set.toList studyTermCandidates
+          forM_ fs $ \f@StudyFeatures{..} -> do
             lift . insertMaybe studyFeaturesDegree $ StudyDegree (unStudyDegreeKey studyFeaturesDegree) Nothing Nothing
             lift . insertMaybe studyFeaturesField $ StudyTerms (unStudyTermsKey studyFeaturesField) Nothing Nothing
 
-          lift $ insertMany_ fs
+            void . lift $ insertUnique f
+
           return $ Authenticated userId
         Nothing -> acceptExisting
 
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index e635731b3..78ef16a73 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -320,7 +320,7 @@ postCRegisterR tid ssh csh = do
           addMessageI Info MsgCourseDeregisterOk
       | codeOk -> do
           actTime <- liftIO getCurrentTime
-          regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
+          regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime Nothing -- TODO
           when (isJust regOk) $ addMessageI Success MsgCourseRegisterOk
       | otherwise -> addMessageI Warning MsgCourseSecretWrong
     _other -> return () -- TODO check this!
diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs
index 9dbce258a..880321e01 100644
--- a/src/Handler/Utils/StudyFeatures.hs
+++ b/src/Handler/Utils/StudyFeatures.hs
@@ -8,12 +8,12 @@ import Text.Parsec
 import Text.Parsec.Text
 
 
-parseStudyFeatures :: UserId -> Text -> Either Text [StudyFeatures]
-parseStudyFeatures uId = first tshow . parse (pStudyFeatures uId <* eof) ""
+parseStudyFeatures :: UserId -> UTCTime -> Text -> Either Text [StudyFeatures]
+parseStudyFeatures uId now = first tshow . parse (pStudyFeatures uId now <* eof) ""
 
   
-pStudyFeatures :: UserId -> Parser [StudyFeatures]
-pStudyFeatures studyFeaturesUser = do
+pStudyFeatures :: UserId -> UTCTime -> Parser [StudyFeatures]
+pStudyFeatures studyFeaturesUser studyFeaturesUpdated = do
   studyFeaturesDegree <- StudyDegreeKey' <$> pKey
   void $ string "$$"
 
@@ -29,6 +29,7 @@ pStudyFeatures studyFeaturesUser = do
       void $ char '!'
       studyFeaturesSemester <- decimal
 
+      let studyFeaturesValid = True
       return StudyFeatures{..}
 
   pStudyFeature `sepBy1` char '#'
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 67e5a3f46..2b842d487 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -39,6 +39,7 @@ import Utils.Lens.TH
 
 import Import hiding (pi)
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect,unsafeSqlValue)
 import qualified Database.Esqueleto.Internal.Language as E (From)
 
@@ -89,9 +90,6 @@ import qualified Data.ByteString.Base64.URL as Base64 (encode)
 import qualified Data.ByteString.Lazy as LBS
 
 
-$(sqlInTuples [2..16])
-
-
 data SortColumn t = forall a. PersistField a => SortColumn { getSortColumn :: t -> E.SqlExpr (E.Value a) }
 
 data SortDirection = SortAsc | SortDesc
@@ -370,7 +368,7 @@ singletonFilter key = prism' fromInner (fmap Just . fromOuter)
 
 data DBTable m x = forall a r r' h i t k k'.
   ( ToSortable h, Functor h
-  , E.SqlSelect a r, SqlIn k k', DBTableKey k'
+  , E.SqlSelect a r, E.SqlIn k k', DBTableKey k'
   , PathPiece i, Eq i
   , E.From E.SqlQuery E.SqlExpr E.SqlBackend t
   ) => DBTable
@@ -642,7 +640,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
           -> do
             E.limit l
             E.offset (psPage * l)
-      Just ps -> E.where_ $ dbtRowKey t `sqlIn` ps
+      Just ps -> E.where_ $ dbtRowKey t `E.sqlIn` ps
       _other  -> return ()
     Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (dbtFilter ! key) args t) >> expr) (return ()) psFilter
     return (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64), dbtRowKey t, res)
diff --git a/src/Handler/Utils/Table/Pagination/Types.hs b/src/Handler/Utils/Table/Pagination/Types.hs
index 44648cf21..187c679a6 100644
--- a/src/Handler/Utils/Table/Pagination/Types.hs
+++ b/src/Handler/Utils/Table/Pagination/Types.hs
@@ -6,8 +6,6 @@ module Handler.Utils.Table.Pagination.Types
   , sortable
   , ToSortable(..)
   , SortableP(..)
-  , SqlIn(..)
-  , sqlInTuples
   , DBTableInvalid(..)
   ) where
 
@@ -20,13 +18,6 @@ import Data.CaseInsensitive (CI)
 
 import Data.Aeson (FromJSON, ToJSON, FromJSONKey, ToJSONKey)
 
-import qualified Database.Esqueleto as E
-import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect)
-
-import Language.Haskell.TH
-
-import Data.List (foldr1, foldl)
-
 
 newtype FilterKey = FilterKey { _unFilterKey :: CI Text }
   deriving (Show, Read, Generic)
@@ -67,38 +58,6 @@ instance ToSortable Headless where
   pSortable = Nothing
 
 
-class E.SqlSelect a r => SqlIn a r | a -> r, r -> a where
-  sqlIn :: a -> [r] -> E.SqlExpr (E.Value Bool)
-
-instance PersistField a => SqlIn (E.SqlExpr (E.Value a)) (E.Value a) where
-  x `sqlIn` xs = x `E.in_` E.valList (map E.unValue xs)
-
-sqlInTuples :: [Int] -> DecsQ
-sqlInTuples = mapM sqlInTuple
-
-sqlInTuple :: Int -> DecQ
-sqlInTuple arity = do
-  tyVars <- replicateM arity $ newName "t"
-  vVs <- replicateM arity $ newName "v"
-  xVs <- replicateM arity $ newName "x"
-  xsV <- newName "xs"
-
-  let
-    matchE = lam1E (tupP $ map (\vV -> conP 'E.Value [varP vV]) vVs) (foldr1 (\e1 e2 -> [e|$(e1) E.&&. $(e2)|]) . map (\(varE -> vE, varE -> xE) -> [e|E.val $(vE) E.==. $(xE)|]) $ zip vVs xVs)
-    tupTy f = foldl (\typ v -> typ `appT` f (varT v)) (tupleT arity) tyVars
-  
-  instanceD (cxt $ map (\v -> [t|PersistField $(varT v)|]) tyVars) [t|SqlIn $(tupTy $ \v -> [t|E.SqlExpr (E.Value $(v))|]) $(tupTy $ \v -> [t|E.Value $(v)|])|]
-    [ funD 'sqlIn
-      [ clause [tupP $ map varP xVs, varP xsV]
-        ( guardedB
-          [ normalGE [e|null $(varE xsV)|] [e|E.val False|]
-          , normalGE [e|otherwise|] [e|foldr1 (E.||.) $ map $(matchE) $(varE xsV)|]
-          ]
-        ) []
-      ]
-    ]
-
-
 data DBTableInvalid = DBTIRowsMissing Int
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index 94655817d..d9cd98342 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -8,6 +8,7 @@ module Model.Types
   , module Numeric.Natural
   , module Mail
   , module Utils.DateTime
+  , module Data.UUID.Types
   ) where
 
 import ClassyPrelude

From 6a53a89faa142f0112b88cfca6963b4057387fb0 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 27 Feb 2019 17:36:39 +0100
Subject: [PATCH 04/56] does not compile, course register from broken

---
 messages/uniworx/de.msg                       |  1 +
 src/CryptoID.hs                               |  1 +
 src/Handler/Course.hs                         | 19 ++++++++++-----
 src/Handler/Utils/Form.hs                     | 23 +++++++++++++++++++
 src/Handler/Utils/StudyFeatures.hs            |  4 ++--
 src/Utils/Form.hs                             |  1 +
 .../register-form/register-form.hamlet        |  1 +
 7 files changed, 42 insertions(+), 8 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 0f0344878..cd1425452 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -53,6 +53,7 @@ CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
 CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
 CourseRegisterOk: Sie wurden angemeldet
 CourseDeregisterOk: Sie wurden abgemeldet
+CourseStudyFeature: Relevantes Hauptfach
 CourseSecretWrong: Falsches Kennwort
 CourseSecret: Zugangspasswort
 CourseNewOk        tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} wurde erfolgreich erstellt.
diff --git a/src/CryptoID.hs b/src/CryptoID.hs
index 58fa1a09a..899047c3b 100644
--- a/src/CryptoID.hs
+++ b/src/CryptoID.hs
@@ -36,6 +36,7 @@ decCryptoIDs [ ''SubmissionId
              , ''SheetId
              , ''SystemMessageId
              , ''SystemMessageTranslationId
+             , ''StudyFeaturesId
              ]
 
 instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => PathPiece (E.CryptoID namespace (CI FilePath)) where
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index e635731b3..0ac01c4e9 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -5,6 +5,7 @@ module Handler.Course where
 import Import
 
 import Utils.Lens
+import Utils.Form
 -- import Utils.DB
 import Handler.Utils
 import Handler.Utils.Table.Cells
@@ -263,8 +264,8 @@ getTermCourseListR tid = do
 getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCShowR tid ssh csh = do
   mbAid <- maybeAuthId
-  (course,schoolName,participants,registered,lecturers) <- runDB . maybeT notFound $ do
-    [(E.Entity cid course, E.Value schoolName, E.Value participants, E.Value registered)]
+  (course,schoolName,participants,registration,lecturers) <- runDB . maybeT notFound $ do
+    [(E.Entity cid course, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
        <- lift . E.select . E.from $
          \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
             E.on $ E.just (course E.^. CourseId) E.==. participant E.?. CourseParticipantCourse
@@ -276,17 +277,19 @@ getCShowR tid ssh csh = do
             let numParticipants = E.sub_select . E.from $ \part -> do
                   E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
                   return ( E.countRows :: E.SqlExpr (E.Value Int64))
-            return (course,school E.^. SchoolName, numParticipants, participant E.?. CourseParticipantRegistration)
+            return (course,school E.^. SchoolName, numParticipants, participant)
+
     lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
       E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
       E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
       return $ user E.^. UserDisplayName
-    return (course,schoolName,participants,registered,map E.unValue lecturers)
+
+    return (course,schoolName,participants,registration,map E.unValue lecturers)
   mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom    course
   mRegTo   <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo      course
   mDereg   <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
-  mRegAt   <- traverse (formatTime SelFormatDateTime)   registered
-  (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm (isJust mRegAt) $ courseRegisterSecret course
+  mRegAt   <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
+  (regWidget, regEnctype) <- generateFormPost $ identForm FIDcourseRegister $ registerForm (isJust mRegAt) $ courseRegisterSecret course
   registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
   siteLayout (toWgt $ courseName course) $ do
     setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
@@ -294,11 +297,15 @@ getCShowR tid ssh csh = do
 
 
 registerForm :: Bool -> Maybe Text -> Form Bool
+-- unfinished WIP: must take study features if registred and show as mforced field
 registerForm registered msecret extra = do
   (msecretRes', msecretView) <- case msecret of
     (Just _) | not registered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
     _ -> return (Nothing,Nothing)
+  (sfRes' , sfView) <- if not registered then return (Nothing,Nothing) else
+                       mopt (studyFeaturesPrimaryFieldFor (error "TODO SJ REMOVE")) (fslI MsgCourseStudyFeature) Nothing
   (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing
+
   let widget = $(widgetFile "widgets/register-form/register-form")
   let msecretRes | Just res <- msecretRes' = Just <$> res
                  | otherwise               = FormSuccess Nothing
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 2a568432e..840c0dbd2 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -214,6 +214,29 @@ schoolFieldEnt = selectField $ optionsPersist [] [Asc SchoolName] schoolName
 schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
 schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
 
+-- | Select one of the user's primary courses
+studyFeaturesPrimaryFieldFor :: UserId -> Field Handler StudyFeaturesId
+studyFeaturesPrimaryFieldFor uid = selectField $ do
+    -- we wanted to use optionsPersistCryptoId, but we need a join here
+    rawOptions <- runDB $ E.select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` field) -> do
+        E.on     $ feature E.^. StudyFeaturesField  E.==. field  E.^. StudyTermsId
+        E.on     $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
+        E.where_ $ feature E.^. StudyFeaturesUser   E.==. E.val uid
+        -- E.where_ $ feature E.^. StudyFeaturesValid  E.==. E.val True -- TODO SJ REMOVE
+        E.where_ $ feature E.^. StudyFeaturesType   E.==. E.val FieldPrimary
+        return (feature E.^. StudyFeaturesId, degree, field)
+    mkOptionList <$> mapM procOptions rawOptions
+  where
+    procOptions (E.Value sfid, Entity dgid StudyDegree{..}, Entity stid StudyTerms{..}) = do
+      let dgname = fromMaybe (tshow dgid) (studyDegreeShorthand <|> studyDegreeName)
+          stname = fromMaybe (tshow stid) (studyTermsShorthand  <|> studyTermsName )
+      cfid <- encrypt sfid
+      return Option
+        { optionDisplay = stname <> " (" <> dgname <> ")"
+        , optionInternalValue = sfid
+        , optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId)
+        }
+
 uploadModeField :: Field Handler UploadMode
 uploadModeField = selectField optionsFinite
 
diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs
index 9dbce258a..1de343aa7 100644
--- a/src/Handler/Utils/StudyFeatures.hs
+++ b/src/Handler/Utils/StudyFeatures.hs
@@ -11,13 +11,14 @@ import Text.Parsec.Text
 parseStudyFeatures :: UserId -> Text -> Either Text [StudyFeatures]
 parseStudyFeatures uId = first tshow . parse (pStudyFeatures uId <* eof) ""
 
-  
+
 pStudyFeatures :: UserId -> Parser [StudyFeatures]
 pStudyFeatures studyFeaturesUser = do
   studyFeaturesDegree <- StudyDegreeKey' <$> pKey
   void $ string "$$"
 
   let
+    studyFeaturesUpdated = error "undefined" --TODO SJ REMOVE
     pStudyFeature = do
       _ <- pKey -- Meaning unknown at this time
       void $ char '!'
@@ -28,7 +29,6 @@ pStudyFeatures studyFeaturesUser = do
       studyFeaturesType <- pType
       void $ char '!'
       studyFeaturesSemester <- decimal
-
       return StudyFeatures{..}
 
   pStudyFeature `sepBy1` char '#'
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 8c53501f8..b007b0cb3 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -194,6 +194,7 @@ addAutosubmit = addAttr "data-autosubmit" ""
 
 data FormIdentifier
   = FIDcourse
+  | FIDcourseRegister
   | FIDsheet
   | FIDsubmission
   | FIDsettings
diff --git a/templates/widgets/register-form/register-form.hamlet b/templates/widgets/register-form/register-form.hamlet
index a2dd97af9..6bb3388fb 100644
--- a/templates/widgets/register-form/register-form.hamlet
+++ b/templates/widgets/register-form/register-form.hamlet
@@ -3,5 +3,6 @@ $# extra protects us against CSRF
 $# Maybe display textField for passcode
 $maybe secretView <- msecretView
   ^{fvInput secretView}
+$# Ask for associated primary field uf study, unless registered
 $# Always display register/deregister button
 ^{fvInput btnView}

From 9ca91b5ec882d65b1ad6d3799ba176ac61f90162 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 27 Feb 2019 17:42:46 +0100
Subject: [PATCH 05/56] removed stubs for merge

---
 src/Handler/Utils/Form.hs          | 2 +-
 src/Handler/Utils/StudyFeatures.hs | 3 +--
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 840c0dbd2..83c29a8c1 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -222,7 +222,7 @@ studyFeaturesPrimaryFieldFor uid = selectField $ do
         E.on     $ feature E.^. StudyFeaturesField  E.==. field  E.^. StudyTermsId
         E.on     $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
         E.where_ $ feature E.^. StudyFeaturesUser   E.==. E.val uid
-        -- E.where_ $ feature E.^. StudyFeaturesValid  E.==. E.val True -- TODO SJ REMOVE
+        E.where_ $ feature E.^. StudyFeaturesValid  E.==. E.val True 
         E.where_ $ feature E.^. StudyFeaturesType   E.==. E.val FieldPrimary
         return (feature E.^. StudyFeaturesId, degree, field)
     mkOptionList <$> mapM procOptions rawOptions
diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs
index d84e79499..d2903309c 100644
--- a/src/Handler/Utils/StudyFeatures.hs
+++ b/src/Handler/Utils/StudyFeatures.hs
@@ -18,7 +18,6 @@ pStudyFeatures studyFeaturesUser studyFeaturesUpdated = do
   void $ string "$$"
 
   let
-    studyFeaturesUpdated = error "undefined" --TODO SJ REMOVE
     pStudyFeature = do
       _ <- pKey -- Meaning unknown at this time
       void $ char '!'
@@ -33,7 +32,7 @@ pStudyFeatures studyFeaturesUser studyFeaturesUpdated = do
       return StudyFeatures{..}
 
   pStudyFeature `sepBy1` char '#'
-
+  
 pKey :: Parser Int
 pKey = decimal
 

From 49c8ca56f52840b30af434d014823ce4fc2d642f Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 27 Feb 2019 17:42:57 +0100
Subject: [PATCH 06/56] Touch StudyFeaturesUpdated on each login

---
 src/Foundation.hs | 12 +++---------
 1 file changed, 3 insertions(+), 9 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index d98795969..8f3613943 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -50,7 +50,6 @@ import Data.Conduit (($$))
 import Data.Conduit.List (sourceList)
 
 import qualified Database.Esqueleto as E
-import qualified Database.Esqueleto.Utils as E
 
 import Control.Monad.Except (MonadError(..), runExceptT)
 import Control.Monad.Trans.Maybe (MaybeT(..))
@@ -2036,18 +2035,13 @@ instance YesodAuth UniWorX where
               studyTermCandidateName <- termNames
               StudyFeatures{ studyFeaturesField = StudyTermsKey' studyTermCandidateKey } <- fs
               return StudyTermCandidate{..}
-
-          lift . E.update $ \f -> do
-            E.set f [ StudyFeaturesValid E.=. E.false ]
-            E.where_ . E.not_ $ (f E.^. StudyFeaturesUser, f E.^. StudyFeaturesDegree, f E.^. StudyFeaturesField, f E.^. StudyFeaturesType, f E.^. StudyFeaturesSemester)
-                      `E.sqlIn` map (\StudyFeatures{..} -> (E.Value studyFeaturesUser, E.Value studyFeaturesDegree, E.Value studyFeaturesField, E.Value studyFeaturesType, E.Value studyFeaturesSemester) ) fs
-
           lift . insertMany_ $ Set.toList studyTermCandidates
+
+          lift $ E.updateWhere [StudyFeaturesUser ==. userId] [StudyFeaturesValid =. False]
           forM_ fs $ \f@StudyFeatures{..} -> do
             lift . insertMaybe studyFeaturesDegree $ StudyDegree (unStudyDegreeKey studyFeaturesDegree) Nothing Nothing
             lift . insertMaybe studyFeaturesField $ StudyTerms (unStudyTermsKey studyFeaturesField) Nothing Nothing
-
-            void . lift $ insertUnique f
+            void . lift $ upsert f [StudyFeaturesUpdated =. now, StudyFeaturesValid =. True]
 
           return $ Authenticated userId
         Nothing -> acceptExisting

From 4db9e5c18a6f4875312a34fa2d5fa3d879b7547f Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 28 Feb 2019 10:02:23 +0100
Subject: [PATCH 07/56] fillDB adjusted for StudyFeatues

---
 src/Handler/Course.hs |  4 +--
 test/Database.hs      | 71 +++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 71 insertions(+), 4 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 55d090092..2224dc20f 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -302,8 +302,8 @@ registerForm registered msecret extra = do
   (msecretRes', msecretView) <- case msecret of
     (Just _) | not registered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
     _ -> return (Nothing,Nothing)
-  (sfRes' , sfView) <- if not registered then return (Nothing,Nothing) else
-                       mopt (studyFeaturesPrimaryFieldFor (error "TODO SJ REMOVE")) (fslI MsgCourseStudyFeature) Nothing
+  (_sfRes' , _sfView) <- if not registered then return (Nothing,Nothing) else
+                        bimap Just Just <$> mopt (studyFeaturesPrimaryFieldFor (error "TODO SJ REMOVE")) (fslI MsgCourseStudyFeature) Nothing
   (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing
 
   let widget = $(widgetFile "widgets/register-form/register-form")
diff --git a/test/Database.hs b/test/Database.hs
index daef8d28a..c4d6ad8e1 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -198,7 +198,7 @@ fillDb = do
     , termActive       = True
     }
   ifi <- insert' $ School "Institut für Informatik" "IfI"
-  mi <- insert' $ School "Institut für Mathematik" "MI"
+  mi  <- insert' $ School "Institut für Mathematik" "MI"
   void . insert' $ UserAdmin gkleen ifi
   void . insert' $ UserAdmin gkleen mi
   void . insert' $ UserAdmin fhamann ifi
@@ -210,13 +210,70 @@ fillDb = do
   let
     sdBsc = StudyDegreeKey' 82
     sdMst = StudyDegreeKey' 88
+    sdLAR = StudyDegreeKey' 33
+    sdLAG = StudyDegreeKey' 35
   repsert sdBsc  $ StudyDegree 82 (Just "BSc") (Just "Bachelor"  )
   repsert sdMst  $ StudyDegree 88 (Just "MSc") (Just "Master"    )
+  repsert sdLAR  $ StudyDegree 33 (Just "LAR") Nothing -- intentionally left unknown
+  repsert sdLAG  $ StudyDegree 35 Nothing      Nothing -- intentionally left unknown
   let
     sdInf  = StudyTermsKey' 79
     sdMath = StudyTermsKey' 105
+    sdMedi = StudyTermsKey' 121
+    sdPhys = StudyTermsKey' 128
   repsert sdInf  $ StudyTerms  79 (Just "IfI") (Just "Institut für Informatik")
   repsert sdMath $ StudyTerms 105 (Just "MI" ) (Just "Mathematisches Institut")
+  repsert sdMedi $ StudyTerms 121 (Just "MnfI") Nothing -- intentionally left unknown
+  repsert sdPhys $ StudyTerms 128  Nothing      Nothing -- intentionally left unknown
+  sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here
+    maxMuster
+    sdBsc
+    sdInf
+    FieldPrimary
+    2
+    now
+    True
+  sfMMs <- insert $ StudyFeatures
+    maxMuster
+    sdBsc
+    sdMath
+    FieldSecondary
+    2
+    now
+    True
+  _sfTTa <- insert $ StudyFeatures
+    tinaTester
+    sdBsc
+    sdInf
+    FieldPrimary
+    4
+    now
+    False
+  sfTTb <- insert $ StudyFeatures
+    tinaTester
+    sdLAG
+    sdPhys
+    FieldPrimary
+    1
+    now
+    True
+  sfTTc <- insert $ StudyFeatures
+    tinaTester
+    sdLAR
+    sdMedi
+    FieldPrimary
+    7
+    now
+    True
+  _sfTTd <- insert $ StudyFeatures
+    tinaTester
+    sdMst
+    sdMath
+    FieldPrimary
+    3
+    now
+    True
+
   -- FFP
   let nbrs :: [Int]
       nbrs = [1,2,3,27,7,1]
@@ -256,6 +313,12 @@ fillDb = do
   insert_ $ SheetEdit gkleen now feste
   keine <- insert $ Sheet ffp "Keine Gruppen" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing (Upload True) UserSubmissions False
   insert_ $ SheetEdit gkleen now keine
+  void . insertMany $ map (\(u,sf) -> CourseParticipant ffp u now sf)
+    [(fhamann   , Nothing)
+    ,(maxMuster , Just sfMMs)
+    ,(tinaTester, Just sfTTc)
+    ]
+
   -- EIP
   eip <- insert' Course
     { courseName = "Einführung in die Programmierung"
@@ -328,7 +391,11 @@ fillDb = do
   insert_ $ CourseEdit jost now pmo
   void . insert $ DegreeCourse pmo sdBsc sdInf
   void . insert $ Lecturer jost pmo
-  void . insertMany $ map (\u -> CourseParticipant pmo u now) [fhamann, maxMuster, tinaTester]
+  void . insertMany $ map (\(u,sf) -> CourseParticipant pmo u now sf)
+    [(fhamann   , Nothing)
+    ,(maxMuster , Just sfMMp)
+    ,(tinaTester, Just sfTTb)
+    ]
   sh1 <- insert Sheet
     { sheetCourse = pmo
     , sheetName = "Blatt 1"

From ad02db27db435e9a4f843b871ca6282842343eea Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Thu, 28 Feb 2019 11:01:44 +0100
Subject: [PATCH 08/56] Keep track of userLastAuthentication

---
 messages/uniworx/de.msg                       |  2 ++
 models/users                                  |  1 +
 src/Foundation.hs                             | 26 ++++++++++++-------
 src/Handler/Course.hs                         |  4 +--
 src/Handler/Profile.hs                        |  2 ++
 src/Import/NoFoundation.hs                    |  3 +++
 templates/profileData.hamlet                  |  6 +++++
 .../register-form/register-form.hamlet        |  2 ++
 8 files changed, 34 insertions(+), 12 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index cd1425452..66404f49c 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -253,8 +253,10 @@ Theme: Oberflächen Design
 Favoriten: Anzahl gespeicherter Favoriten
 Plugin: Plugin
 Ident: Identifikation
+LastLogin: Letzter Login
 Settings: Individuelle Benutzereinstellungen
 SettingsUpdate: Einstellungen wurden gespeichert.
+Never: Nie
 
 MultiFileUploadInfo: (Mehrere Dateien mit Shift oder Strg auswählen)
 
diff --git a/models/users b/models/users
index 59f9ecb6b..ff0c9a965 100644
--- a/models/users
+++ b/models/users
@@ -1,6 +1,7 @@
 User json
     ident          (CI Text)
     authentication AuthenticationMode
+    lastAuthentication UTCTime Maybe
     matrikelnummer Text Maybe
     email          (CI Text)
     displayName    Text
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 8f3613943..fde6cf714 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -80,8 +80,6 @@ import Data.Bits (Bits(zeroBits))
 
 import Network.Wai.Parse (lbsBackEnd)
 
-import qualified Data.UUID.V4 as UUID
-
 
 instance DisplayAble b => DisplayAble (E.CryptoID a b) where
   display = display . ciphertext
@@ -1916,6 +1914,8 @@ instance YesodAuth UniWorX where
         $(widgetFile "login")
 
     authenticate Creds{..} = runDB $ do
+      now <- liftIO getCurrentTime
+
       let
         userIdent = CI.mk credsIdent
         uAuth = UniqueAuthentication userIdent
@@ -1943,7 +1943,12 @@ instance YesodAuth UniWorX where
                   return $ ServerError "LDAP lookup failed"
             ]
 
-        acceptExisting = maybe (UserError $ IdentifierNotFound credsIdent) (Authenticated . entityKey) <$> getBy uAuth
+        acceptExisting = do
+          res <- maybe (UserError $ IdentifierNotFound credsIdent) (Authenticated . entityKey) <$> getBy uAuth
+          case res of
+            Authenticated uid
+              | not isDummy -> res <$ update uid [ UserLastAuthentication =. Just now ]
+            _other -> return res
 
       $logDebugS "auth" $ tshow Creds{..}
       UniWorX{ appSettings = AppSettings{ appUserDefaults = UserDefaultConf{..}, ..}, .. } <- getYesod
@@ -1962,6 +1967,7 @@ instance YesodAuth UniWorX where
             userAuthentication
               | isPWHash  = error "PWHash should only work for users that are already known"
               | otherwise = AuthLDAP
+            userLastAuthentication = now <$ guard (not isDummy)
 
           userEmail <- if
             | Just [bs] <- userEmail'
@@ -2002,15 +2008,15 @@ instance YesodAuth UniWorX where
               , userMailLanguages        = def
               , ..
               }
-            userUpdate =  [ UserMatrikelnummer =. userMatrikelnummer
-                          , UserDisplayName    =. userDisplayName
-                          , UserSurname        =. userSurname
-                          , UserEmail          =. userEmail
-                          ]
+            userUpdate =  [ UserMatrikelnummer     =. userMatrikelnummer
+                          , UserDisplayName        =. userDisplayName
+                          , UserSurname            =. userSurname
+                          , UserEmail              =. userEmail
+                          ] ++
+                          [ UserLastAuthentication =. Just now | not isDummy ]
 
           userId <- lift $ entityKey <$> upsertBy uAuth newUser userUpdate
-          studyTermCandidateIncidence <- liftIO UUID.nextRandom
-          now <- liftIO getCurrentTime
+          studyTermCandidateIncidence <- liftIO getRandom
 
           let
             userStudyFeatures = fmap concat . forM userStudyFeatures' $ parseStudyFeatures userId now
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 55d090092..f97aecaa4 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -302,8 +302,8 @@ registerForm registered msecret extra = do
   (msecretRes', msecretView) <- case msecret of
     (Just _) | not registered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
     _ -> return (Nothing,Nothing)
-  (sfRes' , sfView) <- if not registered then return (Nothing,Nothing) else
-                       mopt (studyFeaturesPrimaryFieldFor (error "TODO SJ REMOVE")) (fslI MsgCourseStudyFeature) Nothing
+  (_msfRes, msfView) <- if not registered then return (Nothing, Nothing) else
+                        bimap Just Just <$> mopt (studyFeaturesPrimaryFieldFor (error "TODO SJ REMOVE")) (fslI MsgCourseStudyFeature) Nothing
   (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing
 
   let widget = $(widgetFile "widgets/register-form/register-form")
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index a57e1149c..5717bd357 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -248,6 +248,8 @@ getProfileDataR = do
   let ownTutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
   let tutorialTable    = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
 
+  lastLogin <- traverse (formatTime SelFormatDateTime) userLastAuthentication
+
   -- Delete Button
   (btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form ButtonDelete)
   defaultLayout $ do
diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs
index 1f1220787..0c6b55264 100644
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@@ -61,6 +61,9 @@ import Database.Esqueleto.Instances as Import ()
 import Database.Persist.Sql.Instances as Import ()
 import Database.Persist.Sql as Import (SqlReadT,SqlWriteT)
 
+import System.Random as Import (Random)
+import Control.Monad.Random.Class as Import (MonadRandom(..))
+
 
 import Control.Monad.Trans.RWS (RWST)
 
diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet
index 175f98f3d..3360b0afa 100644
--- a/templates/profileData.hamlet
+++ b/templates/profileData.hamlet
@@ -10,6 +10,12 @@
       <dd .deflist__dd> #{display userEmail}
       <dt .deflist__dt> _{MsgIdent}
       <dd .deflist__dd> #{display userIdent}
+      <dt .deflist__dt> _{MsgLastLogin}
+      <dd .deflist__dd>
+        $maybe llogin <- lastLogin 
+          #{llogin}
+        $nothing
+          _{MsgNever}
     $if not $ null admin_rights
       <dt .deflist__dt> Administrator
       <dd .deflist__dd>
diff --git a/templates/widgets/register-form/register-form.hamlet b/templates/widgets/register-form/register-form.hamlet
index 6bb3388fb..769c98c3b 100644
--- a/templates/widgets/register-form/register-form.hamlet
+++ b/templates/widgets/register-form/register-form.hamlet
@@ -4,5 +4,7 @@ $# Maybe display textField for passcode
 $maybe secretView <- msecretView
   ^{fvInput secretView}
 $# Ask for associated primary field uf study, unless registered
+$maybe sfView <- msfView
+  ^{fvInput sfView}
 $# Always display register/deregister button
 ^{fvInput btnView}

From 27dffe7d0895519a583db8cca5e090e8de51cc5c Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 28 Feb 2019 11:55:28 +0100
Subject: [PATCH 09/56] Fixbuild tests and linter

---
 src/Database/Esqueleto/Utils.hs | 2 +-
 test/Database.hs                | 5 +++++
 test/ModelSpec.hs               | 5 +++--
 test/TestImport.hs              | 3 ++-
 4 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 003b26168..158fa5bea 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -7,7 +7,7 @@ module Database.Esqueleto.Utils
   , SqlIn(..)
   ) where
 
-import ClassyPrelude.Yesod hiding (isInfixOf, (||.), any, all)
+import ClassyPrelude.Yesod hiding (isInfixOf, any, all)
 import qualified Data.Foldable as F
 import qualified Database.Esqueleto as E
 import Database.Esqueleto.Utils.TH
diff --git a/test/Database.hs b/test/Database.hs
index c4d6ad8e1..1d2b903ba 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -93,6 +93,7 @@ fillDb = do
   gkleen <- insert User
     { userIdent  = "G.Kleen@campus.lmu.de"
     , userAuthentication = AuthLDAP
+    , userLastAuthentication = Just now
     , userMatrikelnummer = Nothing
     , userEmail  = "G.Kleen@campus.lmu.de"
     , userDisplayName = "Gregor Kleen"
@@ -109,6 +110,7 @@ fillDb = do
   fhamann <- insert User
     { userIdent  = "felix.hamann@campus.lmu.de"
     , userAuthentication = AuthLDAP
+    , userLastAuthentication = Nothing
     , userMatrikelnummer = Nothing
     , userEmail  = "felix.hamann@campus.lmu.de"
     , userDisplayName = "Felix Hamann"
@@ -125,6 +127,7 @@ fillDb = do
   jost <- insert User
     { userIdent  = "jost@tcs.ifi.lmu.de"
     , userAuthentication = AuthLDAP
+    , userLastAuthentication = Nothing
     , userMatrikelnummer = Nothing
     , userEmail  = "jost@tcs.ifi.lmu.de"
     , userDisplayName = "Steffen Jost"
@@ -141,6 +144,7 @@ fillDb = do
   maxMuster <- insert User
     { userIdent  = "max@campus.lmu.de"
     , userAuthentication = AuthLDAP
+    , userLastAuthentication = Just now
     , userMatrikelnummer = Just "1299"
     , userEmail  = "max@campus.lmu.de"
     , userDisplayName = "Max Musterstudent"
@@ -157,6 +161,7 @@ fillDb = do
   tinaTester <- insert $ User
     { userIdent  = "tester@campus.lmu.de"
     , userAuthentication = AuthLDAP
+    , userLastAuthentication = Nothing
     , userMatrikelnummer = Just "999"
     , userEmail  = "tester@campus.lmu.de"
     , userDisplayName = "Tina Tester"
diff --git a/test/ModelSpec.hs b/test/ModelSpec.hs
index 33a54c2e3..258211f94 100644
--- a/test/ModelSpec.hs
+++ b/test/ModelSpec.hs
@@ -40,6 +40,7 @@ instance Arbitrary User where
       , on (\l d -> l <> "@" <> d) getPrintableString <$> arbitrary <*> arbitrary
       ]
     userAuthentication <- arbitrary
+    userLastAuthentication <- arbitrary
     userMatrikelnummer <- fmap pack . assertM' (not . null) <$> listOf (elements ['0'..'9'])
     userEmail <- CI.mk . decodeUtf8 . Email.toByteString <$> arbitrary
 
@@ -60,7 +61,7 @@ instance Arbitrary User where
     userDownloadFiles <- arbitrary
     userMailLanguages <- arbitrary
     userNotificationSettings <- arbitrary
-    
+
     return User{..}
   shrink = genericShrink
 
@@ -71,7 +72,7 @@ instance Arbitrary File where
     fileModified <- (addUTCTime <$> arbitrary <*> pure (UTCTime date 0)) `suchThat` inZipRange
     fileContent <- arbitrary
     return File{..}
-    where 
+    where
       inZipRange :: UTCTime -> Bool
       inZipRange time
         | time > UTCTime (fromGregorian 1980 1 1) 0
diff --git a/test/TestImport.hs b/test/TestImport.hs
index 9d84e8722..f576ccf30 100644
--- a/test/TestImport.hs
+++ b/test/TestImport.hs
@@ -92,7 +92,7 @@ authenticateAs (Entity _ User{..}) = do
     setMethod "GET"
     addRequestHeader ("Accept-Language", "de")
     setUrl $ AuthR LoginR
-  
+
   request $ do
     setMethod "POST"
     addToken_ "#login--dummy"
@@ -107,6 +107,7 @@ createUser adjUser = do
   let
     userMatrikelnummer = Nothing
     userAuthentication = AuthLDAP
+    userLastAuthentication = Nothing
     userIdent = "dummy@example.invalid"
     userEmail = "dummy@example.invalid"
     userDisplayName = "Dummy Example"

From 7dcd3339a2d95510ac79d08adcb2cf4fc6a498e2 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 28 Feb 2019 12:00:58 +0100
Subject: [PATCH 10/56] Name sorting fixed

---
 src/Handler/Corrections.hs | 4 ++--
 src/Handler/Course.hs      | 1 +
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 2421a1b6a..cdcc41f73 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -223,7 +223,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
            E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
           E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
           E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
-          E.orderBy [E.asc $ user E.^. UserDisplayName]
+          E.orderBy [E.asc $ user E.^ UserSurname, E.asc $ user E.^. UserDisplayName]
           return (user, pseudonym E.?. SheetPseudonymPseudonym)
         let
           submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
@@ -263,7 +263,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
             E.sub_select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
               E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
               E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
-              E.orderBy [E.asc $ user E.^. UserSurname]
+              E.orderBy [E.asc $ user E.^ UserSurname, E.asc $ user E.^. UserDisplayName]
               E.limit 1
               return (user E.^. UserSurname)
         )
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 8e6edb91c..58811263c 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -282,6 +282,7 @@ getCShowR tid ssh csh = do
     lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
       E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
       E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
+      E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. DisplayName ]
       return (user E.^. UserDisplayName, user E.^. UserSurname, user E.^. UserEmail)
     return (course,schoolName,participants,registration,lecturers)
 

From 3966ad9b24d12920a85f0042c3520bed6594121b Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 28 Feb 2019 12:07:50 +0100
Subject: [PATCH 11/56] Don't know why there are still changes after commit and
 push

---
 src/Handler/Corrections.hs | 4 ++--
 src/Handler/Course.hs      | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index cdcc41f73..af5eb3e23 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -223,7 +223,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
            E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
           E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
           E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
-          E.orderBy [E.asc $ user E.^ UserSurname, E.asc $ user E.^. UserDisplayName]
+          E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
           return (user, pseudonym E.?. SheetPseudonymPseudonym)
         let
           submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
@@ -263,7 +263,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
             E.sub_select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
               E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
               E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
-              E.orderBy [E.asc $ user E.^ UserSurname, E.asc $ user E.^. UserDisplayName]
+              E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
               E.limit 1
               return (user E.^. UserSurname)
         )
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 58811263c..60febf6f0 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -282,7 +282,7 @@ getCShowR tid ssh csh = do
     lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
       E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
       E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
-      E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. DisplayName ]
+      E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName ]
       return (user E.^. UserDisplayName, user E.^. UserSurname, user E.^. UserEmail)
     return (course,schoolName,participants,registration,lecturers)
 

From 933eaa73625c96dd844b4fc6925b767b591d7f3d Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 28 Feb 2019 17:17:34 +0100
Subject: [PATCH 12/56] Registration takes Field of Studies now

---
 messages/uniworx/de.msg   |  3 +-
 src/Handler/Course.hs     | 62 ++++++++++++++++++++++++---------------
 src/Handler/Utils/Form.hs | 24 +++++++++------
 test/Database.hs          |  4 +--
 4 files changed, 58 insertions(+), 35 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index eeadac9d9..713524bf1 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -53,7 +53,8 @@ CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
 CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
 CourseRegisterOk: Sie wurden angemeldet
 CourseDeregisterOk: Sie wurden abgemeldet
-CourseStudyFeature: Relevantes Hauptfach
+CourseStudyFeature: Asoziiertes Hauptfach
+CourseStudyFeatureTooltip: Korrekte Angabe kann Notenweiterleitungen beschleunigen
 CourseSecretWrong: Falsches Kennwort
 CourseSecret: Zugangspasswort
 CourseNewOk        tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} wurde erfolgreich erstellt.
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 60febf6f0..b4a0c0526 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -290,48 +290,64 @@ getCShowR tid ssh csh = do
   mRegTo   <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo      course
   mDereg   <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
   mRegAt   <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
-  (regWidget, regEnctype) <- generateFormPost $ identForm FIDcourseRegister $ registerForm (isJust mRegAt) $ courseRegisterSecret course
+  (regWidget, regEnctype) <- generateFormPost $ registerForm mbAid registration $ courseRegisterSecret course
   registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
   siteLayout (toWgt $ courseName course) $ do
     setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
     $(widgetFile "course")
 
-
-registerForm :: Bool -> Maybe Text -> Form Bool
+-- | Registration button with primary study features if logged in
+-- , existing features if already registered
+-- , and possibly a course secret
+registerForm :: Maybe UserId -> Maybe CourseParticipant -> Maybe Text -> Form (Maybe StudyFeaturesId, Bool)
 -- unfinished WIP: must take study features if registred and show as mforced field
-registerForm registered msecret extra = do
-  (msecretRes', msecretView) <- case msecret of
-    (Just _) | not registered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
-    _ -> return (Nothing,Nothing)
-  (_msfRes, msfView) <- if not registered then return (Nothing, Nothing) else
-                        bimap Just Just <$> mopt (studyFeaturesPrimaryFieldFor (error "TODO SJ REMOVE")) (fslI MsgCourseStudyFeature) Nothing
-  (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing
+registerForm loggedin participant msecret = identForm FIDcourseRegister $ \extra -> do
+    -- secret fields
+    (msecretRes', msecretView) <- case msecret of
+      (Just _) | not isRegistered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
+      _ -> return (Nothing,Nothing)
+    -- study features
+    (msfRes', msfView) <- case loggedin of
+      Nothing -> return (Nothing,Nothing)
+      Just _  -> bimap Just Just <$> case participant of
+        Just CourseParticipant{courseParticipantField=Just sfid}
+                -> mopt (studyFeaturesPrimaryFieldFor [sfid] loggedin) (fslI MsgCourseStudyFeature)  (Just $ Just sfid)
+        _other  -> mopt (studyFeaturesPrimaryFieldFor [ ]    loggedin) (fslI MsgCourseStudyFeature
+                                                                 & setTooltip  MsgCourseStudyFeatureTooltip) Nothing
+    -- button de-/register
+    (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister isRegistered) "buttonField ignores settings anyway" Nothing
 
-  let widget = $(widgetFile "widgets/register-form/register-form")
-  let msecretRes | Just res <- msecretRes' = Just <$> res
-                 | otherwise               = FormSuccess Nothing
-  return (btnRes *> ((==msecret) <$> msecretRes), widget) -- checks that correct button was pressed, and ignores result of btnRes
+    let widget = $(widgetFile "widgets/register-form/register-form")
+    let msecretRes | Just res <- msecretRes' = Just <$> res
+                   | otherwise               = FormSuccess Nothing
+    let msfRes     | Just res <- msfRes'     = res
+                   | otherwise               = FormSuccess Nothing
+    -- checks that correct button was pressed, and ignores result of btnRes
+    let formRes = (,) <$ btnRes <*> msfRes <*> ((==msecret) <$> msecretRes)
+    return (formRes, widget)
+  where
+    isRegistered = isJust participant
 
 
 postCRegisterR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 postCRegisterR tid ssh csh = do
   aid <- requireAuthId
-  (cid, course, registered) <- runDB $ do
+  (cid, course, registration) <- runDB $ do
       (Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh
-      registered <- isJust <$> getBy (UniqueParticipant aid cid)
-      return (cid, course, registered)
-  ((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
-  case regResult of
-    (FormSuccess codeOk)
-      | registered -> do
+      registration <- getBy (UniqueParticipant aid cid)
+      return (cid, course, entityVal <$> registration)
+  let isRegistered  = isJust registration
+  ((regResult,_), _) <- runFormPost $ registerForm (Just aid) registration $ courseRegisterSecret course
+  formResult regResult $ \(mbSfId,codeOk) -> if
+      | isRegistered -> do
           runDB $ deleteBy $ UniqueParticipant aid cid
           addMessageI Info MsgCourseDeregisterOk
       | codeOk -> do
           actTime <- liftIO getCurrentTime
-          regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime Nothing -- TODO
+          regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime mbSfId
           when (isJust regOk) $ addMessageI Success MsgCourseRegisterOk
       | otherwise -> addMessageI Warning MsgCourseSecretWrong
-    _other -> return () -- TODO check this!
+  -- addMessage Info $ toHtml $ show regResult -- For debugging only
   redirect $ CourseR tid ssh csh CShowR
 
 
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 83c29a8c1..3951be40a 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -214,19 +214,25 @@ schoolFieldEnt = selectField $ optionsPersist [] [Asc SchoolName] schoolName
 schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
 schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
 
--- | Select one of the user's primary courses
-studyFeaturesPrimaryFieldFor :: UserId -> Field Handler StudyFeaturesId
-studyFeaturesPrimaryFieldFor uid = selectField $ do
-    -- we wanted to use optionsPersistCryptoId, but we need a join here
+-- | Select one of the user's primary active courses, or from a given list of StudyFeatures (regardless of user)
+studyFeaturesPrimaryFieldFor :: [StudyFeaturesId] -> Maybe UserId -> Field Handler StudyFeaturesId
+studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
+    -- we need a join, so we cannot just use optionsPersistCryptoId
     rawOptions <- runDB $ E.select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` field) -> do
-        E.on     $ feature E.^. StudyFeaturesField  E.==. field  E.^. StudyTermsId
-        E.on     $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
-        E.where_ $ feature E.^. StudyFeaturesUser   E.==. E.val uid
-        E.where_ $ feature E.^. StudyFeaturesValid  E.==. E.val True 
-        E.where_ $ feature E.^. StudyFeaturesType   E.==. E.val FieldPrimary
+        E.on     $   feature E.^. StudyFeaturesField  E.==. field  E.^. StudyTermsId
+        E.on     $   feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
+        E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
+              E.||. isPrimaryActiveUserStudyFeature feature
         return (feature E.^. StudyFeaturesId, degree, field)
     mkOptionList <$> mapM procOptions rawOptions
   where
+    isPrimaryActiveUserStudyFeature feature = case mbuid of
+      Nothing    -> E.val False
+      (Just uid) -> feature E.^. StudyFeaturesUser  E.==. E.val uid
+              E.&&. feature E.^. StudyFeaturesValid E.==. E.val True
+              E.&&. feature E.^. StudyFeaturesType  E.==. E.val FieldPrimary
+
+    procOptions :: (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option StudyFeaturesId)
     procOptions (E.Value sfid, Entity dgid StudyDegree{..}, Entity stid StudyTerms{..}) = do
       let dgname = fromMaybe (tshow dgid) (studyDegreeShorthand <|> studyDegreeName)
           stname = fromMaybe (tshow stid) (studyTermsShorthand  <|> studyTermsName )
diff --git a/test/Database.hs b/test/Database.hs
index 1d2b903ba..aa6d5a0f0 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -448,8 +448,8 @@ fillDb = do
     , courseRegisterFrom = Nothing
     , courseRegisterTo = Nothing
     , courseDeregisterUntil = Nothing
-    , courseRegisterSecret  = Nothing
-    , courseMaterialFree    = True
+    , courseRegisterSecret  = Just "dbs"
+    , courseMaterialFree    = False
     }
   insert_ $ CourseEdit gkleen now dbs
   void . insert' $ DegreeCourse dbs sdBsc sdInf

From e446641666507041ac9a3f50413b1ab28d767cbe Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 28 Feb 2019 18:04:22 +0100
Subject: [PATCH 13/56] Default offered; unnecessarily complicated due using 
 field studyFeature

---
 src/Handler/Course.hs                         | 27 ++++++++++---------
 src/Handler/Utils/Form.hs                     | 18 ++++++++++---
 .../register-form/register-form.hamlet        |  3 +++
 3 files changed, 31 insertions(+), 17 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index b4a0c0526..70e38ae21 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -264,7 +264,7 @@ getTermCourseListR tid = do
 getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCShowR tid ssh csh = do
   mbAid <- maybeAuthId
-  (course,schoolName,participants,registration,lecturers) <- runDB . maybeT notFound $ do
+  (course,schoolName,participants,registration,defSFid,lecturers) <- runDB . maybeT notFound $ do
     [(E.Entity cid course, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
        <- lift . E.select . E.from $
          \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
@@ -278,30 +278,31 @@ getCShowR tid ssh csh = do
                   E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
                   return ( E.countRows :: E.SqlExpr (E.Value Int64))
             return (course,school E.^. SchoolName, numParticipants, participant)
-
+    defSFid <- ifMaybeM mbAid Nothing $ \uid -> lift $ selectFirst [StudyFeaturesUser ==. uid, StudyFeaturesType ==. FieldPrimary, StudyFeaturesValid ==. True] [Desc StudyFeaturesUpdated, Desc StudyFeaturesDegree, Desc StudyFeaturesField] -- sorting by degree & field is an heuristic only, but this is okay for a default suggestion
     lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
       E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
       E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
       E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName ]
       return (user E.^. UserDisplayName, user E.^. UserSurname, user E.^. UserEmail)
-    return (course,schoolName,participants,registration,lecturers)
+    return (course,schoolName,participants,registration,entityKey <$> defSFid,lecturers)
 
   mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom    course
   mRegTo   <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo      course
   mDereg   <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
   mRegAt   <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
-  (regWidget, regEnctype) <- generateFormPost $ registerForm mbAid registration $ courseRegisterSecret course
+  (regWidget, regEnctype) <- generateFormPost $ registerForm mbAid registration defSFid $ courseRegisterSecret course
   registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
   siteLayout (toWgt $ courseName course) $ do
     setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
     $(widgetFile "course")
 
--- | Registration button with primary study features if logged in
--- , existing features if already registered
--- , and possibly a course secret
-registerForm :: Maybe UserId -> Maybe CourseParticipant -> Maybe Text -> Form (Maybe StudyFeaturesId, Bool)
+-- | Registration button with maybe a userid if logged in
+-- , maybe existing features if already registered
+-- , maybe some default study features
+-- , maybe a course secret
+registerForm :: Maybe UserId -> Maybe CourseParticipant -> Maybe StudyFeaturesId -> Maybe Text -> Form (Maybe StudyFeaturesId, Bool)
 -- unfinished WIP: must take study features if registred and show as mforced field
-registerForm loggedin participant msecret = identForm FIDcourseRegister $ \extra -> do
+registerForm loggedin participant defSFid msecret = identForm FIDcourseRegister $ \extra -> do
     -- secret fields
     (msecretRes', msecretView) <- case msecret of
       (Just _) | not isRegistered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
@@ -311,9 +312,9 @@ registerForm loggedin participant msecret = identForm FIDcourseRegister $ \extra
       Nothing -> return (Nothing,Nothing)
       Just _  -> bimap Just Just <$> case participant of
         Just CourseParticipant{courseParticipantField=Just sfid}
-                -> mopt (studyFeaturesPrimaryFieldFor [sfid] loggedin) (fslI MsgCourseStudyFeature)  (Just $ Just sfid)
-        _other  -> mopt (studyFeaturesPrimaryFieldFor [ ]    loggedin) (fslI MsgCourseStudyFeature
-                                                                 & setTooltip  MsgCourseStudyFeatureTooltip) Nothing
+                -> mforced (studyFeaturesPrimaryFieldFor [sfid] loggedin) (fslI MsgCourseStudyFeature) (Just sfid)
+        _other  -> mreq    (studyFeaturesPrimaryFieldFor [ ]    loggedin) (fslI MsgCourseStudyFeature
+                                                                 & setTooltip  MsgCourseStudyFeatureTooltip) (Just defSFid)
     -- button de-/register
     (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister isRegistered) "buttonField ignores settings anyway" Nothing
 
@@ -337,7 +338,7 @@ postCRegisterR tid ssh csh = do
       registration <- getBy (UniqueParticipant aid cid)
       return (cid, course, entityVal <$> registration)
   let isRegistered  = isJust registration
-  ((regResult,_), _) <- runFormPost $ registerForm (Just aid) registration $ courseRegisterSecret course
+  ((regResult,_), _) <- runFormPost $ registerForm (Just aid) registration Nothing $ courseRegisterSecret course
   formResult regResult $ \(mbSfId,codeOk) -> if
       | isRegistered -> do
           runDB $ deleteBy $ UniqueParticipant aid cid
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 3951be40a..708b2bb40 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -215,7 +215,7 @@ schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
 schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
 
 -- | Select one of the user's primary active courses, or from a given list of StudyFeatures (regardless of user)
-studyFeaturesPrimaryFieldFor :: [StudyFeaturesId] -> Maybe UserId -> Field Handler StudyFeaturesId
+studyFeaturesPrimaryFieldFor :: [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
 studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
     -- we need a join, so we cannot just use optionsPersistCryptoId
     rawOptions <- runDB $ E.select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` field) -> do
@@ -224,7 +224,7 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
         E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
               E.||. isPrimaryActiveUserStudyFeature feature
         return (feature E.^. StudyFeaturesId, degree, field)
-    mkOptionList <$> mapM procOptions rawOptions
+    mkOptionList . nonEmptyOptions <$> mapM procOptions rawOptions
   where
     isPrimaryActiveUserStudyFeature feature = case mbuid of
       Nothing    -> E.val False
@@ -232,17 +232,27 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
               E.&&. feature E.^. StudyFeaturesValid E.==. E.val True
               E.&&. feature E.^. StudyFeaturesType  E.==. E.val FieldPrimary
 
-    procOptions :: (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option StudyFeaturesId)
+    procOptions :: (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
     procOptions (E.Value sfid, Entity dgid StudyDegree{..}, Entity stid StudyTerms{..}) = do
       let dgname = fromMaybe (tshow dgid) (studyDegreeShorthand <|> studyDegreeName)
           stname = fromMaybe (tshow stid) (studyTermsShorthand  <|> studyTermsName )
       cfid <- encrypt sfid
       return Option
         { optionDisplay = stname <> " (" <> dgname <> ")"
-        , optionInternalValue = sfid
+        , optionInternalValue = Just sfid
         , optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId)
         }
 
+    nonEmptyOptions :: [Option (Maybe StudyFeaturesId)] -> [Option (Maybe StudyFeaturesId)]
+    nonEmptyOptions opts
+      | null opts = [ Option
+          { optionDisplay       = "-----"
+          , optionInternalValue = Nothing
+          , optionExternalValue = "-----"
+          } ]
+      | otherwise = opts
+
+
 uploadModeField :: Field Handler UploadMode
 uploadModeField = selectField optionsFinite
 
diff --git a/templates/widgets/register-form/register-form.hamlet b/templates/widgets/register-form/register-form.hamlet
index 769c98c3b..c9a9fa1a3 100644
--- a/templates/widgets/register-form/register-form.hamlet
+++ b/templates/widgets/register-form/register-form.hamlet
@@ -2,9 +2,12 @@ $# extra protects us against CSRF
 #{extra}
 $# Maybe display textField for passcode
 $maybe secretView <- msecretView
+  ^{fvLabel secretView}
   ^{fvInput secretView}
 $# Ask for associated primary field uf study, unless registered
 $maybe sfView <- msfView
+  ^{fvLabel sfView}
   ^{fvInput sfView}
+
 $# Always display register/deregister button
 ^{fvInput btnView}

From cf3a0b3d352d04df1b0bc3e60fdbcaf08d2b2812 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 28 Feb 2019 18:28:42 +0100
Subject: [PATCH 14/56] ToMarkup instances for StudyDegree and StudyTerms

---
 src/Handler/Utils/Form.hs |  1 +
 src/Model.hs              | 20 ++++++++++++++++++++
 2 files changed, 21 insertions(+)

diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 708b2bb40..1736f844f 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -215,6 +215,7 @@ schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
 schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
 
 -- | Select one of the user's primary active courses, or from a given list of StudyFeatures (regardless of user)
+-- (too many special cases, hence not used in course registration anymore)
 studyFeaturesPrimaryFieldFor :: [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
 studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
     -- we need a join, so we cannot just use optionsPersistCryptoId
diff --git a/src/Model.hs b/src/Model.hs
index 54acc1b28..f070b082b 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -19,6 +19,8 @@ import Data.Aeson (Value)
 import Data.CaseInsensitive (CI)
 import Data.CaseInsensitive.Instances ()
 
+import Text.Blaze (ToMarkup, toMarkup, Markup)
+
 import Utils.Message (MessageClass)
 import Settings.Cluster (ClusterSettingsKey)
 
@@ -41,3 +43,21 @@ deriving instance Binary (Key Term)
 
 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime
+
+-- Do these instances belong here?
+instance ToMarkup StudyDegree where
+  toMarkup StudyDegree{..} = toMarkup $
+    fromMaybe (tshow studyDegreeKey) (studyDegreeName <|> studyDegreeShorthand)
+
+shortStudyDegree :: StudyDegree -> Markup
+shortStudyDegree StudyDegree{..} = toMarkup $
+    fromMaybe (tshow studyDegreeKey) studyDegreeShorthand
+
+
+instance ToMarkup StudyTerms where
+  toMarkup StudyTerms{..} = toMarkup $
+    fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand)
+
+shortStudyTerms :: StudyTerms -> Markup
+shortStudyTerms StudyTerms{..} = toMarkup $
+    fromMaybe (tshow studyTermsKey) studyTermsShorthand

From fa0ce033ee7ffac2fd92198e9ff5317af7cf3b56 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Fri, 1 Mar 2019 11:36:13 +0100
Subject: [PATCH 15/56] Cannot Return a ValueList from a select. :(

---
 models/users          |  2 +-
 src/Handler/Course.hs | 18 +++++++++++++++---
 src/Model.hs          |  1 -
 3 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/models/users b/models/users
index 906219944..7903f5760 100644
--- a/models/users
+++ b/models/users
@@ -35,7 +35,7 @@ StudyFeatures  -- Abschluss, Studiengang, Haupt/Nebenfachh und Fachsemester
     updated       UTCTime default='NOW()' -- zuletzt als gültig gesehen
     valid         Bool default=true
     UniqueStudyFeatures user degree field type semester
-    -- UniqueUserSubject user degree field -- There exists a counterexample
+    -- UniqueUserSubject ubuser degree field -- There exists a counterexample
 StudyDegree   -- Studienabschluss
     key           Int
     shorthand     Text Maybe
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 70e38ae21..deb566519 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -659,12 +659,24 @@ forceUserTableType = id
 userTableQuery :: UserTableWhere -> UserTableExpr
    -> E.SqlQuery  ( E.SqlExpr (Entity User)
                   , E.SqlExpr (E.Value UTCTime)
-                  , E.SqlExpr (E.Value (Maybe CourseUserNoteId)))
+                  , E.SqlExpr (E.Value (Maybe CourseUserNoteId))
+                  , E.SqlExpr (E.ValueList (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms))
+                  )
 userTableQuery whereClause t@((user `E.InnerJoin` participant) `E.LeftOuterJoin` note) = do
   E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
   E.on $         participant E.^. CourseParticipantUser  E.==. user E.^. UserId
   E.where_ $ whereClause t
-  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId)
+  -- let feature = E.case_ [E.when_ (E.isNothing $ participant E.^. CourseParticipantField) E.then_ E.nothing]
+  --       (E.else_ features )
+  let dfeat :: _hole -- E.SqlQuery (E.ValueList (E.SqlExpr (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms)))
+      dfeat = E.subList_select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` terms) -> do
+              E.on $ feature E.^. StudyFeaturesField  E.==. terms  E.^. StudyTermsId
+              E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
+              E.where_ $ (E.just (feature E.^. StudyFeaturesId)) E.==. (participant E.^. CourseParticipantField)
+              E.limit 1
+              return (feature,degree,terms)
+  -- tr <- dfeat
+  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, dfeat)
 
 instance HasEntity UserTableData User where
   hasEntity = _dbrOutput . _1
@@ -712,7 +724,7 @@ makeCourseUserTable whereClause colChoices psValidator =
       dbtStyle     = def
       dbtSQLQuery  = userTableQuery whereClause
       dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note) = user E.^. UserId
-      dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId) -> return (user, registrationTime, userNoteId)
+      dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId,_) -> return (user, registrationTime, userNoteId) -- TODO continue here
       dbtColonnade = colChoices
       dbtSorting   = Map.fromList [] -- TODO
       dbtFilter    = Map.fromList [] -- TODO
diff --git a/src/Model.hs b/src/Model.hs
index f070b082b..92df5772e 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -53,7 +53,6 @@ shortStudyDegree :: StudyDegree -> Markup
 shortStudyDegree StudyDegree{..} = toMarkup $
     fromMaybe (tshow studyDegreeKey) studyDegreeShorthand
 
-
 instance ToMarkup StudyTerms where
   toMarkup StudyTerms{..} = toMarkup $
     fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand)

From 382a34f970f483f85c68565a5b8624ffb60e4746 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Fri, 1 Mar 2019 12:46:28 +0100
Subject: [PATCH 16/56] commented to compile

---
 src/Handler/Course.hs | 21 ++++++++++-----------
 1 file changed, 10 insertions(+), 11 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index deb566519..dc6ae10aa 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -660,7 +660,7 @@ userTableQuery :: UserTableWhere -> UserTableExpr
    -> E.SqlQuery  ( E.SqlExpr (Entity User)
                   , E.SqlExpr (E.Value UTCTime)
                   , E.SqlExpr (E.Value (Maybe CourseUserNoteId))
-                  , E.SqlExpr (E.ValueList (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms))
+                  -- , E.SqlExpr (E.ValueList (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms))
                   )
 userTableQuery whereClause t@((user `E.InnerJoin` participant) `E.LeftOuterJoin` note) = do
   E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
@@ -668,15 +668,14 @@ userTableQuery whereClause t@((user `E.InnerJoin` participant) `E.LeftOuterJoin`
   E.where_ $ whereClause t
   -- let feature = E.case_ [E.when_ (E.isNothing $ participant E.^. CourseParticipantField) E.then_ E.nothing]
   --       (E.else_ features )
-  let dfeat :: _hole -- E.SqlQuery (E.ValueList (E.SqlExpr (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms)))
-      dfeat = E.subList_select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` terms) -> do
-              E.on $ feature E.^. StudyFeaturesField  E.==. terms  E.^. StudyTermsId
-              E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
-              E.where_ $ (E.just (feature E.^. StudyFeaturesId)) E.==. (participant E.^. CourseParticipantField)
-              E.limit 1
-              return (feature,degree,terms)
-  -- tr <- dfeat
-  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, dfeat)
+  -- let dfeat :: _hole -- E.SqlQuery (E.ValueList (E.SqlExpr (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms)))
+  --     dfeat = E.subList_select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` terms) -> do
+  --             E.on $ feature E.^. StudyFeaturesField  E.==. terms  E.^. StudyTermsId
+  --             E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
+  --             E.where_ $ (E.just (feature E.^. StudyFeaturesId)) E.==. (participant E.^. CourseParticipantField)
+  --             E.limit 1
+  --             return (feature,degree,terms)
+  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId)
 
 instance HasEntity UserTableData User where
   hasEntity = _dbrOutput . _1
@@ -724,7 +723,7 @@ makeCourseUserTable whereClause colChoices psValidator =
       dbtStyle     = def
       dbtSQLQuery  = userTableQuery whereClause
       dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note) = user E.^. UserId
-      dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId,_) -> return (user, registrationTime, userNoteId) -- TODO continue here
+      dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId) -> return (user, registrationTime, userNoteId)
       dbtColonnade = colChoices
       dbtSorting   = Map.fromList [] -- TODO
       dbtFilter    = Map.fromList [] -- TODO

From 56c25c133a871e111ca6281efc4c63676aa6289d Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Tue, 5 Mar 2019 17:20:34 +0100
Subject: [PATCH 17/56] Alternative Query Attempt

---
 src/Handler/Course.hs            | 25 +++++++++++++++++++++++++
 src/Handler/Utils/Database.hs    | 23 +++++++++++++++++++++++
 src/Handler/Utils/Table/Cells.hs |  2 ++
 3 files changed, 50 insertions(+)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index dc6ae10aa..b4d40a905 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -649,6 +649,31 @@ validateCourse CourseForm{..} =
 --------------------
 -- CourseUserTable
 
+
+userTableQuery' :: CourseId ->  E.Esqueleto query expr backend =>
+                         E.LeftOuterJoin
+                           (E.LeftOuterJoin
+                              (E.InnerJoin
+                                 (expr (Entity User)) (expr (Entity CourseParticipant)))
+                              (expr (Maybe (Entity CourseUserNote))))
+                           (E.InnerJoin
+                              (E.InnerJoin
+                                 (expr (Maybe (Entity StudyFeatures)))
+                                 (expr (Maybe (Entity StudyDegree))))
+                              (expr (Maybe (Entity StudyTerms))))
+                         -> query (expr (Entity User), expr (E.Value UTCTime),
+                                   expr (E.Value (Maybe (Key CourseUserNote))),
+                                   (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms))))
+userTableQuery' cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures@(features `E.InnerJoin` degree `E.InnerJoin` terms)) = do
+  E.on $ participant E.^. CourseParticipantField E.==. features E.?. StudyFeaturesId
+  --(features, degree, terms) <- studyFeaturesQuery (participant E.^. CourseParticipantField) studyFeatures
+  E.on $ terms  E.?. StudyTermsId  E.==. features E.?. StudyFeaturesField
+  E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree
+  E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
+  E.on $         participant E.^. CourseParticipantUser  E.==. user E.^. UserId
+  E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
+  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, (features,degree,terms))
+
 type UserTableExpr   = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
 type UserTableWhere  = UserTableExpr -> E.SqlExpr (E.Value Bool)
 type UserTableData   = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId)
diff --git a/src/Handler/Utils/Database.hs b/src/Handler/Utils/Database.hs
index 386fe0983..d558e2c7d 100644
--- a/src/Handler/Utils/Database.hs
+++ b/src/Handler/Utils/Database.hs
@@ -1,6 +1,7 @@
 module Handler.Utils.Database
   ( getSchoolsOf
   , makeSchoolDictionaryDB, makeSchoolDictionary
+  , studyFeaturesQuery, studyFeaturesQuery'
   ) where
 
 import Import
@@ -29,3 +30,25 @@ getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from
   E.where_ $ urights E.^. uuser   E.==. E.val uid
   E.orderBy [E.asc $ school E.^.SchoolName]
   return $ school E.^. SchoolName
+
+
+studyFeaturesQuery :: E.Esqueleto query expr backend
+  => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId
+  -> (expr (Entity StudyFeatures)) `E.InnerJoin` (expr (Entity StudyDegree)) `E.InnerJoin` (expr (Entity StudyTerms))
+  -> query (expr (Entity StudyFeatures), expr (Entity StudyDegree), expr (Entity StudyTerms))
+studyFeaturesQuery sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
+  E.on $ terms  E.^. StudyTermsId  E.==. features E.^. StudyFeaturesField
+  E.on $ degree E.^. StudyDegreeId E.==. features E.^. StudyFeaturesDegree
+  E.where_ $ (E.just (features E.^. StudyFeaturesId)) E.==. sfId
+  return (features, degree, terms)
+
+-- | Variant of @studyFeaturesQuery@ to be used in outer joins
+studyFeaturesQuery' :: E.Esqueleto query expr backend
+  => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId
+  -> (expr (Maybe (Entity StudyFeatures)) `E.InnerJoin` (expr (Maybe (Entity StudyDegree))) `E.InnerJoin` (expr (Maybe (Entity StudyTerms))))
+  -> query (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms)))
+studyFeaturesQuery' sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
+  E.on $ terms  E.?. StudyTermsId  E.==. features E.?. StudyFeaturesField
+  E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree
+  E.where_ $ features E.?. StudyFeaturesId E.==. sfId
+  return (features, degree, terms)
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index dc86454dd..c6ec3e24d 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -41,9 +41,11 @@ maybeCell =flip foldMap
 ---------------------
 -- Icon cells
 
+-- | Maybe display a tickmark/checkmark icon
 tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
 tickmarkCell = cell . toWidget . hasTickmark
 
+-- | Maybe display comment icon linking a given URL or show nothing at all
 commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
 commentCell Nothing     = mempty
 commentCell (Just link) = anchorCell link icon

From 484d99305d4a4f48c48df2cedb244b08a01c52f4 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Tue, 5 Mar 2019 19:06:12 +0100
Subject: [PATCH 18/56] Showing field and degrees compiles, join-on needs
 testing

---
 messages/uniworx/de.msg          |  2 +
 src/Handler/Course.hs            | 84 +++++++++++++-------------------
 src/Handler/Utils/Table/Cells.hs |  6 ++-
 src/Utils/Lens.hs                |  2 +
 4 files changed, 43 insertions(+), 51 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 713524bf1..38c834069 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -405,6 +405,8 @@ SheetCorrectorSubmissionsTip: Abgabe erfolgt über ein Uni2work-externes Verfahr
 
 SubmissionNoUploadExpected: Es ist keine Abgabe von Dateien vorgesehen.
 
+StudyFeatureAge: Fachsemester
+StudyFeatureDegree: Abschluss
 FieldPrimary: Hauptfach
 FieldSecondary: Nebenfach
 
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index b4d40a905..953d349d3 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -650,7 +650,16 @@ validateCourse CourseForm{..} =
 -- CourseUserTable
 
 
-userTableQuery' :: CourseId ->  E.Esqueleto query expr backend =>
+
+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)))
+type UserTableData   = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms))
+
+forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
+forceUserTableType = id
+
+userTableQuery :: CourseId ->  E.Esqueleto query expr backend =>
                          E.LeftOuterJoin
                            (E.LeftOuterJoin
                               (E.InnerJoin
@@ -664,7 +673,7 @@ userTableQuery' :: CourseId ->  E.Esqueleto query expr backend =>
                          -> query (expr (Entity User), expr (E.Value UTCTime),
                                    expr (E.Value (Maybe (Key CourseUserNote))),
                                    (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms))))
-userTableQuery' cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures@(features `E.InnerJoin` degree `E.InnerJoin` terms)) = do
+userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures@(features `E.InnerJoin` degree `E.InnerJoin` terms)) = do
   E.on $ participant E.^. CourseParticipantField E.==. features E.?. StudyFeaturesId
   --(features, degree, terms) <- studyFeaturesQuery (participant E.^. CourseParticipantField) studyFeatures
   E.on $ terms  E.?. StudyTermsId  E.==. features E.?. StudyFeaturesField
@@ -674,33 +683,6 @@ userTableQuery' cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.
   E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
   return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, (features,degree,terms))
 
-type UserTableExpr   = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
-type UserTableWhere  = UserTableExpr -> E.SqlExpr (E.Value Bool)
-type UserTableData   = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId)
-
-forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
-forceUserTableType = id
-
-userTableQuery :: UserTableWhere -> UserTableExpr
-   -> E.SqlQuery  ( E.SqlExpr (Entity User)
-                  , E.SqlExpr (E.Value UTCTime)
-                  , E.SqlExpr (E.Value (Maybe CourseUserNoteId))
-                  -- , E.SqlExpr (E.ValueList (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms))
-                  )
-userTableQuery whereClause t@((user `E.InnerJoin` participant) `E.LeftOuterJoin` note) = do
-  E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
-  E.on $         participant E.^. CourseParticipantUser  E.==. user E.^. UserId
-  E.where_ $ whereClause t
-  -- let feature = E.case_ [E.when_ (E.isNothing $ participant E.^. CourseParticipantField) E.then_ E.nothing]
-  --       (E.else_ features )
-  -- let dfeat :: _hole -- E.SqlQuery (E.ValueList (E.SqlExpr (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms)))
-  --     dfeat = E.subList_select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` terms) -> do
-  --             E.on $ feature E.^. StudyFeaturesField  E.==. terms  E.^. StudyTermsId
-  --             E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
-  --             E.where_ $ (E.just (feature E.^. StudyFeaturesId)) E.==. (participant E.^. CourseParticipantField)
-  --             E.limit 1
-  --             return (feature,degree,terms)
-  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId)
 
 instance HasEntity UserTableData User where
   hasEntity = _dbrOutput . _1
@@ -715,40 +697,40 @@ _userTableRegistration = _dbrOutput . _2
 _userTableNote :: Lens' UserTableData (Maybe CourseUserNoteId)
 _userTableNote = _dbrOutput . _3
 
--- default Where-Clause
-courseIs :: CourseId -> UserTableWhere
-courseIs cid ((_user `E.InnerJoin` participant) `E.LeftOuterJoin` _note) = participant E.^. CourseParticipantCourse E.==. E.val cid
+_userTableFeatures :: Lens' UserTableData (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms)
+_userTableFeatures = _dbrOutput . _4
 
 
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
 colUserComment tid ssh csh =
     sortable (Just "course-user-note") (i18nCell MsgCourseUserNote)
-      $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey) } ->
+      $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey,_) } ->
         maybeEmpty mbNoteKey $ const $
           anchorCellM (courseLink <$> encrypt uid) (toWidget $ hasComment True)
   where
     courseLink = CourseR tid ssh csh . CUserR
 
-    --  makeCourseUserTable :: (ToSortable h, Functor h) =>
-    --                          UserTableWhere
-    --                          -> Colonnade
-    --                               h
-    --                               (DBRow
-    --                                  (Entity User, E.Value UTCTime,
-    --                                   E.Value (Maybe CourseUserNoteId)))
-    --                               (DBCell (HandlerT UniWorX IO) ())
-    --                          -> PSValidator (HandlerT UniWorX IO) ()
-    --                          -> ReaderT SqlBackend (HandlerT UniWorX IO) Widget
+colUserSemester :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
+colUserSemester = sortable (Just "course-user-semesternr") (i18nCell MsgStudyFeatureAge) $
+    foldMap numCell . preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester)
 
-makeCourseUserTable :: UserTableWhere -> _ -> _ -> DB Widget
-makeCourseUserTable whereClause colChoices psValidator =
+colUserField :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
+colUserField = sortable (Just "course-user-field") (i18nCell MsgCourseStudyFeature) $
+    foldMap htmlCell . view (_userTableFeatures . _3)
+
+colUserDegree :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
+colUserDegree = sortable (Just "course-user-degree") (i18nCell MsgStudyFeatureDegree) $
+    foldMap htmlCell . preview (_userTableFeatures . _2 . _Just)
+
+makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget
+makeCourseUserTable cid colChoices psValidator =
   -- return [whamlet|TODO|] -- TODO
   -- -- psValidator has default sorting and filtering
   let dbtIdent     = "courseUsers" :: Text
       dbtStyle     = def
-      dbtSQLQuery  = userTableQuery whereClause
-      dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note) = user E.^. UserId
-      dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId) -> return (user, registrationTime, userNoteId)
+      dbtSQLQuery  = userTableQuery cid
+      dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserId
+      dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms))
       dbtColonnade = colChoices
       dbtSorting   = Map.fromList [] -- TODO
       dbtFilter    = Map.fromList [] -- TODO
@@ -761,16 +743,18 @@ getCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCUsersR tid ssh csh = do
   Entity cid course <- runDB $ getBy404 $ TermSchoolCourseShort tid ssh csh
   let heading = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{display tid}|]
-      whereClause = courseIs cid
       colChoices  = mconcat
         [ colUserParticipantLink tid ssh csh
         , colUserEmail
         , colUserMatriclenr
+        , colUserDegree
+        , colUserField
+        , colUserSemester
         , sortable (Just "registration") (i18nCell MsgRegisteredHeader) (dateCell . view _userTableRegistration)
         , colUserComment tid ssh csh
         ]
       psValidator = def
-  tableWidget <- runDB $ makeCourseUserTable whereClause colChoices psValidator
+  tableWidget <- runDB $ makeCourseUserTable cid colChoices psValidator
   siteLayout heading $ do
     setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
     -- TODO: creat hamlet wrapper
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index c6ec3e24d..47f4f6e8b 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -9,6 +9,8 @@ import Data.Monoid (Any(..))
 import Control.Monad.Writer.Class (MonadWriter(..))
 import Control.Monad.Trans.Writer (WriterT)
 
+import Text.Blaze (ToMarkup(..))
+
 import Utils.Lens
 import Handler.Utils
 
@@ -35,8 +37,10 @@ writerCell :: IsDBTable m w => WriterT w m () -> DBCell m w
 writerCell act = mempty & cellContents %~ (<* act)
 
 maybeCell :: (IsDBTable m a) => Maybe a -> (a -> DBCell m a) -> DBCell m a
-maybeCell =flip foldMap
+maybeCell = flip foldMap
 
+htmlCell :: (IsDBTable m a, ToMarkup c) => c -> DBCell m a
+htmlCell = cell . toWidget . toMarkup
 
 ---------------------
 -- Icon cells
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index b8ac05e63..fc7e7a18e 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -80,6 +80,8 @@ makeLenses_ ''SheetType
 
 makePrisms ''AuthResult
 
+makeLenses_ ''StudyFeatures
+
 -- makeClassy_ ''Load
 
 

From 729831b0bf4e8bab2ef6d37f75bdf64b0773f05e Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 6 Mar 2019 17:50:22 +0100
Subject: [PATCH 19/56] Probably fixes the course participant list?

---
 messages/uniworx/de.msg       |  3 ++-
 src/Foundation.hs             | 10 ++++----
 src/Handler/Course.hs         | 45 +++++++++++++++++++++--------------
 src/Handler/Utils/Database.hs |  6 ++---
 src/Handler/Utils/Form.hs     | 11 +++++----
 5 files changed, 44 insertions(+), 31 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 38c834069..8d51a6547 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -53,7 +53,7 @@ CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
 CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
 CourseRegisterOk: Sie wurden angemeldet
 CourseDeregisterOk: Sie wurden abgemeldet
-CourseStudyFeature: Asoziiertes Hauptfach
+CourseStudyFeature: Assoziiertes Hauptfach
 CourseStudyFeatureTooltip: Korrekte Angabe kann Notenweiterleitungen beschleunigen
 CourseSecretWrong: Falsches Kennwort
 CourseSecret: Zugangspasswort
@@ -409,6 +409,7 @@ StudyFeatureAge: Fachsemester
 StudyFeatureDegree: Abschluss
 FieldPrimary: Hauptfach
 FieldSecondary: Nebenfach
+NoPrimaryStudyField: (kein Hauptfach registriert)
 
 MailTestFormEmail: Email-Addresse
 MailTestFormLanguages: Spracheinstellungen
diff --git a/src/Foundation.hs b/src/Foundation.hs
index fde6cf714..e688b03bb 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1102,10 +1102,12 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb  CourseNewR                  = return ("Neu"      , Just CourseListR)
   breadcrumb (CourseR tid ssh csh CShowR) = return (CI.original csh, Just $ TermSchoolCourseListR tid ssh)
   --         (CourseR tid ssh csh CRegisterR) -- is POST only
-  breadcrumb (CourseR tid ssh csh CEditR)     = return ("Editieren", Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben",Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen"  , Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu",       Just $ CourseR tid ssh csh SheetListR)
+  breadcrumb (CourseR tid ssh csh CEditR)     = return ("Editieren"  , Just $ CourseR tid ssh csh CShowR)
+  breadcrumb (CourseR tid ssh csh CUsersR)    = return ("Anmeldungen", Just $ CourseR tid ssh csh CShowR)
+  breadcrumb (CourseR tid ssh csh (CUserR _)) = return ("Teilnehmer" , Just $ CourseR tid ssh csh CShowR)
+  breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR)
+  breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen"    , Just $ CourseR tid ssh csh CShowR)
+  breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu",         Just $ CourseR tid ssh csh SheetListR)
 
   breadcrumb (CSheetR tid ssh csh shn SShowR) = return (CI.original shn, Just $ CourseR tid ssh csh SheetListR)
   breadcrumb (CSheetR tid ssh csh shn SEditR) = return ("Edit",    Just $ CSheetR tid ssh csh shn SShowR)
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 953d349d3..f7f281c92 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -274,6 +274,7 @@ getCShowR tid ssh csh = do
             E.where_ $ course E.^. CourseTerm      E.==. E.val tid
                  E.&&. course E.^. CourseSchool    E.==. E.val ssh
                  E.&&. course E.^. CourseShorthand E.==. E.val csh
+            E.limit 1 -- we know that there is at most one match, but we tell the DB this info too
             let numParticipants = E.sub_select . E.from $ \part -> do
                   E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
                   return ( E.countRows :: E.SqlExpr (E.Value Int64))
@@ -646,11 +647,10 @@ validateCourse CourseForm{..} =
   ] ]
 
 
+
 --------------------
 -- CourseUserTable
 
-
-
 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)))
@@ -659,25 +659,34 @@ type UserTableData   = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (May
 forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
 forceUserTableType = id
 
-userTableQuery :: CourseId ->  E.Esqueleto query expr backend =>
-                         E.LeftOuterJoin
-                           (E.LeftOuterJoin
-                              (E.InnerJoin
-                                 (expr (Entity User)) (expr (Entity CourseParticipant)))
-                              (expr (Maybe (Entity CourseUserNote))))
-                           (E.InnerJoin
-                              (E.InnerJoin
-                                 (expr (Maybe (Entity StudyFeatures)))
-                                 (expr (Maybe (Entity StudyDegree))))
-                              (expr (Maybe (Entity StudyTerms))))
-                         -> query (expr (Entity User), expr (E.Value UTCTime),
-                                   expr (E.Value (Maybe (Key CourseUserNote))),
-                                   (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms))))
+-- userTableQuery :: CourseId ->  E.Esqueleto query expr backend =>
+--                          E.LeftOuterJoin
+--                            (E.LeftOuterJoin
+--                               (E.InnerJoin
+--                                  (expr (Entity User)) (expr (Entity CourseParticipant)))
+--                               (expr (Maybe (Entity CourseUserNote))))
+--                            (E.InnerJoin
+--                               (E.InnerJoin
+--                                  (expr (Maybe (Entity StudyFeatures)))
+--                                  (expr (Maybe (Entity StudyDegree))))
+--                               (expr (Maybe (Entity StudyTerms))))
+--                          -> query (expr (Entity User), expr (E.Value UTCTime),
+--                                    expr (E.Value (Maybe (Key CourseUserNote))),
+--                                    (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms))))
+userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery (E.SqlExpr (Entity User)
+                                                          ,E.SqlExpr (E.Value UTCTime)
+                                                          ,E.SqlExpr (E.Value (Maybe (Key CourseUserNote)))
+                                                          ,(E.SqlExpr (Maybe (Entity StudyFeatures))
+                                                          , E.SqlExpr (Maybe (Entity StudyDegree))
+                                                          , E.SqlExpr (Maybe (Entity StudyTerms))
+                                                          ))
+
 userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures@(features `E.InnerJoin` degree `E.InnerJoin` terms)) = do
-  E.on $ participant E.^. CourseParticipantField E.==. features E.?. StudyFeaturesId
-  --(features, degree, terms) <- studyFeaturesQuery (participant E.^. CourseParticipantField) studyFeatures
+  -- Order of nested joins unclear, but this one works somehow:
   E.on $ terms  E.?. StudyTermsId  E.==. features E.?. StudyFeaturesField
   E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree
+  E.on $ participant E.^. CourseParticipantField E.==. features E.?. StudyFeaturesId
+  --(features, degree, terms) <- studyFeaturesQuery (participant E.^. CourseParticipantField) studyFeatures
   E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
   E.on $         participant E.^. CourseParticipantUser  E.==. user E.^. UserId
   E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
diff --git a/src/Handler/Utils/Database.hs b/src/Handler/Utils/Database.hs
index d558e2c7d..05d44c8ad 100644
--- a/src/Handler/Utils/Database.hs
+++ b/src/Handler/Utils/Database.hs
@@ -34,18 +34,18 @@ getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from
 
 studyFeaturesQuery :: E.Esqueleto query expr backend
   => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId
-  -> (expr (Entity StudyFeatures)) `E.InnerJoin` (expr (Entity StudyDegree)) `E.InnerJoin` (expr (Entity StudyTerms))
+  -> expr (Entity StudyFeatures) `E.InnerJoin` expr (Entity StudyDegree) `E.InnerJoin` expr (Entity StudyTerms)
   -> query (expr (Entity StudyFeatures), expr (Entity StudyDegree), expr (Entity StudyTerms))
 studyFeaturesQuery sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
   E.on $ terms  E.^. StudyTermsId  E.==. features E.^. StudyFeaturesField
   E.on $ degree E.^. StudyDegreeId E.==. features E.^. StudyFeaturesDegree
-  E.where_ $ (E.just (features E.^. StudyFeaturesId)) E.==. sfId
+  E.where_ $ E.just (features E.^. StudyFeaturesId) E.==. sfId
   return (features, degree, terms)
 
 -- | Variant of @studyFeaturesQuery@ to be used in outer joins
 studyFeaturesQuery' :: E.Esqueleto query expr backend
   => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId
-  -> (expr (Maybe (Entity StudyFeatures)) `E.InnerJoin` (expr (Maybe (Entity StudyDegree))) `E.InnerJoin` (expr (Maybe (Entity StudyTerms))))
+  -> (expr (Maybe (Entity StudyFeatures)) `E.InnerJoin` expr (Maybe (Entity StudyDegree)) `E.InnerJoin` expr (Maybe (Entity StudyTerms)))
   -> query (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms)))
 studyFeaturesQuery' sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
   E.on $ terms  E.?. StudyTermsId  E.==. features E.?. StudyFeaturesField
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 1736f844f..6571849fb 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -225,7 +225,8 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
         E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
               E.||. isPrimaryActiveUserStudyFeature feature
         return (feature E.^. StudyFeaturesId, degree, field)
-    mkOptionList . nonEmptyOptions <$> mapM procOptions rawOptions
+    mr <- getMessageRender
+    mkOptionList . nonEmptyOptions (mr MsgNoPrimaryStudyField) <$> mapM procOptions rawOptions
   where
     isPrimaryActiveUserStudyFeature feature = case mbuid of
       Nothing    -> E.val False
@@ -244,12 +245,12 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
         , optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId)
         }
 
-    nonEmptyOptions :: [Option (Maybe StudyFeaturesId)] -> [Option (Maybe StudyFeaturesId)]
-    nonEmptyOptions opts
+    nonEmptyOptions :: Text -> [Option (Maybe StudyFeaturesId)] -> [Option (Maybe StudyFeaturesId)]
+    nonEmptyOptions emptyOpt opts
       | null opts = [ Option
-          { optionDisplay       = "-----"
+          { optionDisplay       = emptyOpt
           , optionInternalValue = Nothing
-          , optionExternalValue = "-----"
+          , optionExternalValue = "NoPrimaryStudyField"
           } ]
       | otherwise = opts
 

From 4253390e930f4073af09b19080b6a9573d35f884 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Fri, 8 Mar 2019 10:46:47 +0100
Subject: [PATCH 20/56] Study-Features-Subquery extracted

---
 src/Handler/Course.hs         | 40 ++++++++++-------------------------
 src/Handler/Utils/Database.hs | 35 ++++++++++++++++++------------
 start.sh                      |  2 +-
 3 files changed, 34 insertions(+), 43 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index f7f281c92..0da847ef6 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -11,6 +11,7 @@ import Handler.Utils
 import Handler.Utils.Table.Cells
 import Handler.Utils.Course
 import Handler.Utils.Delete
+import Handler.Utils.Database
 
 -- import Data.Time
 -- import qualified Data.Text as T
@@ -653,44 +654,25 @@ validateCourse CourseForm{..} =
 
 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 StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms)))
 type UserTableData   = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms))
 
 forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
 forceUserTableType = id
 
--- userTableQuery :: CourseId ->  E.Esqueleto query expr backend =>
---                          E.LeftOuterJoin
---                            (E.LeftOuterJoin
---                               (E.InnerJoin
---                                  (expr (Entity User)) (expr (Entity CourseParticipant)))
---                               (expr (Maybe (Entity CourseUserNote))))
---                            (E.InnerJoin
---                               (E.InnerJoin
---                                  (expr (Maybe (Entity StudyFeatures)))
---                                  (expr (Maybe (Entity StudyDegree))))
---                               (expr (Maybe (Entity StudyTerms))))
---                          -> query (expr (Entity User), expr (E.Value UTCTime),
---                                    expr (E.Value (Maybe (Key CourseUserNote))),
---                                    (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms))))
-userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery (E.SqlExpr (Entity User)
-                                                          ,E.SqlExpr (E.Value UTCTime)
-                                                          ,E.SqlExpr (E.Value (Maybe (Key CourseUserNote)))
-                                                          ,(E.SqlExpr (Maybe (Entity StudyFeatures))
-                                                          , E.SqlExpr (Maybe (Entity StudyDegree))
-                                                          , E.SqlExpr (Maybe (Entity StudyTerms))
-                                                          ))
+userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User)
+                                                          , E.SqlExpr (E.Value UTCTime)
+                                                          , E.SqlExpr (E.Value (Maybe (Key CourseUserNote)))
+                                                          , StudyFeaturesDescription')
 
-userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures@(features `E.InnerJoin` degree `E.InnerJoin` terms)) = do
-  -- Order of nested joins unclear, but this one works somehow:
-  E.on $ terms  E.?. StudyTermsId  E.==. features E.?. StudyFeaturesField
-  E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree
-  E.on $ participant E.^. CourseParticipantField E.==. features E.?. StudyFeaturesId
-  --(features, degree, terms) <- studyFeaturesQuery (participant E.^. CourseParticipantField) studyFeatures
+userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures) = do
+  -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis
+  features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures
   E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
   E.on $         participant E.^. CourseParticipantUser  E.==. user E.^. UserId
   E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
-  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, (features,degree,terms))
+  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, features)
 
 
 instance HasEntity UserTableData User where
diff --git a/src/Handler/Utils/Database.hs b/src/Handler/Utils/Database.hs
index 05d44c8ad..83b299a94 100644
--- a/src/Handler/Utils/Database.hs
+++ b/src/Handler/Utils/Database.hs
@@ -1,6 +1,7 @@
 module Handler.Utils.Database
   ( getSchoolsOf
   , makeSchoolDictionaryDB, makeSchoolDictionary
+  , StudyFeaturesDescription'
   , studyFeaturesQuery, studyFeaturesQuery'
   ) where
 
@@ -32,23 +33,31 @@ getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from
   return $ school E.^. SchoolName
 
 
+-- | Sub-Query to retrieve StudyFeatures with their human-readable names
 studyFeaturesQuery :: E.Esqueleto query expr backend
-  => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId
+  => expr (E.Value StudyFeaturesId) -- ^ query is joined on this @StudyFeaturesId@
   -> expr (Entity StudyFeatures) `E.InnerJoin` expr (Entity StudyDegree) `E.InnerJoin` expr (Entity StudyTerms)
   -> query (expr (Entity StudyFeatures), expr (Entity StudyDegree), expr (Entity StudyTerms))
-studyFeaturesQuery sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
-  E.on $ terms  E.^. StudyTermsId  E.==. features E.^. StudyFeaturesField
-  E.on $ degree E.^. StudyDegreeId E.==. features E.^. StudyFeaturesDegree
-  E.where_ $ E.just (features E.^. StudyFeaturesId) E.==. sfId
+studyFeaturesQuery studyFeaturesId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
+  E.on $ terms    E.^. StudyTermsId    E.==. features E.^. StudyFeaturesField
+  E.on $ degree   E.^. StudyDegreeId   E.==. features E.^. StudyFeaturesDegree
+  E.on $ features E.^. StudyFeaturesId E.==. studyFeaturesId
   return (features, degree, terms)
 
+type StudyFeaturesDescription' =
+  ( E.SqlExpr (Maybe (Entity StudyFeatures))
+  , E.SqlExpr (Maybe (Entity StudyDegree))
+  , E.SqlExpr (Maybe (Entity StudyTerms))
+  )
+
 -- | Variant of @studyFeaturesQuery@ to be used in outer joins
-studyFeaturesQuery' :: E.Esqueleto query expr backend
-  => expr (E.Value (Maybe StudyFeaturesId)) -- ^ query is filtered by StudyFeatureId
-  -> (expr (Maybe (Entity StudyFeatures)) `E.InnerJoin` expr (Maybe (Entity StudyDegree)) `E.InnerJoin` expr (Maybe (Entity StudyTerms)))
-  -> query (expr (Maybe (Entity StudyFeatures)), expr (Maybe (Entity StudyDegree)), expr (Maybe (Entity StudyTerms)))
-studyFeaturesQuery' sfId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
-  E.on $ terms  E.?. StudyTermsId  E.==. features E.?. StudyFeaturesField
-  E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree
-  E.where_ $ features E.?. StudyFeaturesId E.==. sfId
+--   Sub-Query to retrieve StudyFeatures with their human-readable names
+studyFeaturesQuery'
+  :: E.SqlExpr (E.Value (Maybe StudyFeaturesId)) -- ^ query is joined on this @Maybe StudyFeaturesId@
+  -> (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms)))
+  -> E.SqlQuery StudyFeaturesDescription'
+studyFeaturesQuery' studyFeatureId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
+  E.on $ terms    E.?. StudyTermsId    E.==. features E.?. StudyFeaturesField
+  E.on $ degree   E.?. StudyDegreeId   E.==. features E.?. StudyFeaturesDegree
+  E.on $ features E.?. StudyFeaturesId E.==. studyFeatureId
   return (features, degree, terms)
diff --git a/start.sh b/start.sh
index 24abcd36c..b72d043c2 100755
--- a/start.sh
+++ b/start.sh
@@ -2,7 +2,7 @@
 
 unset HOST
 export DETAILED_LOGGING=true
-export LOG_ALL=true
+export LOG_ALL=false
 export LOGLEVEL=info
 export DUMMY_LOGIN=true
 export ALLOW_DEPRECATED=true

From 2ddda4578eeb452c0cd976583d85a4b851df0257 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Fri, 8 Mar 2019 17:55:13 +0100
Subject: [PATCH 21/56] Generic Columns module allowing generic sorting and
 filtering. Done for an initial part of course participant table.

---
 build.sh                           |  1 +
 src/Database/Esqueleto/Utils.hs    | 21 ++++++++
 src/Handler/Course.hs              | 65 ++++++++++++++++++----
 src/Handler/Utils/Table/Cells.hs   | 27 ----------
 src/Handler/Utils/Table/Columns.hs | 87 ++++++++++++++++++++++++++++++
 src/Utils.hs                       | 10 +++-
 6 files changed, 172 insertions(+), 39 deletions(-)
 create mode 100644 src/Handler/Utils/Table/Columns.hs

diff --git a/build.sh b/build.sh
index 991d2ff3c..13a8b2490 100755
--- a/build.sh
+++ b/build.sh
@@ -1,3 +1,4 @@
 #!/usr/bin/env bash
 
 exec -- stack build --fast --flag uniworx:library-only --flag uniworx:dev
+echo Build task completed.
diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 158fa5bea..5f904f6f3 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -5,9 +5,11 @@ module Database.Esqueleto.Utils
   , isInfixOf, hasInfix
   , any, all
   , SqlIn(..)
+  , mkInFilter
   ) where
 
 import ClassyPrelude.Yesod hiding (isInfixOf, any, all)
+import qualified Data.Set as Set
 import qualified Data.Foldable as F
 import qualified Database.Esqueleto as E
 import Database.Esqueleto.Utils.TH
@@ -51,3 +53,22 @@ all :: Foldable f =>
 all test = F.foldr (\needle acc -> acc E.&&. test needle) true
 
 $(sqlInTuples [2..16])
+
+
+-- | generic filter creation for dbTable
+--   Given a lens-like function, make filter
+-- What I thought:
+-- mkFilter :: (Foldable f, E.From query expr backend a)
+--    => (a -> E.SqlExpr (E.Value b))
+--    -> a
+--    -> f b
+--    -> E.SqlExpr (E.Value Bool)
+-- What is inferred:
+mkInFilter :: (PersistField a)
+  =>  (t -> E.SqlExpr (E.Value a))
+  -> t
+  -> Set.Set a
+  -> E.SqlExpr (E.Value Bool)
+mkInFilter lenslike row criterias
+  | Set.null criterias = true
+  | otherwise      = (lenslike row) `E.in_` E.valList (Set.toList criterias)
\ No newline at end of file
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 0da847ef6..c32e6d47d 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -8,10 +8,12 @@ import Utils.Lens
 import Utils.Form
 -- import Utils.DB
 import Handler.Utils
-import Handler.Utils.Table.Cells
 import Handler.Utils.Course
 import Handler.Utils.Delete
 import Handler.Utils.Database
+import Handler.Utils.Table.Cells
+import Handler.Utils.Table.Columns
+import Database.Esqueleto.Utils
 
 -- import Data.Time
 -- import qualified Data.Text as T
@@ -691,6 +693,32 @@ _userTableNote = _dbrOutput . _3
 _userTableFeatures :: Lens' UserTableData (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms)
 _userTableFeatures = _dbrOutput . _4
 
+_rowUserSemester :: Traversal' UserTableData Int
+_rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester
+
+
+-- Sql-Getters for this query, used for sorting and filtering (cannot be lenses due to being Esqueleto expressions)
+queryUser :: UserTableExpr -> E.SqlExpr (Entity User)
+queryUser ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user
+
+-- queryUserName :: UserTableExpr -> E.SqlExpr (E.Value Text)
+-- queryUserName ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserDisplayName
+
+-- queryUserDisplayName :: UserTableExpr -> E.SqlExpr (E.Value Text)
+-- queryUserDisplayName ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserDisplayName
+
+queryUserFeatures :: UserTableExpr -> (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms)))
+queryUserFeatures ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` studyFeatures) = studyFeatures
+
+queryUserSemester :: UserTableExpr -> E.SqlExpr (E.Value (Maybe Int)) -- (E.Value (Maybe Int))
+queryUserSemester = aux . queryUserFeatures
+  where aux (features `E.InnerJoin` _degree `E.InnerJoin` _terms)
+          = features E.?. StudyFeaturesSemester
+
+-- Deprecated in favour of newer implementation
+queryUserSemester' :: UserTableExpr -> E.SqlExpr (E.Value (Maybe Int)) -- (E.Value (Maybe Int))
+queryUserSemester' ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` (features `E.InnerJoin` _degree `E.InnerJoin` _terms) )
+    = features E.?. StudyFeaturesSemester
 
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
 colUserComment tid ssh csh =
@@ -703,19 +731,26 @@ colUserComment tid ssh csh =
 
 colUserSemester :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserSemester = sortable (Just "course-user-semesternr") (i18nCell MsgStudyFeatureAge) $
-    foldMap numCell . preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester)
+    foldMap numCell . preview _rowUserSemester
 
 colUserField :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserField = sortable (Just "course-user-field") (i18nCell MsgCourseStudyFeature) $
     foldMap htmlCell . view (_userTableFeatures . _3)
 
+colUserFieldShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
+colUserFieldShort = sortable (Just "course-user-field") (i18nCell MsgCourseStudyFeature) $
+    foldMap (htmlCell . shortStudyTerms) . view (_userTableFeatures . _3)
+
 colUserDegree :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserDegree = sortable (Just "course-user-degree") (i18nCell MsgStudyFeatureDegree) $
     foldMap htmlCell . preview (_userTableFeatures . _2 . _Just)
 
+colUserDegreeShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
+colUserDegreeShort = sortable (Just "course-user-degree") (i18nCell MsgStudyFeatureDegree) $
+    foldMap (htmlCell . shortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
+
 makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget
 makeCourseUserTable cid colChoices psValidator =
-  -- return [whamlet|TODO|] -- TODO
   -- -- psValidator has default sorting and filtering
   let dbtIdent     = "courseUsers" :: Text
       dbtStyle     = def
@@ -723,8 +758,18 @@ makeCourseUserTable cid colChoices psValidator =
       dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserId
       dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms))
       dbtColonnade = colChoices
-      dbtSorting   = Map.fromList [] -- TODO
-      dbtFilter    = Map.fromList [] -- TODO
+      dbtSorting   = Map.fromList
+        [ sortUserName        queryUser
+        , sortUserDisplayName queryUser
+        , sortUserMatriclenr  queryUser
+        , ( "course-user-semesternr", SortColumn queryUserSemester) -- $ -- preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester))
+        -- TODO
+        ]
+      dbtFilter    = Map.fromList
+        [ filterUserName queryUser
+        , ( "course-user-semesternr", FilterColumn $ mkInFilter queryUserSemester)
+        -- TODO
+        ]
       dbtFilterUI  = mempty -- TODO
       dbtParams    = def
   in dbTableWidget' psValidator DBTable{..}
@@ -735,20 +780,20 @@ getCUsersR tid ssh csh = do
   Entity cid course <- runDB $ getBy404 $ TermSchoolCourseShort tid ssh csh
   let heading = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{display tid}|]
       colChoices  = mconcat
-        [ colUserParticipantLink tid ssh csh
+        [ colUserNameLink (CourseR tid ssh csh . CUserR)
         , colUserEmail
         , colUserMatriclenr
-        , colUserDegree
-        , colUserField
+        , colUserDegreeShort
+        , colUserFieldShort
         , colUserSemester
         , sortable (Just "registration") (i18nCell MsgRegisteredHeader) (dateCell . view _userTableRegistration)
         , colUserComment tid ssh csh
         ]
-      psValidator = def
+      psValidator = def & defaultSortingByName
   tableWidget <- runDB $ makeCourseUserTable cid colChoices psValidator
   siteLayout heading $ do
     setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
-    -- TODO: creat hamlet wrapper
+    -- TODO: create hamlet wrapper
     tableWidget
 
 
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index 47f4f6e8b..05d2463f3 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -173,30 +173,3 @@ correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a
 correctorLoadCell sc =
   i18nCell $ sheetCorrectorLoad sc
 
-
---------------------------------
--- Generic Columns
--- reuse encourages consistency
---
--- if it works out, turn into its own module
--- together with filters and sorters
-
-
--- | Does not work, since we have now show Instance for RenderMesage UniWorX msg
-colUser :: (IsDBTable m c, HasUser a, RenderMessage UniWorX msg, Show msg) => msg -> Colonnade Sortable a  (DBCell m c)
-colUser msg = sortable (Just $ fromString $ show msg) (i18nCell msg) cellHasUser
-
-colUserParticipant :: (IsDBTable m c, HasUser a) => Colonnade Sortable a  (DBCell m c)
-colUserParticipant = sortable (Just "participant") (i18nCell MsgCourseMembers) cellHasUser
-
-colUserParticipantLink :: (IsDBTable m c, HasEntity a User) => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable a (DBCell m c)
-colUserParticipantLink tid ssh csh = sortable (Just "participant") (i18nCell MsgCourseMembers) (cellHasUserLink courseLink)
-  where
-    -- courseLink :: CryptoUUIDUser -> Route UniWorX
-    courseLink = CourseR tid ssh csh . CUserR
-
-colUserMatriclenr ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
-colUserMatriclenr = sortable (Just "matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
-
-colUserEmail ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
-colUserEmail = sortable (Just "email") (i18nCell MsgEMail) cellHasEMail
diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs
new file mode 100644
index 000000000..6ff916033
--- /dev/null
+++ b/src/Handler/Utils/Table/Columns.hs
@@ -0,0 +1,87 @@
+module Handler.Utils.Table.Columns where
+
+import Import
+
+-- import Data.CaseInsensitive (CI)
+-- import qualified Data.CaseInsensitive as CI
+
+-- import Data.Monoid (Any(..))
+-- import Control.Monad.Writer.Class (MonadWriter(..))
+-- import Control.Monad.Trans.Writer (WriterT)
+
+-- import Text.Blaze (ToMarkup(..))
+
+import qualified Database.Esqueleto as E
+import Database.Esqueleto.Utils
+
+import Utils.Lens
+import Handler.Utils
+import Handler.Utils.Table.Cells
+
+
+--------------------------------
+-- Generic Columns
+-- reuse encourages consistency
+--
+-- The constant string for sort/filter keys
+-- should never be mentioned outside of this module
+-- to ensure consistency!
+--
+-- Each section should have the following parts:
+--  * colXYZ  : column definitions plus variants
+--  * sortXYZ  : sorting definitions for these columns
+--  * fltrXYZ  : filter  definitions for these columns
+--  * additional helper, such as default sorting
+
+
+---------------
+-- User names
+
+-- | Generic sort key from msg does not work, since we have no show Instance for RenderMesage UniWorX msg. Dangerous anyway!
+colUserName' :: (IsDBTable m c, HasUser a, RenderMessage UniWorX msg, Show msg) => msg -> Colonnade Sortable a  (DBCell m c)
+colUserName' msg = sortable (Just $ fromString $ show msg) (i18nCell msg) cellHasUser
+
+colUserName :: (IsDBTable m c, HasUser a) => Colonnade Sortable a  (DBCell m c)
+colUserName = sortable (Just "user-surname") (i18nCell MsgCourseMembers) cellHasUser
+
+colUserNameLink :: (IsDBTable m c, HasEntity a User) => (CryptoUUIDUser -> Route UniWorX) -> Colonnade Sortable a (DBCell m c)
+colUserNameLink userLink = sortable (Just "user-surname") (i18nCell MsgCourseMembers) (cellHasUserLink userLink)
+
+-- | Intended to work with @nameWidget@, showing highlighter Surname within Displayname
+--   TOOD: We want to sort first by UserSurname and then by UserDisplayName, not supportet by dbTable
+--   see also @defaultSortingName@
+sortUserName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
+sortUserName = sortUserSurname
+
+sortUserSurname :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
+sortUserSurname queryUser = ( "user-surname", SortColumn $ compose queryUser (E.^. UserSurname))
+
+sortUserDisplayName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
+sortUserDisplayName queryUser = ( "user-display-name", SortColumn $ compose queryUser (E.^. UserDisplayName))
+
+defaultSortingByName :: PSValidator m x -> PSValidator m x
+defaultSortingByName = defaultSorting [SortAscBy "user-surname", SortAscBy "user-display-name"]
+
+filterUserName :: (IsFilterColumn t (a2 -> Set Text -> E.SqlExpr (E.Value Bool)), IsString a1)
+  => (a2 -> E.SqlExpr (Entity User))
+  -> (a1, FilterColumn t)
+filterUserName queryUser = ( "user-surname", FilterColumn $ mkInFilter queryName )
+  where
+    queryName = compose queryUser (E.^. UserSurname)
+
+
+-------------------
+-- Matriclenumber
+colUserMatriclenr ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
+colUserMatriclenr = sortable (Just "user-matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
+
+sortUserMatriclenr :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
+sortUserMatriclenr queryUser = ( "user-matriclenumber", SortColumn $ compose queryUser (E.^. UserMatrikelnummer))
+
+
+
+----------------
+-- User E-Mail
+colUserEmail ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
+colUserEmail = sortable (Just "email") (i18nCell MsgEMail) cellHasEMail
+
diff --git a/src/Utils.hs b/src/Utils.hs
index a523c723b..33027639a 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -340,6 +340,14 @@ invertMap :: (Ord k, Ord v) => Map k v -> Map v (Set k)
 invertMap = groupMap . map swap . Map.toList
 
 
+---------------
+-- Functions --
+---------------
+
+-- | Just @flip (.)@ for convenient formatting in some rare cases
+compose :: (a -> b) -> (b -> c) -> (a -> c)
+compose = flip (.)
+
 
 -----------
 -- Maybe --
@@ -473,8 +481,6 @@ throwExceptT :: ( Exception e, MonadThrow m )
              => ExceptT e m a -> m a
 throwExceptT = exceptT throwM return
 
-
-
 ------------
 -- Monads --
 ------------

From c4d77d665ac806334e5c32819f1c1f5cfe55180a Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Sat, 9 Mar 2019 14:35:47 +0100
Subject: [PATCH 22/56] Generic contains SQL filter for generic user column

---
 src/Database/Esqueleto/Utils.hs    | 38 ++++++++++++++++++------------
 src/Handler/Course.hs              |  2 +-
 src/Handler/Utils/Table/Columns.hs | 11 ++++++++-
 3 files changed, 34 insertions(+), 17 deletions(-)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 5f904f6f3..f3594d523 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -5,7 +5,7 @@ module Database.Esqueleto.Utils
   , isInfixOf, hasInfix
   , any, all
   , SqlIn(..)
-  , mkInFilter
+  , mkExactFilter, mkContainsFilter
   ) where
 
 import ClassyPrelude.Yesod hiding (isInfixOf, any, all)
@@ -52,23 +52,31 @@ all :: Foldable f =>
   (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
 all test = F.foldr (\needle acc -> acc E.&&. test needle) true
 
+
 $(sqlInTuples [2..16])
 
 
 -- | generic filter creation for dbTable
---   Given a lens-like function, make filter
--- What I thought:
--- mkFilter :: (Foldable f, E.From query expr backend a)
---    => (a -> E.SqlExpr (E.Value b))
---    -> a
---    -> f b
---    -> E.SqlExpr (E.Value Bool)
--- What is inferred:
-mkInFilter :: (PersistField a)
-  =>  (t -> E.SqlExpr (E.Value a))
-  -> t
-  -> Set.Set a
+--   Given a lens-like function, make filter for exact matches in a collection
+--   (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere)
+mkExactFilter :: (PersistField a)
+  =>  (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element
+  -> t                             -- ^ query row
+  -> Set.Set a                     -- ^ needle collection
   -> E.SqlExpr (E.Value Bool)
-mkInFilter lenslike row criterias
+mkExactFilter lenslike row criterias
   | Set.null criterias = true
-  | otherwise      = (lenslike row) `E.in_` E.valList (Set.toList criterias)
\ No newline at end of file
+  | otherwise = (lenslike row) `E.in_` E.valList (Set.toList criterias)
+
+-- | generic filter creation for dbTable
+--   Given a lens-like function, make filter searching for needles in String-like elements
+--   (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere)
+mkContainsFilter :: (E.SqlString a)
+  =>  (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element
+  -> t                             -- ^ query row
+  -> Set.Set Text                  -- ^ needle collection
+  -> E.SqlExpr (E.Value Bool)
+mkContainsFilter lenslike row criterias
+  | Set.null criterias = true
+  | otherwise = any (hasInfix $ lenslike row) criterias
+
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index c32e6d47d..9ed7a197b 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -767,7 +767,7 @@ makeCourseUserTable cid colChoices psValidator =
         ]
       dbtFilter    = Map.fromList
         [ filterUserName queryUser
-        , ( "course-user-semesternr", FilterColumn $ mkInFilter queryUserSemester)
+        , ( "course-user-semesternr", FilterColumn $ mkExactFilter queryUserSemester)
         -- TODO
         ]
       dbtFilterUI  = mempty -- TODO
diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs
index 6ff916033..f864e15ef 100644
--- a/src/Handler/Utils/Table/Columns.hs
+++ b/src/Handler/Utils/Table/Columns.hs
@@ -65,10 +65,19 @@ defaultSortingByName = defaultSorting [SortAscBy "user-surname", SortAscBy "user
 filterUserName :: (IsFilterColumn t (a2 -> Set Text -> E.SqlExpr (E.Value Bool)), IsString a1)
   => (a2 -> E.SqlExpr (Entity User))
   -> (a1, FilterColumn t)
-filterUserName queryUser = ( "user-surname", FilterColumn $ mkInFilter queryName )
+filterUserName queryUser = ( "user-surname", FilterColumn $ mkContainsFilter queryName )
   where
     queryName = compose queryUser (E.^. UserSurname)
 
+filterUserNameExact :: (IsFilterColumn t (a2 -> Set Text -> E.SqlExpr (E.Value Bool)), IsString a1)
+  => (a2 -> E.SqlExpr (Entity User))
+  -> (a1, FilterColumn t)
+filterUserNameExact queryUser = ( "user-surname", FilterColumn $ mkExactFilter queryName )
+  where
+    queryName = compose queryUser (E.^. UserSurname)
+
+
+
 
 -------------------
 -- Matriclenumber

From e5d693e7071ad6f25130c5aef828485c0bd9c5d1 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Sun, 10 Mar 2019 11:43:59 +0100
Subject: [PATCH 23/56] Generic columns filters and sorting

---
 src/Handler/Course.hs              |  9 ++--
 src/Handler/Utils/Table/Columns.hs | 74 ++++++++++++++++++++++--------
 2 files changed, 62 insertions(+), 21 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 9ed7a197b..abb9e27e7 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -759,14 +759,17 @@ makeCourseUserTable cid colChoices psValidator =
       dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms))
       dbtColonnade = colChoices
       dbtSorting   = Map.fromList
-        [ sortUserName        queryUser
-        , sortUserDisplayName queryUser
+        [ sortUserNameLink    queryUser
+        , sortUserDisplayName queryUser -- needed for initial sorting
+        , sortUserEmail       queryUser
         , sortUserMatriclenr  queryUser
         , ( "course-user-semesternr", SortColumn queryUserSemester) -- $ -- preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester))
         -- TODO
         ]
       dbtFilter    = Map.fromList
-        [ filterUserName queryUser
+        [ fltrUserNameLink    queryUser
+        , fltrUserEmail       queryUser
+        , fltrUserMatriclenr  queryUser
         , ( "course-user-semesternr", FilterColumn $ mkExactFilter queryUserSemester)
         -- TODO
         ]
diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs
index f864e15ef..7b384d0db 100644
--- a/src/Handler/Utils/Table/Columns.hs
+++ b/src/Handler/Utils/Table/Columns.hs
@@ -42,40 +42,64 @@ colUserName' :: (IsDBTable m c, HasUser a, RenderMessage UniWorX msg, Show msg)
 colUserName' msg = sortable (Just $ fromString $ show msg) (i18nCell msg) cellHasUser
 
 colUserName :: (IsDBTable m c, HasUser a) => Colonnade Sortable a  (DBCell m c)
-colUserName = sortable (Just "user-surname") (i18nCell MsgCourseMembers) cellHasUser
+colUserName = sortable (Just "user-name") (i18nCell MsgCourseMembers) cellHasUser
 
 colUserNameLink :: (IsDBTable m c, HasEntity a User) => (CryptoUUIDUser -> Route UniWorX) -> Colonnade Sortable a (DBCell m c)
-colUserNameLink userLink = sortable (Just "user-surname") (i18nCell MsgCourseMembers) (cellHasUserLink userLink)
+colUserNameLink userLink = sortable (Just "user-name") (i18nCell MsgCourseMembers) (cellHasUserLink userLink)
 
 -- | Intended to work with @nameWidget@, showing highlighter Surname within Displayname
 --   TOOD: We want to sort first by UserSurname and then by UserDisplayName, not supportet by dbTable
 --   see also @defaultSortingName@
 sortUserName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
-sortUserName = sortUserSurname
+sortUserName queryUser = ("user-name", SortColumn $ toSortKey . queryUser)
+  where toSortKey user = (user E.^. UserSurname) E.++. (user E.^. UserDisplayName)
+
+-- | Alias for sortUserName for consistency, since column comes in two variants
+sortUserNameLink :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
+sortUserNameLink = sortUserName
 
 sortUserSurname :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
-sortUserSurname queryUser = ( "user-surname", SortColumn $ compose queryUser (E.^. UserSurname))
+sortUserSurname queryUser = ("user-surname", SortColumn $ compose queryUser (E.^. UserSurname))
 
 sortUserDisplayName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
-sortUserDisplayName queryUser = ( "user-display-name", SortColumn $ compose queryUser (E.^. UserDisplayName))
+sortUserDisplayName queryUser = ("user-display-name", SortColumn $ compose queryUser (E.^. UserDisplayName))
 
 defaultSortingByName :: PSValidator m x -> PSValidator m x
-defaultSortingByName = defaultSorting [SortAscBy "user-surname", SortAscBy "user-display-name"]
+defaultSortingByName =
+  -- defaultSorting [SortAscBy "user-surname", SortAscBy "user-display-name"] -- old way, requiring two exta sorters
+  defaultSorting [SortAscBy "user-name"] -- new way, untested, working with single sorter
 
-filterUserName :: (IsFilterColumn t (a2 -> Set Text -> E.SqlExpr (E.Value Bool)), IsString a1)
-  => (a2 -> E.SqlExpr (Entity User))
-  -> (a1, FilterColumn t)
-filterUserName queryUser = ( "user-surname", FilterColumn $ mkContainsFilter queryName )
+-- | Alias for sortUserName for consistency
+fltrUserNameLink :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) => (a -> E.SqlExpr (Entity User)) -> (d, FilterColumn t)
+fltrUserNameLink = fltrUserName
+
+fltrUserName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+  => (a -> E.SqlExpr (Entity User))
+  -> (d, FilterColumn t)
+fltrUserName queryUser = ( "user-name", FilterColumn $ mkContainsFilter queryName )
+  where
+    queryName = compose queryUser (E.^. UserDisplayName)
+
+fltrUserNameExact :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+  => (a -> E.SqlExpr (Entity User))
+  -> (d, FilterColumn t)
+fltrUserNameExact queryUser = ( "user-name", FilterColumn $ mkExactFilter queryName )
+  where
+    queryName = compose queryUser (E.^. UserDisplayName)
+
+fltrUserSurname :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+  => (a -> E.SqlExpr (Entity User))
+  -> (d, FilterColumn t)
+fltrUserSurname queryUser = ( "user-surname", FilterColumn $ mkContainsFilter queryName )
   where
     queryName = compose queryUser (E.^. UserSurname)
 
-filterUserNameExact :: (IsFilterColumn t (a2 -> Set Text -> E.SqlExpr (E.Value Bool)), IsString a1)
-  => (a2 -> E.SqlExpr (Entity User))
-  -> (a1, FilterColumn t)
-filterUserNameExact queryUser = ( "user-surname", FilterColumn $ mkExactFilter queryName )
+fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+  => (a -> E.SqlExpr (Entity User))
+  -> (d, FilterColumn t)
+fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter queryName )
   where
-    queryName = compose queryUser (E.^. UserSurname)
-
+    queryName = compose queryUser (E.^. UserDisplayName)
 
 
 
@@ -84,13 +108,27 @@ filterUserNameExact queryUser = ( "user-surname", FilterColumn $ mkExactFilter q
 colUserMatriclenr ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
 colUserMatriclenr = sortable (Just "user-matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
 
-sortUserMatriclenr :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
+sortUserMatriclenr :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t)
 sortUserMatriclenr queryUser = ( "user-matriclenumber", SortColumn $ compose queryUser (E.^. UserMatrikelnummer))
 
+fltrUserMatriclenr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+  => (a -> E.SqlExpr (Entity User))
+  -> (d, FilterColumn t)
+fltrUserMatriclenr queryUser = ( "user-matriclenumber", FilterColumn $ mkContainsFilter $ compose queryUser (E.^. UserMatrikelnummer))
+
 
 
 ----------------
 -- User E-Mail
 colUserEmail ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
-colUserEmail = sortable (Just "email") (i18nCell MsgEMail) cellHasEMail
+colUserEmail = sortable (Just "user-email") (i18nCell MsgEMail) cellHasEMail
+
+sortUserEmail :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t)
+sortUserEmail queryUser = ( "user-email", SortColumn $ compose queryUser (E.^. UserEmail))
+
+fltrUserEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+  => (a -> E.SqlExpr (Entity User))
+  -> (d, FilterColumn t)
+fltrUserEmail queryUser = ( "user-email", FilterColumn $ mkContainsFilter $ compose queryUser (E.^. UserEmail))
+
 

From 529c226ad665dde4504dd98ac9c88b0cf283edc0 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Sun, 10 Mar 2019 18:01:17 +0100
Subject: [PATCH 24/56] Generic Join projections implemented

---
 src/Database/Esqueleto/Utils.hs    |  6 +++++-
 src/Database/Esqueleto/Utils/TH.hs | 12 ++++++++++-
 src/Handler/Course.hs              | 33 ++++++++++++++++++++++--------
 src/Handler/Utils/Table/Columns.hs | 28 +++++++++++--------------
 src/Utils.hs                       | 12 +++++++----
 src/Utils/TH.hs                    | 23 +++++++++++++++++----
 6 files changed, 80 insertions(+), 34 deletions(-)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index f3594d523..4e3e85e22 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -55,6 +55,10 @@ all test = F.foldr (\needle acc -> acc E.&&. test needle) true
 
 $(sqlInTuples [2..16])
 
+-- | Example for usage of sqlIJproj
+-- queryFeaturesDegree :: (a `E.InnerJoin` b `E.InnerJoin` c) -> b
+-- queryFeaturesDegree  = $(sqlIJproj 3 2)
+
 
 -- | generic filter creation for dbTable
 --   Given a lens-like function, make filter for exact matches in a collection
@@ -66,7 +70,7 @@ mkExactFilter :: (PersistField a)
   -> E.SqlExpr (E.Value Bool)
 mkExactFilter lenslike row criterias
   | Set.null criterias = true
-  | otherwise = (lenslike row) `E.in_` E.valList (Set.toList criterias)
+  | otherwise = lenslike row `E.in_` E.valList (Set.toList criterias)
 
 -- | generic filter creation for dbTable
 --   Given a lens-like function, make filter searching for needles in String-like elements
diff --git a/src/Database/Esqueleto/Utils/TH.hs b/src/Database/Esqueleto/Utils/TH.hs
index 7ae382959..5596f31ee 100644
--- a/src/Database/Esqueleto/Utils/TH.hs
+++ b/src/Database/Esqueleto/Utils/TH.hs
@@ -1,6 +1,7 @@
 module Database.Esqueleto.Utils.TH
   ( SqlIn(..)
   , sqlInTuple, sqlInTuples
+  , sqlIJproj, sqlLOJproj
   ) where
 
 import ClassyPrelude
@@ -14,6 +15,8 @@ import Language.Haskell.TH
 
 import Data.List (foldr1, foldl)
 
+import Utils.TH
+
 class E.SqlSelect a r => SqlIn a r | a -> r, r -> a where
   sqlIn :: a -> [r] -> E.SqlExpr (E.Value Bool)
 
@@ -33,7 +36,7 @@ sqlInTuple arity = do
   let
     matchE = lam1E (tupP $ map (\vV -> conP 'E.Value [varP vV]) vVs) (foldr1 (\e1 e2 -> [e|$(e1) E.&&. $(e2)|]) . map (\(varE -> vE, varE -> xE) -> [e|E.val $(vE) E.==. $(xE)|]) $ zip vVs xVs)
     tupTy f = foldl (\typ v -> typ `appT` f (varT v)) (tupleT arity) tyVars
-  
+
   instanceD (cxt $ map (\v -> [t|PersistField $(varT v)|]) tyVars) [t|SqlIn $(tupTy $ \v -> [t|E.SqlExpr (E.Value $(v))|]) $(tupTy $ \v -> [t|E.Value $(v)|])|]
     [ funD 'sqlIn
       [ clause [tupP $ map varP xVs, varP xsV]
@@ -45,4 +48,11 @@ sqlInTuple arity = do
       ]
     ]
 
+-- | Generic projections for InnerJoin-tuples
+--   gives I-th element of N-tuple of left-associative InnerJoin-pairs,
+--   i.e. @$(projN n m) :: (t1 `E.InnerJoin` .. `E.InnerJoin` tn) -> tm@ (for m<=n)
+sqlIJproj :: Int -> Int -> ExpQ
+sqlIJproj = leftAssociativePairProjection 'E.InnerJoin
 
+sqlLOJproj :: Int -> Int -> ExpQ
+sqlLOJproj = leftAssociativePairProjection 'E.LeftOuterJoin
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index abb9e27e7..a9f30a8ce 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -14,6 +14,7 @@ import Handler.Utils.Database
 import Handler.Utils.Table.Cells
 import Handler.Utils.Table.Columns
 import Database.Esqueleto.Utils
+import Database.Esqueleto.Utils.TH
 
 -- import Data.Time
 -- import qualified Data.Text as T
@@ -701,24 +702,31 @@ _rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester
 queryUser :: UserTableExpr -> E.SqlExpr (Entity User)
 queryUser ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user
 
+-- No longer needed:
 -- queryUserName :: UserTableExpr -> E.SqlExpr (E.Value Text)
 -- queryUserName ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserDisplayName
 
 -- queryUserDisplayName :: UserTableExpr -> E.SqlExpr (E.Value Text)
 -- queryUserDisplayName ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserDisplayName
 
+queryUserNote ::  UserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote))
+queryUserNote ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures) = note
+
 queryUserFeatures :: UserTableExpr -> (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms)))
 queryUserFeatures ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` studyFeatures) = studyFeatures
 
+queryFeaturesDegree ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> b
+queryFeaturesDegree = $(sqlIJproj 3 2)
+
 queryUserSemester :: UserTableExpr -> E.SqlExpr (E.Value (Maybe Int)) -- (E.Value (Maybe Int))
 queryUserSemester = aux . queryUserFeatures
   where aux (features `E.InnerJoin` _degree `E.InnerJoin` _terms)
           = features E.?. StudyFeaturesSemester
 
 -- Deprecated in favour of newer implementation
-queryUserSemester' :: UserTableExpr -> E.SqlExpr (E.Value (Maybe Int)) -- (E.Value (Maybe Int))
-queryUserSemester' ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` (features `E.InnerJoin` _degree `E.InnerJoin` _terms) )
-    = features E.?. StudyFeaturesSemester
+-- queryUserSemester :: UserTableExpr -> E.SqlExpr (E.Value (Maybe Int)) -- (E.Value (Maybe Int))
+-- queryUserSemester ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` (features `E.InnerJoin` _degree `E.InnerJoin` _terms) )
+--   = features E.?. StudyFeaturesSemester
 
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
 colUserComment tid ssh csh =
@@ -759,19 +767,28 @@ makeCourseUserTable cid colChoices psValidator =
       dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms))
       dbtColonnade = colChoices
       dbtSorting   = Map.fromList
-        [ sortUserNameLink    queryUser
+        [ sortUserNameLink    queryUser -- slower sorting through clicking name column header
+        , sortUserSurname     queryUser -- needed for initial sorting
         , sortUserDisplayName queryUser -- needed for initial sorting
         , sortUserEmail       queryUser
         , sortUserMatriclenr  queryUser
-        , ( "course-user-semesternr", SortColumn queryUserSemester) -- $ -- preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester))
-        -- TODO
+        , ("course-user-degree", SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> \degree -> degree E.?. StudyDegreeShorthand)
+        , ("course-user-field" , error "TODO") -- TODO
+        , ("course-user-semesternr", SortColumn queryUserSemester) -- $ -- preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester))
+        , ("course-user-note"      , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
+              E.sub_select . E.from $ \edit -> do
+                E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
+                return . E.max_ $ edit E.^. CourseUserNoteEditTime
+          )
         ]
       dbtFilter    = Map.fromList
         [ fltrUserNameLink    queryUser
         , fltrUserEmail       queryUser
         , fltrUserMatriclenr  queryUser
-        , ( "course-user-semesternr", FilterColumn $ mkExactFilter queryUserSemester)
-        -- TODO
+        , ("course-user-degree", error "TODO") -- TODO
+        , ("course-user-field" , error "TODO") -- TODO
+        , ("course-user-semesternr", FilterColumn $ mkExactFilter queryUserSemester)
+        , ("course-user-note", error "TODO") -- TODO
         ]
       dbtFilterUI  = mempty -- TODO
       dbtParams    = def
diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs
index 7b384d0db..507ba10bf 100644
--- a/src/Handler/Utils/Table/Columns.hs
+++ b/src/Handler/Utils/Table/Columns.hs
@@ -59,15 +59,15 @@ sortUserNameLink :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColu
 sortUserNameLink = sortUserName
 
 sortUserSurname :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
-sortUserSurname queryUser = ("user-surname", SortColumn $ compose queryUser (E.^. UserSurname))
+sortUserSurname queryUser = ("user-surname", SortColumn $ queryUser >>> (E.^. UserSurname))
 
 sortUserDisplayName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t)
-sortUserDisplayName queryUser = ("user-display-name", SortColumn $ compose queryUser (E.^. UserDisplayName))
+sortUserDisplayName queryUser = ("user-display-name", SortColumn $ queryUser >>> (E.^. UserDisplayName))
 
 defaultSortingByName :: PSValidator m x -> PSValidator m x
 defaultSortingByName =
-  -- defaultSorting [SortAscBy "user-surname", SortAscBy "user-display-name"] -- old way, requiring two exta sorters
-  defaultSorting [SortAscBy "user-name"] -- new way, untested, working with single sorter
+  defaultSorting [SortAscBy "user-surname", SortAscBy "user-display-name"] -- old way, requiring two exta sorters
+  -- defaultSorting [SortAscBy "user-name"] -- new way, untested, working with single sorter
 
 -- | Alias for sortUserName for consistency
 fltrUserNameLink :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) => (a -> E.SqlExpr (Entity User)) -> (d, FilterColumn t)
@@ -78,28 +78,24 @@ fltrUserName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), I
   -> (d, FilterColumn t)
 fltrUserName queryUser = ( "user-name", FilterColumn $ mkContainsFilter queryName )
   where
-    queryName = compose queryUser (E.^. UserDisplayName)
+    queryName = queryUser >>> (E.^. UserDisplayName)
 
 fltrUserNameExact :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
   => (a -> E.SqlExpr (Entity User))
   -> (d, FilterColumn t)
 fltrUserNameExact queryUser = ( "user-name", FilterColumn $ mkExactFilter queryName )
   where
-    queryName = compose queryUser (E.^. UserDisplayName)
+    queryName = queryUser >>> (E.^. UserDisplayName)
 
 fltrUserSurname :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
   => (a -> E.SqlExpr (Entity User))
   -> (d, FilterColumn t)
-fltrUserSurname queryUser = ( "user-surname", FilterColumn $ mkContainsFilter queryName )
-  where
-    queryName = compose queryUser (E.^. UserSurname)
+fltrUserSurname queryUser = ( "user-surname", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserSurname))
 
 fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
   => (a -> E.SqlExpr (Entity User))
   -> (d, FilterColumn t)
-fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter queryName )
-  where
-    queryName = compose queryUser (E.^. UserDisplayName)
+fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName))
 
 
 
@@ -109,12 +105,12 @@ colUserMatriclenr ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell
 colUserMatriclenr = sortable (Just "user-matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
 
 sortUserMatriclenr :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t)
-sortUserMatriclenr queryUser = ( "user-matriclenumber", SortColumn $ compose queryUser (E.^. UserMatrikelnummer))
+sortUserMatriclenr queryUser = ( "user-matriclenumber", SortColumn $ queryUser >>> (E.^. UserMatrikelnummer))
 
 fltrUserMatriclenr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
   => (a -> E.SqlExpr (Entity User))
   -> (d, FilterColumn t)
-fltrUserMatriclenr queryUser = ( "user-matriclenumber", FilterColumn $ mkContainsFilter $ compose queryUser (E.^. UserMatrikelnummer))
+fltrUserMatriclenr queryUser = ( "user-matriclenumber", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserMatrikelnummer))
 
 
 
@@ -124,11 +120,11 @@ colUserEmail ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
 colUserEmail = sortable (Just "user-email") (i18nCell MsgEMail) cellHasEMail
 
 sortUserEmail :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t)
-sortUserEmail queryUser = ( "user-email", SortColumn $ compose queryUser (E.^. UserEmail))
+sortUserEmail queryUser = ( "user-email", SortColumn $ queryUser >>> (E.^. UserEmail))
 
 fltrUserEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
   => (a -> E.SqlExpr (Entity User))
   -> (d, FilterColumn t)
-fltrUserEmail queryUser = ( "user-email", FilterColumn $ mkContainsFilter $ compose queryUser (E.^. UserEmail))
+fltrUserEmail queryUser = ( "user-email", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserEmail))
 
 
diff --git a/src/Utils.hs b/src/Utils.hs
index 33027639a..cd735a6c0 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -24,8 +24,6 @@ import Utils.DateTime as Utils
 import Utils.PathPiece as Utils
 import Utils.Message as Utils
 import Utils.Lang as Utils
-import Control.Lens as Utils (none)
-
 
 import Text.Blaze (Markup, ToMarkup)
 
@@ -33,13 +31,16 @@ import Data.Char (isDigit, isSpace)
 import Data.Text (dropWhileEnd, takeWhileEnd, justifyRight)
 import Numeric (showFFloat)
 
-import Control.Lens
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Map (Map)
 import qualified Data.Map as Map
 -- import qualified Data.List as List
 
+import Control.Lens
+import Control.Lens as Utils (none)
+
+import Control.Arrow as Utils ((>>>))
 import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT)
 import Control.Monad.Except (MonadError(..))
 import Control.Monad.Trans.Maybe (MaybeT(..))
@@ -344,7 +345,10 @@ invertMap = groupMap . map swap . Map.toList
 -- Functions --
 ---------------
 
--- | Just @flip (.)@ for convenient formatting in some rare cases
+-- curryN, uncurryN see Utils.TH
+
+-- | Just @flip (.)@ for convenient formatting in some cases,
+--   Deprecated in favor of Control.Arrow.(>>>)
 compose :: (a -> b) -> (b -> c) -> (a -> c)
 compose = flip (.)
 
diff --git a/src/Utils/TH.hs b/src/Utils/TH.hs
index ea1e73b3c..b12d90359 100644
--- a/src/Utils/TH.hs
+++ b/src/Utils/TH.hs
@@ -20,10 +20,25 @@ import Data.List ((!!), foldl)
 -- Alternatively uses lenses: "^. _3" projects the 3rd component of an n-tuple for any n >=3, requires import Control.Lens
 projNI :: Int -> Int -> ExpQ -- generic projection gives I-th element of N-tuple, i.e. snd3 = $(projNI 3 2)  --ghci -fth
 -- $(projN n m) :: (t1,..,tn) -> tm (for m<=n)
-projNI n i = lamE [pat] rhs
-  where pat = tupP (map varP xs)
-        rhs = varE (xs !! (i - 1))
-        xs  = [ mkName $ "x" ++ show j | j <- [1..n] ]
+projNI n i = do
+  x <- newName "x"
+  let rhs = varE x
+  let pat = tupP $ replicate (pred i) wildP ++ varP x : replicate (n-i) wildP
+  lamE [pat] rhs
+
+
+-- | Generic projections N-tuples that are actually left-associative pairs
+--   i.e. @$(leftAssociativePairProjection c n m :: (..(t1 `c` t2) `c` .. `c` tn) -> tm@ (for m<=n)
+leftAssociativePairProjection :: Name -> Int -> Int -> ExpQ
+leftAssociativePairProjection constructor n i = do
+    x <- newName "x"
+    lamE [pat x n] (varE x)
+  where
+    pat x 1       = varP x
+    pat x w
+      | w==i      = conP constructor [wildP, varP x]
+      | otherwise = conP constructor [pat x (pred w), wildP]
+
 
 ---------------
 -- Functions --

From f6ace93795130ac4b0a9ef1463c319f11c2ed920 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Sun, 10 Mar 2019 18:08:36 +0100
Subject: [PATCH 25/56] participant list sorting completed

---
 src/Handler/Course.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index a9f30a8ce..a02c66843 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -718,6 +718,9 @@ queryUserFeatures ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E
 queryFeaturesDegree ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> b
 queryFeaturesDegree = $(sqlIJproj 3 2)
 
+queryFeaturesField ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> c
+queryFeaturesField = $(sqlIJproj 3 3)
+
 queryUserSemester :: UserTableExpr -> E.SqlExpr (E.Value (Maybe Int)) -- (E.Value (Maybe Int))
 queryUserSemester = aux . queryUserFeatures
   where aux (features `E.InnerJoin` _degree `E.InnerJoin` _terms)
@@ -773,7 +776,7 @@ makeCourseUserTable cid colChoices psValidator =
         , sortUserEmail       queryUser
         , sortUserMatriclenr  queryUser
         , ("course-user-degree", SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> \degree -> degree E.?. StudyDegreeShorthand)
-        , ("course-user-field" , error "TODO") -- TODO
+        , ("course-user-field" , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsShorthand))
         , ("course-user-semesternr", SortColumn queryUserSemester) -- $ -- preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester))
         , ("course-user-note"      , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
               E.sub_select . E.from $ \edit -> do

From c205fe1b74896890f05a2634e1291d20cc1f15fa Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Sun, 10 Mar 2019 18:13:39 +0100
Subject: [PATCH 26/56] mend

---
 src/Handler/Course.hs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index a02c66843..3305be5a4 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -749,7 +749,7 @@ colUserField = sortable (Just "course-user-field") (i18nCell MsgCourseStudyFeatu
     foldMap htmlCell . view (_userTableFeatures . _3)
 
 colUserFieldShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserFieldShort = sortable (Just "course-user-field") (i18nCell MsgCourseStudyFeature) $
+colUserFieldShort = sortable (Just "course-user-field-short") (i18nCell MsgCourseStudyFeature) $
     foldMap (htmlCell . shortStudyTerms) . view (_userTableFeatures . _3)
 
 colUserDegree :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
@@ -757,7 +757,7 @@ colUserDegree = sortable (Just "course-user-degree") (i18nCell MsgStudyFeatureDe
     foldMap htmlCell . preview (_userTableFeatures . _2 . _Just)
 
 colUserDegreeShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserDegreeShort = sortable (Just "course-user-degree") (i18nCell MsgStudyFeatureDegree) $
+colUserDegreeShort = sortable (Just "course-user-degree-short") (i18nCell MsgStudyFeatureDegree) $
     foldMap (htmlCell . shortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
 
 makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget
@@ -775,10 +775,12 @@ makeCourseUserTable cid colChoices psValidator =
         , sortUserDisplayName queryUser -- needed for initial sorting
         , sortUserEmail       queryUser
         , sortUserMatriclenr  queryUser
-        , ("course-user-degree", SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> \degree -> degree E.?. StudyDegreeShorthand)
-        , ("course-user-field" , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsShorthand))
-        , ("course-user-semesternr", SortColumn queryUserSemester) -- $ -- preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester))
-        , ("course-user-note"      , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
+        , ("course-user-degree"      , SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> (E.?. StudyDegreeName))
+        , ("course-user-degree-short", SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
+        , ("course-user-field"       , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsName))
+        , ("course-user-field-short" , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsShorthand))
+        , ("course-user-semesternr"  , SortColumn queryUserSemester) -- $ -- preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester))
+        , ("course-user-note"        , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
               E.sub_select . E.from $ \edit -> do
                 E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
                 return . E.max_ $ edit E.^. CourseUserNoteEditTime

From 913f4dea7c4b5dbe4e069320cdf23cc4173d83b1 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Tue, 12 Mar 2019 09:20:53 +0100
Subject: [PATCH 27/56] mend

merge from master
---
 src/Handler/Course.hs | 37 +++++++++++++++----------------------
 1 file changed, 15 insertions(+), 22 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 3c303850d..35b635e17 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -699,37 +699,28 @@ _rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester
 
 
 -- 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 ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user
+queryUser = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
 
--- No longer needed:
--- queryUserName :: UserTableExpr -> E.SqlExpr (E.Value Text)
--- queryUserName ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserDisplayName
-
--- queryUserDisplayName :: UserTableExpr -> E.SqlExpr (E.Value Text)
--- queryUserDisplayName ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserDisplayName
+queryParticipant :: UserTableExpr -> E.SqlExpr (Entity CourseParticipant)
+queryParticipant = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
 
 queryUserNote ::  UserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote))
-queryUserNote ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` _studyFeatures) = note
+queryUserNote = $(sqlLOJproj 3 2)
 
 queryUserFeatures :: UserTableExpr -> (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms)))
-queryUserFeatures ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` studyFeatures) = studyFeatures
+queryUserFeatures = $(sqlLOJproj 3 3)
+
+queryFeaturesStudy ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> a
+queryFeaturesStudy  = $(sqlIJproj 3 1)
 
 queryFeaturesDegree ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> b
 queryFeaturesDegree = $(sqlIJproj 3 2)
 
 queryFeaturesField ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> c
-queryFeaturesField = $(sqlIJproj 3 3)
+queryFeaturesField  = $(sqlIJproj 3 3)
 
-queryUserSemester :: UserTableExpr -> E.SqlExpr (E.Value (Maybe Int)) -- (E.Value (Maybe Int))
-queryUserSemester = aux . queryUserFeatures
-  where aux (features `E.InnerJoin` _degree `E.InnerJoin` _terms)
-          = features E.?. StudyFeaturesSemester
-
--- Deprecated in favour of newer implementation
--- queryUserSemester :: UserTableExpr -> E.SqlExpr (E.Value (Maybe Int)) -- (E.Value (Maybe Int))
--- queryUserSemester ((_user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` (features `E.InnerJoin` _degree `E.InnerJoin` _terms) )
---   = features E.?. StudyFeaturesSemester
 
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
 colUserComment tid ssh csh =
@@ -779,7 +770,8 @@ makeCourseUserTable cid colChoices psValidator =
         , ("course-user-degree-short", SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
         , ("course-user-field"       , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsName))
         , ("course-user-field-short" , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsShorthand))
-        , ("course-user-semesternr"  , SortColumn queryUserSemester) -- $ -- preview (_userTableFeatures . _1 . _Just . _studyFeaturesSemester))
+        , ("course-user-semesternr"  , SortColumn $ queryUserFeatures >>> queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
+        , ("course-registration"     , SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration))
         , ("course-user-note"        , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
               E.sub_select . E.from $ \edit -> do
                 E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
@@ -792,7 +784,8 @@ makeCourseUserTable cid colChoices psValidator =
         , fltrUserMatriclenr  queryUser
         , ("course-user-degree", error "TODO") -- TODO
         , ("course-user-field" , error "TODO") -- TODO
-        , ("course-user-semesternr", FilterColumn $ mkExactFilter queryUserSemester)
+        , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryUserFeatures >>> queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
+        , ("course-registration", error "TODO") -- TODO
         , ("course-user-note", error "TODO") -- TODO
         ]
       dbtFilterUI  = mempty -- TODO
@@ -811,7 +804,7 @@ getCUsersR tid ssh csh = do
         , colUserDegreeShort
         , colUserFieldShort
         , colUserSemester
-        , sortable (Just "registration") (i18nCell MsgRegisteredHeader) (dateCell . view _userTableRegistration)
+        , sortable (Just "course-registration") (i18nCell MsgRegisteredHeader) (dateCell . view _userTableRegistration)
         , colUserComment tid ssh csh
         ]
       psValidator = def & defaultSortingByName

From 78ada75704bd6061841e89b3abfbaf9cd9c81011 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Tue, 12 Mar 2019 10:54:32 +0100
Subject: [PATCH 28/56] Filters for Participant List added

---
 src/Handler/Course.hs              | 87 +++++++++++++++---------------
 src/Handler/Utils/Table/Columns.hs | 22 ++++++++
 2 files changed, 67 insertions(+), 42 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 35b635e17..4260a94b3 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -659,45 +659,10 @@ type UserTableExpr   = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity
         `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)))
-type UserTableData   = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms))
 
 forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
 forceUserTableType = id
 
-userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User)
-                                                          , E.SqlExpr (E.Value UTCTime)
-                                                          , E.SqlExpr (E.Value (Maybe (Key CourseUserNote)))
-                                                          , StudyFeaturesDescription')
-
-userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures) = do
-  -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis
-  features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures
-  E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
-  E.on $         participant E.^. CourseParticipantUser  E.==. user E.^. UserId
-  E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
-  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, features)
-
-
-instance HasEntity UserTableData User where
-  hasEntity = _dbrOutput . _1
-
-instance HasUser UserTableData where
-  -- hasUser = _entityVal
-  hasUser = _dbrOutput . _1 . _entityVal
-
-_userTableRegistration :: Lens' UserTableData UTCTime
-_userTableRegistration = _dbrOutput . _2
-
-_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
-
-
 -- 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)
@@ -722,6 +687,41 @@ queryFeaturesField ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> c
 queryFeaturesField  = $(sqlIJproj 3 3)
 
 
+userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User)
+                                                          , E.SqlExpr (E.Value UTCTime)
+                                                          , E.SqlExpr (E.Value (Maybe (Key CourseUserNote)))
+                                                          , StudyFeaturesDescription')
+userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures) = do
+  -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis
+  features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures
+  E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
+  E.on $         participant E.^. CourseParticipantUser  E.==. user E.^. UserId
+  E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
+  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, features)
+
+
+type UserTableData   = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms))
+
+instance HasEntity UserTableData User where
+  hasEntity = _dbrOutput . _1
+
+instance HasUser UserTableData where
+  -- hasUser = _entityVal
+  hasUser = _dbrOutput . _1 . _entityVal
+
+_userTableRegistration :: Lens' UserTableData UTCTime
+_userTableRegistration = _dbrOutput . _2
+
+_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
+
+
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
 colUserComment tid ssh csh =
     sortable (Just "course-user-note") (i18nCell MsgCourseUserNote)
@@ -755,7 +755,7 @@ makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget
 makeCourseUserTable cid colChoices psValidator =
   -- -- psValidator has default sorting and filtering
   let dbtIdent     = "courseUsers" :: Text
-      dbtStyle     = def
+      dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
       dbtSQLQuery  = userTableQuery cid
       dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserId
       dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms))
@@ -771,7 +771,7 @@ makeCourseUserTable cid colChoices psValidator =
         , ("course-user-field"       , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsName))
         , ("course-user-field-short" , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsShorthand))
         , ("course-user-semesternr"  , SortColumn $ queryUserFeatures >>> queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
-        , ("course-registration"     , SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration))
+        , ("course-registration"     , SortColumn $ queryParticipant  >>> (E.^. CourseParticipantRegistration))
         , ("course-user-note"        , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
               E.sub_select . E.from $ \edit -> do
                 E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
@@ -782,13 +782,16 @@ makeCourseUserTable cid colChoices psValidator =
         [ fltrUserNameLink    queryUser
         , fltrUserEmail       queryUser
         , fltrUserMatriclenr  queryUser
-        , ("course-user-degree", error "TODO") -- TODO
-        , ("course-user-field" , error "TODO") -- TODO
+        -- , ("course-user-degree", error "TODO") -- TODO
+        -- , ("course-user-field" , error "TODO") -- TODO
         , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryUserFeatures >>> queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
-        , ("course-registration", error "TODO") -- TODO
-        , ("course-user-note", error "TODO") -- TODO
+        -- , ("course-registration", error "TODO") -- TODO
+        -- , ("course-user-note", error "TODO") -- TODO
+        ]
+      dbtFilterUI  = \mPrev -> mconcat
+        [ fltrUserNameLinkUI   mPrev
+        , fltrUserMatriclenrUI mPrev
         ]
-      dbtFilterUI  = mempty -- TODO
       dbtParams    = def
   in dbTableWidget' psValidator DBTable{..}
 
diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs
index 507ba10bf..b3791fe47 100644
--- a/src/Handler/Utils/Table/Columns.hs
+++ b/src/Handler/Utils/Table/Columns.hs
@@ -97,8 +97,23 @@ fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bo
   -> (d, FilterColumn t)
 fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName))
 
+-- --TODO
+-- fltrUserAny :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+--   => (a -> E.SqlExpr (Entity User))
+--   -> (d, FilterColumn t)
+-- fltrUserAny queryUser = ( "user-name-any", FilterColumn $ mkContainsFilter (queryAny . queryName))
+--   where
+--     queryAny user = queryUser >>> (E.^. UserDisplayName)
 
 
+
+fltrUserNameLinkUI ::  Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrUserNameLinkUI = fltrUserNameUI
+
+fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrUserNameUI mPrev =
+  prismAForm (singletonFilter "user-name") mPrev $ aopt (searchField True) (fslI MsgCourseMembers)
+
 -------------------
 -- Matriclenumber
 colUserMatriclenr ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
@@ -112,6 +127,9 @@ fltrUserMatriclenr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Boo
   -> (d, FilterColumn t)
 fltrUserMatriclenr queryUser = ( "user-matriclenumber", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserMatrikelnummer))
 
+fltrUserMatriclenrUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrUserMatriclenrUI mPrev =
+  prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt (searchField False) (fslI MsgMatrikelNr)
 
 
 ----------------
@@ -127,4 +145,8 @@ fltrUserEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)),
   -> (d, FilterColumn t)
 fltrUserEmail queryUser = ( "user-email", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserEmail))
 
+fltrUserEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrUserEmailUI mPrev =
+  prismAForm (singletonFilter "user-email") mPrev $ aopt (searchField False) (fslI MsgEMail)
+
 

From 25019eec58fea9edca2a6b57c2e98409242d5770 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Tue, 12 Mar 2019 10:58:14 +0100
Subject: [PATCH 29/56] mend

---
 src/Handler/Course.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 4260a94b3..ccba2fdbb 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -788,7 +788,7 @@ makeCourseUserTable cid colChoices psValidator =
         -- , ("course-registration", error "TODO") -- TODO
         -- , ("course-user-note", error "TODO") -- TODO
         ]
-      dbtFilterUI  = \mPrev -> mconcat
+      dbtFilterUI mPrev = mconcat
         [ fltrUserNameLinkUI   mPrev
         , fltrUserMatriclenrUI mPrev
         ]

From a76090a31fc808b993af4d901aad442e21cf5db2 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Tue, 12 Mar 2019 22:52:28 +0100
Subject: [PATCH 30/56] Stub for Studyfeature overview created

---
 messages/uniworx/de.msg |  8 +++++
 routes                  |  1 +
 src/Handler/Admin.hs    | 66 +++++++++++++++++++++++++++++++++++++++++
 src/Handler/Course.hs   |  2 +-
 src/Utils/Lens.hs       |  7 +++++
 5 files changed, 83 insertions(+), 1 deletion(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 6558b7e75..4bf4301c3 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -353,6 +353,7 @@ LecturersFor: Dozenten
 ForSchools n@Int: für #{pluralDE n "Institut" "Institute"}
 UserListTitle: Komprehensive Benutzerliste
 AccessRightsSaved: Berechtigungsänderungen wurden gespeichert.
+AdminFeaturesHeading: Studiengänge
 
 Date: Datum
 DateTimeFormat: Datums- und Uhrzeitformat
@@ -412,6 +413,13 @@ FieldPrimary: Hauptfach
 FieldSecondary: Nebenfach
 NoPrimaryStudyField: (kein Hauptfach registriert)
 
+DegreeKey: Schlüssel Abschluss
+DegreeName: Abschluss
+DegreeShort: Abschlusskürzel
+StudyTermsKey: Schlüssel Studiengang
+StudyTermsName: Studiengang
+StudyTermsShort: Studiengangkürzel
+
 MailTestFormEmail: Email-Addresse
 MailTestFormLanguages: Spracheinstellungen
 
diff --git a/routes b/routes
index 1a9f35659..3be16416b 100644
--- a/routes
+++ b/routes
@@ -39,6 +39,7 @@
 /users/#CryptoUUIDUser        AdminUserR        GET POST      !development
 /users/#CryptoUUIDUser/hijack AdminHijackUserR  POST          !adminANDno-escalation
 /admin/test                   AdminTestR        GET POST
+/admin/features               AdminFeaturesR    GET --POST    
 /admin/errMsg                 AdminErrMsgR      GET POST
 
 /info                         InfoR             GET            !free
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 946310640..083e5656e 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -8,11 +8,17 @@ import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
 
 import Control.Monad.Trans.Except
 
+import Utils.Lens
+
 -- import Data.Time
 -- import qualified Data.Text as T
 -- import Data.Function ((&))
 -- import Yesod.Form.Bootstrap3
 
+-- import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Handler.Utils.Table.Cells
+import qualified Database.Esqueleto as E
 import Database.Persist.Sql (fromSqlKey)
 
 -- import Colonnade hiding (fromMaybe)
@@ -154,3 +160,63 @@ postAdminErrMsgR = do
       <form action=@{AdminErrMsgR} method=post enctype=#{ctEncoding}>
         ^{ctView}
     |]
+
+
+
+getAdminFeaturesR :: Handler Html
+getAdminFeaturesR = do
+    degreeTable <- runDB mkDegreeTable
+    studytermsTable <- runDB mkStudytermsTable
+
+    siteLayoutMsg MsgAdminFeaturesHeading $ do
+      setTitleI MsgAdminFeaturesHeading
+      [whamlet|
+        ^{degreeTable}
+        ^{studytermsTable}
+      |]
+  where
+    mkDegreeTable =
+      let dbtIdent      = "admin-studydegrees" :: Text
+          dbtStyle      = def
+          dbtSQLQuery   :: (E.SqlExpr (Entity StudyDegree)) -> E.SqlQuery ( E.SqlExpr (Entity StudyDegree))
+          dbtSQLQuery   = return
+          dbtRowKey     = (E.^. StudyDegreeKey)
+          dbtProj       = return
+          dbtColonnade  = mconcat
+            [ sortable (Just "degree-key")   (i18nCell MsgDegreeKey)   (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
+            , sortable (Just "degree-name")  (i18nCell MsgDegreeName)  (foldMap textCell . view (_dbrOutput . _entityVal . _studyDegreeName))
+            , sortable (Just "degree-short") (i18nCell MsgDegreeShort) (foldMap textCell . view (_dbrOutput . _entityVal . _studyDegreeShorthand))
+            ]
+          dbtSorting    = Map.fromList
+            [ ("degree-key"  , SortColumn (E.^. StudyDegreeKey))
+            , ("degree-name" , SortColumn (E.^. StudyDegreeName))
+            , ("degree-short", SortColumn (E.^. StudyDegreeShorthand))
+            ]
+          dbtFilter     = mempty
+          dbtFilterUI   = mempty
+          dbtParams     = def
+          psValidator   = def & defaultSorting [SortAscBy "degree-name", SortAscBy "degree-short", SortAscBy "degree-key"]
+      in dbTableWidget' psValidator DBTable{..}
+
+    mkStudytermsTable =
+      let dbtIdent      = "admin-studyterms" :: Text
+          dbtStyle      = def
+          dbtSQLQuery   :: (E.SqlExpr (Entity StudyTerms)) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
+          dbtSQLQuery   = return
+          dbtRowKey     = (E.^. StudyTermsKey)
+          dbtProj       = return
+          dbtColonnade  = mconcat
+            [ sortable (Just "studyterms-key")   (i18nCell MsgStudyTermsKey)   (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
+            , sortable (Just "studyterms-name")  (i18nCell MsgStudyTermsName)  (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsName))
+            , sortable (Just "studyterms-short") (i18nCell MsgStudyTermsShort) (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsShorthand))
+            ]
+          dbtSorting    = Map.fromList
+            [ ("studyterms-key"  , SortColumn (E.^. StudyTermsKey))
+            , ("studyterms-name" , SortColumn (E.^. StudyTermsName))
+            , ("studyterms-short", SortColumn (E.^. StudyTermsShorthand))
+            ]
+          dbtFilter     = mempty
+          dbtFilterUI   = mempty
+          dbtParams     = def
+          psValidator   = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"]
+      in dbTableWidget' psValidator DBTable{..}
\ No newline at end of file
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index ccba2fdbb..0306d097c 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -757,7 +757,7 @@ makeCourseUserTable cid colChoices psValidator =
   let dbtIdent     = "courseUsers" :: Text
       dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
       dbtSQLQuery  = userTableQuery cid
-      dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserId
+      dbtRowKey    = queryUser >>> (E.^. UserId)
       dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms))
       dbtColonnade = colChoices
       dbtSorting   = Map.fromList
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index fc7e7a18e..1443b259d 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -82,6 +82,13 @@ makePrisms ''AuthResult
 
 makeLenses_ ''StudyFeatures
 
+makeLenses_ ''StudyDegree
+
+makeLenses_ ''StudyTerms
+
+makeLenses_ ''StudyTermCandidate
+
+
 -- makeClassy_ ''Load
 
 

From 579225b4d09a0bedc894e80bf7320ecb757436d2 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 13 Mar 2019 11:20:08 +0100
Subject: [PATCH 31/56] table for candidates added to admin-features

---
 models/users                          |  2 +-
 src/Handler/Admin.hs                  | 40 ++++++++++++++++++++++++---
 src/Handler/Course.hs                 | 33 ++++++++++------------
 src/Handler/Utils/Table/Cells.hs      |  3 ++
 src/Handler/Utils/Table/Pagination.hs |  2 +-
 5 files changed, 56 insertions(+), 24 deletions(-)

diff --git a/models/users b/models/users
index 7903f5760..2c8506b69 100644
--- a/models/users
+++ b/models/users
@@ -47,7 +47,7 @@ StudyTerms    -- Studiengang
     name          Text Maybe
     Primary key
 StudyTermCandidate
-    incidence     UUID
+    incidence     UUID     --random id per login to associate matching pairs
     key           Int
     name          Text
     deriving Show Eq Ord
\ No newline at end of file
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 083e5656e..76795c743 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -165,14 +165,23 @@ postAdminErrMsgR = do
 
 getAdminFeaturesR :: Handler Html
 getAdminFeaturesR = do
-    degreeTable <- runDB mkDegreeTable
-    studytermsTable <- runDB mkStudytermsTable
+    (degreeTable,studytermsTable,candidateTable) <- runDB $ (,,)
+      <$> mkDegreeTable
+      <*> mkStudytermsTable
+      <*> mkCandidateTable
 
     siteLayoutMsg MsgAdminFeaturesHeading $ do
       setTitleI MsgAdminFeaturesHeading
       [whamlet|
-        ^{degreeTable}
-        ^{studytermsTable}
+        <div .container>
+          <section>
+            ^{degreeTable}
+        <div .container>
+          <section>
+            ^{studytermsTable}
+        <div .container>
+          <section>
+            ^{candidateTable}
       |]
   where
     mkDegreeTable =
@@ -219,4 +228,27 @@ getAdminFeaturesR = do
           dbtFilterUI   = mempty
           dbtParams     = def
           psValidator   = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"]
+      in dbTableWidget' psValidator DBTable{..}
+
+    mkCandidateTable =
+      let dbtIdent      = "admin-termcandidate" :: Text
+          dbtStyle      = def
+          dbtSQLQuery   :: (E.SqlExpr (Entity StudyTermCandidate)) -> E.SqlQuery ( E.SqlExpr (Entity StudyTermCandidate))
+          dbtSQLQuery   = return
+          dbtRowKey     = (E.^. StudyTermCandidateId)
+          dbtProj       = return
+          dbtColonnade  = mconcat
+            [ sortable (Just "termcandidate-key")       (i18nCell MsgStudyTermsKey)   (numCell  . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
+            , sortable (Just "termcandidate-name")      (i18nCell MsgStudyTermsName)  (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
+            , sortable (Just "termcandidate-incidence") (i18nCell MsgStudyTermsShort) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
+            ]
+          dbtSorting    = Map.fromList
+            [ ("termcandidate-key"      , SortColumn (E.^. StudyTermCandidateKey))
+            , ("termcandidate-name"     , SortColumn (E.^. StudyTermCandidateName))
+            , ("termcandidate-incidence", SortColumn (E.^. StudyTermCandidateIncidence))
+            ]
+          dbtFilter     = mempty
+          dbtFilterUI   = mempty
+          dbtParams     = def
+          psValidator   = def & defaultSorting [SortAscBy "termcandidate-name", SortAscBy "termcandidate-key"]
       in dbTableWidget' psValidator DBTable{..}
\ No newline at end of file
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 0306d097c..417069c88 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -660,8 +660,8 @@ type UserTableExpr   = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity
         `E.LeftOuterJoin`
         (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms)))
 
-forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
-forceUserTableType = id
+-- forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
+-- forceUserTableType = id
 
 -- 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
@@ -674,17 +674,14 @@ queryParticipant = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
 queryUserNote ::  UserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote))
 queryUserNote = $(sqlLOJproj 3 2)
 
-queryUserFeatures :: UserTableExpr -> (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms)))
-queryUserFeatures = $(sqlLOJproj 3 3)
+queryFeaturesStudy ::  UserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures))
+queryFeaturesStudy  = $(sqlIJproj 3 1) . $(sqlLOJproj 3 3)
 
-queryFeaturesStudy ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> a
-queryFeaturesStudy  = $(sqlIJproj 3 1)
+queryFeaturesDegree :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree))
+queryFeaturesDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 3 3)
 
-queryFeaturesDegree ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> b
-queryFeaturesDegree = $(sqlIJproj 3 2)
-
-queryFeaturesField ::  (a `E.InnerJoin` b `E.InnerJoin` c) -> c
-queryFeaturesField  = $(sqlIJproj 3 3)
+queryFeaturesField :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms))
+queryFeaturesField  = $(sqlIJproj 3 3) . $(sqlLOJproj 3 3)
 
 
 userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User)
@@ -766,12 +763,12 @@ makeCourseUserTable cid colChoices psValidator =
         , sortUserDisplayName queryUser -- needed for initial sorting
         , sortUserEmail       queryUser
         , sortUserMatriclenr  queryUser
-        , ("course-user-degree"      , SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> (E.?. StudyDegreeName))
-        , ("course-user-degree-short", SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
-        , ("course-user-field"       , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsName))
-        , ("course-user-field-short" , SortColumn $ queryUserFeatures >>> queryFeaturesField  >>> (E.?. StudyTermsShorthand))
-        , ("course-user-semesternr"  , SortColumn $ queryUserFeatures >>> queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
-        , ("course-registration"     , SortColumn $ queryParticipant  >>> (E.^. CourseParticipantRegistration))
+        , ("course-user-degree"      , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
+        , ("course-user-degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
+        , ("course-user-field"       , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsName))
+        , ("course-user-field-short" , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsShorthand))
+        , ("course-user-semesternr"  , SortColumn $ queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
+        , ("course-registration"     , SortColumn $ queryParticipant    >>> (E.^. CourseParticipantRegistration))
         , ("course-user-note"        , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
               E.sub_select . E.from $ \edit -> do
                 E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
@@ -784,7 +781,7 @@ makeCourseUserTable cid colChoices psValidator =
         , fltrUserMatriclenr  queryUser
         -- , ("course-user-degree", error "TODO") -- TODO
         -- , ("course-user-field" , error "TODO") -- TODO
-        , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryUserFeatures >>> queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
+        , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
         -- , ("course-registration", error "TODO") -- TODO
         -- , ("course-user-note", error "TODO") -- TODO
         ]
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index 05d2463f3..d832b868b 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -42,6 +42,9 @@ maybeCell = flip foldMap
 htmlCell :: (IsDBTable m a, ToMarkup c) => c -> DBCell m a
 htmlCell = cell . toWidget . toMarkup
 
+pathPieceCell :: (IsDBTable m a, PathPiece p) => p -> DBCell m a
+pathPieceCell = cell . toWidget . toPathPiece
+
 ---------------------
 -- Icon cells
 
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 2b842d487..a7bfbfa9b 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -373,7 +373,7 @@ data DBTable m x = forall a r r' h i t k k'.
   , E.From E.SqlQuery E.SqlExpr E.SqlBackend t
   ) => DBTable
   { dbtSQLQuery :: t -> E.SqlQuery a
-  , dbtRowKey :: t -> k
+  , dbtRowKey :: t -> k                 -- ^ required for table forms; always same key for repeated requests. For joins: return unique tuples.
   , dbtProj :: DBRow r -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) r'
   , dbtColonnade :: Colonnade h r' (DBCell m x)
   , dbtSorting :: Map SortingKey (SortColumn t)

From a02cf61c82eaa262d56eb090ea543f4e85c7058f Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 13 Mar 2019 13:30:11 +0100
Subject: [PATCH 32/56] filter email name ui combined

---
 models/users                       | 10 +++++-----
 src/Database/Esqueleto/Utils.hs    | 11 ++++++++++-
 src/Handler/Course.hs              | 29 +++++++++++++++--------------
 src/Handler/Utils/Table/Columns.hs | 25 +++++++++++++++----------
 4 files changed, 45 insertions(+), 30 deletions(-)

diff --git a/models/users b/models/users
index 2c8506b69..60909e42c 100644
--- a/models/users
+++ b/models/users
@@ -5,16 +5,16 @@ User json
     lastAuthentication UTCTime Maybe
     matrikelnummer Text Maybe
     email          (CI Text)
-    displayName    Text
-    surname        Text            -- always use: nameWidget displayName surname
-    maxFavourites  Int default=12
+    displayName    Text            -- we always show the LDAP displayName only, but highlight the LDAP surname within (or appended if not contained)
+    surname        Text            -- Name displayed through 'nameWidget displayName surname' which highlights surname within displayName
+    maxFavourites  Int default=12  -- Number of last used course names to be remembered for quick links for convenience
     theme          Theme default='Default'
     dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'"
     dateFormat     DateTimeFormat "default='%d.%m.%Y'"
     timeFormat     DateTimeFormat "default='%R'"
-    downloadFiles  Bool default=false
+    downloadFiles  Bool default=false          -- Files should be opened in browser or downloaded
     mailLanguages  MailLanguages default='[]'
-    notificationSettings NotificationSettings
+    notificationSettings NotificationSettings  -- Bit-array for which events email notification is requested by user
     UniqueAuthentication ident
     UniqueEmail email
     deriving Show Eq Generic
diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 4e3e85e22..2dab7cf8d 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -6,6 +6,7 @@ module Database.Esqueleto.Utils
   , any, all
   , SqlIn(..)
   , mkExactFilter, mkContainsFilter
+  , anyFilter
   ) where
 
 import ClassyPrelude.Yesod hiding (isInfixOf, any, all)
@@ -53,6 +54,8 @@ all :: Foldable f =>
 all test = F.foldr (\needle acc -> acc E.&&. test needle) true
 
 
+
+-- Allow usage of Tuples as DbtRowKey, i.e. SqlIn instances for tuples
 $(sqlInTuples [2..16])
 
 -- | Example for usage of sqlIJproj
@@ -74,7 +77,7 @@ mkExactFilter lenslike row criterias
 
 -- | generic filter creation for dbTable
 --   Given a lens-like function, make filter searching for needles in String-like elements
---   (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere)
+--   (Keep Set here to ensure that there are no duplicates)
 mkContainsFilter :: (E.SqlString a)
   =>  (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element
   -> t                             -- ^ query row
@@ -84,3 +87,9 @@ mkContainsFilter lenslike row criterias
   | Set.null criterias = true
   | otherwise = any (hasInfix $ lenslike row) criterias
 
+
+anyFilter :: (Foldable f) => f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool))
+                   -> t -> Set.Set Text-> E.SqlExpr (E.Value Bool)
+anyFilter fltrs needle criterias = F.foldr aux false fltrs
+  where
+    aux fltr acc = fltr needle criterias E.||. acc
\ No newline at end of file
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 417069c88..aa839b697 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -721,7 +721,7 @@ _rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester
 
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
 colUserComment tid ssh csh =
-    sortable (Just "course-user-note") (i18nCell MsgCourseUserNote)
+    sortable (Just "note") (i18nCell MsgCourseUserNote)
       $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey,_) } ->
         maybeEmpty mbNoteKey $ const $
           anchorCellM (courseLink <$> encrypt uid) (toWidget $ hasComment True)
@@ -729,23 +729,23 @@ colUserComment tid ssh csh =
     courseLink = CourseR tid ssh csh . CUserR
 
 colUserSemester :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserSemester = sortable (Just "course-user-semesternr") (i18nCell MsgStudyFeatureAge) $
+colUserSemester = sortable (Just "semesternr") (i18nCell MsgStudyFeatureAge) $
     foldMap numCell . preview _rowUserSemester
 
 colUserField :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserField = sortable (Just "course-user-field") (i18nCell MsgCourseStudyFeature) $
+colUserField = sortable (Just "field") (i18nCell MsgCourseStudyFeature) $
     foldMap htmlCell . view (_userTableFeatures . _3)
 
 colUserFieldShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserFieldShort = sortable (Just "course-user-field-short") (i18nCell MsgCourseStudyFeature) $
+colUserFieldShort = sortable (Just "field-short") (i18nCell MsgCourseStudyFeature) $
     foldMap (htmlCell . shortStudyTerms) . view (_userTableFeatures . _3)
 
 colUserDegree :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserDegree = sortable (Just "course-user-degree") (i18nCell MsgStudyFeatureDegree) $
+colUserDegree = sortable (Just "degree") (i18nCell MsgStudyFeatureDegree) $
     foldMap htmlCell . preview (_userTableFeatures . _2 . _Just)
 
 colUserDegreeShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
-colUserDegreeShort = sortable (Just "course-user-degree-short") (i18nCell MsgStudyFeatureDegree) $
+colUserDegreeShort = sortable (Just "degree-short") (i18nCell MsgStudyFeatureDegree) $
     foldMap (htmlCell . shortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
 
 makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget
@@ -763,13 +763,13 @@ makeCourseUserTable cid colChoices psValidator =
         , sortUserDisplayName queryUser -- needed for initial sorting
         , sortUserEmail       queryUser
         , sortUserMatriclenr  queryUser
-        , ("course-user-degree"      , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
-        , ("course-user-degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
-        , ("course-user-field"       , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsName))
-        , ("course-user-field-short" , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsShorthand))
-        , ("course-user-semesternr"  , SortColumn $ queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
-        , ("course-registration"     , SortColumn $ queryParticipant    >>> (E.^. CourseParticipantRegistration))
-        , ("course-user-note"        , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
+        , ("degree"      , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
+        , ("degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
+        , ("field"       , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsName))
+        , ("field-short" , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsShorthand))
+        , ("semesternr"  , SortColumn $ queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
+        , ("registration", SortColumn $ queryParticipant    >>> (E.^. CourseParticipantRegistration))
+        , ("note"        , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
               E.sub_select . E.from $ \edit -> do
                 E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
                 return . E.max_ $ edit E.^. CourseUserNoteEditTime
@@ -779,6 +779,7 @@ makeCourseUserTable cid colChoices psValidator =
         [ fltrUserNameLink    queryUser
         , fltrUserEmail       queryUser
         , fltrUserMatriclenr  queryUser
+        , fltrUserNameEmail   queryUser
         -- , ("course-user-degree", error "TODO") -- TODO
         -- , ("course-user-field" , error "TODO") -- TODO
         , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
@@ -786,7 +787,7 @@ makeCourseUserTable cid colChoices psValidator =
         -- , ("course-user-note", error "TODO") -- TODO
         ]
       dbtFilterUI mPrev = mconcat
-        [ fltrUserNameLinkUI   mPrev
+        [ fltrUserNameEmailUI   mPrev
         , fltrUserMatriclenrUI mPrev
         ]
       dbtParams    = def
diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs
index b3791fe47..52e8b5dfe 100644
--- a/src/Handler/Utils/Table/Columns.hs
+++ b/src/Handler/Utils/Table/Columns.hs
@@ -12,7 +12,7 @@ import Import
 -- import Text.Blaze (ToMarkup(..))
 
 import qualified Database.Esqueleto as E
-import Database.Esqueleto.Utils
+import Database.Esqueleto.Utils as E
 
 import Utils.Lens
 import Handler.Utils
@@ -97,15 +97,16 @@ fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bo
   -> (d, FilterColumn t)
 fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName))
 
--- --TODO
--- fltrUserAny :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
---   => (a -> E.SqlExpr (Entity User))
---   -> (d, FilterColumn t)
--- fltrUserAny queryUser = ( "user-name-any", FilterColumn $ mkContainsFilter (queryAny . queryName))
---   where
---     queryAny user = queryUser >>> (E.^. UserDisplayName)
-
-
+-- | Searche all names, i.e. DisplayName, Surname, EMail
+fltrUserNameEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+   => (a -> E.SqlExpr (Entity User))
+   -> (d, FilterColumn t)
+fltrUserNameEmail queryUser = ( "user-name-email", FilterColumn $ anyFilter
+    [ mkContainsFilter  $ queryUser >>> (E.^. UserDisplayName)
+    , mkContainsFilter  $ queryUser >>> (E.^. UserSurname)
+    , mkContainsFilter  $ queryUser >>> (E.^. UserEmail)
+    ]
+  )
 
 fltrUserNameLinkUI ::  Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
 fltrUserNameLinkUI = fltrUserNameUI
@@ -114,6 +115,10 @@ fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map F
 fltrUserNameUI mPrev =
   prismAForm (singletonFilter "user-name") mPrev $ aopt (searchField True) (fslI MsgCourseMembers)
 
+fltrUserNameEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrUserNameEmailUI mPrev =
+  prismAForm (singletonFilter "user-name-email") mPrev $ aopt (searchField True) (fslI MsgCourseMembers)
+
 -------------------
 -- Matriclenumber
 colUserMatriclenr ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)

From b2bb30a4294f939fb20e1a524ef7c34cac6f44d5 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 13 Mar 2019 14:50:58 +0100
Subject: [PATCH 33/56] Form for Degrees changes implemented

---
 messages/uniworx/de.msg               |  2 ++
 routes                                |  2 +-
 src/Handler/Admin.hs                  | 36 +++++++++++++++++++++------
 src/Handler/Course.hs                 |  2 +-
 src/Handler/Utils/Table/Pagination.hs | 14 +++++------
 5 files changed, 40 insertions(+), 16 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 4bf4301c3..1645c1da7 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -419,6 +419,8 @@ DegreeShort: Abschlusskürzel
 StudyTermsKey: Schlüssel Studiengang
 StudyTermsName: Studiengang
 StudyTermsShort: Studiengangkürzel
+StudyDegreeChangeSuccess: Abschlusszuordnungen wurden aktualisiert
+
 
 MailTestFormEmail: Email-Addresse
 MailTestFormLanguages: Spracheinstellungen
diff --git a/routes b/routes
index 3be16416b..a7961404f 100644
--- a/routes
+++ b/routes
@@ -39,7 +39,7 @@
 /users/#CryptoUUIDUser        AdminUserR        GET POST      !development
 /users/#CryptoUUIDUser/hijack AdminHijackUserR  POST          !adminANDno-escalation
 /admin/test                   AdminTestR        GET POST
-/admin/features               AdminFeaturesR    GET --POST    
+/admin/features               AdminFeaturesR    GET POST
 /admin/errMsg                 AdminErrMsgR      GET POST
 
 /info                         InfoR             GET            !free
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 76795c743..741e4b17e 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -163,13 +163,24 @@ postAdminErrMsgR = do
 
 
 
-getAdminFeaturesR :: Handler Html
-getAdminFeaturesR = do
-    (degreeTable,studytermsTable,candidateTable) <- runDB $ (,,)
+getAdminFeaturesR, postAdminFeaturesR :: Handler Html
+getAdminFeaturesR = postAdminFeaturesR
+postAdminFeaturesR = do
+    ((degreeResult,degreeTable),studytermsTable,candidateTable) <- runDB $ (,,)
       <$> mkDegreeTable
       <*> mkStudytermsTable
       <*> mkCandidateTable
 
+    let degreeResult' :: FormResult (Map (Key StudyDegree) (Maybe Text, Maybe Text))
+        degreeResult' = degreeResult <&> getDBFormResult
+          (\row -> ( row ^. _dbrOutput . _entityVal . _studyDegreeName
+                   , row ^. _dbrOutput . _entityVal . _studyDegreeShorthand
+          ))
+        updateDegree degreeKey (name,short) = update degreeKey [StudyDegreeName =. name, StudyDegreeShorthand =. short]
+    formResult degreeResult' $ \res -> do
+      void . runDB $ Map.traverseWithKey updateDegree res
+      addMessageI Success MsgStudyDegreeChangeSuccess
+
     siteLayoutMsg MsgAdminFeaturesHeading $ do
       setTitleI MsgAdminFeaturesHeading
       [whamlet|
@@ -184,6 +195,7 @@ getAdminFeaturesR = do
             ^{candidateTable}
       |]
   where
+    mkDegreeTable :: DB (FormResult (DBFormResult (Key StudyDegree) (Maybe Text, Maybe Text) (DBRow (Entity StudyDegree))), Widget)
     mkDegreeTable =
       let dbtIdent      = "admin-studydegrees" :: Text
           dbtStyle      = def
@@ -193,8 +205,18 @@ getAdminFeaturesR = do
           dbtProj       = return
           dbtColonnade  = mconcat
             [ sortable (Just "degree-key")   (i18nCell MsgDegreeKey)   (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
-            , sortable (Just "degree-name")  (i18nCell MsgDegreeName)  (foldMap textCell . view (_dbrOutput . _entityVal . _studyDegreeName))
-            , sortable (Just "degree-short") (i18nCell MsgDegreeShort) (foldMap textCell . view (_dbrOutput . _entityVal . _studyDegreeShorthand))
+            , sortable (Just "degree-name")  (i18nCell MsgDegreeName)
+              (formCell id (return . view (_dbrOutput . _entityKey))
+                (\row _mkUnique ->
+                  (\(res,nameview) -> (set _1 <$> res, fvInput nameview)) <$>
+                  mopt textField "" (Just $ row ^. _dbrOutput . _entityVal . _studyDegreeName)
+              ))
+            , sortable (Just "degree-short") (i18nCell MsgDegreeShort)
+              (formCell id (return . view (_dbrOutput . _entityKey))
+                (\row _mkUnique ->
+                  (\(res,shortview) -> (set _2 <$> res, fvInput shortview)) <$>
+                  mopt textField "" (Just $ row ^. _dbrOutput . _entityVal . _studyDegreeShorthand)
+              ))
             ]
           dbtSorting    = Map.fromList
             [ ("degree-key"  , SortColumn (E.^. StudyDegreeKey))
@@ -203,9 +225,9 @@ getAdminFeaturesR = do
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
-          dbtParams     = def
+          dbtParams     = def { dbParamsFormAddSubmit = True }
           psValidator   = def & defaultSorting [SortAscBy "degree-name", SortAscBy "degree-short", SortAscBy "degree-key"]
-      in dbTableWidget' psValidator DBTable{..}
+      in dbTable psValidator DBTable{..}
 
     mkStudytermsTable =
       let dbtIdent      = "admin-studyterms" :: Text
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index aa839b697..1175bf6e0 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -787,7 +787,7 @@ makeCourseUserTable cid colChoices psValidator =
         -- , ("course-user-note", error "TODO") -- TODO
         ]
       dbtFilterUI mPrev = mconcat
-        [ fltrUserNameEmailUI   mPrev
+        [ fltrUserNameEmailUI  mPrev
         , fltrUserMatriclenrUI mPrev
         ]
       dbtParams    = def
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index a7bfbfa9b..22e536887 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -844,11 +844,11 @@ instance Ord i => Monoid (DBFormResult i a r) where
 getDBFormResult :: forall r i a. Ord i => (r -> a) -> DBFormResult i a r -> Map i a
 getDBFormResult initial (DBFormResult m) = Map.map (\(r, f) -> f $ initial r) m
 
-formCell :: forall res r i a. (Ord i, Monoid res)
-         => Lens' res (FormResult (DBFormResult i a (DBRow r)))
-         -> (DBRow r -> MForm (HandlerT UniWorX IO) i)
+formCell :: forall x r i a. (Ord i, Monoid x)
+         => Lens' x (FormResult (DBFormResult i a (DBRow r)))   -- ^ lens focussing on the form result within the larger DBResult; @id@ iff the form delivers the only result of the table
+         -> (DBRow r -> MForm (HandlerT UniWorX IO) i)          -- ^ generate row identfifiers for use in form result
          -> (DBRow r -> (forall p. PathPiece p => p -> Text) -> MForm (HandlerT UniWorX IO) (FormResult (a -> a), Widget)) -- ^ Given the row data and a callback to make an input name suitably unique generate the `MForm`
-         -> (DBRow r -> DBCell (MForm (HandlerT UniWorX IO)) res)
+         -> (DBRow r -> DBCell (MForm (HandlerT UniWorX IO)) x)
 formCell formCellLens genIndex genForm input@(DBRow{dbrKey}) = FormCell
   { formCellAttrs    = []
   , formCellContents = do -- MForm (HandlerT UniWorX IO) (FormResult (Map i (Endo a)), Widget)
@@ -871,11 +871,11 @@ formCell formCellLens genIndex genForm input@(DBRow{dbrKey}) = FormCell
 dbRow :: forall h r m a. (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a)
 dbRow = Colonnade.singleton (headednessPure $ i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex
 
-dbSelect :: forall res h r i a. (Headedness h, Ord i, PathPiece i, Monoid res)
-         => Lens' res (FormResult (DBFormResult i a (DBRow r)))
+dbSelect :: forall x h r i a. (Headedness h, Ord i, PathPiece i, Monoid x)
+         => Lens' x (FormResult (DBFormResult i a (DBRow r)))
          -> Setter' a Bool
          -> (DBRow r -> MForm (HandlerT UniWorX IO) i)
-         -> Colonnade h (DBRow r) (DBCell (MForm (HandlerT UniWorX IO)) res)
+         -> Colonnade h (DBRow r) (DBCell (MForm (HandlerT UniWorX IO)) x)
 dbSelect resLens selLens genIndex = Colonnade.singleton (headednessPure $ i18nCell MsgSelectColumn) $ formCell resLens genIndex genForm
   where
     genForm _ mkUnique = do

From 6cce5c05cc09d16f09a9fa5f2805695719ed03bb Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 13 Mar 2019 16:41:22 +0100
Subject: [PATCH 34/56] Forms for terms added, but buggy

---
 db.sh                            |  2 +-
 messages/uniworx/de.msg          |  4 +--
 src/Handler/Admin.hs             | 53 +++++++++++++++++++-------------
 src/Handler/Utils/Table/Cells.hs |  5 +++
 4 files changed, 39 insertions(+), 25 deletions(-)

diff --git a/db.sh b/db.sh
index bb9685550..2e6f5026a 100755
--- a/db.sh
+++ b/db.sh
@@ -1,4 +1,4 @@
 #!/usr/bin/env -S bash -xe
-
+# Options: see /test/Database.hs (Main)
 stack build --fast --flag uniworx:library-only --flag uniworx:dev
 stack exec uniworxdb -- $@
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 1645c1da7..d92e4810a 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -419,8 +419,8 @@ DegreeShort: Abschlusskürzel
 StudyTermsKey: Schlüssel Studiengang
 StudyTermsName: Studiengang
 StudyTermsShort: Studiengangkürzel
-StudyDegreeChangeSuccess: Abschlusszuordnungen wurden aktualisiert
-
+StudyTermsChangeSuccess: Zuordnung Abschlüsse aktualisiert
+StudyDegreeChangeSuccess: Zuordnung Studiengänge aktualisiert
 
 MailTestFormEmail: Email-Addresse
 MailTestFormLanguages: Spracheinstellungen
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 741e4b17e..da90c398f 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -166,7 +166,9 @@ postAdminErrMsgR = do
 getAdminFeaturesR, postAdminFeaturesR :: Handler Html
 getAdminFeaturesR = postAdminFeaturesR
 postAdminFeaturesR = do
-    ((degreeResult,degreeTable),studytermsTable,candidateTable) <- runDB $ (,,)
+    (   (degreeResult,degreeTable)
+      , (studyTermsResult,studytermsTable)
+      , ((),candidateTable)) <- runDB $ (,,)
       <$> mkDegreeTable
       <*> mkStudytermsTable
       <*> mkCandidateTable
@@ -181,6 +183,16 @@ postAdminFeaturesR = do
       void . runDB $ Map.traverseWithKey updateDegree res
       addMessageI Success MsgStudyDegreeChangeSuccess
 
+    let studyTermsResult' :: FormResult (Map (Key StudyTerms) (Maybe Text, Maybe Text))
+        studyTermsResult' = studyTermsResult <&> getDBFormResult
+          (\row -> ( row ^. _dbrOutput . _entityVal . _studyTermsName
+                   , row ^. _dbrOutput . _entityVal . _studyTermsShorthand
+          ))
+        updateStudyTerms studyTermsKey (name,short) = update studyTermsKey [StudyTermsName =. name, StudyTermsShorthand =. short]
+    formResult studyTermsResult' $ \res -> do
+      void . runDB $ Map.traverseWithKey updateStudyTerms res
+      addMessageI Success MsgStudyTermsChangeSuccess
+
     siteLayoutMsg MsgAdminFeaturesHeading $ do
       setTitleI MsgAdminFeaturesHeading
       [whamlet|
@@ -195,6 +207,12 @@ postAdminFeaturesR = do
             ^{candidateTable}
       |]
   where
+    textInputCell lensRes lensDefault = formCell id (return . view (_dbrOutput . _entityKey))
+      (\row _mkUnique -> (\(res,fieldView) -> (set lensRes <$> res, fvInput fieldView))
+        <$> mopt textField "" (Just $ row ^. lensDefault)
+      )
+
+
     mkDegreeTable :: DB (FormResult (DBFormResult (Key StudyDegree) (Maybe Text, Maybe Text) (DBRow (Entity StudyDegree))), Widget)
     mkDegreeTable =
       let dbtIdent      = "admin-studydegrees" :: Text
@@ -203,20 +221,10 @@ postAdminFeaturesR = do
           dbtSQLQuery   = return
           dbtRowKey     = (E.^. StudyDegreeKey)
           dbtProj       = return
-          dbtColonnade  = mconcat
+          dbtColonnade  = formColonnade $ mconcat
             [ sortable (Just "degree-key")   (i18nCell MsgDegreeKey)   (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
-            , sortable (Just "degree-name")  (i18nCell MsgDegreeName)
-              (formCell id (return . view (_dbrOutput . _entityKey))
-                (\row _mkUnique ->
-                  (\(res,nameview) -> (set _1 <$> res, fvInput nameview)) <$>
-                  mopt textField "" (Just $ row ^. _dbrOutput . _entityVal . _studyDegreeName)
-              ))
-            , sortable (Just "degree-short") (i18nCell MsgDegreeShort)
-              (formCell id (return . view (_dbrOutput . _entityKey))
-                (\row _mkUnique ->
-                  (\(res,shortview) -> (set _2 <$> res, fvInput shortview)) <$>
-                  mopt textField "" (Just $ row ^. _dbrOutput . _entityVal . _studyDegreeShorthand)
-              ))
+            , sortable (Just "degree-name")  (i18nCell MsgDegreeName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
+            , sortable (Just "degree-short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
             ]
           dbtSorting    = Map.fromList
             [ ("degree-key"  , SortColumn (E.^. StudyDegreeKey))
@@ -225,10 +233,11 @@ postAdminFeaturesR = do
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
-          dbtParams     = def { dbParamsFormAddSubmit = True }
+          dbtParams     = def { dbParamsFormAddSubmit = True } -- dbParamsFormEvaluate = liftHandlerT . (runFormPost . identifyForm "degree-table" - (identForm FIDdegree))}
           psValidator   = def & defaultSorting [SortAscBy "degree-name", SortAscBy "degree-short", SortAscBy "degree-key"]
       in dbTable psValidator DBTable{..}
 
+    mkStudytermsTable :: DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
     mkStudytermsTable =
       let dbtIdent      = "admin-studyterms" :: Text
           dbtStyle      = def
@@ -236,10 +245,10 @@ postAdminFeaturesR = do
           dbtSQLQuery   = return
           dbtRowKey     = (E.^. StudyTermsKey)
           dbtProj       = return
-          dbtColonnade  = mconcat
+          dbtColonnade  = formColonnade $ mconcat
             [ sortable (Just "studyterms-key")   (i18nCell MsgStudyTermsKey)   (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
-            , sortable (Just "studyterms-name")  (i18nCell MsgStudyTermsName)  (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsName))
-            , sortable (Just "studyterms-short") (i18nCell MsgStudyTermsShort) (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsShorthand))
+            , sortable (Just "studyterms-name")  (i18nCell MsgStudyTermsName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
+            , sortable (Just "studyterms-short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
             ]
           dbtSorting    = Map.fromList
             [ ("studyterms-key"  , SortColumn (E.^. StudyTermsKey))
@@ -248,9 +257,9 @@ postAdminFeaturesR = do
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
-          dbtParams     = def
+          dbtParams     = def { dbParamsFormAddSubmit = True } -- , dbParamsFormEvaluate = liftHandlerT . runFormPost }
           psValidator   = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"]
-      in dbTableWidget' psValidator DBTable{..}
+      in dbTable psValidator DBTable{..}
 
     mkCandidateTable =
       let dbtIdent      = "admin-termcandidate" :: Text
@@ -259,7 +268,7 @@ postAdminFeaturesR = do
           dbtSQLQuery   = return
           dbtRowKey     = (E.^. StudyTermCandidateId)
           dbtProj       = return
-          dbtColonnade  = mconcat
+          dbtColonnade  = dbColonnade $ mconcat
             [ sortable (Just "termcandidate-key")       (i18nCell MsgStudyTermsKey)   (numCell  . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
             , sortable (Just "termcandidate-name")      (i18nCell MsgStudyTermsName)  (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
             , sortable (Just "termcandidate-incidence") (i18nCell MsgStudyTermsShort) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
@@ -273,4 +282,4 @@ postAdminFeaturesR = do
           dbtFilterUI   = mempty
           dbtParams     = def
           psValidator   = def & defaultSorting [SortAscBy "termcandidate-name", SortAscBy "termcandidate-key"]
-      in dbTableWidget' psValidator DBTable{..}
\ No newline at end of file
+      in dbTable psValidator DBTable{..}
\ No newline at end of file
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index d832b868b..d4b9e5249 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -45,6 +45,11 @@ htmlCell = cell . toWidget . toMarkup
 pathPieceCell :: (IsDBTable m a, PathPiece p) => p -> DBCell m a
 pathPieceCell = cell . toWidget . toPathPiece
 
+-- | execute a DB action that return a widget for the cell contents
+sqlCell :: (IsDBTable (YesodDB UniWorX) a) => YesodDB UniWorX Widget -> DBCell (YesodDB UniWorX) a
+sqlCell act = mempty & cellContents .~ lift act
+
+
 ---------------------
 -- Icon cells
 

From 0917b2c58015b5567a8d2a41382065489752070d Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 13 Mar 2019 18:18:31 +0100
Subject: [PATCH 35/56] testdata added for studytermcandidates

---
 .hlint.yaml             |  5 ++--
 db.sh                   |  2 +-
 messages/uniworx/de.msg |  1 +
 src/Handler/Admin.hs    |  6 ++---
 test/Database.hs        | 57 ++++++++++++++++++++++++++++++++++++++---
 5 files changed, 61 insertions(+), 10 deletions(-)

diff --git a/.hlint.yaml b/.hlint.yaml
index b9203d95b..ecd17c599 100644
--- a/.hlint.yaml
+++ b/.hlint.yaml
@@ -1,5 +1,5 @@
-# HLint configuration file                                                 
-# https://github.com/ndmitchell/hlint                                      
+# HLint configuration file
+# https://github.com/ndmitchell/hlint
 ##########################
 
   - ignore: { name: "Parse error" }
@@ -7,6 +7,7 @@
   - ignore: { name: "Use ||" }
   - ignore: { name: "Use &&" }
   - ignore: { name: "Use ++" }
+  - ignore: { name: "Use ***" }
 
   - arguments:
       - -XQuasiQuotes
diff --git a/db.sh b/db.sh
index 2e6f5026a..82d89d19f 100755
--- a/db.sh
+++ b/db.sh
@@ -1,4 +1,4 @@
-#!/usr/bin/env -S bash -xe
+#!/bin/bash
 # Options: see /test/Database.hs (Main)
 stack build --fast --flag uniworx:library-only --flag uniworx:dev
 stack exec uniworxdb -- $@
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index d92e4810a..17602162c 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -421,6 +421,7 @@ StudyTermsName: Studiengang
 StudyTermsShort: Studiengangkürzel
 StudyTermsChangeSuccess: Zuordnung Abschlüsse aktualisiert
 StudyDegreeChangeSuccess: Zuordnung Studiengänge aktualisiert
+StudyCandidateIncidienc: Anmeldevorgang
 
 MailTestFormEmail: Email-Addresse
 MailTestFormLanguages: Spracheinstellungen
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index da90c398f..47bf781dd 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -217,7 +217,7 @@ postAdminFeaturesR = do
     mkDegreeTable =
       let dbtIdent      = "admin-studydegrees" :: Text
           dbtStyle      = def
-          dbtSQLQuery   :: (E.SqlExpr (Entity StudyDegree)) -> E.SqlQuery ( E.SqlExpr (Entity StudyDegree))
+          dbtSQLQuery   :: E.SqlExpr (Entity StudyDegree) -> E.SqlQuery ( E.SqlExpr (Entity StudyDegree))
           dbtSQLQuery   = return
           dbtRowKey     = (E.^. StudyDegreeKey)
           dbtProj       = return
@@ -241,7 +241,7 @@ postAdminFeaturesR = do
     mkStudytermsTable =
       let dbtIdent      = "admin-studyterms" :: Text
           dbtStyle      = def
-          dbtSQLQuery   :: (E.SqlExpr (Entity StudyTerms)) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
+          dbtSQLQuery   :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
           dbtSQLQuery   = return
           dbtRowKey     = (E.^. StudyTermsKey)
           dbtProj       = return
@@ -264,7 +264,7 @@ postAdminFeaturesR = do
     mkCandidateTable =
       let dbtIdent      = "admin-termcandidate" :: Text
           dbtStyle      = def
-          dbtSQLQuery   :: (E.SqlExpr (Entity StudyTermCandidate)) -> E.SqlQuery ( E.SqlExpr (Entity StudyTermCandidate))
+          dbtSQLQuery   :: E.SqlExpr (Entity StudyTermCandidate) -> E.SqlQuery ( E.SqlExpr (Entity StudyTermCandidate))
           dbtSQLQuery   = return
           dbtRowKey     = (E.^. StudyTermCandidateId)
           dbtProj       = return
diff --git a/test/Database.hs b/test/Database.hs
index aa6d5a0f0..df9afb496 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -226,10 +226,59 @@ fillDb = do
     sdMath = StudyTermsKey' 105
     sdMedi = StudyTermsKey' 121
     sdPhys = StudyTermsKey' 128
-  repsert sdInf  $ StudyTerms  79 (Just "IfI") (Just "Institut für Informatik")
-  repsert sdMath $ StudyTerms 105 (Just "MI" ) (Just "Mathematisches Institut")
-  repsert sdMedi $ StudyTerms 121 (Just "MnfI") Nothing -- intentionally left unknown
-  repsert sdPhys $ StudyTerms 128  Nothing      Nothing -- intentionally left unknown
+    sdBioI1 = StudyTermsKey' 221
+    sdBioI2 = StudyTermsKey' 228
+    sdBiol  = StudyTermsKey' 26
+    sdChem1 = StudyTermsKey' 61
+    sdChem2 = StudyTermsKey' 113
+  repsert sdInf   $ StudyTerms  79 (Just "Inf")   (Just "Informatik")
+  repsert sdMath  $ StudyTerms 105 (Just "Math" ) (Just "Mathematik")
+  repsert sdMedi  $ StudyTerms 121  Nothing       (Just "Medieninformatik") -- intentionally left unknown
+  repsert sdPhys  $ StudyTerms 128  Nothing        Nothing                  -- intentionally left unknown
+  repsert sdBioI1 $ StudyTerms 221  Nothing        Nothing                  -- intentionally left unknown
+  repsert sdBioI2 $ StudyTerms 228  Nothing        Nothing                  -- intentionally left unknown
+  repsert sdBiol  $ StudyTerms 26   Nothing        Nothing                  -- intentionally left unknown
+  repsert sdChem1 $ StudyTerms 61   Nothing        Nothing                  -- intentionally left unknown
+  repsert sdChem2 $ StudyTerms 113  Nothing        Nothing                  -- intentionally left unknown
+  incidence1 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence1 221 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence1 221 "Mathematik"
+  void . insert $ StudyTermCandidate incidence1 105 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence1 105 "Mathematik"
+  incidence2 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence2 221 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence2 221 "Chemie"
+  void . insert $ StudyTermCandidate incidence2 61  "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence2 61  "Chemie"
+  incidence3 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence3 113 "Chemie"
+  incidence4 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence4 221 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence4 221 "Chemie"
+  void . insert $ StudyTermCandidate incidence4 221 "Biologie"
+  void . insert $ StudyTermCandidate incidence4 61  "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence4 61  "Chemie"
+  void . insert $ StudyTermCandidate incidence4 61  "Biologie"
+  void . insert $ StudyTermCandidate incidence4 61  "Chemie"
+  void . insert $ StudyTermCandidate incidence4 26  "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence4 26  "Chemie"
+  void . insert $ StudyTermCandidate incidence4 26  "Biologie"
+  incidence5 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence5 228 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence5 228 "Physik"
+  void . insert $ StudyTermCandidate incidence5 128 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence5 128 "Physik"
+  incidence6 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence6 228 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence6 228 "Physik"
+  void . insert $ StudyTermCandidate incidence6 128 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence6 128 "Physik"
+  incidence7 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence7 228 "Physik"
+  void . insert $ StudyTermCandidate incidence7 228 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence7 128 "Physik"
+  void . insert $ StudyTermCandidate incidence7 128 "Bioinformatik"
+
   sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here
     maxMuster
     sdBsc

From 5a8fa8648fe5247cd1299a5e9cba11d41c27f0cd Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 13 Mar 2019 20:35:46 +0100
Subject: [PATCH 36/56] Created AdminR page to remove clutter from homepage

---
 messages/uniworx/de.msg |  3 +-
 routes                  |  3 +-
 src/Foundation.hs       | 75 +++++++++++++++++++++++++++++++++++------
 src/Handler/Admin.hs    | 10 ++++++
 test/Database.hs        |  7 +++-
 5 files changed, 84 insertions(+), 14 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 17602162c..9f3f4bf28 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -345,6 +345,8 @@ MultiSinkException name@Text error@Text: In Abgabe #{name} ist ein Fehler aufget
 NoTableContent: Kein Tabelleninhalt
 NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
 
+AdminHeading: Administration
+AdminFeaturesHeading: Studiengänge
 AdminUserHeading: Benutzeradministration
 AccessRightsFor: Berechtigungen für
 AdminFor: Administrator
@@ -353,7 +355,6 @@ LecturersFor: Dozenten
 ForSchools n@Int: für #{pluralDE n "Institut" "Institute"}
 UserListTitle: Komprehensive Benutzerliste
 AccessRightsSaved: Berechtigungsänderungen wurden gespeichert.
-AdminFeaturesHeading: Studiengänge
 
 Date: Datum
 DateTimeFormat: Datums- und Uhrzeitformat
diff --git a/routes b/routes
index a7961404f..9b15ab3b9 100644
--- a/routes
+++ b/routes
@@ -38,8 +38,9 @@
 /users                        UsersR            GET           -- no tags, i.e. admins only
 /users/#CryptoUUIDUser        AdminUserR        GET POST      !development
 /users/#CryptoUUIDUser/hijack AdminHijackUserR  POST          !adminANDno-escalation
-/admin/test                   AdminTestR        GET POST
+/admin                        AdminR            GET
 /admin/features               AdminFeaturesR    GET POST
+/admin/test                   AdminTestR        GET POST
 /admin/errMsg                 AdminErrMsgR      GET POST
 
 /info                         InfoR             GET            !free
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 6e91611f3..adc685fa0 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1077,9 +1077,12 @@ applySystemMessages = liftHandlerT . runDB . runConduit $ selectSource [] [] .|
 instance YesodBreadcrumbs UniWorX where
   breadcrumb (AuthR _)        = return ("Login"        , Just HomeR)
   breadcrumb HomeR            = return ("Uni2work"     , Nothing)
-  breadcrumb UsersR           = return ("Benutzer"     , Just HomeR)
-  breadcrumb AdminTestR       = return ("Test"         , Just HomeR)
+  breadcrumb UsersR           = return ("Benutzer"     , Just AdminR)
   breadcrumb (AdminUserR _)   = return ("Users"        , Just UsersR)
+  breadcrumb AdminR           = return ("Administration", Nothing)
+  breadcrumb AdminFeaturesR   = return ("Test"         , Just AdminR)
+  breadcrumb AdminTestR       = return ("Test"         , Just AdminR)
+  breadcrumb AdminErrMsgR     = return ("Test"         , Just AdminR)
 
   breadcrumb InfoR            = return ("Information"  , Nothing)
   breadcrumb InfoLecturerR    = return ("Veranstalter" , Just InfoR)
@@ -1134,7 +1137,7 @@ instance YesodBreadcrumbs UniWorX where
     return $ if
       | mayList   -> ("Statusmeldung", Just MessageListR)
       | otherwise -> ("Statusmeldung", Just HomeR)
-  breadcrumb (MessageListR) = return ("Statusmeldungen", Just HomeR)
+  breadcrumb (MessageListR) = return ("Statusmeldungen", Just AdminR)
   breadcrumb  _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
 
 submissionList :: TermId -> CourseShorthand -> SheetName -> UserId -> DB [E.Value SubmissionId]
@@ -1253,6 +1256,14 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
       , menuItemModal = False
       , menuItemAccessCallback' = return True -- Creates a LOOP: (Authorized ==) <$> isAuthorized UsersR False
       }
+  , return MenuItem
+      { menuItemType  = NavbarAside
+      , menuItemLabel = MsgAdminHeading
+      , menuItemIcon  = Just "screwdriver"
+      , menuItemRoute = SomeRoute AdminR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
   ]
 
 
@@ -1274,33 +1285,75 @@ pageActions (HomeR) =
       , menuItemAccessCallback' = return True
       }
   ,  MenuItem
-      { menuItemType = PageActionPrime
-      , menuItemLabel = MsgMenuAdminTest
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgAdminHeading
       , menuItemIcon  = Just "screwdriver"
-      , menuItemRoute = SomeRoute AdminTestR
+      , menuItemRoute = SomeRoute AdminR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  ,  MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgAdminFeaturesHeading
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute AdminFeaturesR
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   , MenuItem
-      { menuItemType = PageActionPrime
+      { menuItemType  = PageActionPrime
       , menuItemLabel = MsgMenuMessageList
-      , menuItemIcon = Nothing
+      , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute MessageListR
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   , MenuItem
-      { menuItemType = PageActionPrime
+      { menuItemType  = PageActionPrime
       , menuItemLabel = MsgMenuAdminErrMsg
-      , menuItemIcon = Nothing
+      , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute AdminErrMsgR
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   ]
+pageActions (AdminR) =
+  [ MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgAdminFeaturesHeading
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute AdminFeaturesR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  , MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgErrMsgHeading
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute AdminErrMsgR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  , MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgMenuUsers
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute UsersR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  , MenuItem
+      { menuItemType  = PageActionSecondary
+      , menuItemLabel = MsgMenuAdminTest
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute AdminTestR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  ]
 pageActions (InfoR) = [
     MenuItem
-      { menuItemType = PageActionPrime
+      { menuItemType  = PageActionPrime
       , menuItemLabel = MsgInfoLecturerTitle
       , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute InfoLecturerR
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 47bf781dd..414e2aba0 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -28,6 +28,16 @@ import Database.Persist.Sql (fromSqlKey)
 
 import Control.Monad.Trans.Writer (mapWriterT)
 
+
+getAdminR :: Handler Html
+getAdminR = -- do
+   siteLayoutMsg MsgAdminHeading $ do
+      setTitleI MsgAdminHeading
+      [whamlet|
+        This shall become the Administrators' overview page.
+        Its current purpose is to provide links to some important admin functions
+      |]
+
 -- BEGIN - Buttons needed only here
 data ButtonCreate = CreateMath | CreateInf  -- Dummy for Example
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
diff --git a/test/Database.hs b/test/Database.hs
index df9afb496..084f6d3f1 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -233,7 +233,7 @@ fillDb = do
     sdChem2 = StudyTermsKey' 113
   repsert sdInf   $ StudyTerms  79 (Just "Inf")   (Just "Informatik")
   repsert sdMath  $ StudyTerms 105 (Just "Math" ) (Just "Mathematik")
-  repsert sdMedi  $ StudyTerms 121  Nothing       (Just "Medieninformatik") -- intentionally left unknown
+  repsert sdMedi  $ StudyTerms 121  Nothing       (Just "Fehler hier")
   repsert sdPhys  $ StudyTerms 128  Nothing        Nothing                  -- intentionally left unknown
   repsert sdBioI1 $ StudyTerms 221  Nothing        Nothing                  -- intentionally left unknown
   repsert sdBioI2 $ StudyTerms 228  Nothing        Nothing                  -- intentionally left unknown
@@ -278,6 +278,11 @@ fillDb = do
   void . insert $ StudyTermCandidate incidence7 228 "Bioinformatik"
   void . insert $ StudyTermCandidate incidence7 128 "Physik"
   void . insert $ StudyTermCandidate incidence7 128 "Bioinformatik"
+  incidence8 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence8 128 "Physik"
+  void . insert $ StudyTermCandidate incidence8 128 "Medieninformatik"
+  void . insert $ StudyTermCandidate incidence8 121 "Physik"
+  void . insert $ StudyTermCandidate incidence8 121 "Medieninformatik"
 
   sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here
     maxMuster

From 86086633abae21139243e43ebfdf3aa169921104 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 13 Mar 2019 21:17:30 +0100
Subject: [PATCH 37/56] Conflict detection for studyTermCandidates implemented

---
 src/Handler/Admin.hs | 26 +++++++++++++++++++++++---
 test/Database.hs     |  4 +++-
 2 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 414e2aba0..de4eea2e7 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -178,9 +178,11 @@ getAdminFeaturesR = postAdminFeaturesR
 postAdminFeaturesR = do
     (   (degreeResult,degreeTable)
       , (studyTermsResult,studytermsTable)
-      , ((),candidateTable)) <- runDB $ (,,)
+      , conflicts
+      , ((),candidateTable)) <- runDB $ (,,,)
       <$> mkDegreeTable
       <*> mkStudytermsTable
+      <*> conflictedStudyTerms
       <*> mkCandidateTable
 
     let degreeResult' :: FormResult (Map (Key StudyDegree) (Maybe Text, Maybe Text))
@@ -214,6 +216,14 @@ postAdminFeaturesR = do
             ^{studytermsTable}
         <div .container>
           <section>
+            $if null conflicts
+              Kein Konflikte beobachtet.
+            $else
+              <h3>Studiengangseingträge mit beobachteten Konflikten:
+              <ul>
+                $forall (Entity _ (StudyTerms ky _ nm)) <- conflicts
+                  <li> #{show ky} - #{foldMap id nm}
+
             ^{candidateTable}
       |]
   where
@@ -291,5 +301,15 @@ postAdminFeaturesR = do
           dbtFilter     = mempty
           dbtFilterUI   = mempty
           dbtParams     = def
-          psValidator   = def & defaultSorting [SortAscBy "termcandidate-name", SortAscBy "termcandidate-key"]
-      in dbTable psValidator DBTable{..}
\ No newline at end of file
+          psValidator   = def & defaultSorting [SortAscBy "termcandidate-key", SortAscBy "termcandidate-name"]
+      in dbTable psValidator DBTable{..}
+
+    conflictedStudyTerms :: DB [Entity StudyTerms]
+    conflictedStudyTerms = E.select $ E.from $ \studyTerms -> do
+      E.where_ $ E.not_ $ E.isNothing $ studyTerms E.^. StudyTermsName
+      E.where_ $ E.exists $ E.from $ \candidateOne -> do
+        E.where_ $ candidateOne E.^. StudyTermCandidateKey E.==. studyTerms E.^. StudyTermsKey
+        E.where_ $ E.notExists . E.from $ \candidateTwo ->  do
+            E.where_ $ candidateTwo E.^. StudyTermCandidateIncidence E.==. candidateOne E.^. StudyTermCandidateIncidence
+            E.where_ $ studyTerms E.^. StudyTermsName E.==. E.just (candidateTwo E.^. StudyTermCandidateName)
+      return studyTerms
diff --git a/test/Database.hs b/test/Database.hs
index 084f6d3f1..11b14a157 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -231,7 +231,7 @@ fillDb = do
     sdBiol  = StudyTermsKey' 26
     sdChem1 = StudyTermsKey' 61
     sdChem2 = StudyTermsKey' 113
-  repsert sdInf   $ StudyTerms  79 (Just "Inf")   (Just "Informatik")
+  repsert sdInf   $ StudyTerms  79 (Just "Inf")   (Just "Informatikk")
   repsert sdMath  $ StudyTerms 105 (Just "Math" ) (Just "Mathematik")
   repsert sdMedi  $ StudyTerms 121  Nothing       (Just "Fehler hier")
   repsert sdPhys  $ StudyTerms 128  Nothing        Nothing                  -- intentionally left unknown
@@ -283,6 +283,8 @@ fillDb = do
   void . insert $ StudyTermCandidate incidence8 128 "Medieninformatik"
   void . insert $ StudyTermCandidate incidence8 121 "Physik"
   void . insert $ StudyTermCandidate incidence8 121 "Medieninformatik"
+  incidence9 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence9 79 "Informatik"
 
   sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here
     maxMuster

From 40204d2424d4331f7127a21801834f9754643ad3 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 13 Mar 2019 21:18:38 +0100
Subject: [PATCH 38/56] mend

---
 src/Handler/Admin.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index de4eea2e7..19e2ef515 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -223,8 +223,8 @@ postAdminFeaturesR = do
               <ul>
                 $forall (Entity _ (StudyTerms ky _ nm)) <- conflicts
                   <li> #{show ky} - #{foldMap id nm}
-
-            ^{candidateTable}
+            <div .container>
+              ^{candidateTable}
       |]
   where
     textInputCell lensRes lensDefault = formCell id (return . view (_dbrOutput . _entityKey))

From 26375b11406dfe397a29f3ad72bd2bf56cc46f64 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 13 Mar 2019 21:36:21 +0100
Subject: [PATCH 39/56] mend

---
 messages/uniworx/de.msg |  2 +-
 src/Handler/Admin.hs    | 24 +++++++++++++++++-------
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 9f3f4bf28..ce399d6a0 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -422,7 +422,7 @@ StudyTermsName: Studiengang
 StudyTermsShort: Studiengangkürzel
 StudyTermsChangeSuccess: Zuordnung Abschlüsse aktualisiert
 StudyDegreeChangeSuccess: Zuordnung Studiengänge aktualisiert
-StudyCandidateIncidienc: Anmeldevorgang
+StudyCandidateIncidence: Anmeldevorgang
 
 MailTestFormEmail: Email-Addresse
 MailTestFormLanguages: Spracheinstellungen
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 19e2ef515..29622f29c 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -18,8 +18,9 @@ import Utils.Lens
 -- import qualified Data.Set as Set
 import qualified Data.Map as Map
 import Handler.Utils.Table.Cells
-import qualified Database.Esqueleto as E
 import Database.Persist.Sql (fromSqlKey)
+import qualified Database.Esqueleto as E
+import Database.Esqueleto.Utils as E
 
 -- import Colonnade hiding (fromMaybe)
 -- import Yesod.Colonnade
@@ -283,23 +284,32 @@ postAdminFeaturesR = do
 
     mkCandidateTable =
       let dbtIdent      = "admin-termcandidate" :: Text
-          dbtStyle      = def
+          dbtStyle      = def { dbsFilterLayout = defaultDBSFilterLayout }
           dbtSQLQuery   :: E.SqlExpr (Entity StudyTermCandidate) -> E.SqlQuery ( E.SqlExpr (Entity StudyTermCandidate))
           dbtSQLQuery   = return
           dbtRowKey     = (E.^. StudyTermCandidateId)
           dbtProj       = return
           dbtColonnade  = dbColonnade $ mconcat
-            [ sortable (Just "termcandidate-key")       (i18nCell MsgStudyTermsKey)   (numCell  . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
-            , sortable (Just "termcandidate-name")      (i18nCell MsgStudyTermsName)  (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
-            , sortable (Just "termcandidate-incidence") (i18nCell MsgStudyTermsShort) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
+            [ sortable (Just "termcandidate-key")       (i18nCell MsgStudyTermsKey)           (numCell  . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
+            , sortable (Just "termcandidate-name")      (i18nCell MsgStudyTermsName)          (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
+            , sortable (Just "termcandidate-incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
             ]
           dbtSorting    = Map.fromList
             [ ("termcandidate-key"      , SortColumn (E.^. StudyTermCandidateKey))
             , ("termcandidate-name"     , SortColumn (E.^. StudyTermCandidateName))
             , ("termcandidate-incidence", SortColumn (E.^. StudyTermCandidateIncidence))
             ]
-          dbtFilter     = mempty
-          dbtFilterUI   = mempty
+          dbtFilter     = Map.fromList
+            [ ("key",       FilterColumn $ mkExactFilter    (E.^. StudyTermCandidateKey))
+            , ("name",      FilterColumn $ mkContainsFilter (E.^. StudyTermCandidateName))
+            , ("incidence", FilterColumn $ mkExactFilter (E.^. StudyTermCandidateIncidence)) -- TODO containts filter desired here
+            ]
+          dbtFilterUI   = \mPrev -> mconcat
+            -- [ prismAForm (singletonFilter "key")       mPrev $ aopt intField            (fslI MsgStudyTermsKey) -- Typing problem exactFilter suffices here
+            [ prismAForm (singletonFilter "key")       mPrev $ aopt (searchField False) (fslI MsgStudyTermsKey)
+            , prismAForm (singletonFilter "name")      mPrev $ aopt (searchField False) (fslI MsgStudyTermsName)
+            , prismAForm (singletonFilter "incidence") mPrev $ aopt (searchField False) (fslI MsgStudyCandidateIncidence)
+            ]
           dbtParams     = def
           psValidator   = def & defaultSorting [SortAscBy "termcandidate-key", SortAscBy "termcandidate-name"]
       in dbTable psValidator DBTable{..}

From 7fe091b1ffeb4c22c513adef8e25533830688c69 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 14 Mar 2019 18:04:32 +0100
Subject: [PATCH 40/56] DSGV model descriptions: user

---
 RoleDescriptions.txt | 42 +++++++++++++++++++
 models/users         | 97 ++++++++++++++++++++++++--------------------
 2 files changed, 96 insertions(+), 43 deletions(-)
 create mode 100644 RoleDescriptions.txt

diff --git a/RoleDescriptions.txt b/RoleDescriptions.txt
new file mode 100644
index 000000000..4f7be843f
--- /dev/null
+++ b/RoleDescriptions.txt
@@ -0,0 +1,42 @@
+Most roles are school dependent, i.e. a lecturer for the Math-department can only create new lectures that have Math-department in their school field.
+
+
+Administrator for a school
+- top-level rights, can access everything other roles can within the same school
+- restrictions only apply to routes containing a different school; then no special rights are given
+- may appoint further administrators and lecturers for his school
+- all school-independent routes, such as help-requests and user-list are accessible
+- can impersonate any other user with lesser rights, i.e. lecturers within same school, all students, etc.
+- a user can be administrator for more than one school
+
+
+Lecturer for a school
+- can create courses for their school for all active terms
+- can view participants of his courses and record notes for participants
+- can create sheets for their courses
+- can view homework submissions for his courses, including marks and plain user-names
+- can mark homework
+- may appoint correctors for sheets belonging to his courses
+- may assign submitted homework to correctors
+- a user can be lecturer for more than one school
+- all rights correctors for his courses have
+
+
+Corrector for a sheet
+- may download their assigned anonymous homework submissions (submissions are identify through crypto-ids, no user-names)
+- may upload corrected and marked homework submissions for their assignments
+- may always download solution and sheet description files for their sheet, ignoring deadline constraints
+
+
+User (logged-in)
+- all logged-in users may use this role
+- no special school restrictions
+- may enrol in courses from any school
+- may submit homework for marking in enrolled courses
+- all rights that not logged-in users have
+
+
+User (not logged-in)
+- can view course descriptions
+- can download course materials from courses that allow this for all un-enrolled users
+- can requests help from administrators
\ No newline at end of file
diff --git a/models/users b/models/users
index 60909e42c..7e5a86465 100644
--- a/models/users
+++ b/models/users
@@ -1,53 +1,64 @@
--- Some comments needes
-User json
-    ident          (CI Text)
-    authentication AuthenticationMode
-    lastAuthentication UTCTime Maybe
-    matrikelnummer Text Maybe
-    email          (CI Text)
-    displayName    Text            -- we always show the LDAP displayName only, but highlight the LDAP surname within (or appended if not contained)
-    surname        Text            -- Name displayed through 'nameWidget displayName surname' which highlights surname within displayName
-    maxFavourites  Int default=12  -- Number of last used course names to be remembered for quick links for convenience
-    theme          Theme default='Default'
-    dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'"
-    dateFormat     DateTimeFormat "default='%d.%m.%Y'"
-    timeFormat     DateTimeFormat "default='%R'"
-    downloadFiles  Bool default=false          -- Files should be opened in browser or downloaded
-    mailLanguages  MailLanguages default='[]'
-    notificationSettings NotificationSettings  -- Bit-array for which events email notification is requested by user
-    UniqueAuthentication ident
-    UniqueEmail email
-    deriving Show Eq Generic
-UserAdmin
+-- The files in /models determine the database scheme.
+-- The organisational split into several files has no operational effects.
+-- White-space and case matters: Each SQL table is named in 1st column of this file
+-- Indendent lower-case lines describe the SQL-columns of the table with name, type and options
+-- Nullable columns have "Maybe" written after their type
+-- Option "default=xyz" is only used for database migrations due to changes in the SQL-schema, also see Model.Migration
+-- Indendent upper-case lines usually impose Uniqueness constraints for rows by some columns.
+-- Each table will also have an column storing a unique numeric row key, unless there is a row Primary columnname
+--
+User Json    -- Each Uni2work user has a corresponding row in this table; created upon first login.
+    ident          (CI Text)                -- Case-insensitive user-identifier
+    authentication AuthenticationMode       -- 'AuthLDAP' or ('AuthPWHash'+password-hash)
+    lastAuthentication UTCTime Maybe        -- last login date
+    matrikelnummer Text Maybe               -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...)
+    email          (CI Text)                -- Case-insensitive eMail address
+    displayName    Text                     -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained)
+    surname        Text                     -- Display user names always through 'nameWidget displayName surname'
+    maxFavourites  Int default=12           -- Number of last used course names to be remembered for quick links for convenience
+    theme          Theme default='Default'  -- Color-theme of the frontend, chosen by user
+    dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" -- preferred Date+Time display format for user
+    dateFormat     DateTimeFormat "default='%d.%m.%Y'"       -- preferred Date-only display format for user
+    timeFormat     DateTimeFormat "default='%R'"             -- preferred Time-only display format for user
+    downloadFiles  Bool default=false          -- Should files be opened in browser or downloaded? (users often oblivious that their browser has a setting for this)
+    mailLanguages  MailLanguages default='[]'  -- Preferred language for eMail; i18n not yet implemented
+    notificationSettings NotificationSettings  -- Bit-array for which events email notifications are requested by user
+    UniqueAuthentication ident                 -- Column 'ident' can be used as a row-key in this table
+    UniqueEmail email                          -- Column 'email' can be used as a row-key in this table
+    deriving Show Eq Generic                   -- Haskell-specific settings for runtime-value representing a row in memory
+UserAdmin      -- Each row in this table grants school-specific administrator-rights to a specific user
     user   UserId
     school SchoolId
-    UniqueUserAdmin user school
-UserLecturer
+    UniqueUserAdmin user school       -- combination of user+school must be unique, i.e. no duplicate rows
+UserLecturer   -- Each row in this table grants school-specific lecturer-rights to a specific user
     user   UserId
     school SchoolId
-    UniqueSchoolLecturer user school
-StudyFeatures  -- Abschluss, Studiengang, Haupt/Nebenfachh und Fachsemester
+    UniqueSchoolLecturer user school  -- combination of user+school must be unique, i.e. no duplicate rows
+StudyFeatures  -- multiple entries possible for students pursuing several degrees at once, usually created upon LDAP login
     user          UserId
-    degree        StudyDegreeId
-    field         StudyTermsId
-    type          StudyFieldType
+    degree        StudyDegreeId   -- Abschluss, i.e. Master, Bachelor, etc.
+    field         StudyTermsId    -- Fach, i.e. Informatics, Philosophy, etc.
+    type          StudyFieldType  -- Major or minor, i.e. Haupt-/Nebenfach
     semester      Int
-    updated       UTCTime default='NOW()' -- zuletzt als gültig gesehen
-    valid         Bool default=true
+    updated       UTCTime default='NOW()' -- last update from LDAP
+    valid         Bool default=true       -- marked as active in LDAP (students may switch, but LDAP never forgets)
     UniqueStudyFeatures user degree field type semester
     -- UniqueUserSubject ubuser degree field -- There exists a counterexample
 StudyDegree   -- Studienabschluss
-    key           Int
-    shorthand     Text Maybe
-    name          Text Maybe
-    Primary key
+    key           Int            -- LMU-internal key
+    shorthand     Text Maybe     -- admin determined shorthand
+    name          Text Maybe     -- description given by LDAP
+    Primary key                  -- column key is used as actual DB row key
 StudyTerms    -- Studiengang
-    key           Int
-    shorthand     Text Maybe
-    name          Text Maybe
-    Primary key
-StudyTermCandidate
-    incidence     UUID     --random id per login to associate matching pairs
-    key           Int
-    name          Text
-    deriving Show Eq Ord
\ No newline at end of file
+    key           Int            -- LMU-internal key
+    shorthand     Text Maybe     -- admin determined shorthand
+    name          Text Maybe     -- description given by LDAP
+    Primary key                  -- column key is used as actual DB row key
+StudyTermCandidate    -- No one at LMU is willing and able to tell us the meaning of the keys for StudyDegrees and StudyTerms.
+    -- Each LDAP login provides an unordered set of keys and an unordered set of plain text description with an unknown 1-1 correspondence.
+    -- This table helps us to infer which key belongs to which plain text by recording possible combinations at login.
+    -- If a login provides n keys and n plan texts, then n^2 rows with the same incidence are created, storing all combinations
+    incidence     UUID     -- random id, generated once  per login to associate matching pairs
+    key           Int      -- a possible key for the studyTermName
+    name          Text     -- studyTermName as plain text from LDAP
+    deriving Show Eq Ord

From 0bd4b9b9c23e6a59c59138eae14b34bff8acf0c1 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 14 Mar 2019 19:30:12 +0100
Subject: [PATCH 41/56] description course model

---
 RoleDescriptions.txt |  7 +++++-
 models/courses       | 52 ++++++++++++++++++++++----------------------
 models/users         | 14 ++++++------
 3 files changed, 39 insertions(+), 34 deletions(-)

diff --git a/RoleDescriptions.txt b/RoleDescriptions.txt
index 4f7be843f..73b66bad8 100644
--- a/RoleDescriptions.txt
+++ b/RoleDescriptions.txt
@@ -39,4 +39,9 @@ User (logged-in)
 User (not logged-in)
 - can view course descriptions
 - can download course materials from courses that allow this for all un-enrolled users
-- can requests help from administrators
\ No newline at end of file
+- can requests help from administrators
+
+
+
+Terminology:
+ - participants: a logged-in users that is enrolled in a specific course
\ No newline at end of file
diff --git a/models/courses b/models/courses
index 8ee384558..c2720cccf 100644
--- a/models/courses
+++ b/models/courses
@@ -1,51 +1,51 @@
-DegreeCourse json
+DegreeCourse json   -- for which degree programmes this course is appropriate for
     course       CourseId
     degree       StudyDegreeId
     terms        StudyTermsId
     UniqueDegreeCourse course degree terms
-Course
+Course    -- Information about a single course; contained info is always visible to all users
     name             (CI Text)
-    description      Html Maybe
-    linkExternal     Text Maybe
-    shorthand        (CI Text)
-    term             TermId
+    description      Html Maybe    -- user-defined large Html, ought to contain module description
+    linkExternal     Text Maybe    -- arbitrary user-defined url for external course page
+    shorthand        (CI Text)     -- practical shorthand of course name, used for identification
+    term             TermId        -- semester this course is taught
     school           SchoolId
-    capacity         Int64 Maybe
+    capacity         Int64 Maybe   -- number of allowed enrolements, if restricted
     -- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
-    registerFrom     UTCTime Maybe
-    registerTo       UTCTime Maybe
-    deregisterUntil  UTCTime Maybe
-    registerSecret   Text Maybe        -- Falls ein Passwort erforderlich ist
-    materialFree     Bool
-    TermSchoolCourseShort  term school shorthand
-    TermSchoolCourseName   term school name
+    registerFrom     UTCTime Maybe -- enrolement allowed from a given day onwwards or prohibited
+    registerTo       UTCTime Maybe -- enrolement may be prohibited from a given date onwards
+    deregisterUntil  UTCTime Maybe -- unenrolement may be prohibited from a given date onwards
+    registerSecret   Text Maybe    -- enrolement maybe protected by a simple common passphrase
+    materialFree     Bool          -- False: only enrolled users may see course materials not stored in this table
+    TermSchoolCourseShort  term school shorthand    -- shorthand must be unique within school and semester
+    TermSchoolCourseName   term school name         -- name must be unique within school and semester
     deriving Generic
-CourseEdit
+CourseEdit                -- who edited when a row in table "Course", kept indefinitely
     user         UserId
     time         UTCTime
     course       CourseId
-CourseFavourite
-    user         UserId
-    time         UTCTime
+CourseFavourite           -- which user accessed which course when, only displayed to user for convenience;
+    user         UserId   -- max number of rows kept per user is user-defined by column 'maxFavourites' in table "User"
+    time         UTCTime  -- oldest is removed first
     course       CourseId
     UniqueCourseFavourite user course
     deriving Show
-Lecturer
+Lecturer                       -- course ownership
     user         UserId
     course       CourseId
-    UniqueLecturer user course
-CourseParticipant
+    UniqueLecturer user course -- note: multiple lecturers per course are allowed, but no duplicated rows in this table
+CourseParticipant                      -- course enrolement
     course       CourseId
     user         UserId
-    registration UTCTime
-    field        StudyFeaturesId Maybe 
+    registration UTCTime               -- time of last enrolement for this course
+    field        StudyFeaturesId Maybe -- associated degree course, user-defined; required for communicating grades
     UniqueParticipant user course
-CourseUserNote
+CourseUserNote                 -- lecturers of a specific course may share a text note on each enrolled student
     course       CourseId
     user         UserId
-    note         Text
+    note         Text          -- arbitrary user-defined text; visible only to lecturer of this course
     UniqueCourseUserNotes user course
-CourseUserNoteEdit
+CourseUserNoteEdit             -- who edited a participants course note whenl
     user         UserId
     time         UTCTime
     note         CourseUserNoteId
diff --git a/models/users b/models/users
index 7e5a86465..82c5b6d72 100644
--- a/models/users
+++ b/models/users
@@ -15,14 +15,14 @@ User Json    -- Each Uni2work user has a corresponding row in this table; create
     email          (CI Text)                -- Case-insensitive eMail address
     displayName    Text                     -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained)
     surname        Text                     -- Display user names always through 'nameWidget displayName surname'
-    maxFavourites  Int default=12           -- Number of last used course names to be remembered for quick links for convenience
-    theme          Theme default='Default'  -- Color-theme of the frontend, chosen by user
-    dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" -- preferred Date+Time display format for user
-    dateFormat     DateTimeFormat "default='%d.%m.%Y'"       -- preferred Date-only display format for user
-    timeFormat     DateTimeFormat "default='%R'"             -- preferred Time-only display format for user
+    maxFavourites  Int default=12           -- max number of rows with this userId in table "CourseFavourite"; for convenience links; user-defined
+    theme          Theme default='Default'  -- Color-theme of the frontend; user-defined
+    dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" -- preferred Date+Time display format for user; user-defined
+    dateFormat     DateTimeFormat "default='%d.%m.%Y'"       -- preferred Date-only display format for user; user-defined
+    timeFormat     DateTimeFormat "default='%R'"             -- preferred Time-only display format for user; user-defined
     downloadFiles  Bool default=false          -- Should files be opened in browser or downloaded? (users often oblivious that their browser has a setting for this)
-    mailLanguages  MailLanguages default='[]'  -- Preferred language for eMail; i18n not yet implemented
-    notificationSettings NotificationSettings  -- Bit-array for which events email notifications are requested by user
+    mailLanguages  MailLanguages default='[]'  -- Preferred language for eMail; i18n not yet implemented; user-defined
+    notificationSettings NotificationSettings  -- Bit-array for which events email notifications are requested by user; user-defined
     UniqueAuthentication ident                 -- Column 'ident' can be used as a row-key in this table
     UniqueEmail email                          -- Column 'email' can be used as a row-key in this table
     deriving Show Eq Generic                   -- Haskell-specific settings for runtime-value representing a row in memory

From 4c685d67102f9cb15b07a5885e8b88456b1eab62 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 14 Mar 2019 20:03:14 +0100
Subject: [PATCH 42/56] more model descriptions added

---
 RoleDescriptions.txt |  4 ++++
 models/exams         |  6 +++---
 models/files         |  3 +++
 models/jobs          |  7 ++++---
 models/rooms         |  8 +++++++-
 models/schools       |  2 ++
 models/sheets        |  2 +-
 models/terms         | 13 ++++++++-----
 models/tutorials     |  3 +++
 9 files changed, 35 insertions(+), 13 deletions(-)

diff --git a/RoleDescriptions.txt b/RoleDescriptions.txt
index 73b66bad8..b77d924f1 100644
--- a/RoleDescriptions.txt
+++ b/RoleDescriptions.txt
@@ -28,6 +28,10 @@ Corrector for a sheet
 - may always download solution and sheet description files for their sheet, ignoring deadline constraints
 
 
+Tutor for a tutorial of a course
+- yet unimplemented, likely similar to corrector; ie. can access sheets and solutions earlier than participants
+
+
 User (logged-in)
 - all logged-in users may use this role
 - no special school restrictions
diff --git a/models/exams b/models/exams
index e356e4221..f9d326011 100644
--- a/models/exams
+++ b/models/exams
@@ -1,4 +1,4 @@
--- EXAMS ARE TODO:
+-- EXAMS ARE TODO; THIS IS JUST AN UNUSED STUB
 Exam
     course              CourseId
     name                Text
@@ -8,8 +8,8 @@ Exam
     registrationBegin   UTCTime
     registrationEnd     UTCTime
     deregistrationEnd   UTCTime
-    ratingVisible       Bool
-    statisticsVisible   Bool
+    ratingVisible       Bool     -- may participants see their own rating yet
+    statisticsVisible   Bool     -- may participants view statistics over all participants (should not be allowed for 'small' courses)
 --ExamEdit
 --    user                UserId
 --    time                UTCTime
diff --git a/models/files b/models/files
index 62a5ffe72..f96745687 100644
--- a/models/files
+++ b/models/files
@@ -1,3 +1,6 @@
+-- Table storing all kinds of larges files as 8bit-byte vectors (regardless of encoding)
+-- PostgreSQL is intelligent enough to handle this in a sensible manner;
+-- helps to ensure consistency of database snapshots, no data is stored outside database
 File
     title           FilePath
     content         ByteString Maybe -- Nothing iff this is a directory
diff --git a/models/jobs b/models/jobs
index 15f7bb7dc..537d0d7ab 100644
--- a/models/jobs
+++ b/models/jobs
@@ -1,9 +1,10 @@
+-- Routine tasks to be executed later
 QueuedJob
     content             Value
-    creationInstance    InstanceId
+    creationInstance    InstanceId         -- multiple uni2work instances access the same database, but each job must be only executed once
     creationTime        UTCTime
-    lockInstance        InstanceId Maybe
-    lockTime            UTCTime Maybe
+    lockInstance        InstanceId Maybe   -- instance that has started to execute this job
+    lockTime            UTCTime Maybe      -- time when execution had begun
     deriving Eq Read Show Generic Typeable
 CronLastExec
     job                 Value
diff --git a/models/rooms b/models/rooms
index 7b62d41f5..2ef670fd3 100644
--- a/models/rooms
+++ b/models/rooms
@@ -1,3 +1,8 @@
+-- ROOMS ARE TODO; THIS IS JUST AN UNUSED STUB
+-- Idea is to create a selection of rooms that may be
+-- associated with exercise classes and exams
+-- offering links to the LMU Roomfinder
+-- and allow the creation of neat timetables for users
 Booking
     term        TermId
     begin       UTCTime
@@ -13,7 +18,8 @@ BookingEdit
 Room
     name        Text
     capacity    Int Maybe
-    building    Text Maybe
+    building    Text Maybe -- name of building
+    roomfinder  Text Maybe -- external url for LMU Roomfinder
 -- BookingRoom
 --    subject     RoomForId
 --    room        RoomId
diff --git a/models/schools b/models/schools
index 6b73e1c27..f877a1aeb 100644
--- a/models/schools
+++ b/models/schools
@@ -1,3 +1,5 @@
+-- Description of all primary schools managed by uni2work
+-- Each school must have a unique human-readable shorthand which is used as database row key
 School json
     name          (CI Text)
     shorthand     (CI Text)  -- SchoolKey :: SchoolShorthand -> SchoolId
diff --git a/models/sheets b/models/sheets
index 8fd75eae1..ccdaed2e8 100644
--- a/models/sheets
+++ b/models/sheets
@@ -1,4 +1,4 @@
-Sheet
+Sheet   -- exercise sheet for a given course
     course          CourseId
     name            (CI Text)
     description     Html Maybe
diff --git a/models/terms b/models/terms
index 698a6a6d1..21d85a957 100644
--- a/models/terms
+++ b/models/terms
@@ -1,10 +1,13 @@
+-- Describes each term time.
+-- TermIdentifier is either W for Winterterm or S for Summerterm,
+-- followed by a two-digit year
 Term json
     name          TermIdentifier -- unTermKey :: TermId -> TermIdentifier
     start         Day            -- TermKey   :: TermIdentifier -> TermId
-    end           Day
-    holidays      [Day]
-    lectureStart  Day
-    lectureEnd    Day
-    active        Bool
+    end           Dayl
+    holidays      [Day]          -- LMU holidays, for display in timetables
+    lectureStart  Day            -- lectures usually start/end  later/earlier than the actual term,
+    lectureEnd    Day            -- used to generate warnings for lecturers creating unusual courses
+    active        Bool           -- may lecturers add courses to this term?
     Primary name       -- newtype Key Term = TermKey { unTermKey :: TermIdentifier }
     deriving Show Eq Generic -- type TermId = Key Term
diff --git a/models/tutorials b/models/tutorials
index 51e20b195..8e657a672 100644
--- a/models/tutorials
+++ b/models/tutorials
@@ -1,7 +1,10 @@
+-- TUTORIALS ARE TODO; THIS IS JUST AN UNUSED STUB
+-- Idea: management of exercise classes, offering sub-enrolement to distribute all students among all exercise classs
 Tutorial json
     name        Text
     tutor       UserId
     course      CourseId
+    capacity    Int64 Maybe -- limit for enrolement in this tutorial
 TutorialUser
     user        UserId
     tutorial    TutorialId

From 7ca5b87409b773944c488617fe3af8f13f9fe1d6 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 14 Mar 2019 20:19:42 +0100
Subject: [PATCH 43/56] fixbuild

---
 models/terms | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/models/terms b/models/terms
index 21d85a957..1ca1daae7 100644
--- a/models/terms
+++ b/models/terms
@@ -4,7 +4,7 @@
 Term json
     name          TermIdentifier -- unTermKey :: TermId -> TermIdentifier
     start         Day            -- TermKey   :: TermIdentifier -> TermId
-    end           Dayl
+    end           Day
     holidays      [Day]          -- LMU holidays, for display in timetables
     lectureStart  Day            -- lectures usually start/end  later/earlier than the actual term,
     lectureEnd    Day            -- used to generate warnings for lecturers creating unusual courses

From 7e66b72618cbda259e8cdc876e3d212b93ec3ee7 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Fri, 15 Mar 2019 07:38:36 +0100
Subject: [PATCH 44/56] fixbuild typo

---
 models/users | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/models/users b/models/users
index 82c5b6d72..9b9df02ff 100644
--- a/models/users
+++ b/models/users
@@ -7,7 +7,7 @@
 -- Indendent upper-case lines usually impose Uniqueness constraints for rows by some columns.
 -- Each table will also have an column storing a unique numeric row key, unless there is a row Primary columnname
 --
-User Json    -- Each Uni2work user has a corresponding row in this table; created upon first login.
+User json    -- Each Uni2work user has a corresponding row in this table; created upon first login.
     ident          (CI Text)                -- Case-insensitive user-identifier
     authentication AuthenticationMode       -- 'AuthLDAP' or ('AuthPWHash'+password-hash)
     lastAuthentication UTCTime Maybe        -- last login date

From 8d13d9278f8d533f10ebe5c01aa268c450cf6488 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Fri, 15 Mar 2019 10:56:25 +0100
Subject: [PATCH 45/56] Model descriptions mostly done

---
 models/sheets        | 38 +++++++++++++++++++-------------------
 models/submissions   | 30 +++++++++++++++---------------
 src/Handler/Admin.hs |  2 +-
 3 files changed, 35 insertions(+), 35 deletions(-)

diff --git a/models/sheets b/models/sheets
index ccdaed2e8..e1daa300e 100644
--- a/models/sheets
+++ b/models/sheets
@@ -2,38 +2,38 @@ Sheet   -- exercise sheet for a given course
     course          CourseId
     name            (CI Text)
     description     Html Maybe
-    type            SheetType
-    grouping        SheetGroup
-    markingText     Html Maybe
-    visibleFrom     UTCTime Maybe
-    activeFrom      UTCTime
-    activeTo        UTCTime
-    hintFrom        UTCTime Maybe
-    solutionFrom    UTCTime Maybe
-    uploadMode      UploadMode
-    submissionMode  SheetSubmissionMode default='UserSubmissions'
-    autoDistribute  Bool default=false
+    type            SheetType        -- Does it count towards overall course grade?
+    grouping        SheetGroup       -- May participants submit in groups of certain sizes?
+    markingText     Html Maybe       -- Instructions for correctors, included in marking templates
+    visibleFrom     UTCTime Maybe    -- Invisible to enrolled participants before
+    activeFrom      UTCTime          -- Download of questions and submission is permitted afterwards
+    activeTo        UTCTime          -- Submission is only permitted before
+    hintFrom        UTCTime Maybe    -- Additional files are made available
+    solutionFrom    UTCTime Maybe    -- Solution is made available
+    uploadMode      UploadMode       -- Take apart Zip-Archives or not?
+    submissionMode  SheetSubmissionMode default='UserSubmissions'  -- Submission upload by students or through tutors only?
+    autoDistribute  Bool default=false  -- Should correctors be assigned submissions automagically?
     CourseSheet course name
     deriving Generic
-SheetEdit
+SheetEdit                     -- who edited when a row in table "Course", kept indefinitely
     user            UserId
     time            UTCTime
     sheet           SheetId
-SheetPseudonym
+SheetPseudonym                -- for anonoymous external submissions (ie paper submission tracked in uni2work)
     sheet           SheetId
-    pseudonym       Pseudonym
+    pseudonym       Pseudonym -- should be attached to submission
     user            UserId
     UniqueSheetPseudonym sheet pseudonym
     UniqueSheetPseudonymUser sheet user
-SheetCorrector
+SheetCorrector                -- grant corrector role to user for a sheet
     user            UserId
     sheet           SheetId
-    load            Load
-    state           CorrectorState default='CorrectorNormal'
+    load            Load      -- portion of work that will be assigned to this corrector
+    state           CorrectorState default='CorrectorNormal' -- whether a corrector is assigned his load this time (e.g. in case of sickness)
     UniqueSheetCorrector user sheet
     deriving Show Eq Ord
-SheetFile
+SheetFile                     -- a file that is part of an exercise sheet
     sheet           SheetId
     file            FileId
-    type            SheetFileType
+    type            SheetFileType   -- excercise, marking, hint or solution
     UniqueSheetFile file sheet type
diff --git a/models/submissions b/models/submissions
index ff998b845..e8ea0d049 100644
--- a/models/submissions
+++ b/models/submissions
@@ -1,34 +1,34 @@
-Submission
+Submission                        -- submission for marking by a CourseParticipant
     sheet           SheetId
-    ratingPoints    Points  Maybe -- "Just" does not mean done
-    ratingComment   Text    Maybe -- "Just" does not mean done
+    ratingPoints    Points  Maybe -- "Just" does not mean done; not yet visible to participant
+    ratingComment   Text    Maybe -- "Just" does not mean done; not yet visible to participant
     ratingBy        UserId  Maybe -- assigned corrector
-    ratingAssigned  UTCTime Maybe -- time assigned corrector
-    ratingTime      UTCTime Maybe -- "Just" here indicates done!
+    ratingAssigned  UTCTime Maybe -- time when corrector was assigned
+    ratingTime      UTCTime Maybe -- "Just" here indicates done; marking is made visible to participant
     deriving Show Generic
-SubmissionEdit
-    user            UserId
+SubmissionEdit                    -- user uploads new version of their submission
+    user            UserId        -- track id, important for group submissions
     time            UTCTime
     submission      SubmissionId
-SubmissionFile
+SubmissionFile                    -- files that are part of a submission
     submission      SubmissionId
     file            FileId
-    isUpdate        Bool         -- is this the file updated by a corrector (original will always be retained)
-    isDeletion      Bool         -- only set if isUpdate is also set, but file was deleted by corrector
+    isUpdate        Bool          -- is this the file updated by a corrector (original will always be retained)
+    isDeletion      Bool          -- only set if isUpdate is also set, but file was deleted by corrector
     UniqueSubmissionFile file submission isUpdate
     deriving Show
-SubmissionUser                   -- Actual submission participant
+SubmissionUser                    -- which submission belongs to whom
     user            UserId
     submission      SubmissionId
-    UniqueSubmissionUser user submission
-SubmissionGroup
+    UniqueSubmissionUser user submission -- multiple users may share same submission, in case of (ad-hoc) submission groups
+SubmissionGroup                   -- pre-defined submission groups; some courses only allow pre-defined submission groups
     course          CourseId
     name            Text Maybe
-SubmissionGroupEdit
+SubmissionGroupEdit               -- who edited a submissionGroup when?
     user            UserId
     time            UTCTime
     submissionGroup SubmissionGroupId
-SubmissionGroupUser              -- Registered submission groups, independent of actual SubmissionUser
+SubmissionGroupUser              -- Registered submission groups, just for checking upon submission, but independent of actual SubmissionUser
     submissionGroup     SubmissionGroupId
     user                UserId
     UniqueSubmissionGroupUser submissionGroup   user
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 29622f29c..ed5c31550 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -304,7 +304,7 @@ postAdminFeaturesR = do
             , ("name",      FilterColumn $ mkContainsFilter (E.^. StudyTermCandidateName))
             , ("incidence", FilterColumn $ mkExactFilter (E.^. StudyTermCandidateIncidence)) -- TODO containts filter desired here
             ]
-          dbtFilterUI   = \mPrev -> mconcat
+          dbtFilterUI mPrev = mconcat
             -- [ prismAForm (singletonFilter "key")       mPrev $ aopt intField            (fslI MsgStudyTermsKey) -- Typing problem exactFilter suffices here
             [ prismAForm (singletonFilter "key")       mPrev $ aopt (searchField False) (fslI MsgStudyTermsKey)
             , prismAForm (singletonFilter "name")      mPrev $ aopt (searchField False) (fslI MsgStudyTermsName)

From 2d1f74b4a446754747856dafd18d3151f42e4f60 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Fri, 15 Mar 2019 13:05:46 +0100
Subject: [PATCH 46/56] Further comments on database-model

Fixes #319
---
 RoleDescriptions.txt   |  6 ++++--
 models/config          |  6 ++++--
 models/jobs            | 16 ++++++++++------
 models/sheets          |  8 ++++++--
 models/system-messages | 16 +++++++++-------
 5 files changed, 33 insertions(+), 19 deletions(-)

diff --git a/RoleDescriptions.txt b/RoleDescriptions.txt
index b77d924f1..054b6a3d5 100644
--- a/RoleDescriptions.txt
+++ b/RoleDescriptions.txt
@@ -26,6 +26,7 @@ Corrector for a sheet
 - may download their assigned anonymous homework submissions (submissions are identify through crypto-ids, no user-names)
 - may upload corrected and marked homework submissions for their assignments
 - may always download solution and sheet description files for their sheet, ignoring deadline constraints
+- may create homework submissions in the name of students (which identify themselves to the corrector by pseudonym; no association with real identity needed) for homework assignments which have their submission-mode set to "Submission external with pseudonym" by a lecturer
 
 
 Tutor for a tutorial of a course
@@ -35,7 +36,7 @@ Tutor for a tutorial of a course
 User (logged-in)
 - all logged-in users may use this role
 - no special school restrictions
-- may enrol in courses from any school
+- may enroll in courses from any school; enrollment is associated with a field of study the user had at the time
 - may submit homework for marking in enrolled courses
 - all rights that not logged-in users have
 
@@ -44,8 +45,9 @@ User (not logged-in)
 - can view course descriptions
 - can download course materials from courses that allow this for all un-enrolled users
 - can requests help from administrators
+- can log in with their campus-id creating a new user record in the process and elevating rights to "logged-in"
 
 
 
 Terminology:
- - participants: a logged-in users that is enrolled in a specific course
\ No newline at end of file
+ - participants: a logged-in users that is enrolled in a specific course
diff --git a/models/config b/models/config
index 33bcaf8d6..5ec2357d6 100644
--- a/models/config
+++ b/models/config
@@ -1,4 +1,6 @@
+-- Configuration settings shared among all uni2work-instances for interoperability (Users can seamlessly switch between uni2work-instances (load-balancing need not attach users to an instance persistently))
+-- Mostly cryptographic keys
 ClusterConfig
-    setting             ClusterSettingsKey
-    value               Value
+    setting             ClusterSettingsKey -- I.e. Symmetric key for encrypting database-ids for use in URLs, Symmetric key for encrypting user-sessions so they can be saved directly as a browser-cookie, Symmetric key for encrypting error messages which might contain secret information, ...
+    value               Value              -- JSON-encoded value
     Primary setting
\ No newline at end of file
diff --git a/models/jobs b/models/jobs
index 537d0d7ab..fcf0006b8 100644
--- a/models/jobs
+++ b/models/jobs
@@ -1,13 +1,17 @@
--- Routine tasks to be executed later
+-- Jobs to be executed as soon as possible in the background (so not to delay HTTP-responses, or triggered by cron-system without associated HTTP-Request)
 QueuedJob
-    content             Value
-    creationInstance    InstanceId         -- multiple uni2work instances access the same database, but each job must be only executed once
+    content             Value              -- JSON-encoded description of the work to be done (send an email to "test@example.org", find all recipients for a certain notifications and queue one new job each, distribute all submissions for a sheet to correctors, ...)
+    creationInstance    InstanceId         -- multiple uni2work-instances access the same database, record which instance created this job for debugging purposes
     creationTime        UTCTime
     lockInstance        InstanceId Maybe   -- instance that has started to execute this job
     lockTime            UTCTime Maybe      -- time when execution had begun
     deriving Eq Read Show Generic Typeable
+
+-- Jobs are deleted from @QueuedJob@ after they are executed successfully and recorded in @CronLastExec@
+-- There is a Cron-system that, at set intervals, queries the database for work to be done in the background (i.e. if a lecturer has set a sheet's submissions to be automatically distributed and the submission deadline passed since the last check, then queue a new job to actually do the distribution)
+-- For the cron-system to determine whether a job needs to be done it needs to know if and when it was last (or ever) executed (i.e. a sheet's submissions should not be distributed twice)
 CronLastExec
-    job                 Value
-    time                UTCTime
-    instance            InstanceId
+    job                 Value -- JSON-encoded description of work done
+    time                UTCTime -- When was the job executed
+    instance            InstanceId -- Which uni2work-instance did the work
     UniqueCronLastExec job
diff --git a/models/sheets b/models/sheets
index e1daa300e..e13fc2d47 100644
--- a/models/sheets
+++ b/models/sheets
@@ -19,9 +19,13 @@ SheetEdit                     -- who edited when a row in table "Course", kept i
     user            UserId
     time            UTCTime
     sheet           SheetId
-SheetPseudonym                -- for anonoymous external submissions (ie paper submission tracked in uni2work)
+
+-- For anonoymous external submissions (i.e. paper submission tracked in uni2work)
+-- Map pseudonyms to users injectively in the context of a single sheet; for the next sheet all-new pseudonyms need to be created
+-- Chosen uniformly at random when the submitting user presses a button on the view of a sheet
+SheetPseudonym
     sheet           SheetId
-    pseudonym       Pseudonym -- should be attached to submission
+    pseudonym       Pseudonym -- 24-bit number that should be attached to external submission (i.e. written on the submitted paper); encoded as two english words akin to PGP-Wordlist
     user            UserId
     UniqueSheetPseudonym sheet pseudonym
     UniqueSheetPseudonymUser sheet user
diff --git a/models/system-messages b/models/system-messages
index 0ceec9223..f2692ab64 100644
--- a/models/system-messages
+++ b/models/system-messages
@@ -1,12 +1,14 @@
+-- Messages shown to all users as soon as they visit the site/log in (i.e.: "System is going down for maintenance next sunday")
+-- Only administrators (of any school) should be able to create these via a web-interface
 SystemMessage
-    from                UTCTime Maybe
-    to                  UTCTime Maybe
-    authenticatedOnly   Bool
-    severity            MessageStatus
-    defaultLanguage     Lang
-    content             Html
+    from                UTCTime Maybe -- Message is not shown before this date has passed (never shown, if null)
+    to                  UTCTime Maybe -- Message is shown until this date has passed (shown forever, if null)
+    authenticatedOnly   Bool -- Show message to all users upon visiting the site or only upon login?
+    severity            MessageStatus -- Success, Warning, Error, Info, ...
+    defaultLanguage     Lang -- Language of @content@ and @summary@
+    content             Html -- Detailed message shown when clicking on the @summary@-popup or when no @summary@ is specified
     summary             Html Maybe
-SystemMessageTranslation
+SystemMessageTranslation -- Translation of a @SystemMessage@ into another language; which language to choose is determined by user-sent HTTP-headers
     message             SystemMessageId
     language            Lang
     content             Html

From 9b944d70b88c24c1b2700553ba7a607abdd9f031 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Mon, 18 Mar 2019 18:57:36 +0100
Subject: [PATCH 47/56] StudyTermCandidate inference implemented needs tests

---
 models/users                        |   1 +
 src/Handler/Course.hs               |   2 +-
 src/Handler/Utils/TermCandidates.hs | 202 ++++++++++++++++++++++++++++
 src/Utils.hs                        |  11 ++
 4 files changed, 215 insertions(+), 1 deletion(-)
 create mode 100644 src/Handler/Utils/TermCandidates.hs

diff --git a/models/users b/models/users
index 9b9df02ff..adc672252 100644
--- a/models/users
+++ b/models/users
@@ -54,6 +54,7 @@ StudyTerms    -- Studiengang
     shorthand     Text Maybe     -- admin determined shorthand
     name          Text Maybe     -- description given by LDAP
     Primary key                  -- column key is used as actual DB row key
+                                 -- newtype Key StudyTerms = StudyTermsKey { unStudyTermsKey :: Int }
 StudyTermCandidate    -- No one at LMU is willing and able to tell us the meaning of the keys for StudyDegrees and StudyTerms.
     -- Each LDAP login provides an unordered set of keys and an unordered set of plain text description with an unknown 1-1 correspondence.
     -- This table helps us to infer which key belongs to which plain text by recording possible combinations at login.
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 1175bf6e0..fd49acdce 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -803,7 +803,7 @@ getCUsersR tid ssh csh = do
         , colUserEmail
         , colUserMatriclenr
         , colUserDegreeShort
-        , colUserFieldShort
+        , colUserField
         , colUserSemester
         , sortable (Just "course-registration") (i18nCell MsgRegisteredHeader) (dateCell . view _userTableRegistration)
         , colUserComment tid ssh csh
diff --git a/src/Handler/Utils/TermCandidates.hs b/src/Handler/Utils/TermCandidates.hs
new file mode 100644
index 000000000..8997969c8
--- /dev/null
+++ b/src/Handler/Utils/TermCandidates.hs
@@ -0,0 +1,202 @@
+module Handler.Utils.TermCandidates where
+
+import Import
+-- import Handler.Utils
+
+
+-- Import this module as Candidates
+
+-- import Utils.Lens
+
+-- import Data.Time
+-- import qualified Data.Text as T
+-- import Data.Function ((&))
+-- import Yesod.Form.Bootstrap3
+-- import Colonnade hiding (fromMaybe)
+-- import Yesod.Colonnade
+-- import qualified Data.UUID.Cryptographic as UUID
+-- import Control.Monad.Trans.Writer (mapWriterT)
+-- import Database.Persist.Sql (fromSqlKey)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.List as List
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+
+import qualified Database.Esqueleto as E
+-- import Database.Esqueleto.Utils as E
+
+
+type STKey = Int -- Key StudyTerms -- for convenience, assmued identical to field StudyTermCandidateKey
+
+-- | Just an heuristik to fill in defaults
+shortenStudyTerm :: Text -> Text
+shortenStudyTerm = concatMap (take 4) . splitCamel
+
+-- | Attempt to identify new StudyTerms based on observations
+-- infer :: MonadHandler m => m ([Entity StudyTerms],[Entity StudyTerms])
+infer :: DB ([Entity StudyTerms],[(STKey, Text)])
+infer = do
+    void removeAmbiguous -- TODO: show result
+    inferAcc []
+  where
+    inferAcc prevSet = do
+      problems <- conflicts
+      if null problems
+        then do
+          void removeRedundant -- TODO: show result
+          newSet <- acceptSingletons
+          if null newSet
+            then -- inference complete
+              return ([],prevSet)
+            else
+              inferAcc (newSet ++ prevSet)
+        else --abort
+          return (problems,prevSet)
+
+
+{-
+Candidate 1 11 "A"
+Candidate 1 11 "B"
+Candidate 1 12 "A"
+Candidate 1 12 "B"
+Candidate 2 12 "B"
+Candidate 2 12 "C"
+Candidate 2 13 "B"
+Candidate 2 13 "C"
+
+should readily yield 11/A, 12/B 13/C:
+
+it can infer due to overlab that 12/B must be true, then eliminating B identifies A and C;
+this rests on the assumption that the Names are unique, which is NOT TRUE;
+as a fix we simply eliminate all observations that have the same name twice, see removeInconsistent
+
+-}
+
+-- | remove candidates with ambiguous observations,
+--   ie. candidates that have duplicated term names with differing keys
+--   which may happen in rare cases
+removeAmbiguous :: DB [UUID]
+removeAmbiguous = do
+  ambiList <- E.select $ E.from $ \(candA `E.InnerJoin` candB) -> do
+    -- Either an innerJoin with itself or an exists-sub-select
+    E.on $    (candA E.^. StudyTermCandidateIncidence E.==. candB E.^. StudyTermCandidateIncidence)
+        E.&&. (candA E.^. StudyTermCandidateKey       E.!=. candB E.^. StudyTermCandidateKey)
+        E.&&. (candA E.^. StudyTermCandidateName      E.==. candB E.^. StudyTermCandidateName)
+        E.&&. (candA E.^. StudyTermCandidateId        E.!=. candB E.^. StudyTermCandidateId) -- should not be needed, but does not hurt either
+    return $ candA E.^. StudyTermCandidateIncidence
+  let ambiSet = E.unValue <$> List.nub ambiList
+  -- Most SQL dialects won't allow deletion and queries on the same table at once, hence we delete in two steps.
+  deleteWhere [StudyTermCandidateIncidence <-. ambiSet]
+  return ambiSet
+
+
+-- | remove known StudyTerm from candidates that have the _exact_ name,
+--   ie. if a candidate contains a known key, we remove it and its associated fullname
+--   only save if ambiguous candidates haven been removed
+removeRedundant :: DB [Entity StudyTermCandidate]
+removeRedundant = do
+  redundants <- E.select $ E.distinct $ E.from $ \(candidate `E.InnerJoin` sterm) -> do
+    E.on $  candidate E.^. StudyTermCandidateKey  E.==. sterm E.^. StudyTermsKey
+      E.&&. E.just (candidate E.^. StudyTermCandidateName) E.==. sterm E.^. StudyTermsName
+    return candidate
+  -- Most SQL dialects won't allow deletion and queries on the same table at once, hence we delete in two steps.
+  forM_ redundants $ \Entity{entityVal=StudyTermCandidate{..}} ->
+    deleteWhere $   ( StudyTermCandidateIncidence ==. studyTermCandidateIncidence )
+                :  ([ StudyTermCandidateKey       ==. studyTermCandidateKey       ]
+                ||. [ StudyTermCandidateName      ==. studyTermCandidateName      ])
+  return redundants
+
+
+-- | Search for single candidates and memorize them as StudyTerms.
+--   Should be called after @removeRedundant@ to increase success chances and reduce cost; otherwise memory heavy!
+--   Does not delete the used candidates, user @removeRedundant@ for this later on.
+--   Esqueleto does not provide the INTERESECT operator, thus
+--   we load the table into Haskell and operate there. Memory usage problem? StudyTermsCandidate may become huge.
+acceptSingletons :: DB [(STKey,Text)]
+acceptSingletons = do
+  knownKeys <- fmap unStudyTermsKey <$> selectKeysList [] [Asc StudyTermsKey]
+  -- let knownKeysSet = Set.fromAscList knownKeys
+  -- In case of memory problems, change next lines to conduit proper:
+  incidences <- fmap entityVal <$> selectList [StudyTermCandidateKey /<-. knownKeys] [] -- LimitTo might be dangerous here, if we get a partial incidence. Possibly first select N incidences, then retrieving all those only.
+  -- incidences <- E.select $ E.from $ \candidate -> do
+  --   E.where_ $ candidate E.^. StudyTermCandidayeKey `E.notIn` E.valList knownKeys
+  --   return candidate
+
+  -- Possibly expensive pure computations follows. Break runDB to shorten transaction?
+  let groupedCandidates :: Map STKey (Map UUID (Set Text))
+      groupedCandidates = foldl' groupFun mempty incidences
+
+      -- given a key, map each incidence to set of possible names for this key
+      groupFun :: Map STKey (Map UUID (Set Text)) -> StudyTermCandidate -> Map STKey (Map UUID (Set Text))
+      groupFun m StudyTermCandidate{..} =
+        insertWith (Map.unionWith Set.union)
+                   studyTermCandidateKey
+                   (Map.singleton studyTermCandidateIncidence $ Set.singleton studyTermCandidateName)
+                   m
+
+      -- pointwise intersection per incidence gives possible candidates per key
+      keyCandidates :: Map STKey (Set Text)
+      keyCandidates = Map.map (setIntersections . Map.elems) groupedCandidates
+
+      -- filter candidates having a unique possibility left
+      fixedKeys :: [(STKey,Text)]
+      fixedKeys = Map.foldlWithKey' combFixed [] keyCandidates
+
+      combFixed :: [(STKey,Text)] -> STKey -> Set Text ->  [(STKey,Text)]
+      combFixed acc k s | Set.size s == 1 -- possibly redundant
+                        , [n] <- Set.elems s = (k,n):acc
+                        -- empty sets should not occur here , if LDAP is consistent. Maybe raise a warning?!
+                        | otherwise = acc
+
+      -- registerFixed :: (STKey, Text) -> DB (Key StudyTerms)
+      registerFixed :: (STKey, Text) -> DB ()
+      registerFixed (key, name) =
+        -- insertKey (StudyTermsKey key) $ StudyTerms key (Just $ shortenStudyTerm name) (Just name) -- name clash!
+        void . insert $ StudyTerms key (Just $ shortenStudyTerm name) (Just name)
+
+
+  -- register newly fixed candidates
+  forM_ fixedKeys registerFixed
+  return fixedKeys
+
+
+  -- SOME EARLIER ATTEMPTS FOLLOW:
+  --
+  -- unknownKeys <- E.select $ E.distinct $ E.from $ \candidate -> do
+  --    E.where_ $ E.notExists $ E.from $ \sterm ->
+  --      E.where_ $ candidate E.^. StudyTermCandidateKey E.==. sterm E.^. StudyTermKey
+  --    return $ candidate E.^. StudyTermCandidateKey
+  -- forM unknownKeys $ \(E.Value key) -> do
+  --   incidences <- E.select $ E.from $ \candidate -> do
+  --     E.where_ $
+  --
+  -- -- DON'T KNOW HOW TO DO IN SQL :( BUT WE NEED THE ENTIRE TABLE ANYHOW
+  -- candidates <- entityVal <$> selectList [] [] -- load entire candidate table
+  -- -- create map from UUID to set of candidates for efficiency
+  -- let collectCandidates m stc@StudyTermCandidate{studyTermCandidateIncidence=inci}
+  --       = insertWith Set.union inci stc
+  --     incidences = foldl collectCandidates Map.empty candidates
+  --
+  --     collectKeys m
+  --     keySets = foldl collectKeys Map.empty candidates
+  --
+  -- -- StudyTermCandidateKey -> Set StudyTermCandidateName
+
+
+
+
+-- | all existing StudyTerms that are contradiced by current observations
+conflicts :: DB [Entity StudyTerms]
+conflicts = E.select $ E.from $ \studyTerms -> do
+  E.where_ $ E.not_ $ E.isNothing $ studyTerms E.^. StudyTermsName
+  E.where_ $ E.exists $ E.from $ \candidateOne -> do
+    E.where_ $ candidateOne E.^. StudyTermCandidateKey E.==. studyTerms E.^. StudyTermsKey
+    E.where_ $ E.notExists . E.from $ \candidateTwo ->  do
+        E.where_ $ candidateTwo E.^. StudyTermCandidateIncidence E.==. candidateOne E.^. StudyTermCandidateIncidence
+        E.where_ $ studyTerms E.^. StudyTermsName E.==. E.just (candidateTwo E.^. StudyTermCandidateName)
+  return studyTerms
+
+
+
diff --git a/src/Utils.hs b/src/Utils.hs
index cd735a6c0..73debb0e8 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -321,6 +321,17 @@ mergeAttrs = mergeAttrs' `on` sort
 
 
 
+----------
+-- Sets --
+----------
+
+-- | Intersection of multiple sets. Returns empty set for empty input list
+setIntersections :: Ord a => [Set a] -> Set a
+setIntersections []    = Set.empty
+setIntersections (h:t) = foldl' Set.intersection h t
+
+
+
 ----------
 -- Maps --
 ----------

From b815abf19e259a209890a842740678f96259c1bf Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 19 Mar 2019 10:40:28 +0100
Subject: [PATCH 48/56] Add migration which randomly assigns
 "course_participant"."field"

---
 db.sh                  | 2 +-
 src/Model/Migration.hs | 9 +++++++++
 2 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/db.sh b/db.sh
index 82d89d19f..8861a2ac4 100755
--- a/db.sh
+++ b/db.sh
@@ -1,4 +1,4 @@
-#!/bin/bash
+#!/usr/bin/env bash
 # Options: see /test/Database.hs (Main)
 stack build --fast --flag uniworx:library-only --flag uniworx:dev
 stack exec uniworxdb -- $@
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index ac11d3241..38de10773 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -207,6 +207,15 @@ customMigrations = Map.fromListWith (>>)
            UPDATE "sheet" SET "type" = json_build_object('type', "type"->'type', 'grading', json_build_object('type', "type"->'grading'->'type', 'max', "type"->'grading'->'points', 'passing', 0)) WHERE ("type"->'grading'->'type') = '"pass-points"' AND jsonb_exists("type"->'grading', 'points');
         |]
     )
+  , ( AppliedMigrationKey [migrationVersion|8.0.0|] [version|9.0.0|]
+    , whenM ((\a b c -> a && b && not c) <$> tableExists "study_features" <*> tableExists "course_participant" <*> columnExists "course_participant" "field") $ do
+        [executeQQ|
+          ALTER TABLE "course_participant" ADD COLUMN "field" bigint DEFAULT null REFERENCES study_features(id);
+          ALTER TABLE "study_features" ADD COLUMN IF NOT EXISTS "valid" boolean NOT NULL DEFAULT true;
+        |]
+        users <- [sqlQQ| SELECT DISTINCT ON ("user"."id") "user"."id", "study_features"."id" FROM "user", "study_features" WHERE "study_features"."user" = "user"."id" AND "study_features"."valid" AND "study_features"."type" = 'FieldPrimary' ORDER BY "user"."id", random(); |]
+        forM_ users $ \(uid :: UserId, sfid :: StudyFeaturesId) -> [executeQQ| UPDATE "course_participant" SET "field" = #{sfid} WHERE "user" = #{uid} AND "field" IS NULL; |]
+    )
   ]
 
 

From 8c221ad5e81ab743b15cfe2fd87184b039b82784 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 20 Mar 2019 09:49:06 +0100
Subject: [PATCH 49/56] Term candidate inference handler added, not connected

---
 src/Handler/Admin.hs                | 28 +++++++++-------------
 src/Handler/Course.hs               |  2 +-
 src/Handler/Utils/TermCandidates.hs | 36 +++++++++++++++++++++++++++++
 3 files changed, 48 insertions(+), 18 deletions(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 6751053b2..a9d5afa59 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -1,12 +1,12 @@
 module Handler.Admin where
 
 import Import
-import Handler.Utils
 import Jobs
-
+import Handler.Utils
 import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
 
 import Control.Monad.Trans.Except
+import Control.Monad.Trans.Writer (mapWriterT)
 
 import Utils.Lens
 
@@ -17,17 +17,20 @@ import Utils.Lens
 
 -- import qualified Data.Set as Set
 import qualified Data.Map as Map
-import Handler.Utils.Table.Cells
+
 import Database.Persist.Sql (fromSqlKey)
 import qualified Database.Esqueleto as E
 import Database.Esqueleto.Utils as E
 
+import Handler.Utils.Table.Cells
+import qualified Handler.Utils.TermCandidates as Candidates
+
 -- import Colonnade hiding (fromMaybe)
 -- import Yesod.Colonnade
 
 -- import qualified Data.UUID.Cryptographic as UUID
 
-import Control.Monad.Trans.Writer (mapWriterT)
+
 
 
 getAdminR :: Handler Html
@@ -179,11 +182,11 @@ getAdminFeaturesR = postAdminFeaturesR
 postAdminFeaturesR = do
     (   (degreeResult,degreeTable)
       , (studyTermsResult,studytermsTable)
-      , conflicts
+      , conflicted
       , ((),candidateTable)) <- runDB $ (,,,)
       <$> mkDegreeTable
       <*> mkStudytermsTable
-      <*> conflictedStudyTerms
+      <*> Candidates.conflicts
       <*> mkCandidateTable
 
     let degreeResult' :: FormResult (Map (Key StudyDegree) (Maybe Text, Maybe Text))
@@ -217,12 +220,12 @@ postAdminFeaturesR = do
             ^{studytermsTable}
         <div .container>
           <section>
-            $if null conflicts
+            $if null conflicted
               Kein Konflikte beobachtet.
             $else
               <h3>Studiengangseingträge mit beobachteten Konflikten:
               <ul>
-                $forall (Entity _ (StudyTerms ky _ nm)) <- conflicts
+                $forall (Entity _ (StudyTerms ky _ nm)) <- conflicted
                   <li> #{show ky} - #{foldMap id nm}
             <div .container>
               ^{candidateTable}
@@ -314,12 +317,3 @@ postAdminFeaturesR = do
           psValidator   = def & defaultSorting [SortAscBy "termcandidate-key", SortAscBy "termcandidate-name"]
       in dbTable psValidator DBTable{..}
 
-    conflictedStudyTerms :: DB [Entity StudyTerms]
-    conflictedStudyTerms = E.select $ E.from $ \studyTerms -> do
-      E.where_ $ E.not_ $ E.isNothing $ studyTerms E.^. StudyTermsName
-      E.where_ $ E.exists $ E.from $ \candidateOne -> do
-        E.where_ $ candidateOne E.^. StudyTermCandidateKey E.==. studyTerms E.^. StudyTermsKey
-        E.where_ $ E.notExists . E.from $ \candidateTwo ->  do
-            E.where_ $ candidateTwo E.^. StudyTermCandidateIncidence E.==. candidateOne E.^. StudyTermCandidateIncidence
-            E.where_ $ studyTerms E.^. StudyTermsName E.==. E.just (candidateTwo E.^. StudyTermCandidateName)
-      return studyTerms
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index fa3c811cb..823504dcc 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -307,7 +307,7 @@ getCShowR tid ssh csh = do
 -- , maybe a course secret
 registerForm :: Maybe UserId -> Maybe CourseParticipant -> Maybe StudyFeaturesId -> Maybe Text -> Form (Maybe StudyFeaturesId, Bool)
 -- unfinished WIP: must take study features if registred and show as mforced field
-registerForm loggedin participant defSFid msecret = identForm FIDcourseRegister $ \extra -> do
+registerForm loggedin participant defSFid msecret = identifyForm FIDcourseRegister $ \extra -> do
     -- secret fields
     (msecretRes', msecretView) <- case msecret of
       (Just _) | not isRegistered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
diff --git a/src/Handler/Utils/TermCandidates.hs b/src/Handler/Utils/TermCandidates.hs
index 8997969c8..def3fff41 100644
--- a/src/Handler/Utils/TermCandidates.hs
+++ b/src/Handler/Utils/TermCandidates.hs
@@ -30,10 +30,46 @@ import qualified Database.Esqueleto as E
 
 type STKey = Int -- Key StudyTerms -- for convenience, assmued identical to field StudyTermCandidateKey
 
+data FailedCandidateInference = FailedCandidateInference [Entity StudyTerms]
+  deriving (Typeable)
+
+instance Show FailedCandidateInference where
+  show (FailedCandidateInference _) = "Failed Candidate Inference" -- TODO
+
+instance Exception FailedCandidateInference
+  -- Default Instance
+
 -- | Just an heuristik to fill in defaults
 shortenStudyTerm :: Text -> Text
 shortenStudyTerm = concatMap (take 4) . splitCamel
 
+-- | Attempt to identify new StudyTerms based on observations
+inferHandler :: Handler ([UUID],([Entity StudyTerms],[Entity StudyTermCandidate],[(STKey,Text)]))
+inferHandler = do
+    (ambiguous, problems) <- runDB $ (,) <$> removeAmbiguous <*> conflicts
+    if (null problems)
+      then do
+        infRes <- inferAcc ([],[])
+        return (ambiguous, infRes)
+      else
+        return (ambiguous,(problems,[],[]))
+
+  where
+    inferAcc (accRedundants, accAccepted) =
+      handle (\(FailedCandidateInference fails) -> return (fails,accRedundants,accAccepted)) $ do
+        (infReds,infAccs) <- runDB inferStep
+        if null infAccs
+          then return ([], infReds ++ accRedundants,            accAccepted)
+          else inferAcc   (infReds ++ accRedundants, infAccs ++ accAccepted)
+
+    inferStep = do
+      redundants <- removeRedundant
+      accepted <- acceptSingletons
+      problems <- conflicts
+      when (not $ null problems) $ throw $ FailedCandidateInference problems
+      return (redundants, accepted)
+
+
 -- | Attempt to identify new StudyTerms based on observations
 -- infer :: MonadHandler m => m ([Entity StudyTerms],[Entity StudyTerms])
 infer :: DB ([Entity StudyTerms],[(STKey, Text)])

From d65b5918f0bd295282e31669f4a6b7006c48a16b Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 20 Mar 2019 11:59:08 +0100
Subject: [PATCH 50/56] =?UTF-8?q?Inferenz=20Studieng=C3=A4nge=20verdrahte,?=
 =?UTF-8?q?=20hat=20noch=20Fehler?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 messages/uniworx/de.msg             |   8 ++-
 models/users                        |   7 +-
 src/Foundation.hs                   |   4 +-
 src/Handler/Admin.hs                | 106 +++++++++++++++-------------
 src/Handler/Utils/Table/Cells.hs    |   4 ++
 src/Handler/Utils/TermCandidates.hs |  95 ++++++-------------------
 src/Model/Types.hs                  |   1 +
 src/Utils.hs                        |   5 ++
 templates/adminFeatures.hamlet      |  19 +++++
 9 files changed, 122 insertions(+), 127 deletions(-)
 create mode 100644 templates/adminFeatures.hamlet

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index ce399d6a0..0155c491a 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -346,7 +346,6 @@ NoTableContent: Kein Tabelleninhalt
 NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
 
 AdminHeading: Administration
-AdminFeaturesHeading: Studiengänge
 AdminUserHeading: Benutzeradministration
 AccessRightsFor: Berechtigungen für
 AdminFor: Administrator
@@ -408,6 +407,8 @@ SheetCorrectorSubmissionsTip: Abgabe erfolgt über ein Uni2work-externes Verfahr
 
 SubmissionNoUploadExpected: Es ist keine Abgabe von Dateien vorgesehen.
 
+AdminFeaturesHeading: Studiengänge
+StudyFeatureInference: Studiengangschlüssel-Inferenz
 StudyFeatureAge: Fachsemester
 StudyFeatureDegree: Abschluss
 FieldPrimary: Hauptfach
@@ -423,6 +424,11 @@ StudyTermsShort: Studiengangkürzel
 StudyTermsChangeSuccess: Zuordnung Abschlüsse aktualisiert
 StudyDegreeChangeSuccess: Zuordnung Studiengänge aktualisiert
 StudyCandidateIncidence: Anmeldevorgang
+AmbiguousCandidatesRemoved n@Int: #{show n} #{pluralDE n "uneindeutiger Kandidat" "uneindeutige Kandiaten"} entfernt
+RedundantCandidatesRemoved n@Int: #{show n} bereits #{pluralDE n "bekannter Kandidat" "bekannte Kandiaten"} entfernt
+CandidatesInferred n@Int: #{show n} neue #{pluralDE n "Studiengangszuordnung" "Studiengangszuordnungen"} inferiert
+NoCandidatesInferred: Keine neuen Studienganszuordnungen inferiert
+StudyTermIsNew: Neu
 
 MailTestFormEmail: Email-Addresse
 MailTestFormLanguages: Spracheinstellungen
diff --git a/models/users b/models/users
index adc672252..80e5ff43c 100644
--- a/models/users
+++ b/models/users
@@ -49,17 +49,20 @@ StudyDegree   -- Studienabschluss
     shorthand     Text Maybe     -- admin determined shorthand
     name          Text Maybe     -- description given by LDAP
     Primary key                  -- column key is used as actual DB row key
+                                 -- newtype Key StudyDegree = StudyDegreeKey' { unStudyDegreeKey :: Int }
+    deriving Show
 StudyTerms    -- Studiengang
     key           Int            -- LMU-internal key
     shorthand     Text Maybe     -- admin determined shorthand
     name          Text Maybe     -- description given by LDAP
     Primary key                  -- column key is used as actual DB row key
-                                 -- newtype Key StudyTerms = StudyTermsKey { unStudyTermsKey :: Int }
+                                 -- newtype Key StudyTerms = StudyTermsKey' { unStudyTermsKey :: Int }
+    deriving Show
 StudyTermCandidate    -- No one at LMU is willing and able to tell us the meaning of the keys for StudyDegrees and StudyTerms.
     -- Each LDAP login provides an unordered set of keys and an unordered set of plain text description with an unknown 1-1 correspondence.
     -- This table helps us to infer which key belongs to which plain text by recording possible combinations at login.
     -- If a login provides n keys and n plan texts, then n^2 rows with the same incidence are created, storing all combinations
-    incidence     UUID     -- random id, generated once  per login to associate matching pairs
+    incidence     TermCandidateIncidence -- random id, generated once per login to associate matching pairs
     key           Int      -- a possible key for the studyTermName
     name          Text     -- studyTermName as plain text from LDAP
     deriving Show Eq Ord
diff --git a/src/Foundation.hs b/src/Foundation.hs
index adc685fa0..282b0111e 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -2097,11 +2097,11 @@ instance YesodAuth UniWorX where
           fs <- either (\err -> throwError . ServerError $ "Could not parse features of study: " <> err) return userStudyFeatures
 
           let
-            studyTermCandidates = Set.fromList $ do
+            studyTermCandidates = do
               studyTermCandidateName <- termNames
               StudyFeatures{ studyFeaturesField = StudyTermsKey' studyTermCandidateKey } <- fs
               return StudyTermCandidate{..}
-          lift . insertMany_ $ Set.toList studyTermCandidates
+          lift $ insertMany_ studyTermCandidates
 
           lift $ E.updateWhere [StudyFeaturesUser ==. userId] [StudyFeaturesValid =. False]
           forM_ fs $ \f@StudyFeatures{..} -> do
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index a9d5afa59..bf5a29f6d 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -15,7 +15,7 @@ import Utils.Lens
 -- import Data.Function ((&))
 -- import Yesod.Form.Bootstrap3
 
--- import qualified Data.Set as Set
+import qualified Data.Set as Set
 import qualified Data.Map as Map
 
 import Database.Persist.Sql (fromSqlKey)
@@ -56,7 +56,7 @@ instance Button UniWorX ButtonCreate where
 
   btnClasses CreateMath = [BCIsButton, BCInfo]
   btnClasses CreateInf  = [BCIsButton, BCPrimary]
--- END Button needed here
+-- END Button needed only here
 
 emailTestForm :: AForm (HandlerT UniWorX IO) (Email, MailContext)
 emailTestForm = (,)
@@ -176,17 +176,40 @@ postAdminErrMsgR = do
     |]
 
 
+-- BEGIN - Buttons needed only for StudyTermCandidateManagement
+data ButtonInferStudyTerms = ButtonInferStudyTerms
+  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+instance Universe ButtonInferStudyTerms
+instance Finite ButtonInferStudyTerms
+
+nullaryPathPiece ''ButtonInferStudyTerms camelToPathPiece
+
+instance Button UniWorX ButtonInferStudyTerms where
+  btnLabel   ButtonInferStudyTerms = "Studienfachzuordnung automatisch lernen"
+  btnClasses ButtonInferStudyTerms = [BCIsButton, BCPrimary]
+-- END Button needed only here
 
 getAdminFeaturesR, postAdminFeaturesR :: Handler Html
 getAdminFeaturesR = postAdminFeaturesR
 postAdminFeaturesR = do
+    ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonInferStudyTerms)
+    (infConflicts,infAccepted) <- case btnResult of
+      (FormSuccess ButtonInferStudyTerms) -> do
+        (infConflicts,infAmbiguous,infRedundant,infAccepted) <- Candidates.inferHandler
+        unless (null infAmbiguous) $ addMessageI Info $ MsgAmbiguousCandidatesRemoved $ length infAmbiguous
+        unless (null infRedundant) $ addMessageI Info $ MsgRedundantCandidatesRemoved $ length infRedundant
+        if (null infAccepted)
+          then addMessageI Info    $ MsgNoCandidatesInferred
+          else addMessageI Success $ MsgCandidatesInferred $ length infAccepted
+        return (infConflicts,infAccepted)
+      _other -> (,[]) <$> runDB Candidates.conflicts
+    unless (null infConflicts) $ addMessage Warning "KONFLIKTE vorhanden" --TODO i18n
+
     (   (degreeResult,degreeTable)
       , (studyTermsResult,studytermsTable)
-      , conflicted
-      , ((),candidateTable)) <- runDB $ (,,,)
+      , ((),candidateTable)) <- runDB $ (,,)
       <$> mkDegreeTable
-      <*> mkStudytermsTable
-      <*> Candidates.conflicts
+      <*> mkStudytermsTable (Set.fromList $ map (StudyTermsKey' . fst) infAccepted)
       <*> mkCandidateTable
 
     let degreeResult' :: FormResult (Map (Key StudyDegree) (Maybe Text, Maybe Text))
@@ -211,25 +234,7 @@ postAdminFeaturesR = do
 
     siteLayoutMsg MsgAdminFeaturesHeading $ do
       setTitleI MsgAdminFeaturesHeading
-      [whamlet|
-        <div .container>
-          <section>
-            ^{degreeTable}
-        <div .container>
-          <section>
-            ^{studytermsTable}
-        <div .container>
-          <section>
-            $if null conflicted
-              Kein Konflikte beobachtet.
-            $else
-              <h3>Studiengangseingträge mit beobachteten Konflikten:
-              <ul>
-                $forall (Entity _ (StudyTerms ky _ nm)) <- conflicted
-                  <li> #{show ky} - #{foldMap id nm}
-            <div .container>
-              ^{candidateTable}
-      |]
+      $(widgetFile "adminFeatures")
   where
     textInputCell lensRes lensDefault = formCell id (return . view (_dbrOutput . _entityKey))
       (\row _mkUnique -> (\(res,fieldView) -> (set lensRes <$> res, fvInput fieldView))
@@ -246,23 +251,24 @@ postAdminFeaturesR = do
           dbtRowKey     = (E.^. StudyDegreeKey)
           dbtProj       = return
           dbtColonnade  = formColonnade $ mconcat
-            [ sortable (Just "degree-key")   (i18nCell MsgDegreeKey)   (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
-            , sortable (Just "degree-name")  (i18nCell MsgDegreeName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
-            , sortable (Just "degree-short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
+            [ sortable (Just "key")   (i18nCell MsgDegreeKey)   (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
+            , sortable (Just "name")  (i18nCell MsgDegreeName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
+            , sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
+            , dbRow
             ]
           dbtSorting    = Map.fromList
-            [ ("degree-key"  , SortColumn (E.^. StudyDegreeKey))
-            , ("degree-name" , SortColumn (E.^. StudyDegreeName))
-            , ("degree-short", SortColumn (E.^. StudyDegreeShorthand))
+            [ ("key"  , SortColumn (E.^. StudyDegreeKey))
+            , ("name" , SortColumn (E.^. StudyDegreeName))
+            , ("short", SortColumn (E.^. StudyDegreeShorthand))
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
           dbtParams     = def { dbParamsFormAddSubmit = True } -- dbParamsFormEvaluate = liftHandlerT . (runFormPost . identifyForm "degree-table" - (identForm FIDdegree))}
-          psValidator   = def & defaultSorting [SortAscBy "degree-name", SortAscBy "degree-short", SortAscBy "degree-key"]
+          psValidator   = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
       in dbTable psValidator DBTable{..}
 
-    mkStudytermsTable :: DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
-    mkStudytermsTable =
+    mkStudytermsTable :: Set (Key StudyTerms) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
+    mkStudytermsTable newKeys =
       let dbtIdent      = "admin-studyterms" :: Text
           dbtStyle      = def
           dbtSQLQuery   :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
@@ -270,19 +276,22 @@ postAdminFeaturesR = do
           dbtRowKey     = (E.^. StudyTermsKey)
           dbtProj       = return
           dbtColonnade  = formColonnade $ mconcat
-            [ sortable (Just "studyterms-key")   (i18nCell MsgStudyTermsKey)   (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
-            , sortable (Just "studyterms-name")  (i18nCell MsgStudyTermsName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
-            , sortable (Just "studyterms-short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
+            [ sortable (Just "key")   (i18nCell MsgStudyTermsKey)   (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
+            , sortable (Just "isnew") (i18nCell MsgStudyTermIsNew)  (isNewCell . flip Set.member newKeys . view (_dbrOutput . _entityKey))
+            , sortable (Just "name")  (i18nCell MsgStudyTermsName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
+            , sortable (Just "short") (i18nCell MsgStudyTermsShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
+            , dbRow
             ]
           dbtSorting    = Map.fromList
-            [ ("studyterms-key"  , SortColumn (E.^. StudyTermsKey))
-            , ("studyterms-name" , SortColumn (E.^. StudyTermsName))
-            , ("studyterms-short", SortColumn (E.^. StudyTermsShorthand))
+            [ ("key"   , SortColumn (E.^. StudyTermsKey))
+            , ("isnew" , SortColumn (\studyTerm -> studyTerm E.^. StudyTermsId `E.in_` E.valList (Set.toList newKeys)))
+            , ("name"  , SortColumn (E.^. StudyTermsName))
+            , ("short" , SortColumn (E.^. StudyTermsShorthand))
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
           dbtParams     = def { dbParamsFormAddSubmit = True } -- , dbParamsFormEvaluate = liftHandlerT . runFormPost }
-          psValidator   = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"]
+          psValidator   = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
       in dbTable psValidator DBTable{..}
 
     mkCandidateTable =
@@ -293,14 +302,15 @@ postAdminFeaturesR = do
           dbtRowKey     = (E.^. StudyTermCandidateId)
           dbtProj       = return
           dbtColonnade  = dbColonnade $ mconcat
-            [ sortable (Just "termcandidate-key")       (i18nCell MsgStudyTermsKey)           (numCell  . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
-            , sortable (Just "termcandidate-name")      (i18nCell MsgStudyTermsName)          (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
-            , sortable (Just "termcandidate-incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
+            [ dbRow
+            , sortable (Just "key")       (i18nCell MsgStudyTermsKey)           (numCell  . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
+            , sortable (Just "name")      (i18nCell MsgStudyTermsName)          (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
+            , sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
             ]
           dbtSorting    = Map.fromList
-            [ ("termcandidate-key"      , SortColumn (E.^. StudyTermCandidateKey))
-            , ("termcandidate-name"     , SortColumn (E.^. StudyTermCandidateName))
-            , ("termcandidate-incidence", SortColumn (E.^. StudyTermCandidateIncidence))
+            [ ("key"      , SortColumn (E.^. StudyTermCandidateKey))
+            , ("name"     , SortColumn (E.^. StudyTermCandidateName))
+            , ("incidence", SortColumn (E.^. StudyTermCandidateIncidence))
             ]
           dbtFilter     = Map.fromList
             [ ("key",       FilterColumn $ mkExactFilter    (E.^. StudyTermCandidateKey))
@@ -314,6 +324,6 @@ postAdminFeaturesR = do
             , prismAForm (singletonFilter "incidence") mPrev $ aopt (searchField False) (fslI MsgStudyCandidateIncidence)
             ]
           dbtParams     = def
-          psValidator   = def & defaultSorting [SortAscBy "termcandidate-key", SortAscBy "termcandidate-name"]
+          psValidator   = def & defaultSorting [SortAscBy "key", SortAscBy "name"]
       in dbTable psValidator DBTable{..}
 
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index d4b9e5249..7abd6b4d7 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -57,6 +57,10 @@ sqlCell act = mempty & cellContents .~ lift act
 tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
 tickmarkCell = cell . toWidget . hasTickmark
 
+-- | Maybe display a exclamation icon
+isNewCell :: (IsDBTable m a) => Bool -> DBCell m a
+isNewCell = cell . toWidget . isNew
+
 -- | Maybe display comment icon linking a given URL or show nothing at all
 commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
 commentCell Nothing     = mempty
diff --git a/src/Handler/Utils/TermCandidates.hs b/src/Handler/Utils/TermCandidates.hs
index def3fff41..48fdec8cb 100644
--- a/src/Handler/Utils/TermCandidates.hs
+++ b/src/Handler/Utils/TermCandidates.hs
@@ -28,13 +28,10 @@ import qualified Database.Esqueleto as E
 -- import Database.Esqueleto.Utils as E
 
 
-type STKey = Int -- Key StudyTerms -- for convenience, assmued identical to field StudyTermCandidateKey
+type STKey = Int -- for convenience, assmued identical to field StudyTermCandidateKey
 
 data FailedCandidateInference = FailedCandidateInference [Entity StudyTerms]
-  deriving (Typeable)
-
-instance Show FailedCandidateInference where
-  show (FailedCandidateInference _) = "Failed Candidate Inference" -- TODO
+  deriving (Typeable, Show)
 
 instance Exception FailedCandidateInference
   -- Default Instance
@@ -43,54 +40,30 @@ instance Exception FailedCandidateInference
 shortenStudyTerm :: Text -> Text
 shortenStudyTerm = concatMap (take 4) . splitCamel
 
--- | Attempt to identify new StudyTerms based on observations
-inferHandler :: Handler ([UUID],([Entity StudyTerms],[Entity StudyTermCandidate],[(STKey,Text)]))
-inferHandler = do
-    (ambiguous, problems) <- runDB $ (,) <$> removeAmbiguous <*> conflicts
-    if (null problems)
-      then do
-        infRes <- inferAcc ([],[])
-        return (ambiguous, infRes)
-      else
-        return (ambiguous,(problems,[],[]))
-
+-- | Attempt to identify new StudyTerms based on observations, returning:
+--   * list of ambiguous instances that were discarded outright (identical names for differents keys observed in single incidences)
+--   * list of problems, ie. StudyTerms that contradict observed incidences
+--   * list of redundants, i.e. redundant observed incidences
+--   * list of accepted, i.e. newly accepted key/name pairs
+inferHandler :: Handler ([Entity StudyTerms],[TermCandidateIncidence],[Entity StudyTermCandidate],[(STKey,Text)])
+inferHandler = runDB $ inferAcc ([],[],[])
   where
-    inferAcc (accRedundants, accAccepted) =
-      handle (\(FailedCandidateInference fails) -> return (fails,accRedundants,accAccepted)) $ do
-        (infReds,infAccs) <- runDB inferStep
+    inferAcc (accAmbiguous, accRedundants, accAccepted) =
+      handle (\(FailedCandidateInference fails) -> (fails,accAmbiguous,accRedundants,accAccepted) <$ E.transactionUndo) $ do
+        (infAmbis, infReds,infAccs) <- inferStep
         if null infAccs
-          then return ([], infReds ++ accRedundants,            accAccepted)
-          else inferAcc   (infReds ++ accRedundants, infAccs ++ accAccepted)
+          then return ([],          accAmbiguous, infReds ++ accRedundants,            accAccepted)
+          else do
+            E.transactionSave -- commit transaction if there are no problems
+            inferAcc   (infAmbis ++ accAmbiguous, infReds ++ accRedundants, infAccs ++ accAccepted)
 
     inferStep = do
+      ambiguous  <- removeAmbiguous
       redundants <- removeRedundant
       accepted <- acceptSingletons
       problems <- conflicts
-      when (not $ null problems) $ throw $ FailedCandidateInference problems
-      return (redundants, accepted)
-
-
--- | Attempt to identify new StudyTerms based on observations
--- infer :: MonadHandler m => m ([Entity StudyTerms],[Entity StudyTerms])
-infer :: DB ([Entity StudyTerms],[(STKey, Text)])
-infer = do
-    void removeAmbiguous -- TODO: show result
-    inferAcc []
-  where
-    inferAcc prevSet = do
-      problems <- conflicts
-      if null problems
-        then do
-          void removeRedundant -- TODO: show result
-          newSet <- acceptSingletons
-          if null newSet
-            then -- inference complete
-              return ([],prevSet)
-            else
-              inferAcc (newSet ++ prevSet)
-        else --abort
-          return (problems,prevSet)
-
+      when (not $ null problems) $ throwM $ FailedCandidateInference problems
+      return (ambiguous, redundants, accepted)
 
 {-
 Candidate 1 11 "A"
@@ -113,7 +86,7 @@ as a fix we simply eliminate all observations that have the same name twice, see
 -- | remove candidates with ambiguous observations,
 --   ie. candidates that have duplicated term names with differing keys
 --   which may happen in rare cases
-removeAmbiguous :: DB [UUID]
+removeAmbiguous :: DB [TermCandidateIncidence]
 removeAmbiguous = do
   ambiList <- E.select $ E.from $ \(candA `E.InnerJoin` candB) -> do
     -- Either an innerJoin with itself or an exists-sub-select
@@ -165,7 +138,7 @@ acceptSingletons = do
       groupedCandidates = foldl' groupFun mempty incidences
 
       -- given a key, map each incidence to set of possible names for this key
-      groupFun :: Map STKey (Map UUID (Set Text)) -> StudyTermCandidate -> Map STKey (Map UUID (Set Text))
+      groupFun :: Map STKey (Map TermCandidateIncidence (Set Text)) -> StudyTermCandidate -> Map STKey (Map TermCandidateIncidence (Set Text))
       groupFun m StudyTermCandidate{..} =
         insertWith (Map.unionWith Set.union)
                    studyTermCandidateKey
@@ -192,37 +165,11 @@ acceptSingletons = do
         -- insertKey (StudyTermsKey key) $ StudyTerms key (Just $ shortenStudyTerm name) (Just name) -- name clash!
         void . insert $ StudyTerms key (Just $ shortenStudyTerm name) (Just name)
 
-
   -- register newly fixed candidates
   forM_ fixedKeys registerFixed
   return fixedKeys
 
 
-  -- SOME EARLIER ATTEMPTS FOLLOW:
-  --
-  -- unknownKeys <- E.select $ E.distinct $ E.from $ \candidate -> do
-  --    E.where_ $ E.notExists $ E.from $ \sterm ->
-  --      E.where_ $ candidate E.^. StudyTermCandidateKey E.==. sterm E.^. StudyTermKey
-  --    return $ candidate E.^. StudyTermCandidateKey
-  -- forM unknownKeys $ \(E.Value key) -> do
-  --   incidences <- E.select $ E.from $ \candidate -> do
-  --     E.where_ $
-  --
-  -- -- DON'T KNOW HOW TO DO IN SQL :( BUT WE NEED THE ENTIRE TABLE ANYHOW
-  -- candidates <- entityVal <$> selectList [] [] -- load entire candidate table
-  -- -- create map from UUID to set of candidates for efficiency
-  -- let collectCandidates m stc@StudyTermCandidate{studyTermCandidateIncidence=inci}
-  --       = insertWith Set.union inci stc
-  --     incidences = foldl collectCandidates Map.empty candidates
-  --
-  --     collectKeys m
-  --     keySets = foldl collectKeys Map.empty candidates
-  --
-  -- -- StudyTermCandidateKey -> Set StudyTermCandidateName
-
-
-
-
 -- | all existing StudyTerms that are contradiced by current observations
 conflicts :: DB [Entity StudyTerms]
 conflicts = E.select $ E.from $ \studyTerms -> do
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index d9cd98342..52fd5ed32 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -785,3 +785,4 @@ type UserEmail       = CI Email
 
 type PWHashAlgorithm = ByteString -> PWStore.Salt -> Int -> ByteString
 type InstanceId      = UUID
+type TermCandidateIncidence = UUID
diff --git a/src/Utils.hs b/src/Utils.hs
index 965a32f66..25142c944 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -161,6 +161,11 @@ hasTickmark :: Bool -> Markup
 hasTickmark True  = [shamlet|<i .fas .fa-check>|]
 hasTickmark False = mempty
 
+isNew :: Bool -> Markup
+isNew True  = [shamlet|<i .fas .fa-exclamation>|]
+isNew False = mempty
+
+
 ---------------------
 -- Text and String --
 ---------------------
diff --git a/templates/adminFeatures.hamlet b/templates/adminFeatures.hamlet
new file mode 100644
index 000000000..bda21478b
--- /dev/null
+++ b/templates/adminFeatures.hamlet
@@ -0,0 +1,19 @@
+<section>
+  ^{degreeTable}
+<section>
+  ^{studytermsTable}
+<section>
+    <h2>_{MsgStudyFeatureInference}
+    <p>
+      $if null infConflicts
+        Kein Konflikte beobachtet.
+      $else
+        <h3>Studiengangseingträge mit beobachteten Konflikten:
+        <ul>
+          $forall (Entity _ (StudyTerms ky _ nm)) <- infConflicts
+            <li> #{show ky} - #{foldMap id nm}
+    <form .form-inline method=post action=@{AdminFeaturesR} enctype=#{btnEnctype}>
+      ^{btnWdgt}
+
+    <div .container>
+      ^{candidateTable}

From 6317ae92f0986d6943bd18155a5d571d0510e5ce Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 20 Mar 2019 11:59:14 +0100
Subject: [PATCH 51/56] Bessere Fehlermeldungen bei SortKey/FilterKey-Mismatch

---
 src/Handler/Utils/Table/Pagination.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 741117297..22f3ef19b 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -53,7 +53,7 @@ import Control.Monad.Trans.Maybe
 
 import Data.Foldable (Foldable(foldMap))
 
-import Data.Map (Map, (!))
+import Data.Map (Map)
 import qualified Data.Map as Map
 
 import qualified Data.Set as Set
@@ -652,7 +652,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       = (, def) . first (map SomeMessage errs' <>) $ runPSValidator dbtable Nothing
       | otherwise
       = (, def) $ runPSValidator dbtable Nothing
-    psSorting' = map (\SortingSetting{..} -> (dbtSorting ! sortKey, sortDir)) psSorting
+    psSorting' = map (\SortingSetting{..} -> (Map.findWithDefault (error $ "Invalid sorting key: " <> show sortKey) sortKey dbtSorting, sortDir)) psSorting
 
   mapM_ (addMessageI Warning) errs
 
@@ -667,7 +667,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
             E.offset (psPage * l)
       Just ps -> E.where_ $ dbtRowKey t `sqlIn` ps
       _other  -> return ()
-    Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (dbtFilter ! key) args t) >> expr) (return ()) psFilter
+    Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (Map.findWithDefault (error $ "Invalid filter key: " <> show key) key dbtFilter) args t) >> expr) (return ()) psFilter
     return (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64), dbtRowKey t, res)
 
   let mapMaybeM f = fmap catMaybes . mapM (\(k, v) -> runMaybeT $ (,) <$> pure k <*> f v)

From 6344017db34ae6d415c3be0a039c2ecf552b507a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 20 Mar 2019 12:15:04 +0100
Subject: [PATCH 52/56] Ensure better, that
 study_{degree,terms}.{shorthand,name} isn't ""

---
 src/Handler/Admin.hs   | 4 ++--
 src/Model/Migration.hs | 7 +++++++
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index bf5a29f6d..dd3252b9b 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -11,7 +11,7 @@ import Control.Monad.Trans.Writer (mapWriterT)
 import Utils.Lens
 
 -- import Data.Time
--- import qualified Data.Text as T
+import qualified Data.Text as Text
 -- import Data.Function ((&))
 -- import Yesod.Form.Bootstrap3
 
@@ -237,7 +237,7 @@ postAdminFeaturesR = do
       $(widgetFile "adminFeatures")
   where
     textInputCell lensRes lensDefault = formCell id (return . view (_dbrOutput . _entityKey))
-      (\row _mkUnique -> (\(res,fieldView) -> (set lensRes <$> res, fvInput fieldView))
+      (\row _mkUnique -> (\(res,fieldView) -> (set lensRes . assertM (not . Text.null) <$> res, fvInput fieldView))
         <$> mopt textField "" (Just $ row ^. lensDefault)
       )
 
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index 38de10773..7b5fcc375 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -216,6 +216,13 @@ customMigrations = Map.fromListWith (>>)
         users <- [sqlQQ| SELECT DISTINCT ON ("user"."id") "user"."id", "study_features"."id" FROM "user", "study_features" WHERE "study_features"."user" = "user"."id" AND "study_features"."valid" AND "study_features"."type" = 'FieldPrimary' ORDER BY "user"."id", random(); |]
         forM_ users $ \(uid :: UserId, sfid :: StudyFeaturesId) -> [executeQQ| UPDATE "course_participant" SET "field" = #{sfid} WHERE "user" = #{uid} AND "field" IS NULL; |]
     )
+  , ( AppliedMigrationKey [migrationVersion|9.0.0|] [version|10.0.0|]
+    , do
+        whenM (columnExists "study_degree" "shorthand") $ [executeQQ| UPDATE "study_degree" SET "shorthand" = NULL WHERE "shorthand" = '' |]
+        whenM (columnExists "study_degree" "name") $ [executeQQ| UPDATE "study_degree" SET "name" = NULL WHERE "shorthand" = '' |]
+        whenM (columnExists "study_terms" "shorthand") $ [executeQQ| UPDATE "study_terms" SET "shorthand" = NULL WHERE "shorthand" = '' |]
+        whenM (columnExists "study_terms" "name") $ [executeQQ| UPDATE "study_terms" SET "name" = NULL WHERE "shorthand" = '' |]
+    )
   ]
 
 

From a81da6b7bfcb0e77fc3b8f9adea0ea212c1da2c1 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 20 Mar 2019 13:12:58 +0100
Subject: [PATCH 53/56] Ensure termNames read from LDAP are unique

---
 src/Foundation.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 282b0111e..4295f1179 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -42,6 +42,8 @@ import qualified Data.Set as Set
 import Data.Map (Map, (!?))
 import qualified Data.Map as Map
 
+import Data.List (nubBy)
+
 import Data.Monoid (Any(..))
 
 import Data.Pool
@@ -2087,7 +2089,7 @@ instance YesodAuth UniWorX where
               Right str <- return $ Text.decodeUtf8' v'
               return str
 
-            termNames = do
+            termNames = nubBy ((==) `on` CI.mk) $ do
               (k, v) <- ldapData
               guard $ k == Attr "dfnEduPersonFieldOfStudyString"
               v' <- v

From c4aab6248a963228579168186d4e010c7e0e1ab1 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 20 Mar 2019 13:15:23 +0100
Subject: [PATCH 54/56] inference for studyterms works now

---
 src/Handler/Admin.hs                |  4 ++--
 src/Handler/Utils/TermCandidates.hs | 20 +++++++++-----------
 test/Database.hs                    | 26 +++++++++++++++++++++++++-
 3 files changed, 36 insertions(+), 14 deletions(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index bf5a29f6d..3df9b1b9d 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -315,7 +315,7 @@ postAdminFeaturesR = do
           dbtFilter     = Map.fromList
             [ ("key",       FilterColumn $ mkExactFilter    (E.^. StudyTermCandidateKey))
             , ("name",      FilterColumn $ mkContainsFilter (E.^. StudyTermCandidateName))
-            , ("incidence", FilterColumn $ mkExactFilter (E.^. StudyTermCandidateIncidence)) -- TODO containts filter desired here
+            , ("incidence", FilterColumn $ mkExactFilter    (E.^. StudyTermCandidateIncidence)) -- contains filter desired, but impossible here
             ]
           dbtFilterUI mPrev = mconcat
             -- [ prismAForm (singletonFilter "key")       mPrev $ aopt intField            (fslI MsgStudyTermsKey) -- Typing problem exactFilter suffices here
@@ -324,6 +324,6 @@ postAdminFeaturesR = do
             , prismAForm (singletonFilter "incidence") mPrev $ aopt (searchField False) (fslI MsgStudyCandidateIncidence)
             ]
           dbtParams     = def
-          psValidator   = def & defaultSorting [SortAscBy "key", SortAscBy "name"]
+          psValidator   = def & defaultSorting [SortAscBy "incidence", SortAscBy "key", SortAscBy "name"]
       in dbTable psValidator DBTable{..}
 
diff --git a/src/Handler/Utils/TermCandidates.hs b/src/Handler/Utils/TermCandidates.hs
index 48fdec8cb..fdf91a7f9 100644
--- a/src/Handler/Utils/TermCandidates.hs
+++ b/src/Handler/Utils/TermCandidates.hs
@@ -88,13 +88,13 @@ as a fix we simply eliminate all observations that have the same name twice, see
 --   which may happen in rare cases
 removeAmbiguous :: DB [TermCandidateIncidence]
 removeAmbiguous = do
-  ambiList <- E.select $ E.from $ \(candA `E.InnerJoin` candB) -> do
-    -- Either an innerJoin with itself or an exists-sub-select
-    E.on $    (candA E.^. StudyTermCandidateIncidence E.==. candB E.^. StudyTermCandidateIncidence)
-        E.&&. (candA E.^. StudyTermCandidateKey       E.!=. candB E.^. StudyTermCandidateKey)
-        E.&&. (candA E.^. StudyTermCandidateName      E.==. candB E.^. StudyTermCandidateName)
-        E.&&. (candA E.^. StudyTermCandidateId        E.!=. candB E.^. StudyTermCandidateId) -- should not be needed, but does not hurt either
-    return $ candA E.^. StudyTermCandidateIncidence
+  ambiList <- E.select $ E.from $ \candidate -> do
+    E.groupBy ( candidate E.^. StudyTermCandidateIncidence
+              , candidate E.^. StudyTermCandidateKey
+              , candidate E.^. StudyTermCandidateName
+              )
+    E.having $ E.countRows E.!=. E.val (1 :: Int64)
+    return $ candidate E.^. StudyTermCandidateIncidence
   let ambiSet = E.unValue <$> List.nub ambiList
   -- Most SQL dialects won't allow deletion and queries on the same table at once, hence we delete in two steps.
   deleteWhere [StudyTermCandidateIncidence <-. ambiSet]
@@ -125,7 +125,7 @@ removeRedundant = do
 --   we load the table into Haskell and operate there. Memory usage problem? StudyTermsCandidate may become huge.
 acceptSingletons :: DB [(STKey,Text)]
 acceptSingletons = do
-  knownKeys <- fmap unStudyTermsKey <$> selectKeysList [] [Asc StudyTermsKey]
+  knownKeys <- fmap unStudyTermsKey <$> selectKeysList [StudyTermsName !=. Nothing] [Asc StudyTermsKey]
   -- let knownKeysSet = Set.fromAscList knownKeys
   -- In case of memory problems, change next lines to conduit proper:
   incidences <- fmap entityVal <$> selectList [StudyTermCandidateKey /<-. knownKeys] [] -- LimitTo might be dangerous here, if we get a partial incidence. Possibly first select N incidences, then retrieving all those only.
@@ -161,9 +161,7 @@ acceptSingletons = do
 
       -- registerFixed :: (STKey, Text) -> DB (Key StudyTerms)
       registerFixed :: (STKey, Text) -> DB ()
-      registerFixed (key, name) =
-        -- insertKey (StudyTermsKey key) $ StudyTerms key (Just $ shortenStudyTerm name) (Just name) -- name clash!
-        void . insert $ StudyTerms key (Just $ shortenStudyTerm name) (Just name)
+      registerFixed (key, name) = repsert (StudyTermsKey' key) $ StudyTerms key (Just $ shortenStudyTerm name) (Just name)
 
   -- register newly fixed candidates
   forM_ fixedKeys registerFixed
diff --git a/test/Database.hs b/test/Database.hs
index 11b14a157..8df98f6e9 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -231,6 +231,8 @@ fillDb = do
     sdBiol  = StudyTermsKey' 26
     sdChem1 = StudyTermsKey' 61
     sdChem2 = StudyTermsKey' 113
+    sdBWL   = StudyTermsKey' 21
+    sdDeut  = StudyTermsKey' 103
   repsert sdInf   $ StudyTerms  79 (Just "Inf")   (Just "Informatikk")
   repsert sdMath  $ StudyTerms 105 (Just "Math" ) (Just "Mathematik")
   repsert sdMedi  $ StudyTerms 121  Nothing       (Just "Fehler hier")
@@ -240,6 +242,8 @@ fillDb = do
   repsert sdBiol  $ StudyTerms 26   Nothing        Nothing                  -- intentionally left unknown
   repsert sdChem1 $ StudyTerms 61   Nothing        Nothing                  -- intentionally left unknown
   repsert sdChem2 $ StudyTerms 113  Nothing        Nothing                  -- intentionally left unknown
+  repsert sdBWL   $ StudyTerms 21   Nothing        Nothing                  -- intentionally left unknown
+  repsert sdDeut  $ StudyTerms 103  Nothing        Nothing                  -- intentionally left unknown
   incidence1 <- liftIO getRandom
   void . insert $ StudyTermCandidate incidence1 221 "Bioinformatik"
   void . insert $ StudyTermCandidate incidence1 221 "Mathematik"
@@ -252,7 +256,7 @@ fillDb = do
   void . insert $ StudyTermCandidate incidence2 61  "Chemie"
   incidence3 <- liftIO getRandom
   void . insert $ StudyTermCandidate incidence3 113 "Chemie"
-  incidence4 <- liftIO getRandom
+  incidence4 <- liftIO getRandom  -- ambiguous incidence
   void . insert $ StudyTermCandidate incidence4 221 "Bioinformatik"
   void . insert $ StudyTermCandidate incidence4 221 "Chemie"
   void . insert $ StudyTermCandidate incidence4 221 "Biologie"
@@ -285,6 +289,26 @@ fillDb = do
   void . insert $ StudyTermCandidate incidence8 121 "Medieninformatik"
   incidence9 <- liftIO getRandom
   void . insert $ StudyTermCandidate incidence9 79 "Informatik"
+  incidence10 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence10 103  "Deutsch"
+  void . insert $ StudyTermCandidate incidence10 103  "Betriebswirtschafslehre"
+  void . insert $ StudyTermCandidate incidence10 21   "Deutsch"
+  void . insert $ StudyTermCandidate incidence10 21   "Betriebswirtschafslehre"
+  incidence11 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence11 221 "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence11 221 "Chemie"
+  void . insert $ StudyTermCandidate incidence11 221 "Biologie"
+  void . insert $ StudyTermCandidate incidence11 61  "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence11 61  "Chemie"
+  void . insert $ StudyTermCandidate incidence11 61  "Biologie"
+  void . insert $ StudyTermCandidate incidence11 26  "Bioinformatik"
+  void . insert $ StudyTermCandidate incidence11 26  "Chemie"
+  void . insert $ StudyTermCandidate incidence11 26  "Biologie"
+  incidence12 <- liftIO getRandom
+  void . insert $ StudyTermCandidate incidence12 103  "Deutsch"
+  void . insert $ StudyTermCandidate incidence12 103  "Betriebswirtschafslehre"
+  void . insert $ StudyTermCandidate incidence12 21   "Deutsch"
+  void . insert $ StudyTermCandidate incidence12 21   "Betriebswirtschafslehre"
 
   sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here
     maxMuster

From d310e5a8c344e0abe22f7ca48dc58901b5b67678 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 20 Mar 2019 13:36:26 +0100
Subject: [PATCH 55/56] Inference tested and linted

---
 package.yaml                        |  1 +
 src/Handler/Admin.hs                | 12 ++++++++----
 src/Handler/Utils/TermCandidates.hs |  3 ++-
 test/Database.hs                    |  8 ++++----
 4 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/package.yaml b/package.yaml
index 0aadd7a3f..70a0a0c90 100644
--- a/package.yaml
+++ b/package.yaml
@@ -170,6 +170,7 @@ default-extensions:
 ghc-options:
   - -Wall
   - -fno-warn-type-defaults
+  - -fno-warn-unrecognised-pragmas
   - -fno-warn-partial-type-signatures
 
 when:
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index fa09fba75..3eab2f26c 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -198,8 +198,8 @@ postAdminFeaturesR = do
         (infConflicts,infAmbiguous,infRedundant,infAccepted) <- Candidates.inferHandler
         unless (null infAmbiguous) $ addMessageI Info $ MsgAmbiguousCandidatesRemoved $ length infAmbiguous
         unless (null infRedundant) $ addMessageI Info $ MsgRedundantCandidatesRemoved $ length infRedundant
-        if (null infAccepted)
-          then addMessageI Info    $ MsgNoCandidatesInferred
+        if null infAccepted
+          then addMessageI Info    MsgNoCandidatesInferred
           else addMessageI Success $ MsgCandidatesInferred $ length infAccepted
         return (infConflicts,infAccepted)
       _other -> (,[]) <$> runDB Candidates.conflicts
@@ -263,7 +263,9 @@ postAdminFeaturesR = do
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
-          dbtParams     = def { dbParamsFormAddSubmit = True } -- dbParamsFormEvaluate = liftHandlerT . (runFormPost . identifyForm "degree-table" - (identForm FIDdegree))}
+          dbtParams     = def { dbParamsFormAddSubmit = True
+                              , dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studydegrees-table-wrapper" :: Text)
+                              }
           psValidator   = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
       in dbTable psValidator DBTable{..}
 
@@ -290,7 +292,9 @@ postAdminFeaturesR = do
             ]
           dbtFilter     = mempty
           dbtFilterUI   = mempty
-          dbtParams     = def { dbParamsFormAddSubmit = True } -- , dbParamsFormEvaluate = liftHandlerT . runFormPost }
+          dbtParams     = def { dbParamsFormAddSubmit = True
+                              , dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)
+                              }
           psValidator   = def & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
       in dbTable psValidator DBTable{..}
 
diff --git a/src/Handler/Utils/TermCandidates.hs b/src/Handler/Utils/TermCandidates.hs
index fdf91a7f9..0832c343d 100644
--- a/src/Handler/Utils/TermCandidates.hs
+++ b/src/Handler/Utils/TermCandidates.hs
@@ -27,6 +27,7 @@ import qualified Data.Map as Map
 import qualified Database.Esqueleto as E
 -- import Database.Esqueleto.Utils as E
 
+{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}
 
 type STKey = Int -- for convenience, assmued identical to field StudyTermCandidateKey
 
@@ -62,7 +63,7 @@ inferHandler = runDB $ inferAcc ([],[],[])
       redundants <- removeRedundant
       accepted <- acceptSingletons
       problems <- conflicts
-      when (not $ null problems) $ throwM $ FailedCandidateInference problems
+      unless (null problems) $ throwM $ FailedCandidateInference problems
       return (ambiguous, redundants, accepted)
 
 {-
diff --git a/test/Database.hs b/test/Database.hs
index 8df98f6e9..c3b83c636 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -291,9 +291,9 @@ fillDb = do
   void . insert $ StudyTermCandidate incidence9 79 "Informatik"
   incidence10 <- liftIO getRandom
   void . insert $ StudyTermCandidate incidence10 103  "Deutsch"
-  void . insert $ StudyTermCandidate incidence10 103  "Betriebswirtschafslehre"
+  void . insert $ StudyTermCandidate incidence10 103  "Betriebswirtschaftslehre"
   void . insert $ StudyTermCandidate incidence10 21   "Deutsch"
-  void . insert $ StudyTermCandidate incidence10 21   "Betriebswirtschafslehre"
+  void . insert $ StudyTermCandidate incidence10 21   "Betriebswirtschaftslehre"
   incidence11 <- liftIO getRandom
   void . insert $ StudyTermCandidate incidence11 221 "Bioinformatik"
   void . insert $ StudyTermCandidate incidence11 221 "Chemie"
@@ -306,9 +306,9 @@ fillDb = do
   void . insert $ StudyTermCandidate incidence11 26  "Biologie"
   incidence12 <- liftIO getRandom
   void . insert $ StudyTermCandidate incidence12 103  "Deutsch"
-  void . insert $ StudyTermCandidate incidence12 103  "Betriebswirtschafslehre"
+  void . insert $ StudyTermCandidate incidence12 103  "Betriebswirtschaftslehre"
   void . insert $ StudyTermCandidate incidence12 21   "Deutsch"
-  void . insert $ StudyTermCandidate incidence12 21   "Betriebswirtschafslehre"
+  void . insert $ StudyTermCandidate incidence12 21   "Betriebswirtschaftslehre"
 
   sfMMp <- insert $ StudyFeatures -- keyword type prevents record syntax here
     maxMuster

From 1c1dc70066553422df757e6f0eb06919f5900c07 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 20 Mar 2019 14:09:46 +0100
Subject: [PATCH 56/56] Various minor fixes

---
 ChangeLog.md                        |  4 ++++
 messages/uniworx/de.msg             |  4 ++--
 models/courses                      |  4 ++--
 models/tutorials                    |  2 +-
 src/Handler/Course.hs               | 10 +++++-----
 src/Handler/Utils/TermCandidates.hs |  8 ++++----
 6 files changed, 18 insertions(+), 14 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index 59d7755a2..c1ce2db41 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,7 @@
+  * Version 20.03.2019
+
+    Kursanmeldung benötigen assoziertes Hauptfach (für Studierende mit mehreren Hauptfächern)
+
   * Version 30.01.2019
 
     Designänderungen
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 0155c491a..0b5ad6e65 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -71,8 +71,8 @@ CourseNewHeading: Neuen Kurs anlegen
 CourseEditHeading tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} editieren
 CourseEditTitle: Kurs editieren/anlegen
 CourseMembers: Teilnehmer
-CourseMembersCount num@Int64: #{display num}
-CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max}
+CourseMembersCount n@Int: #{display n}
+CourseMembersCountLimited n@Int max@Int: #{display n}/#{display max}
 CourseName: Name
 CourseDescription: Beschreibung
 CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet
diff --git a/models/courses b/models/courses
index c2720cccf..fb9b06462 100644
--- a/models/courses
+++ b/models/courses
@@ -10,7 +10,7 @@ Course    -- Information about a single course; contained info is always visible
     shorthand        (CI Text)     -- practical shorthand of course name, used for identification
     term             TermId        -- semester this course is taught
     school           SchoolId
-    capacity         Int64 Maybe   -- number of allowed enrolements, if restricted
+    capacity         Int Maybe   -- number of allowed enrolements, if restricted
     -- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
     registerFrom     UTCTime Maybe -- enrolement allowed from a given day onwwards or prohibited
     registerTo       UTCTime Maybe -- enrolement may be prohibited from a given date onwards
@@ -20,7 +20,7 @@ Course    -- Information about a single course; contained info is always visible
     TermSchoolCourseShort  term school shorthand    -- shorthand must be unique within school and semester
     TermSchoolCourseName   term school name         -- name must be unique within school and semester
     deriving Generic
-CourseEdit                -- who edited when a row in table "Course", kept indefinitely
+CourseEdit                -- who edited when a row in table "Course", kept indefinitely (might be replaced by generic Audit Table; like all ...-Edit tables)
     user         UserId
     time         UTCTime
     course       CourseId
diff --git a/models/tutorials b/models/tutorials
index 8e657a672..3afed739e 100644
--- a/models/tutorials
+++ b/models/tutorials
@@ -4,7 +4,7 @@ Tutorial json
     name        Text
     tutor       UserId
     course      CourseId
-    capacity    Int64 Maybe -- limit for enrolement in this tutorial
+    capacity    Int Maybe -- limit for enrolement in this tutorial
 TutorialUser
     user        UserId
     tutorial    TutorialId
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 823504dcc..838f81fe7 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -31,7 +31,7 @@ import qualified Database.Esqueleto as E
 
 
 -- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
-type CourseTableData = DBRow (Entity Course, Int64, Bool, Entity School)
+type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School)
 
 colCourse :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
 colCourse = sortable (Just "course") (i18nCell MsgCourse)
@@ -108,10 +108,10 @@ colRegistered = sortable (Just "registered") (i18nCell MsgRegistered)
 
 type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School)
 
-course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int64)
+course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int)
 course2Participants (course `E.InnerJoin` _school) = E.sub_select . E.from $ \courseParticipant -> do
     E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
-    return (E.countRows :: E.SqlExpr (E.Value Int64))
+    return (E.countRows :: E.SqlExpr (E.Value Int))
 
 course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
 course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant ->
@@ -281,7 +281,7 @@ getCShowR tid ssh csh = do
             E.limit 1 -- we know that there is at most one match, but we tell the DB this info too
             let numParticipants = E.sub_select . E.from $ \part -> do
                   E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
-                  return ( E.countRows :: E.SqlExpr (E.Value Int64))
+                  return ( E.countRows :: E.SqlExpr (E.Value Int))
             return (course,school E.^. SchoolName, numParticipants, participant)
     defSFid <- ifMaybeM mbAid Nothing $ \uid -> lift $ selectFirst [StudyFeaturesUser ==. uid, StudyFeaturesType ==. FieldPrimary, StudyFeaturesValid ==. True] [Desc StudyFeaturesUpdated, Desc StudyFeaturesDegree, Desc StudyFeaturesField] -- sorting by degree & field is an heuristic only, but this is okay for a default suggestion
     lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
@@ -532,7 +532,7 @@ data CourseForm = CourseForm
         , cfShort      :: CourseShorthand
         , cfTerm       :: TermId
         , cfSchool     :: SchoolId
-        , cfCapacity   :: Maybe Int64
+        , cfCapacity   :: Maybe Int
         , cfSecret     :: Maybe Text
         , cfMatFree    :: Bool
         , cfRegFrom    :: Maybe UTCTime
diff --git a/src/Handler/Utils/TermCandidates.hs b/src/Handler/Utils/TermCandidates.hs
index 0832c343d..5eeba9a56 100644
--- a/src/Handler/Utils/TermCandidates.hs
+++ b/src/Handler/Utils/TermCandidates.hs
@@ -37,9 +37,9 @@ data FailedCandidateInference = FailedCandidateInference [Entity StudyTerms]
 instance Exception FailedCandidateInference
   -- Default Instance
 
--- | Just an heuristik to fill in defaults
-shortenStudyTerm :: Text -> Text
-shortenStudyTerm = concatMap (take 4) . splitCamel
+-- -- | Just an heuristik to fill in defaults
+-- shortenStudyTerm :: Text -> Text
+-- shortenStudyTerm = concatMap (take 4) . splitCamel
 
 -- | Attempt to identify new StudyTerms based on observations, returning:
 --   * list of ambiguous instances that were discarded outright (identical names for differents keys observed in single incidences)
@@ -162,7 +162,7 @@ acceptSingletons = do
 
       -- registerFixed :: (STKey, Text) -> DB (Key StudyTerms)
       registerFixed :: (STKey, Text) -> DB ()
-      registerFixed (key, name) = repsert (StudyTermsKey' key) $ StudyTerms key (Just $ shortenStudyTerm name) (Just name)
+      registerFixed (key, name) = repsert (StudyTermsKey' key) $ StudyTerms key Nothing (Just name)
 
   -- register newly fixed candidates
   forM_ fixedKeys registerFixed