feat(allocations): show table of course applications

messages/uniworx/de.msg

@@ -969,6 +969,7 @@ MenuCourseList: Kurse
 MenuCourseMembers: Kursteilnehmer
 MenuCourseAddMembers: Kursteilnehmer hinzufügen
 MenuCourseCommunication: Kursmitteilung
+MenuCourseApplications: Bewerbungen
 MenuTermShow: Semester
 MenuSubmissionDelete: Abgabe löschen
 MenuUsers: Benutzer
@@ -1513,4 +1514,12 @@ AllocationSchoolShort: Institut
 Allocation: Zentralanmeldung
 AllocationRegisterTo: Anmeldungen bis
 
-AllocationListTitle: Zentralanmeldungen
+AllocationListTitle: Zentralanmeldungen
+
+CourseApplicationsListTitle: Bewerbungen
+CourseApplicationId: Bewerbungsnummer
+CourseApplicationRatingPoints: Bewertung
+CourseApplicationVeto: Veto
+
+UserDisplayName: Voller Name
+UserMatriculation: Matrikelnummer

models/users

@@ -12,10 +12,10 @@ User json    -- Each Uni2work user has a corresponding row in this table; create
     authentication AuthenticationMode       -- 'AuthLDAP' or ('AuthPWHash'+password-hash)
     lastAuthentication UTCTime Maybe        -- last login date
     tokensIssuedAfter  UTCTime Maybe        -- do not accept bearer tokens issued before this time (accept all tokens if null) 
-    matrikelnummer Text Maybe               -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...)
+    matrikelnummer UserMatriculation 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)
+    displayName    UserDisplayName          -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained)
-    surname        Text                     -- Display user names always through 'nameWidget displayName surname'
+    surname        UserSurname              -- Display user names always through 'nameWidget displayName surname'
     firstName      Text                     -- For export in tables, pre-split firstName from displayName
     title          Text Maybe               -- For upcoming name customisation
     maxFavourites  Int default=12           -- max number of rows with this userId in table "CourseFavourite"; for convenience links; user-defined

src/Application.hs

@@ -64,8 +64,6 @@ import qualified Yesod.Core.Types as Yesod (Logger(..))
 
 import qualified Data.HashMap.Strict as HashMap
 
-import Data.Proxy
-
 import qualified Data.Aeson as Aeson
 
 import System.Exit

src/Database/Esqueleto/Utils.hs

@@ -18,6 +18,7 @@ module Database.Esqueleto.Utils
   , SqlHashable
   , sha256
   , maybe
+  , SqlProject(..)
   ) where
 
 
@@ -232,3 +233,16 @@ maybe onNothing onJust val = E.case_
       (onJust $ E.veryUnsafeCoerceSqlExprValue val)
   ]
   (E.else_ onNothing)
+
+
+class (PersistEntity entity, PersistField value) => SqlProject entity value entity' value' | entity value entity' -> value', entity value value' -> entity' where
+  sqlProject :: E.SqlExpr entity' -> EntityField entity value -> E.SqlExpr (E.Value value')
+  unSqlProject :: forall p1 p2. p1 entity -> p2 entity' -> value -> value'
+
+instance (PersistEntity val, PersistField typ) => SqlProject val typ (E.Entity val) typ where
+  sqlProject = (E.^.)
+  unSqlProject _ _ = id
+
+instance (PersistEntity val, PersistField typ) => SqlProject val typ (Maybe (E.Entity val)) (Maybe typ) where
+  sqlProject = (E.?.)
+  unSqlProject _ _ = Just

src/Foundation.hs

@@ -1041,6 +1041,7 @@ tagAccessPredicate AuthAllocationRegistered = APDB $ \mAuthId route _ -> case ro
   r -> $unsupportedAuthPredicate AuthAllocationRegistered r
 tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
   CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do
+    cTime <- liftIO getCurrentTime
     let authorizedIfExists f = do
           [E.Value ok] <- lift . E.select . return . E.exists $ E.from f
           whenExceptT ok Authorized
@@ -1101,12 +1102,16 @@ tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
            E.&&. course E.^. CourseSchool    E.==. E.val ssh
            E.&&. course E.^. CourseShorthand E.==. E.val csh
     -- participant is applicant for this course
-    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` courseApplication) -> do
+    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \((course `E.InnerJoin` courseApplication) `E.LeftOuterJoin` allocation) -> do
+      E.on $ allocation E.?. AllocationId E.==. courseApplication E.^. CourseApplicationAllocation
       E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
       E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val participant
            E.&&. course E.^. CourseTerm      E.==. E.val tid
            E.&&. course E.^. CourseSchool    E.==. E.val ssh
            E.&&. course E.^. CourseShorthand E.==. E.val csh
+      E.where_ $ E.maybe E.true (E.maybe E.false $ \f -> f E.<=. E.val cTime) (allocation E.?. AllocationStaffAllocationFrom)
+           E.&&. E.maybe E.true (E.maybe E.true  $ \t -> t E.>=. E.val cTime) (allocation E.?. AllocationStaffAllocationTo)
+      
     unauthorizedI MsgUnauthorizedParticipant
   r -> $unsupportedAuthPredicate AuthParticipant r
 tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of
@@ -1770,6 +1775,8 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb (CourseR tid ssh csh CExamListR) = return ("Prüfungen", Just $ CourseR tid ssh csh CShowR)
   breadcrumb (CourseR tid ssh csh CExamNewR) = return ("Anlegen", Just $ CourseR tid ssh csh CExamListR)
 
+  breadcrumb (CourseR tid ssh csh CApplicationsR) = return ("Bewerbungen", Just $ CourseR tid ssh csh CShowR)
+
   breadcrumb (CExamR tid ssh csh examn EShowR) = return (original examn, Just $ CourseR tid ssh csh CExamListR)
   breadcrumb (CExamR tid ssh csh examn EEditR) = return ("Bearbeiten", Just $ CExamR tid ssh csh examn EShowR)
   breadcrumb (CExamR tid ssh csh examn EUsersR) = return ("Teilnehmer", Just $ CExamR tid ssh csh examn EShowR)
@@ -2239,6 +2246,28 @@ pageActions (CourseR tid ssh csh CShowR) =
                 anyM examNames $ examAccess . E.unValue
            in runDB $ lecturerAccess `or2M` existsVisible
       }
+  , MenuItem
+      { menuItemType  = PageActionSecondary
+      , menuItemLabel = MsgMenuCourseApplications
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute $ CourseR tid ssh csh CApplicationsR
+      , menuItemModal = False
+      , menuItemAccessCallback' =
+          let courseWhere course = course <$ 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
+              existsApplications = E.selectExists . E.from $ \(course `E.InnerJoin` courseApplication) -> do
+                E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
+                void $ courseWhere course
+              courseApplications = fmap (any E.unValue) . E.select . E.from $ \course -> do
+                void $ courseWhere course
+                return $ course E.^. CourseApplicationsRequired
+              courseAllocation = E.selectExists . E.from $ \(course `E.InnerJoin` allocationCourse) -> do
+                E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
+                void $ courseWhere course
+           in runDB $ courseAllocation `or2M` courseApplications `or2M` existsApplications
+      }
   , MenuItem
       { menuItemType = PageActionSecondary
       , menuItemLabel = MsgMenuCourseMembers

src/Handler/Allocation/List.hs

@@ -18,7 +18,7 @@ allocationListIdent = "allocations"
 queryAllocation :: Getter AllocationTableExpr (E.SqlExpr (Entity Allocation))
 queryAllocation = id
 
-resultAllocation :: Getter AllocationTableData (Entity Allocation)
+resultAllocation :: Lens' AllocationTableData (Entity Allocation)
 resultAllocation = _dbrOutput
 
 allocationTermLink :: TermId -> SomeRoute UniWorX
@@ -43,9 +43,9 @@ getAllocationListR = do
 
     dbtColonnade :: Colonnade Sortable _ _
     dbtColonnade = mconcat
-      [ anchorColonnade (views (resultAllocation . _entityVal . _allocationTerm) allocationTermLink) . colTermShort $ resultAllocation . _entityVal . _allocationTerm
+      [ anchorColonnade (views (resultAllocation . _entityVal . _allocationTerm) allocationTermLink) $ colTermShort (resultAllocation . _entityVal . _allocationTerm)
-      , anchorColonnade (views (resultAllocation . _entityVal . _allocationSchool) allocationSchoolLink) . colSchoolShort $ resultAllocation . _entityVal . _allocationSchool
+      , anchorColonnade (views (resultAllocation . _entityVal . _allocationSchool) allocationSchoolLink) $ colSchoolShort (resultAllocation . _entityVal . _allocationSchool)
-      , anchorColonnade (views (resultAllocation . _entityVal) allocationLink) . colAllocationName $ resultAllocation . _entityVal . _allocationName
+      , anchorColonnade (views (resultAllocation . _entityVal) allocationLink) $ colAllocationName (resultAllocation . _entityVal . _allocationName)
       ]
 
     dbtSorting = mconcat
@@ -57,12 +57,12 @@ getAllocationListR = do
     dbtFilter = mconcat
       [ fltrTerm $ queryAllocation . to (E.^. AllocationTerm)
       , fltrSchool $ queryAllocation . to (E.^. AllocationSchool)
-      , fltrAllocationName $ queryAllocation . to (E.^. AllocationName)
+      , fltrAllocation queryAllocation
       ]
     dbtFilterUI = mconcat
       [ fltrTermUI
       , fltrSchoolUI
-      , fltrAllocationNameUI
+      , fltrAllocationUI
       ]
 
     dbtStyle = def
@@ -77,6 +77,7 @@ getAllocationListR = do
 
     psValidator :: PSValidator _ _
     psValidator = def
+      & defaultSorting [SortAscBy "term", SortAscBy "school", SortAscBy "allocation"]
 
   table <- runDB $ dbTableWidget' psValidator DBTable{..}
 

src/Handler/Course/Application.hs

@@ -6,8 +6,10 @@ module Handler.Course.Application
 import Import
 
 import Handler.Utils
+import Handler.Utils.Table.Columns
 
 import qualified Database.Esqueleto as E
+import Database.Esqueleto.Utils.TH
 
 import System.FilePath (addExtension)
 
@@ -37,6 +39,192 @@ getCAFilesR tid ssh csh cID = do
 
   serveSomeFiles archiveName $ fsSource .| C.map entityVal
 
+
+type CourseApplicationsTableExpr = (              E.SqlExpr (Entity CourseApplication)
+                                    `E.InnerJoin` E.SqlExpr (Entity User)
+                                   )
+                 `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity Allocation))
+                 `E.LeftOuterJoin` (              E.SqlExpr (Maybe (Entity StudyFeatures))
+                                    `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
+                                    `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
+                                   )
+type CourseApplicationsTableData = DBRow ( Entity CourseApplication
+                                         , Entity User
+                                         , E.Value Bool -- hasFiles
+                                         , Maybe (Entity Allocation)
+                                         , Maybe (Entity StudyFeatures)
+                                         , Maybe (Entity StudyTerms)
+                                         , Maybe (Entity StudyDegree)
+                                         )
+  
+courseApplicationsIdent :: Text
+courseApplicationsIdent = "applications"
+
+queryCourseApplication :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity CourseApplication))
+queryCourseApplication = to $ $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
+
+queryUser :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity User))
+queryUser = to $ $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
+
+queryHasFiles :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool))
+queryHasFiles = to $ hasFiles . $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
+  where
+    hasFiles appl = E.exists . E.from $ \courseApplicationFile ->
+      E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. appl E.^. CourseApplicationId
+
+queryAllocation :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity Allocation)))
+queryAllocation = to $(sqlLOJproj 3 2)
+
+queryStudyFeatures :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyFeatures)))
+queryStudyFeatures = to $ $(sqlIJproj 3 1) . $(sqlLOJproj 3 3)
+
+queryStudyTerms :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyTerms)))
+queryStudyTerms = to $ $(sqlIJproj 3 2) . $(sqlLOJproj 3 3)
+
+queryStudyDegree :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyDegree)))
+queryStudyDegree = to $ $(sqlIJproj 3 3) . $(sqlLOJproj 3 3)
+
+resultCourseApplication :: Lens' CourseApplicationsTableData (Entity CourseApplication)
+resultCourseApplication = _dbrOutput . _1
+
+resultUser :: Lens' CourseApplicationsTableData (Entity User)
+resultUser = _dbrOutput . _2
+
+resultHasFiles :: Lens' CourseApplicationsTableData Bool
+resultHasFiles = _dbrOutput . _3 . _Value
+
+resultAllocation :: Traversal' CourseApplicationsTableData (Entity Allocation)
+resultAllocation = _dbrOutput . _4 . _Just
+
+resultStudyFeatures :: Traversal' CourseApplicationsTableData (Entity StudyFeatures)
+resultStudyFeatures = _dbrOutput . _5 . _Just
+
+resultStudyTerms :: Traversal' CourseApplicationsTableData (Entity StudyTerms)
+resultStudyTerms = _dbrOutput . _6 . _Just
+
+resultStudyDegree :: Traversal' CourseApplicationsTableData (Entity StudyDegree)
+resultStudyDegree = _dbrOutput . _7 . _Just
+
 getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCApplicationsR = postCApplicationsR
-postCApplicationsR = fail "not implemented" -- dbtable of _all_ course applications
+postCApplicationsR tid ssh csh = do
+  table <- runDB $ do
+    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+
+    let
+      allocationLink :: Allocation -> SomeRoute UniWorX
+      allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR
+
+      participantLink :: MonadCrypto m => UserId -> m (SomeRoute UniWorX)
+      participantLink uid = do
+        cID <- encrypt uid
+        return . SomeRoute . CourseR tid ssh csh $ CUserR cID
+      
+      dbtSQLQuery :: CourseApplicationsTableExpr -> E.SqlQuery _
+      dbtSQLQuery = runReaderT $ do
+        courseApplication <- view queryCourseApplication
+        hasFiles <- view queryHasFiles
+        user <- view queryUser
+        allocation <- view queryAllocation
+        studyFeatures <- view queryStudyFeatures
+        studyTerms <- view queryStudyTerms
+        studyDegree <- view queryStudyDegree
+
+        lift $ do
+          E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
+          E.on $ studyTerms E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
+          E.on $ studyFeatures E.?. StudyFeaturesId E.==. courseApplication E.^. CourseApplicationField
+          E.on $ courseApplication E.^. CourseApplicationAllocation E.==. allocation E.?. AllocationId
+          E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser
+          E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid
+
+        return (courseApplication, user, hasFiles, allocation, studyFeatures, studyTerms, studyDegree)
+
+      dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) CourseApplicationsTableData
+      dbtProj = runReaderT $ do
+        appId <- view $ resultCourseApplication . _entityKey
+        cID <- encrypt appId
+        
+        guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR -- TODO: replace with CAShowR
+
+        view id
+
+      dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId)
+
+      dbtColonnade :: Colonnade Sortable _ _
+      dbtColonnade = mconcat
+        [ emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand)
+        , colApplicationId (resultCourseApplication . _entityKey)
+        , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
+        , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
+        , emptyOpticColonnade (resultStudyTerms . _entityVal) colStudyTerms
+        , emptyOpticColonnade (resultStudyDegree . _entityVal) colStudyDegree
+        , emptyOpticColonnade (resultStudyFeatures . _entityVal . _studyFeaturesSemester) colStudyFeaturesSemester
+        , colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText)
+        , lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusL 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles))
+        , colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto)
+        , colApplicationRatingPoints (resultCourseApplication . _entityVal . _courseApplicationRatingPoints)
+        , colApplicationRatingComment (resultCourseApplication . _entityVal . _courseApplicationRatingComment)
+        ]
+
+      dbtSorting = mconcat
+        [ sortAllocationShorthand $ queryAllocation . to (E.?. AllocationShorthand)
+        , sortUserName' $ $(multifocusG 2) (queryUser . to (E.^. UserDisplayName)) (queryUser . to (E.^. UserSurname))
+        , sortUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
+        , sortStudyTerms queryStudyTerms
+        , sortStudyDegree queryStudyDegree
+        , sortStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester)
+        , sortApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
+        , sortApplicationFiles queryHasFiles
+        , sortApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
+        , sortApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints)
+        , sortApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment)
+        ]
+
+      dbtFilter = mconcat
+        [ fltrAllocation queryAllocation
+        , fltrUserName' $ queryUser . to (E.^. UserDisplayName)
+        , fltrUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
+        , fltrStudyTerms queryStudyTerms
+        , fltrStudyDegree queryStudyDegree
+        , fltrStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester)
+        , fltrApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
+        , fltrApplicationFiles queryHasFiles
+        , fltrApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
+        , fltrApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints)
+        , fltrApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment)
+        ]
+      dbtFilterUI = mconcat
+        [ fltrAllocationUI
+        , fltrUserNameUI'
+        , fltrUserMatriculationUI
+        , fltrStudyTermsUI
+        , fltrStudyDegreeUI
+        , fltrStudyFeaturesSemesterUI
+        , fltrApplicationTextUI
+        , fltrApplicationFilesUI
+        , fltrApplicationVetoUI
+        , fltrApplicationRatingPointsUI
+        , fltrApplicationRatingCommentUI
+        ]
+
+      dbtStyle = def
+        { dbsFilterLayout = defaultDBSFilterLayout
+        }
+      dbtParams = def
+
+      dbtCsvEncode = noCsvEncode
+      dbtCsvDecode = Nothing
+
+      dbtIdent = courseApplicationsIdent
+
+      psValidator :: PSValidator _ _
+      psValidator = def
+
+    dbTableWidget' psValidator DBTable{..}
+
+  let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle
+
+  siteLayoutMsg title $ do
+    setTitleI title
+    table

src/Handler/CryptoIDDispatch.hs

@@ -5,8 +5,6 @@ module Handler.CryptoIDDispatch
 
 import Import
 
-import Data.Proxy
-
 import qualified Data.Text as Text
 
 import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))

src/Handler/Utils/Form.hs

@@ -43,8 +43,6 @@ import Data.Either (partitionEithers)
 import Data.Aeson (eitherDecodeStrict')
 import Data.Aeson.Text (encodeToLazyText)
 
-import Data.Proxy
-
 import qualified Text.Email.Validate as Email
 
 import Yesod.Core.Types (FileInfo(..))

src/Handler/Utils/Table/Cells.hs

@@ -100,6 +100,9 @@ msgCell = textCell . toMessage
 ---------------------
 -- Icon cells
 
+iconCell :: IsDBTable m a => Icon -> DBCell m a
+iconCell = cell . toWidget . icon
+
 addIconFixedWidth :: (IsDBTable m a) => DBCell m a -> DBCell m a
 addIconFixedWidth = over cellAttrs $ insertClass "icon-fixed-width"
 

src/Handler/Utils/Table/Columns.hs

@@ -12,6 +12,7 @@ import Import
 -- import Text.Blaze (ToMarkup(..))
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils (mkExactFilter, mkExactFilterWith, mkContainsFilter, mkContainsFilterWith, anyFilter)
 
 import Handler.Utils
@@ -22,6 +23,8 @@ import qualified Data.CaseInsensitive as CI
 import qualified Colonnade
 import Colonnade.Encode (Colonnade(..), OneColonnade(..))
 
+import Text.Blaze (toMarkup)
+
 
 --------------------------------
 -- Generic Columns
@@ -42,27 +45,32 @@ type OpticColonnade focus
        ( IsDBTable m x
        , FromSortable h
        )
-    => Getting focus r' focus
+    => (forall focus'. Getting focus' r' focus)
     -> Colonnade h r' (DBCell m x)
 
-type OpticSortColumn focus
+type OpticSortColumn' focus
   = forall t sortingMap.
        ( IsMap sortingMap
        , ContainerKey sortingMap ~ SortingKey
        , MapValue sortingMap ~ SortColumn t
        )
-    => Getting (E.SqlExpr focus) t (E.SqlExpr focus)
+    => (forall focus'. Getting focus' t focus)
     -> sortingMap
 
-type OpticFilterColumn t focus
+type OpticSortColumn val = OpticSortColumn' (E.SqlExpr (E.Value val))
+
+type OpticFilterColumn' t inp focus
   = forall filterMap.
        ( IsMap filterMap
        , ContainerKey filterMap ~ FilterKey
        , MapValue filterMap ~ FilterColumn t
+       , IsFilterColumn t (t -> inp -> E.SqlExpr (E.Value Bool))
        )
-    => Getting (E.SqlExpr focus) t (E.SqlExpr focus)
+    => (forall focus'. Getting focus' t focus)
     -> filterMap
 
+type OpticFilterColumn t focus = OpticFilterColumn' t (Set focus) (E.SqlExpr (E.Value focus))
+
 -----------------------
 -- Numbers and Indices
 
@@ -81,11 +89,10 @@ colTermShort resultTid = Colonnade.singleton (fromSortable header) body
     header = Sortable (Just "term") (i18nCell MsgTerm)
     body = i18nCell . ShortTermIdentifier . unTermKey . view resultTid
 
-sortTerm :: OpticSortColumn (E.Value TermId)
+sortTerm :: OpticSortColumn TermId
 sortTerm queryTid = singletonMap "term" . SortColumn $ view queryTid
 
-fltrTerm :: IsFilterColumn t (t -> Set TermId -> E.SqlExpr (E.Value Bool))
+fltrTerm :: OpticFilterColumn t TermId
-         => OpticFilterColumn t (E.Value TermId)
 fltrTerm queryTid = singletonMap "term" . FilterColumn $ mkExactFilter (view queryTid)
 
 fltrTermUI :: DBFilterUI
@@ -101,11 +108,10 @@ colSchoolShort resultSsh = Colonnade.singleton (fromSortable header) body
     header = Sortable (Just "school") (i18nCell MsgSchool)
     body = i18nCell . unSchoolKey . view resultSsh
 
-sortSchool :: OpticSortColumn (E.Value SchoolId)
+sortSchool :: OpticSortColumn SchoolId
 sortSchool querySsh = singletonMap "school" . SortColumn $ view querySsh
 
-fltrSchool :: IsFilterColumn t (t -> Set SchoolId -> E.SqlExpr (E.Value Bool))
+fltrSchool :: OpticFilterColumn t SchoolId
-           => OpticFilterColumn t (E.Value SchoolId)
 fltrSchool querySsh = singletonMap "school" . FilterColumn $ mkExactFilter (view querySsh)
 
 fltrSchoolUI :: DBFilterUI
@@ -121,15 +127,126 @@ colAllocationName resultName = Colonnade.singleton (fromSortable header) body
     header = Sortable (Just "allocation") (i18nCell MsgAllocationName)
     body = i18nCell . view resultName
 
-sortAllocationName :: OpticSortColumn (E.Value AllocationName)
+sortAllocationName :: OpticSortColumn AllocationName
 sortAllocationName queryName = singletonMap "allocation" . SortColumn $ view queryName
 
-fltrAllocationName :: IsFilterColumn t (t -> Set AllocationName -> E.SqlExpr (E.Value Bool))
+fltrAllocation :: forall allocation t shorthand name.
-                   => OpticFilterColumn t (E.Value AllocationName)
+                  ( E.SqlProject Allocation AllocationShorthand allocation shorthand
-fltrAllocationName queryName = singletonMap "allocation" . FilterColumn $ mkContainsFilter (view queryName)
+                  , E.SqlProject Allocation AllocationName      allocation name
+                  , E.SqlString name, E.SqlString shorthand
+                  )
+               => OpticFilterColumn' t (Set Text) (E.SqlExpr allocation)
+fltrAllocation query = singletonMap "allocation" . FilterColumn $ anyFilter
+  [ mkContainsFilterWith (unSqlProject' . CI.mk) $ views query (`E.sqlProject` AllocationShorthand)
+  , mkContainsFilterWith (unSqlProject' . CI.mk) $ views query (`E.sqlProject` AllocationName)
+  ]
+  where
+    unSqlProject' = E.unSqlProject (Proxy @Allocation) (Proxy @allocation)
 
-fltrAllocationNameUI :: DBFilterUI
+fltrAllocationUI :: DBFilterUI
-fltrAllocationNameUI mPrev = prismAForm (singletonFilter "allocation" . maybePrism _PathPiece) mPrev $ aopt (ciField :: Field _ AllocationName) (fslI MsgAllocation)
+fltrAllocationUI mPrev = prismAForm (singletonFilter "allocation" . maybePrism _PathPiece) mPrev $ aopt (ciField :: Field _ AllocationName) (fslI MsgAllocation)
+
+
+colAllocationShorthand :: OpticColonnade AllocationShorthand
+colAllocationShorthand resultShort = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "allocation-short") (i18nCell MsgAllocation)
+    body = i18nCell . view resultShort
+
+sortAllocationShorthand :: forall shorthand. PersistField shorthand => OpticSortColumn shorthand
+sortAllocationShorthand queryShorthand = singletonMap "allocation-short" . SortColumn $ view queryShorthand
+
+-------------------------
+-- Course Applications --
+-------------------------
+
+colApplicationId :: OpticColonnade CourseApplicationId
+colApplicationId resultId = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable Nothing (i18nCell MsgCourseApplicationId)
+    body = views resultId $ cell . (toWidget . toMarkup =<<) . (encrypt :: CourseApplicationId -> WidgetT UniWorX IO CryptoFileNameCourseApplication)
+
+colApplicationRatingPoints :: OpticColonnade (Maybe ExamGrade)
+colApplicationRatingPoints resultPoints = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "points") (i18nCell MsgCourseApplicationRatingPoints)
+    body = views resultPoints $ maybe mempty i18nCell
+
+sortApplicationRatingPoints :: OpticSortColumn (Maybe ExamGrade)
+sortApplicationRatingPoints queryPoints = singletonMap "points" . SortColumn $ view queryPoints
+
+fltrApplicationRatingPoints :: OpticFilterColumn t (Maybe ExamGrade)
+fltrApplicationRatingPoints queryPoints = singletonMap "points" . FilterColumn . mkExactFilter $ view queryPoints
+
+fltrApplicationRatingPointsUI :: DBFilterUI
+fltrApplicationRatingPointsUI mPrev = prismAForm (singletonFilter "points" . maybePrism _PathPiece) mPrev $ aopt examGradeField (fslI MsgCourseApplicationRatingPoints)
+
+colApplicationVeto :: OpticColonnade Bool
+colApplicationVeto resultVeto = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "veto") (i18nCell MsgCourseApplicationVeto)
+    body = views resultVeto $ bool mempty (iconCell IconApplicationVeto)
+
+sortApplicationVeto :: OpticSortColumn Bool
+sortApplicationVeto queryVeto = singletonMap "veto" . SortColumn $ view queryVeto
+
+fltrApplicationVeto :: OpticFilterColumn t Bool
+fltrApplicationVeto queryVeto = singletonMap "veto" . FilterColumn . mkExactFilter $ view queryVeto
+
+fltrApplicationVetoUI :: DBFilterUI
+fltrApplicationVetoUI mPrev = prismAForm (singletonFilter "veto" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgCourseApplicationVeto)
+
+colApplicationRatingComment :: OpticColonnade (Maybe Text)
+colApplicationRatingComment resultComment = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "comment") (i18nCell MsgApplicationRatingComment)
+    body = views resultComment . maybe mempty $ cell . modal (toWidget $ hasComment True) . Right . toWidget
+
+sortApplicationRatingComment :: OpticSortColumn (Maybe Text)
+sortApplicationRatingComment queryComment = singletonMap "comment" . SortColumn $ view queryComment
+
+fltrApplicationRatingComment :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value (Maybe Text)))
+fltrApplicationRatingComment queryComment = singletonMap "comment" . FilterColumn . mkContainsFilterWith Just $ view queryComment
+
+fltrApplicationRatingCommentUI :: DBFilterUI
+fltrApplicationRatingCommentUI mPrev = prismAForm (singletonFilter "comment") mPrev $ aopt textField (fslI MsgApplicationRatingComment)
+
+colApplicationText :: OpticColonnade (Maybe Text)
+colApplicationText resultText = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "text") (i18nCell MsgCourseApplicationText)
+    body = views resultText . maybe mempty $ cell . modal (toWidget $ hasComment True) . Right . toWidget
+
+sortApplicationText :: OpticSortColumn (Maybe Text)
+sortApplicationText queryText = singletonMap "text" . SortColumn $ view queryText
+
+fltrApplicationText :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value (Maybe Text)))
+fltrApplicationText queryText = singletonMap "text" . FilterColumn . mkContainsFilterWith Just $ view queryText
+
+fltrApplicationTextUI :: DBFilterUI
+fltrApplicationTextUI mPrev = prismAForm (singletonFilter "text") mPrev $ aopt textField (fslI MsgCourseApplicationText)
+
+
+colApplicationFiles :: OpticColonnade (TermId, SchoolId, CourseShorthand, CourseApplicationId, Bool) -- ^ `Bool` controls whether link is shown, use result of determination whether files exist
+colApplicationFiles resultInfo = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "has-files") (i18nCell MsgCourseApplicationFiles)
+    body = views resultInfo $ \(tid, ssh, csh, appId, showLink) -> if
+      | showLink
+        -> flip anchorCellM (asWidgetT $ toWidget iconApplicationFiles) $ do
+          cID <- encrypt appId
+          return $ CApplicationR tid ssh csh cID CAFilesR
+      | otherwise
+        -> mempty
+ 
+sortApplicationFiles :: OpticSortColumn Bool
+sortApplicationFiles queryFiles = singletonMap "has-files" . SortColumn $ view queryFiles
+
+fltrApplicationFiles :: OpticFilterColumn t Bool
+fltrApplicationFiles queryFiles = singletonMap "has-files" . FilterColumn . mkExactFilter $ view queryFiles
+
+fltrApplicationFilesUI :: DBFilterUI
+fltrApplicationFilesUI mPrev = prismAForm (singletonFilter "has-files" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgCourseApplicationFiles)
 
 ---------------
 -- Files
@@ -178,9 +295,24 @@ defaultSortingByFileModification = defaultSorting [SortAscBy "time"]
 ---------------
 -- User names
 
--- | Generic sort key from msg does not work, since we have no show Instance for RenderMesage UniWorX msg. Dangerous anyway!
+colUserDisplayName :: OpticColonnade (UserDisplayName, UserSurname)
-colUserName' :: (IsDBTable m c, HasUser a, RenderMessage UniWorX msg, Show msg) => msg -> Colonnade Sortable a  (DBCell m c)
+colUserDisplayName resultDisplayName = Colonnade.singleton (fromSortable header) body
-colUserName' msg = sortable (Just $ fromString $ show msg) (i18nCell msg) cellHasUser
+  where
+    header = Sortable (Just "user-name") (i18nCell MsgUserDisplayName)
+    body = views resultDisplayName $ cell . uncurry nameWidget
+
+sortUserName' :: OpticSortColumn' (E.SqlExpr (E.Value UserDisplayName), E.SqlExpr (E.Value UserSurname))
+sortUserName' queryDisplayName = singletonMap "user-name" . SortColumns $ \(view queryDisplayName -> (dn, sn))
+  -> [ SomeExprValue sn
+     , SomeExprValue dn
+     ]
+
+fltrUserName' :: OpticFilterColumn t UserDisplayName
+fltrUserName' queryDisplayName = singletonMap "user-name" . FilterColumn . mkContainsFilter $ view queryDisplayName
+
+fltrUserNameUI' :: DBFilterUI
+fltrUserNameUI' mPrev = prismAForm (singletonFilter "user-name") mPrev $ aopt textField (fslI MsgUserDisplayName)
+
 
 colUserName :: (IsDBTable m c, HasUser a) => Colonnade Sortable a  (DBCell m c)
 colUserName = sortable (Just "user-name") (i18nCell MsgCourseMembers) cellHasUser
@@ -189,11 +321,12 @@ colUserNameLink :: (IsDBTable m c, HasEntity a User) => (CryptoUUIDUser -> Route
 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 queryUser = ("user-name", SortColumn $ toSortKey . queryUser)
+sortUserName queryUser = ("user-name", SortColumns $ queryUser >>> \user ->
-  where toSortKey user = (user E.^. UserSurname) E.++. (user E.^. UserDisplayName)
+                                                       [ SomeExprValue $ user E.^. UserSurname
+                                                       , SomeExprValue $ 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)
@@ -261,7 +394,25 @@ fltrUserNameEmailUI mPrev =
   prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgCourseMembers)
 
 -------------------
--- Matriclenumber
+-- Matriculation --
+-------------------
+
+colUserMatriculation :: OpticColonnade (Maybe UserMatriculation)
+colUserMatriculation resultMatriculation = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "user-matriculation") (i18nCell MsgUserMatriculation)
+    body = views resultMatriculation . maybe mempty $ cell . toWidget
+
+sortUserMatriculation :: OpticSortColumn (Maybe UserMatriculation)
+sortUserMatriculation queryMatriculation = singletonMap "user-matriculation" . SortColumn $ view queryMatriculation
+
+fltrUserMatriculation :: OpticFilterColumn' t (Set Text) (E.SqlExpr (E.Value (Maybe UserMatriculation)))
+fltrUserMatriculation queryMatriculation = singletonMap "user-matriculation" . FilterColumn . mkContainsFilterWith Just $ view queryMatriculation
+
+fltrUserMatriculationUI :: DBFilterUI
+fltrUserMatriculationUI mPrev = prismAForm (singletonFilter "user-matriculation") mPrev $ aopt textField (fslI MsgUserMatriculation)
+
+  
 colUserMatriclenr ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
 colUserMatriclenr = sortable (Just "user-matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
 
@@ -304,6 +455,109 @@ fltrUserEmailUI mPrev =
 -- Study features --
 --------------------
 
+colStudyDegree :: OpticColonnade StudyDegree
+colStudyDegree resultDegree = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "features-degree") (i18nCell MsgStudyFeatureDegree)
+    body = views resultDegree $ \StudyDegree{..}
+      -> cell . maybe (toWidget $ toMarkup studyDegreeKey) toWidget $ studyDegreeShorthand <|> studyDegreeName
+
+sortStudyDegree :: forall studyDegree name shorthand key.
+                   ( E.SqlProject StudyDegree (Maybe StudyDegreeName) studyDegree name
+                   , E.SqlProject StudyDegree (Maybe StudyDegreeShorthand) studyDegree shorthand
+                   , E.SqlProject StudyDegree StudyDegreeKey studyDegree key
+                   , PersistField key, PersistField name, PersistField shorthand
+                   )
+                => OpticSortColumn' (E.SqlExpr studyDegree)
+sortStudyDegree queryDegree = singletonMap "features-degree" . SortColumns $ \(view queryDegree -> degree)
+  -> [ SomeExprValue $ degree `E.sqlProject` StudyDegreeName
+     , SomeExprValue $ degree `E.sqlProject` StudyDegreeShorthand
+     , SomeExprValue $ degree `E.sqlProject` StudyDegreeKey
+     ]
+
+fltrStudyDegree :: forall studyDegree t name shorthand key.
+                   ( E.SqlProject StudyDegree (Maybe StudyDegreeName) studyDegree name
+                   , E.SqlProject StudyDegree (Maybe StudyDegreeShorthand) studyDegree shorthand
+                   , E.SqlProject StudyDegree StudyDegreeKey studyDegree key
+                   , E.SqlString name, E.SqlString shorthand, PersistField key
+                   )
+                => OpticFilterColumn' t (Set Text) (E.SqlExpr studyDegree)
+fltrStudyDegree queryDegree = singletonMap "features-degree" . FilterColumn $ anyFilter
+  [ mkContainsFilterWith (unSqlProject' . Just) $ view queryDegree >>> (`E.sqlProject` StudyDegreeName)
+  , mkContainsFilterWith (unSqlProject' . Just) $ view queryDegree >>> (`E.sqlProject` StudyDegreeShorthand)
+  , mkExactFilterWith (fmap unSqlProject' . (readMay :: Text -> Maybe StudyDegreeKey)) $ view queryDegree >>> (`E.sqlProject` StudyDegreeKey) >>> E.just
+  ]
+  where
+    unSqlProject' :: E.SqlProject StudyDegree value studyDegree value' => value -> value'
+    unSqlProject' = E.unSqlProject (Proxy @StudyDegree) (Proxy @studyDegree)
+
+fltrStudyDegreeUI :: DBFilterUI
+fltrStudyDegreeUI mPrev = prismAForm (singletonFilter "features-degree") mPrev $ aopt textField (fslI MsgStudyFeatureDegree)
+
+
+colStudyTerms :: OpticColonnade StudyTerms
+colStudyTerms resultTerms = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "features-terms") (i18nCell MsgStudyTerm)
+    body = views resultTerms $ \StudyTerms{..}
+      -> cell . maybe (toWidget $ toMarkup studyTermsKey) toWidget $ studyTermsShorthand <|> studyTermsName
+
+sortStudyTerms :: forall studyTerms name shorthand key.
+                   ( E.SqlProject StudyTerms (Maybe StudyTermsName) studyTerms name
+                   , E.SqlProject StudyTerms (Maybe StudyTermsShorthand) studyTerms shorthand
+                   , E.SqlProject StudyTerms StudyTermsKey studyTerms key
+                   , PersistField key, PersistField name, PersistField shorthand
+                   )
+                => OpticSortColumn' (E.SqlExpr studyTerms)
+sortStudyTerms queryTerms = singletonMap "features-terms" . SortColumns $ \(view queryTerms -> terms)
+  -> [ SomeExprValue $ terms `E.sqlProject` StudyTermsName
+     , SomeExprValue $ terms `E.sqlProject` StudyTermsShorthand
+     , SomeExprValue $ terms `E.sqlProject` StudyTermsKey
+     ]
+
+fltrStudyTerms :: forall studyTerms t name shorthand key.
+                   ( E.SqlProject StudyTerms (Maybe StudyTermsName) studyTerms name
+                   , E.SqlProject StudyTerms (Maybe StudyTermsShorthand) studyTerms shorthand
+                   , E.SqlProject StudyTerms StudyTermsKey studyTerms key
+                   , E.SqlString name, E.SqlString shorthand, PersistField key
+                   )
+                => OpticFilterColumn' t (Set Text) (E.SqlExpr studyTerms)
+fltrStudyTerms queryTerms = singletonMap "features-terms" . FilterColumn $ anyFilter
+  [ mkContainsFilterWith (unSqlProject' . Just) $ view queryTerms >>> (`E.sqlProject` StudyTermsName)
+  , mkContainsFilterWith (unSqlProject' . Just) $ view queryTerms >>> (`E.sqlProject` StudyTermsShorthand)
+  , mkExactFilterWith (fmap unSqlProject' . (readMay :: Text -> Maybe StudyTermsKey)) $ view queryTerms >>> (`E.sqlProject` StudyTermsKey) >>> E.just
+  ]
+  where
+    unSqlProject' :: E.SqlProject StudyTerms value studyTerms value' => value -> value'
+    unSqlProject' = E.unSqlProject (Proxy @StudyTerms) (Proxy @studyTerms)
+
+fltrStudyTermsUI :: DBFilterUI
+fltrStudyTermsUI mPrev = prismAForm (singletonFilter "features-terms") mPrev $ aopt textField (fslI MsgStudyTerm)
+
+
+colStudyFeaturesSemester :: OpticColonnade Int
+colStudyFeaturesSemester resultSemester = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "features-semester") (i18nCell MsgStudyFeatureAge)
+    body = views resultSemester $ cell . toWidget . toMarkup
+
+sortStudyFeaturesSemester :: forall semester. PersistField semester => OpticSortColumn semester
+sortStudyFeaturesSemester querySemester = singletonMap "features-semester" . SortColumn $ view querySemester
+
+fltrStudyFeaturesSemester :: forall studyFeatures t semester.
+                             ( E.SqlProject StudyFeatures Int studyFeatures semester
+                             , PersistField semester
+                             )
+                          => OpticFilterColumn' t (Set Int) (E.SqlExpr (E.Value semester))
+fltrStudyFeaturesSemester querySemester = singletonMap "features-semester" . FilterColumn . mkExactFilterWith unSqlProject' $ view querySemester
+  where
+    unSqlProject' :: Int -> semester
+    unSqlProject' = E.unSqlProject (Proxy @StudyFeatures) (Proxy @studyFeatures)
+
+fltrStudyFeaturesSemesterUI :: DBFilterUI
+fltrStudyFeaturesSemesterUI mPrev = prismAForm (singletonFilter "features-semester" . maybePrism _PathPiece) mPrev $ aopt (intField :: Field _ Int) (fslI MsgStudyFeatureAge)
+
+
 colFeaturesSemester :: (IsDBTable m c, HasStudyFeatures x) => Getting (Leftmost x) a x -> Colonnade Sortable a (DBCell m c)
 colFeaturesSemester feature = sortable (Just "features-semester") (i18nCell MsgStudyFeatureAge) $ maybe mempty cellHasSemester . firstOf feature
 
@@ -408,3 +662,24 @@ anchorColonnadeM mkUrl = imapColonnade anchorColonnade'
     anchorColonnade' :: r' -> DBCell m a -> DBCell m a
     anchorColonnade' inp (view dbCell -> (attrs, act)) = review dbCell . (attrs,) $
       view (dbCell . _2) . anchorCellM (mkUrl inp) =<< act
+
+emptyOpticColonnade :: forall h r' focus c.
+                       ( Monoid c
+                       )
+                    => Fold r' focus -- ^ View on @focus@ within @r'@ that may produce any number of results
+                    -> ((forall focus'. Getting focus' r' focus) -> Colonnade h r' c) -- ^ `OpticColonnade focus`
+                    -> Colonnade h r' c
+-- ^ Generalize an `OpticColonnade` from `Getter` to `Fold` by defaulting results of zero or more than one values to `mempty`
+emptyOpticColonnade l c = Colonnade $ oldColonnade <&> \column -> column { oneColonnadeEncode = \s -> defaultColumn s $ oneColonnadeEncode column }
+  where
+    Colonnade oldColonnade = c $ singular l
+    -- This is safe (as long as we don't evaluate the `oneColonnadeEncode`s)
+    -- because `Getter s a` is of kind @k -> *@ and can thus only be inspected
+    -- by @c@ through application which is precluded by the type of `Getter s a`
+    -- and the definition of `OneColonnade`
+
+    defaultColumn :: r' -> (r' -> c) -> c
+    defaultColumn x f = case x ^.. l of
+      [_] -> f x
+      _   -> mempty
+

src/Handler/Utils/Table/Pagination.hs

@@ -1,6 +1,7 @@
 module Handler.Utils.Table.Pagination
   ( module Handler.Utils.Table.Pagination.Types
   , dbFilterKey
+  , SomeExprValue(..)
   , SortColumn(..), SortDirection(..)
   , SortingSetting(..)
   , pattern SortAscBy, pattern SortDescBy
@@ -130,7 +131,10 @@ dbFilterKey :: PathPiece dbtIdent => dbtIdent -> FilterKey -> Text
 dbFilterKey ident = toPathPiece . WithIdent ident
 
 
+data SomeExprValue = forall a. PersistField a => SomeExprValue { getSomeExprValue :: E.SqlExpr (E.Value a) }
+  
 data SortColumn t = forall a. PersistField a => SortColumn { getSortColumn :: t -> E.SqlExpr (E.Value a) }
+                  | SortColumns { getSortColumns :: t -> [SomeExprValue] }
 
 data SortDirection = SortAsc | SortDesc
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
@@ -147,9 +151,11 @@ deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 1
   } ''SortDirection
 
-sqlSortDirection :: t -> (SortColumn t, SortDirection) -> E.SqlExpr E.OrderBy
+sqlSortDirection :: t -> (SortColumn t, SortDirection) -> [E.SqlExpr E.OrderBy]
-sqlSortDirection t (SortColumn e, SortAsc ) = E.asc  $ e t
+sqlSortDirection t (SortColumn  e , SortAsc ) = pure . E.asc  $ e t
-sqlSortDirection t (SortColumn e, SortDesc) = E.desc $ e t
+sqlSortDirection t (SortColumn  e , SortDesc) = pure . E.desc $ e t
+sqlSortDirection t (SortColumns es, SortAsc ) = es t <&> \(SomeExprValue v) -> E.asc  v
+sqlSortDirection t (SortColumns es, SortDesc) = es t <&> \(SomeExprValue v) -> E.desc v
 
 
 data SortingSetting = SortingSetting
@@ -867,7 +873,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
   rows' <- E.select . E.from $ \t -> do
     res <- dbtSQLQuery t
-    E.orderBy (map (sqlSortDirection t) psSorting')
+    E.orderBy $ concatMap (sqlSortDirection t) psSorting'
     case csvMode of
       FormSuccess DBCsvExport -> return ()
       FormSuccess DBCsvImport{} -> return ()

src/Import/NoModel.hs

@@ -91,6 +91,8 @@ import Data.Void as Import (Void)
 
 import Algebra.Lattice as Import hiding (meet, join)
 
+import Data.Proxy as Import (Proxy(..))
+
 import Language.Haskell.TH.Instances as Import ()
 import Data.List.NonEmpty.Instances as Import ()
 import Data.NonNull.Instances as Import ()

src/Model/Types/Common.hs

@@ -18,6 +18,17 @@ type Points                  = Centi
 
 type Email                   = Text
 
+type UserDisplayName         = Text
+type UserSurname             = Text
+type UserMatriculation       = Text
+
+type StudyDegreeName         = Text
+type StudyDegreeShorthand    = Text
+type StudyDegreeKey          = Int
+type StudyTermsName          = Text
+type StudyTermsShorthand     = Text
+type StudyTermsKey           = Int
+
 type SchoolName              = CI Text
 type SchoolShorthand         = CI Text
 type CourseName              = CI Text

src/Utils/Icon.hs

@@ -59,6 +59,8 @@ data Icon
   | IconApplyTrue
   | IconApplyFalse
   | IconNoCorrectors
+  | IconApplicationVeto
+  | IconApplicationFiles
   deriving (Eq, Ord, Enum, Bounded, Show, Read)
 
 iconText :: Icon -> Text
@@ -92,6 +94,8 @@ iconText = \case
     IconApplyTrue          -> "file-alt"
     IconApplyFalse         -> "trash"
     IconNoCorrectors       -> "user-slash"
+    IconApplicationVeto    -> "times"
+    IconApplicationFiles   -> "file-alt"
 
 instance Universe Icon
 instance Finite   Icon

src/Utils/Lens.hs

@@ -14,7 +14,7 @@ import Control.Lens as Utils.Lens
          , Index, index, (<.)
          )
 import Control.Lens.Extras as Utils.Lens (is)
-import Utils.Lens.TH as Utils.Lens (makeLenses_, makeClassyFor_)
+import Utils.Lens.TH as Utils.Lens
 import Data.Set.Lens as Utils.Lens
 
 import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))

src/Utils/Lens/TH.hs

@@ -1,10 +1,17 @@
-module Utils.Lens.TH where
+module Utils.Lens.TH
+  ( makeLenses_, makeClassyFor_
+  , multifocusG, multifocusL
+  ) where
 
-import ClassyPrelude (Maybe(..), (<>))
+import ClassyPrelude
 import Control.Lens
 import Control.Lens.Internal.FieldTH
 import Language.Haskell.TH
 
+import Numeric.Natural
+
+import Data.Foldable (Foldable(foldl))
+
 -- import Control.Lens.Misc
 {-
     NOTE: The code for lensRules_  and makeLenses_ was stolen from package lens-misc-0.0.2.0,
@@ -65,3 +72,47 @@ makeClassyFor_ recName = makeFieldOptics (classyRulesFor_ clNamer) recName
       clNamer :: ClassyNamer
       -- clNamer _ = Just (clsName, funName) -- for newer versions >= 4.17
       clNamer _ = Just (mkName clsName, mkName funName)
+
+multifocusG :: Natural -> ExpQ
+multifocusG = multifocusOptic
+  [e|to . view|]
+  (\s a -> [t|Getting $(a) $(s) $(a)|])
+  (\s a -> [t|Getter $(s) $(a)|])
+  (\doGet _doSet -> [e|to $(doGet)|])
+
+multifocusL :: Natural -> ExpQ
+multifocusL = multifocusOptic
+  [e|cloneLens|]
+  (\s a -> [t|ALens' $(s) $(a)|])
+  (\s a -> [t|Lens' $(s) $(a)|])
+  (\doGet doSet -> [e|lens $(doGet) $(doSet)|])
+
+
+multifocusOptic :: _ -> _ -> _ -> _ -> Natural -> ExpQ
+multifocusOptic _       _      _     _      0                  = [e|united|]
+multifocusOptic doClone _      _     _      1                  = doClone
+multifocusOptic doClone alensT lensT lens' (fromIntegral -> n) = do
+  ll <- newName "l"
+  ls <- replicateM n $ newName "l"
+  s  <- newName "s"
+  xs <- replicateM n $ newName "x"
+
+  tS  <- newName "s"
+  tXs <- replicateM n $ newName "x" :: Q [Name]
+
+  let tup = foldl (\t x -> [t|$(t) $(varT x)|]) (tupleT (length tXs)) tXs
+      mkL x = alensT (varT tS) (varT x)
+
+  letE
+    [ sigD ll $ foldr (\x t -> [t|$(mkL x) -> $(t)|]) (lensT (varT tS) tup) tXs
+    , funD ll
+      [ clause
+          (map (viewP doClone . varP) ls)
+          (normalB $ lens'
+             (lamE [varP s] . tupE . flip map ls $ \l -> [e| $(varE s) ^. $(varE l) |])
+             (lamE [varP s, tupP $ map varP xs] . foldr (\(x, l) x' -> [e|$(x') & $(varE l) .~ $(varE x)|]) (varE s) $ zip xs ls)
+          )
+          []
+      ]
+    ]
+    (varE ll)

src/Utils/Sql.hs

@@ -23,7 +23,7 @@ setSerializable act = setSerializable' (0 :: Integer)
             let
               delay :: NominalDiffTime
               delay = 1e-3 * 2 ^ logBackoff
-            $logWarnS "Sql" $ tshow (delay, e)
+            $logDebugS "Sql" $ tshow (delay, e)
             transactionUndo
             threadDelay . round $ delay * 1e6
             setSerializable' (succ logBackoff)