Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

messages/uniworx/de.msg

@@ -227,6 +227,8 @@ CourseAllocationCapacityMayNotBeChanged: Kapazität eines Kurses, der an einer Z
 
 CourseLecturerRightsIdentical: Alle Sorten von Kursverwalter haben identische Rechte.
 
+School: Institut
+
 NoSuchTerm tid@TermId: Semester #{tid} gibt es nicht.
 NoSuchSchool ssh@SchoolId: Institut #{ssh} gibt es nicht.
 NoSuchCourseShorthand csh@CourseShorthand: Kein Kurs mit Kürzel #{csh} bekannt.
@@ -963,10 +965,12 @@ MenuHelp: Hilfe
 MenuProfile: Anpassen
 MenuLogin: Login
 MenuLogout: Logout
+MenuAllocationList: Zentralanmeldungen
 MenuCourseList: Kurse
 MenuCourseMembers: Kursteilnehmer
 MenuCourseAddMembers: Kursteilnehmer hinzufügen
 MenuCourseCommunication: Kursmitteilung
+MenuCourseApplications: Bewerbungen
 MenuTermShow: Semester
 MenuSubmissionDelete: Abgabe löschen
 MenuUsers: Benutzer
@@ -1469,6 +1473,7 @@ MailSchoolLecturerInviteHeading school@SchoolName: Einladung zum Dozent für „
 SchoolLecturerInviteExplanation: Sie wurden eingeladen, Dozent für ein Institut zu sein. Sie können, nachdem Sie die Einladung annehmen, eigenständig neue Kurse anlegen.
 SchoolLecturerInvitationAccepted school@SchoolName: Einladung zum Dozent für „#{school}“ angenommen
 
+AllocationName: Name
 AllocationTitle termText@Text ssh'@SchoolShorthand allocation@AllocationName: #{termText} - #{ssh'}: #{allocation}
 AllocationShortTitle termText@Text ssh'@SchoolShorthand ash@AllocationShorthand: #{termText} - #{ssh'} - #{ash}
 AllocationDescription: Beschreibung
@@ -1513,4 +1518,14 @@ ApplicationRatingCommentInvisibleTip: Dient zunächst nur als Notiz für Kursver
 
 AllocationSchoolShort: Institut
 Allocation: Zentralanmeldung
-AllocationRegisterTo: Anmeldungen bis
+AllocationRegisterTo: Anmeldungen bis
+
+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

routes

@@ -81,6 +81,7 @@
 /school                    SchoolListR         GET             !development
 /school/#SchoolId          SchoolShowR         GET             !development
 
+/allocation/               AllocationListR     GET             !free
 /allocation/#TermId/#SchoolId/#AllocationShorthand AllocationR:
   /                                              AShowR         GET             !free
   /register                                      ARegisterR         POST        !time

src/Application.hs

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

src/Auth/LDAP.hs

@@ -10,7 +10,6 @@ module Auth.LDAP
   ) where
 
 import Import.NoFoundation hiding (userEmail, userDisplayName)
-import Control.Lens
 import Network.Connection
 
 import Data.CaseInsensitive (CI)

src/Colonnade/Instances.hs

@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Colonnade.Instances
+  (
+  ) where
+
+import ClassyPrelude
+
+import Control.Lens.Indexed (FunctorWithIndex(imap))
+
+import Colonnade.Encode (Colonnade(..), OneColonnade(..))
+
+instance Functor h => FunctorWithIndex (Maybe a) (Colonnade h a) where
+ imap f (Colonnade ones) = Colonnade $ dimapColonnade' <$> ones
+   where
+     dimapColonnade' OneColonnade{..} = OneColonnade
+       { oneColonnadeEncode = \x -> f (Just x) $ oneColonnadeEncode x
+       , oneColonnadeHead   = f Nothing <$> oneColonnadeHead
+       }

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

@@ -65,7 +65,6 @@ import Control.Monad.Memo.Class (MonadMemo(..), for4)
 import qualified Control.Monad.Catch as C
 
 import Handler.Utils.StudyFeatures
-import Utils.Lens
 import Utils.Form
 import Utils.Sheet
 import Utils.SystemMessage
@@ -1047,6 +1046,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
@@ -1107,12 +1107,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
@@ -1748,10 +1752,11 @@ instance YesodBreadcrumbs UniWorX where
 
   breadcrumb (TermSchoolCourseListR tid ssh)  = return (original $ unSchoolKey ssh, Just $ TermCourseListR tid)
 
+  breadcrumb AllocationListR        = return ("Zentralanmeldungen", Just HomeR)
   breadcrumb (AllocationR tid ssh ash AShowR) = do
     mr <- getMessageRender
     Entity _ Allocation{allocationName} <- runDB . getBy404 $ TermSchoolAllocationShort tid ssh ash
-    return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{original (unSchoolKey ssh)})|], Just $ HomeR)
+    return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{original (unSchoolKey ssh)})|], Just $ AllocationListR)
   breadcrumb (AllocationR tid ssh ash (AApplicationR _)) = return ("Bewerbung", Just $ AllocationR tid ssh ash AShowR)
 
   breadcrumb  CourseListR                 = return ("Kurse"    , Nothing)
@@ -1776,6 +1781,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)
@@ -1970,35 +1977,11 @@ pageActions (HomeR) =
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
-  ,  MenuItem
-      { menuItemType  = PageActionPrime
-      , menuItemLabel = MsgAdminHeading
-      , menuItemIcon  = Just "screwdriver"
-      , 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
-      , menuItemLabel = MsgMenuMessageList
+      , menuItemLabel = MsgMenuAllocationList
       , menuItemIcon  = Nothing
-      , menuItemRoute = SomeRoute MessageListR
+      , menuItemRoute = SomeRoute AllocationListR
-      , menuItemModal = False
-      , menuItemAccessCallback' = return True
-      }
-  , MenuItem
-      { menuItemType  = PageActionPrime
-      , menuItemLabel = MsgMenuAdminErrMsg
-      , menuItemIcon  = Nothing
-      , menuItemRoute = SomeRoute AdminErrMsgR
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
@@ -2022,20 +2005,12 @@ pageActions (AdminR) =
       }
   , MenuItem
       { menuItemType  = PageActionPrime
-      , menuItemLabel = MsgErrMsgHeading
+      , menuItemLabel = MsgMenuAdminErrMsg
       , 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
@@ -2201,6 +2176,14 @@ pageActions (CourseListR) =
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
+  , MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgMenuAllocationList
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute AllocationListR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
   ]
 pageActions (CourseNewR) = [
     MenuItem
@@ -2279,6 +2262,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/Admin.hs

@@ -8,8 +8,6 @@ import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Writer (mapWriterT)
 
-import Utils.Lens
-
 -- import Data.Time
 import Data.Char (isDigit)
 import qualified Data.Text as Text

src/Handler/Allocation.hs

@@ -6,3 +6,4 @@ import Handler.Allocation.Info as Handler.Allocation
 import Handler.Allocation.Show as Handler.Allocation
 import Handler.Allocation.Application as Handler.Allocation
 import Handler.Allocation.Register as Handler.Allocation
+import Handler.Allocation.List as Handler.Allocation

src/Handler/Allocation/Application.hs

@@ -12,8 +12,6 @@ module Handler.Allocation.Application
 import Import hiding (hash)
 
 import Handler.Utils
-import Utils.Lens
-
 import qualified Data.Text as Text
 import qualified Data.Set as Set
 

src/Handler/Allocation/List.hs

@@ -0,0 +1,86 @@
+module Handler.Allocation.List
+  ( getAllocationListR
+  ) where
+
+import Import
+  
+import qualified Database.Esqueleto as E
+import Handler.Utils.Table.Columns
+import Handler.Utils.Table.Pagination
+
+
+type AllocationTableExpr = E.SqlExpr (Entity Allocation)
+type AllocationTableData = DBRow (Entity Allocation)
+
+allocationListIdent :: Text
+allocationListIdent = "allocations"
+
+queryAllocation :: Getter AllocationTableExpr (E.SqlExpr (Entity Allocation))
+queryAllocation = id
+
+resultAllocation :: Lens' AllocationTableData (Entity Allocation)
+resultAllocation = _dbrOutput
+
+allocationTermLink :: TermId -> SomeRoute UniWorX
+allocationTermLink tid = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "term", toPathPiece tid)])
+  
+allocationSchoolLink :: SchoolId -> SomeRoute UniWorX
+allocationSchoolLink ssh = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "school", toPathPiece ssh)])
+
+allocationLink :: Allocation -> SomeRoute UniWorX
+allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR
+
+getAllocationListR :: Handler Html
+getAllocationListR = do
+  let
+    dbtSQLQuery :: AllocationTableExpr -> E.SqlQuery _
+    dbtSQLQuery = return
+
+    dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) AllocationTableData
+    dbtProj = return
+
+    dbtRowKey = view $ queryAllocation . to (E.^. AllocationId)
+
+    dbtColonnade :: Colonnade Sortable _ _
+    dbtColonnade = mconcat
+      [ anchorColonnade (views (resultAllocation . _entityVal . _allocationTerm) allocationTermLink) $ colTermShort (resultAllocation . _entityVal . _allocationTerm)
+      , anchorColonnade (views (resultAllocation . _entityVal . _allocationSchool) allocationSchoolLink) $ colSchoolShort (resultAllocation . _entityVal . _allocationSchool)
+      , anchorColonnade (views (resultAllocation . _entityVal) allocationLink) $ colAllocationName (resultAllocation . _entityVal . _allocationName)
+      ]
+
+    dbtSorting = mconcat
+      [ sortTerm $ queryAllocation . to (E.^. AllocationTerm)
+      , sortSchool $ queryAllocation . to (E.^. AllocationSchool)
+      , sortAllocationName $ queryAllocation . to (E.^. AllocationName)
+      ]
+
+    dbtFilter = mconcat
+      [ fltrTerm $ queryAllocation . to (E.^. AllocationTerm)
+      , fltrSchool $ queryAllocation . to (E.^. AllocationSchool)
+      , fltrAllocation queryAllocation
+      ]
+    dbtFilterUI = mconcat
+      [ fltrTermUI
+      , fltrSchoolUI
+      , fltrAllocationUI
+      ]
+
+    dbtStyle = def
+      { dbsFilterLayout = defaultDBSFilterLayout
+      }
+    dbtParams = def
+
+    dbtCsvEncode = noCsvEncode
+    dbtCsvDecode = Nothing
+
+    dbtIdent = allocationListIdent
+
+    psValidator :: PSValidator _ _
+    psValidator = def
+      & defaultSorting [SortAscBy "term", SortAscBy "school", SortAscBy "allocation"]
+
+  table <- runDB $ dbTableWidget' psValidator DBTable{..}
+
+  siteLayoutMsg MsgAllocationListTitle $ do
+    setTitleI MsgAllocationListTitle
+    table

src/Handler/Allocation/Register.hs

@@ -8,8 +8,6 @@ module Handler.Allocation.Register
 
 import Import
 
-import Utils.Lens
-
 import Handler.Utils.Form
 
 {-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}

src/Handler/Allocation/Show.hs

@@ -4,8 +4,7 @@ module Handler.Allocation.Show
 
 import Import
 import Handler.Utils
-import Utils.Lens
+  
-
 import Handler.Allocation.Register
 import Handler.Allocation.Application
 

src/Handler/Corrections.hs

@@ -12,8 +12,6 @@ import Handler.Utils.SheetType
 import Handler.Utils.Delete
 -- import Handler.Utils.Zip
 
-import Utils.Lens
-
 import Data.List as List (nub, foldl, foldr)
 import Data.Set (Set)
 import qualified Data.Set as Set

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/Course/Edit.hs

@@ -5,7 +5,6 @@ module Handler.Course.Edit
 
 import Import
 
-import Utils.Lens
 import Utils.Form
 import Handler.Utils
 import Handler.Utils.Invitations

src/Handler/Course/LecturerInvite.hs

@@ -8,7 +8,6 @@ module Handler.Course.LecturerInvite
 
 import Import
 
-import Utils.Lens
 import Utils.Form
 import Handler.Utils.Invitations
 

src/Handler/Course/List.hs

@@ -10,7 +10,6 @@ import Import
 
 import Data.Maybe (fromJust)
 
-import Utils.Lens
 import Utils.Form
 -- import Utils.DB
 import Handler.Utils

src/Handler/Course/ParticipantInvite.hs

@@ -8,7 +8,6 @@ module Handler.Course.ParticipantInvite
 
 import Import
 
-import Utils.Lens
 import Utils.Form
 import Handler.Utils
 import Handler.Utils.Invitations

src/Handler/Course/Register.hs

@@ -7,7 +7,6 @@ module Handler.Course.Register
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 
 import Data.Function ((&))

src/Handler/Course/Show.hs

@@ -12,7 +12,6 @@ import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
 
 import qualified Data.CaseInsensitive as CI
-import Utils.Lens
 
 import qualified Data.Map as Map
 

src/Handler/Course/User.hs

@@ -4,7 +4,6 @@ module Handler.Course.User
 
 import Import
 
-import Utils.Lens
 import Utils.Form
 import Handler.Utils
 import Database.Esqueleto.Utils.TH

src/Handler/Course/Users.hs

@@ -9,7 +9,6 @@ module Handler.Course.Users
 
 import Import
 
-import Utils.Lens
 import Utils.Form
 import Handler.Utils
 import Handler.Utils.Database

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/Exam/AddUser.hs

@@ -8,8 +8,6 @@ import Handler.Exam.RegistrationInvite
 import Handler.Utils
 import Handler.Utils.Exam
 import Handler.Utils.Invitations
-
-import Utils.Lens
   
 import qualified Data.Set as Set
 

src/Handler/Exam/CorrectorInvite.hs

@@ -12,8 +12,6 @@ import Import
 import Handler.Utils.Invitations
 import Handler.Utils.Exam
 
-import Utils.Lens
-
 import Text.Hamlet (ihamlet)
 
 import Data.Aeson hiding (Result(..))

src/Handler/Exam/Edit.hs

@@ -6,8 +6,6 @@ import Import
 import Handler.Exam.Form
 import Handler.Exam.CorrectorInvite
 
-import Utils.Lens
-
 import qualified Data.Set as Set
 
 import Handler.Utils

src/Handler/Exam/Form.hs

@@ -8,8 +8,6 @@ module Handler.Exam.Form
   ) where
 
 import Import
-import Utils.Lens hiding (parts)
-
 import Handler.Exam.CorrectorInvite
 
 import Handler.Utils
@@ -230,12 +228,12 @@ examPartsForm prev = wFormToAForm $ do
 
 examFormTemplate :: Entity Exam -> DB ExamForm
 examFormTemplate (Entity eId Exam{..}) = do
-  parts <- selectList [ ExamPartExam ==. eId ] []
+  examParts <- selectList [ ExamPartExam ==. eId ] []
   occurrences <- selectList [ ExamOccurrenceExam ==. eId ] []
   correctors <- selectList [ ExamCorrectorExam ==. eId ] []
   invitations <- map (\(email, InvDBDataExamCorrector) -> email) <$> sourceInvitationsList eId
 
-  parts' <- forM parts $ \(Entity pid part) -> (,) <$> encrypt pid <*> pure part
+  examParts' <- forM examParts $ \(Entity pid part) -> (,) <$> encrypt pid <*> pure part
   occurrences' <- forM occurrences $ \(Entity oid occ) -> (,) <$> encrypt oid <*> pure occ
 
   return ExamForm
@@ -267,7 +265,7 @@ examFormTemplate (Entity eId Exam{..}) = do
           , eofDescription = examOccurrenceDescription
           }
     , efExamParts        = Set.fromList $ do
-        (Just -> epfId, ExamPart{..}) <- parts'
+        (Just -> epfId, ExamPart{..}) <- examParts'
         return ExamPartForm
           { epfId
           , epfName      = examPartName

src/Handler/Exam/RegistrationInvite.hs

@@ -16,8 +16,6 @@ import Handler.Utils.Invitations
 import qualified Data.Set as Set
 
 import Text.Hamlet (ihamlet)
-
-import Utils.Lens
   
 import Data.Aeson hiding (Result(..))
   

src/Handler/Exam/Show.hs

@@ -5,8 +5,6 @@ module Handler.Exam.Show
 import Import
 import Handler.Exam.Register
 
-import Utils.Lens hiding (parts)
-
 import Data.Map ((!?))
 import qualified Data.Map as Map
 
@@ -24,7 +22,7 @@ getEShowR tid ssh csh examn = do
   cTime <- liftIO getCurrentTime
   mUid <- maybeAuthId
 
-  (Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do
+  (Entity _ Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do
     exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
 
     let examVisible = NTop (Just cTime) >= NTop examVisibleFrom
@@ -35,12 +33,12 @@ getEShowR tid ssh csh examn = do
     let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments
     occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
 
-    parts <- selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
+    examParts <- selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
 
     resultsRaw <- for mUid $ \uid ->
       E.select . E.from $ \examPartResult -> do
         E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid
-             E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map entityKey parts)
+             E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map entityKey examParts)
         return examPartResult
     let results = maybe Map.empty (\rs -> Map.fromList [ (examPartResultExamPart, res) | res@(Entity _ ExamPartResult{..}) <- rs ]) resultsRaw
 
@@ -66,7 +64,7 @@ getEShowR tid ssh csh examn = do
 
     occurrenceNamesShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
 
-    return (exam, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown)
+    return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown)
 
   let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
       registerWidget

src/Handler/Exam/Users.hs

@@ -6,7 +6,6 @@ module Handler.Exam.Users
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 import Handler.Utils.Exam
 import Handler.Utils.Table.Columns

src/Handler/Health.hs

@@ -5,8 +5,6 @@ import Import
 import qualified Data.Aeson.Encode.Pretty as Aeson
 import qualified Data.Text.Lazy.Builder as Builder
 
-import Utils.Lens
-
 import qualified Data.UUID as UUID
 
 import Data.Semigroup (Min(..), Max(..))

src/Handler/Home.hs

@@ -2,7 +2,6 @@ module Handler.Home where
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 import Handler.Utils.Table.Cells
 

src/Handler/Material.hs

@@ -14,7 +14,6 @@ import qualified Data.Conduit.List as C
 import qualified Database.Esqueleto as E
 import Database.Esqueleto.Utils.TH
 
-import Utils.Lens
 import Utils.Form
 import Handler.Utils
 import Handler.Utils.Delete

src/Handler/Profile.hs

@@ -5,7 +5,6 @@ import Import
 import Handler.Utils
 import Handler.Utils.Table.Cells
 
-import Utils.Lens
 -- import Colonnade hiding (fromMaybe, singleton)
 -- import Yesod.Colonnade
 import Data.Monoid (Any(..))

src/Handler/Sheet.hs

@@ -49,11 +49,6 @@ import Data.Map (Map, (!))
 
 import Data.Monoid (Any(..))
 
--- import Control.Lens
-import Utils.Lens
-
---import qualified Data.Aeson as Aeson
-
 import Control.Monad.Random.Class (MonadRandom(..))
 import Utils.Sql
 

src/Handler/Submission.hs

@@ -6,8 +6,6 @@ import Import
 
 import Jobs
 
-import Utils.Lens
-
 -- import Yesod.Form.Bootstrap3
 
 import Handler.Utils

src/Handler/SystemMessage.hs

@@ -11,8 +11,6 @@ import qualified Data.List.NonEmpty as NonEmpty
 import Handler.Utils
 import Handler.Utils.Table.Cells
 
-import Utils.Lens
-
 import qualified Database.Esqueleto as E
 
 -- htmlField' moved to Handler.Utils.Form/Fields

src/Handler/Term.hs

@@ -5,8 +5,6 @@ import Handler.Utils
 import Handler.Utils.Table.Cells
 import qualified Data.Map as Map
 
-import Utils.Lens
-
 import qualified Database.Esqueleto as E
 
 import qualified Data.Set as Set

src/Handler/Tutorial.hs

@@ -25,8 +25,6 @@ import qualified Data.CaseInsensitive as CI
 
 import qualified Data.Text as Text
 
-import Utils.Lens
-
 import Data.Aeson hiding (Result(..))
 import Text.Hamlet (ihamlet)
 

src/Handler/Tutorial/Users.hs

@@ -4,7 +4,6 @@ module Handler.Tutorial.Users
 
 import Import
 
-import Utils.Lens
 import Utils.Form
 -- import Utils.DB
 import Handler.Utils

src/Handler/Users.hs

@@ -13,8 +13,6 @@ import Handler.Utils.Invitations
 
 import qualified Auth.LDAP as Auth
 
-import Utils.Lens
-
 import qualified Data.CaseInsensitive as CI
 
 import qualified Data.Set as Set

src/Handler/Utils.hs

@@ -4,8 +4,6 @@ module Handler.Utils
 
 import Import
 
-import Utils.Lens
-
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import Data.Map ((!))

src/Handler/Utils/Communication.hs

@@ -9,7 +9,6 @@ module Handler.Utils.Communication
 
 import Import
 import Handler.Utils
-import Utils.Lens
 
 import Jobs.Queue
 import Control.Monad.Trans.Reader (mapReaderT)

src/Handler/Utils/ContentDisposition.hs

@@ -5,8 +5,6 @@ module Handler.Utils.ContentDisposition
 
 import Import
 
-import Utils.Lens
-
 -- | Check whether the user's preference for files is inline-viewing or downloading
 downloadFiles :: (MonadHandler m, HandlerSite m ~ UniWorX) => m Bool
 downloadFiles = do

src/Handler/Utils/DateTime.hs

@@ -16,8 +16,6 @@ module Handler.Utils.DateTime
 
 import Import
 
-import Utils.Lens
-
 import Data.Time.Zones
 import qualified Data.Time.Zones as TZ
 

src/Handler/Utils/Delete.hs

@@ -17,8 +17,6 @@ module Handler.Utils.Delete
 import Import
 import Handler.Utils.Form
 
-import Utils.Lens
-
 import qualified Data.Text as Text
 import qualified Data.Set as Set
 

src/Handler/Utils/Exam.hs

@@ -12,8 +12,6 @@ import qualified Database.Esqueleto.Utils as E
 import qualified Database.Esqueleto.Internal.Sql as E
 import Database.Esqueleto.Utils.TH
 
-import Utils.Lens
-
 import qualified Data.Conduit.List as C
 
 import qualified Data.Map as Map

src/Handler/Utils/Form.hs

@@ -40,13 +40,9 @@ import Control.Monad.Error.Class (MonadError(..))
 
 import Data.Either (partitionEithers)
 
-import Utils.Lens
-
 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/Form/MassInput.hs

@@ -17,7 +17,6 @@ module Handler.Utils.Form.MassInput
 
 import Import
 import Utils.Form
-import Utils.Lens
 import Handler.Utils.Form.MassInput.Liveliness
 import Handler.Utils.Form.MassInput.TH
 

src/Handler/Utils/Form/Occurrences.hs

@@ -10,8 +10,6 @@ import qualified Data.Set as Set
 import Data.Map ((!))
 import qualified Data.Map as Map
 
-import Utils.Lens
-
 
 data OccurrenceScheduleKind = ScheduleKindWeekly
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)

src/Handler/Utils/Invitations.hs

@@ -16,7 +16,6 @@ module Handler.Utils.Invitations
   ) where
 
 import Import
-import Utils.Lens
 import Utils.Form
 import Jobs.Queue
 

src/Handler/Utils/Mail.hs

@@ -7,8 +7,6 @@ module Handler.Utils.Mail
 
 import Import
 
-import Utils.Lens
-
 import qualified Data.CaseInsensitive as CI
 
 import qualified Data.ByteString.Lazy as LBS

src/Handler/Utils/Rating.hs

@@ -39,8 +39,6 @@ import qualified Database.Esqueleto as E
 
 import qualified Data.Conduit.List as Conduit
 
-import Utils.Lens
-
 
 instance HasResolution prec => Pretty (Fixed prec) where
   pretty = pretty . show

src/Handler/Utils/SheetType.hs

@@ -5,7 +5,6 @@ module Handler.Utils.SheetType
 
 import Import
 import Data.Monoid (Sum(..))
-import Utils.Lens
 
 addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary
 addBonusToPoints sts =

src/Handler/Utils/Submission.hs

@@ -15,8 +15,6 @@ import Import hiding (joinPath)
 import Jobs.Queue
 import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
 
-import Utils.Lens
-
 import Control.Monad.State as State (StateT)
 import Control.Monad.State.Class as State
 import Control.Monad.Writer (MonadWriter(..), execWriterT, execWriter)

src/Handler/Utils/Table.hs

@@ -2,7 +2,6 @@ module Handler.Utils.Table where
 -- General Utilities for Tables
 
 import Import
-import Data.Profunctor
 
 import Control.Monad.Except
 
@@ -51,10 +50,12 @@ headedRowSelector toExternal fromExternal attrs colonnade tdata = do
   externalIds <- mapM (lift . toExternal) tdata
 
   let
-    checkbox extId = Field parse view UrlEncoded
+    checkbox extId = Field{..}
       where
-        parse [] _ = return $ Right Nothing
+        fieldEnctype = UrlEncoded
-        parse optlist _ = runExceptT $ do
+        
+        fieldParse [] _ = return $ Right Nothing
+        fieldParse optlist _ = runExceptT $ do
           extIds <- maybe (throwError "Error parsing values") return $ mapM fromPathPiece optlist
           case () of
             _ | extId `elem` extIds
@@ -62,11 +63,11 @@ headedRowSelector toExternal fromExternal attrs colonnade tdata = do
               | otherwise
                 -> return Nothing
 
-        view _ name attributes val _ =
+        fieldView theId name attributes val _ =
           -- TODO: move this to a *.hamlet file
           [whamlet|
             <label style="display: block">
-              <input type=checkbox name=#{name} value=#{toPathPiece extId} *{attributes} :isRight val:checked>
+              <input ##{theId} type=checkbox name=#{name} value=#{toPathPiece extId} *{attributes} :isRight val:checked>
           |]
 
   selectionIdent <- newFormIdent

src/Handler/Utils/Table/Cells.hs

@@ -13,7 +13,6 @@ import Control.Monad.Trans.Writer (WriterT)
 
 import Text.Blaze (ToMarkup(..))
 
-import Utils.Lens
 import Handler.Utils
 
 import Utils.Occurrences
@@ -101,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,14 +12,19 @@ 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 Utils.Lens
 import Handler.Utils
 import Handler.Utils.Table.Cells
 
 import qualified Data.CaseInsensitive as CI
 
+import qualified Colonnade
+import Colonnade.Encode (Colonnade(..), OneColonnade(..))
+
+import Text.Blaze (toMarkup)
+
 
 --------------------------------
 -- Generic Columns
@@ -35,6 +40,36 @@ import qualified Data.CaseInsensitive as CI
 --  * fltrXYZ  : filter  definitions for these columns
 --  * additional helper, such as default sorting
 
+type OpticColonnade focus
+  = forall m x r' h.
+       ( IsDBTable m x
+       , FromSortable h
+       )
+    => (forall focus'. Getting focus' r' focus)
+    -> Colonnade h r' (DBCell m x)
+
+type OpticSortColumn' focus
+  = forall t sortingMap.
+       ( IsMap sortingMap
+       , ContainerKey sortingMap ~ SortingKey
+       , MapValue sortingMap ~ SortColumn t
+       )
+    => (forall focus'. Getting focus' t focus)
+    -> sortingMap
+
+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))
+       )
+    => (forall focus'. Getting focus' t focus)
+    -> filterMap
+
+type OpticFilterColumn t focus = OpticFilterColumn' t (Set focus) (E.SqlExpr (E.Value focus))
 
 -----------------------
 -- Numbers and Indices
@@ -44,6 +79,174 @@ import qualified Data.CaseInsensitive as CI
 dbRowIndicator :: IsDBTable m Any => Colonnade Sortable (DBRow r) (DBCell m Any)
 dbRowIndicator = sortable Nothing (i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } ->  tellCell (Any True) $ textCell $ tshow dbrIndex
 
+-----------
+-- Terms --
+-----------
+
+colTermShort :: OpticColonnade TermId
+colTermShort resultTid = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "term") (i18nCell MsgTerm)
+    body = i18nCell . ShortTermIdentifier . unTermKey . view resultTid
+
+sortTerm :: OpticSortColumn TermId
+sortTerm queryTid = singletonMap "term" . SortColumn $ view queryTid
+
+fltrTerm :: OpticFilterColumn t TermId
+fltrTerm queryTid = singletonMap "term" . FilterColumn $ mkExactFilter (view queryTid)
+
+fltrTermUI :: DBFilterUI
+fltrTermUI mPrev = prismAForm (singletonFilter "term" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift termField) (fslI MsgTerm)
+
+-------------
+-- Schools --
+-------------
+
+colSchoolShort :: OpticColonnade SchoolId
+colSchoolShort resultSsh = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "school") (i18nCell MsgSchool)
+    body = i18nCell . unSchoolKey . view resultSsh
+
+sortSchool :: OpticSortColumn SchoolId
+sortSchool querySsh = singletonMap "school" . SortColumn $ view querySsh
+
+fltrSchool :: OpticFilterColumn t SchoolId
+fltrSchool querySsh = singletonMap "school" . FilterColumn $ mkExactFilter (view querySsh)
+
+fltrSchoolUI :: DBFilterUI
+fltrSchoolUI mPrev = prismAForm (singletonFilter "school" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift schoolField) (fslI MsgSchool)
+
+-----------------
+-- Allocations --
+-----------------
+
+colAllocationName :: OpticColonnade AllocationName
+colAllocationName resultName = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "allocation") (i18nCell MsgAllocationName)
+    body = i18nCell . view resultName
+
+sortAllocationName :: OpticSortColumn AllocationName
+sortAllocationName queryName = singletonMap "allocation" . SortColumn $ view queryName
+
+fltrAllocation :: forall allocation t shorthand name.
+                  ( E.SqlProject Allocation AllocationShorthand allocation shorthand
+                  , 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)
+
+fltrAllocationUI :: DBFilterUI
+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
@@ -92,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
@@ -103,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)
@@ -175,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
 
@@ -218,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
 
@@ -282,3 +622,64 @@ fltrDegree queryFeatures = ( "degree"
 fltrDegreeUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
 fltrDegreeUI mPrev =
   prismAForm (singletonFilter "degree") mPrev $ aopt textField (fslI MsgDegreeName)
+
+----------------------------
+-- Colonnade manipulation --
+----------------------------
+
+imapColonnade :: (a -> c -> c)
+              -> Colonnade h a c
+              -> Colonnade h a c
+-- ^ Not quite `imap`
+imapColonnade f (Colonnade ones) = Colonnade $ dimapColonnade' <$> ones
+   where
+     dimapColonnade' OneColonnade{..} = OneColonnade
+       { oneColonnadeEncode = \x -> f x $ oneColonnadeEncode x
+       , oneColonnadeHead
+       }
+
+anchorColonnade :: forall h r' m a url.
+                   ( HasRoute UniWorX url
+                   , IsDBTable m a
+                   , HandlerSite m ~ UniWorX
+                   )
+                => (r' -> url)
+                -> Colonnade h r' (DBCell m a)
+                -> Colonnade h r' (DBCell m a)
+anchorColonnade = anchorColonnadeM . (return .)
+
+  
+anchorColonnadeM :: forall h r' m a url.
+                    ( HasRoute UniWorX url
+                    , IsDBTable m a
+                    , HandlerSite m ~ UniWorX
+                    )
+                 => (r' -> WidgetT UniWorX IO url)
+                 -> Colonnade h r' (DBCell m a)
+                 -> Colonnade h r' (DBCell m a)
+anchorColonnadeM mkUrl = imapColonnade anchorColonnade'
+  where
+    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,5 +1,7 @@
 module Handler.Utils.Table.Pagination
   ( module Handler.Utils.Table.Pagination.Types
+  , dbFilterKey
+  , SomeExprValue(..)
   , SortColumn(..), SortDirection(..)
   , SortingSetting(..)
   , pattern SortAscBy, pattern SortDescBy
@@ -10,7 +12,7 @@ module Handler.Utils.Table.Pagination
   , DBCsvActionMode(..)
   , DBCsvDiff(..), _DBCsvDiffNew, _DBCsvDiffExisting, _DBCsvDiffMissing, _dbCsvOldKey, _dbCsvOld, _dbCsvNewKey, _dbCsvNew
   , DBTCsvEncode, DBTCsvDecode(..)
-  , DBTable(..), noCsvEncode, IsDBTable(..), DBCell(..)
+  , DBTable(..), DBFilterUI, noCsvEncode, IsDBTable(..), DBCell(..)
   , singletonFilter
   , DBParams(..)
   , cellAttrs, cellContents
@@ -81,8 +83,6 @@ import Text.Hamlet (hamletFile)
 
 import Data.Ratio ((%))
 
-import Control.Lens.Extras (is)
-
 import Data.List (elemIndex)
 
 import Data.Aeson (Options(..), SumEncoding(..), defaultOptions)
@@ -116,7 +116,26 @@ type Monoid' x = (Sem.Semigroup x, Monoid x)
 #endif
 
 
+data WithIdent x = forall ident. PathPiece ident => WithIdent { _ident :: ident, _withoutIdent :: x }
+
+instance PathPiece x => PathPiece (WithIdent x) where
+  toPathPiece (WithIdent ident x)
+    | not . null $ toPathPiece ident = toPathPiece ident <> "-" <> toPathPiece x
+    | otherwise = toPathPiece x
+  fromPathPiece txt = do
+    let sep = "-"
+    (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt
+    WithIdent <$> pure ident <*> fromPathPiece rest
+
+
+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)
@@ -133,9 +152,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
@@ -486,17 +507,6 @@ singletonFilter key = prism' fromInner (fmap Just . fromOuter)
       fromOuter = Map.lookup key >=> listToMaybe
 
 
-data WithIdent x = forall ident. PathPiece ident => WithIdent { _ident :: ident, _withoutIdent :: x }
-
-instance PathPiece x => PathPiece (WithIdent x) where
-  toPathPiece (WithIdent ident x)
-    | not . null $ toPathPiece ident = toPathPiece ident <> "-" <> toPathPiece x
-    | otherwise = toPathPiece x
-  fromPathPiece txt = do
-    let sep = "-"
-    (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt
-    WithIdent <$> pure ident <*> fromPathPiece rest
-
 type DBTCsvEncode r' csv = DictMaybe (ToNamedRecord csv, DefaultOrdered csv, CsvColumnsExplained csv) (Conduit r' (YesodDB UniWorX) csv)
 data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass csvException.
   ( FromNamedRecord csv, ToNamedRecord csv, DefaultOrdered csv
@@ -529,7 +539,7 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtColonnade :: Colonnade h r' (DBCell m x)
   , dbtSorting :: Map SortingKey (SortColumn t)
   , dbtFilter :: Map FilterKey (FilterColumn t)
-  , dbtFilterUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+  , dbtFilterUI :: DBFilterUI
   , dbtStyle :: DBStyle r'
   , dbtParams :: DBParams m x
   , dbtCsvEncode :: DBTCsvEncode r' csv
@@ -537,6 +547,8 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtIdent :: i
   }
 
+type DBFilterUI = Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+
 noCsvEncode :: DictMaybe (ToNamedRecord Void, DefaultOrdered Void, CsvColumnsExplained Void) (Conduit r' (YesodDB UniWorX) Void)
 noCsvEncode = Nothing
 
@@ -771,7 +783,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
   piInput <- lift . runInputGetResult $ PaginationInput
     <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting")
-    <*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ toPathPiece k) dbtFilter)
+    <*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField $ dbFilterKey dbtIdent' k) dbtFilter)
     <*> iopt pathPieceField (wIdent "pagesize")
     <*> iopt intField (wIdent "page")
 
@@ -818,7 +830,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     tblLink f = SomeRoute . (currentRoute, ) . over (mapped . _2) (fromMaybe Text.empty) $ (f . substPi . setParam "_hasdata" Nothing) getParams
     substPi = foldr (.) id
       [ setParams (wIdent "sorting") . map toPathPiece $ fromMaybe [] piSorting
-      , foldr (.) id . map (\k -> setParams (wIdent $ toPathPiece k) . fromMaybe [] . join $ traverse (Map.lookup k) piFilter) $ Map.keys dbtFilter
+      , foldr (.) id . map (\k -> setParams (dbFilterKey dbtIdent' k) . fromMaybe [] . join $ traverse (Map.lookup k) piFilter) $ Map.keys dbtFilter
       , setParam (wIdent "pagesize") $ fmap toPathPiece piLimit
       , setParam (wIdent "page") $ fmap toPathPiece piPage
       , setParam (wIdent "pagination") Nothing
@@ -863,7 +875,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/Handler/Utils/Table/Pagination/Types.hs

@@ -4,7 +4,7 @@ module Handler.Utils.Table.Pagination.Types
   ( FilterKey, SortingKey
   , Sortable(..)
   , sortable
-  , ToSortable(..)
+  , ToSortable(..), FromSortable(..)
   , SortableP(..)
   , DBTableInvalid(..)
   ) where
@@ -58,6 +58,19 @@ instance ToSortable Headless where
   pSortable = Nothing
 
 
+class FromSortable s where
+  fromSortable :: forall a. Sortable a -> s a
+
+instance FromSortable Sortable where
+  fromSortable = id
+
+instance FromSortable Headed where
+  fromSortable Sortable{..} = Headed sortableContent
+
+instance FromSortable Headless where
+  fromSortable _ = Headless
+
+
 data DBTableInvalid = DBTIRowsMissing Int
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 

src/Handler/Utils/Tokens.hs

@@ -5,8 +5,6 @@ module Handler.Utils.Tokens
 
 import Import
 
-import Utils.Lens
-
 import Control.Monad.Trans.Maybe (runMaybeT)
 
 

src/Handler/Utils/Tutorial.hs

@@ -10,8 +10,6 @@ import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Internal.Sql as E
 import Database.Esqueleto.Utils.TH
 
-import Utils.Lens
-
 
 fetchTutorialAux :: ( SqlBackendCanRead backend
                     , E.SqlSelect b a

src/Import/NoFoundation.hs

@@ -10,6 +10,7 @@ import Model.Submission       as Import
 import Model.Tokens           as Import
 import Utils.Tokens           as Import
 import Utils.Frontend.Modal   as Import
+import Utils.Lens             as Import
 
 import Settings               as Import
 import Settings.StaticFiles   as Import

src/Import/NoModel.hs

@@ -3,7 +3,18 @@ module Import.NoModel
   , MForm
   ) where
 
-import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, getMessages, addMessage, addMessageI, (.=), MForm, Proxy, foldlM, static, boolField, identifyForm, cons, HasHttpManager(..))
+import ClassyPrelude.Yesod    as Import
+  hiding ( formatTime
+         , derivePersistFieldJSON
+         , getMessages, addMessage, addMessageI
+         , (.=)
+         , MForm
+         , Proxy
+         , foldlM
+         , static
+         , boolField, identifyForm
+         , HasHttpManager(..)
+         )
 
 import Model.Types.TH.JSON as Import
 import Model.Types.TH.Wordlist as Import
@@ -80,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 ()
@@ -114,6 +127,16 @@ import System.FilePath.Instances as Import ()
 import Net.IP.Instances as Import ()
 import Data.Void.Instances as Import ()
 import Crypto.Hash.Instances as Import ()
+import Colonnade.Instances as Import ()
+
+import Control.Lens as Import
+  hiding ( (<.>)
+         , universe
+         , cons, uncons, snoc, unsnoc, (<|)
+         , Index, index, (<.)
+         )
+import Control.Lens.Extras as Import (is)
+import Data.Set.Lens as Import
 
 
 import Control.Monad.Trans.RWS (RWST)

src/Jobs.hs

@@ -6,8 +6,6 @@ module Jobs
   ) where
 
 import Import
-import Utils.Lens
-
 import Jobs.Types as Types hiding (JobCtl(JobCtlQueue))
 import Jobs.Types (JobCtl(JobCtlQueue))
 import Jobs.Queue

src/Jobs/Crontab.hs

@@ -4,8 +4,6 @@ module Jobs.Crontab
 
 import Import 
 
-import Utils.Lens
-
 import qualified Data.HashMap.Strict as HashMap
 import Jobs.Types
 

src/Jobs/Handler/HelpRequest.hs

@@ -9,8 +9,6 @@ import qualified Data.CaseInsensitive as CI
 
 import Handler.Utils
 
-import Utils.Lens
-
 import Data.Bitraversable
   
 

src/Jobs/Handler/Invitation.hs

@@ -3,7 +3,6 @@ module Jobs.Handler.Invitation
   ) where
 
 import Import
-import Utils.Lens
 import Handler.Utils.Mail
 
 import qualified Data.CaseInsensitive as CI

src/Jobs/Handler/SendCourseCommunication.hs

@@ -4,7 +4,6 @@ module Jobs.Handler.SendCourseCommunication
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 
 import qualified Data.Set as Set

src/Jobs/Handler/SendNotification/SubmissionRated.hs

@@ -6,7 +6,6 @@ module Jobs.Handler.SendNotification.SubmissionRated
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 import Jobs.Handler.SendNotification.Utils
 

src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs

@@ -5,7 +5,6 @@ module Jobs.Handler.SendNotification.UserAuthModeUpdate
   ) where
 
 import Import
-import Utils.Lens
 
 import Handler.Utils.Mail
 import Jobs.Handler.SendNotification.Utils

src/Jobs/Handler/SendPasswordReset.hs

@@ -4,7 +4,6 @@ module Jobs.Handler.SendPasswordReset
 
 import Import
 
-import Utils.Lens
 import Handler.Utils
 import Handler.Utils.Users
 

src/Jobs/Handler/SendTestEmail.hs

@@ -8,8 +8,6 @@ import Handler.Utils.DateTime
 
 import Text.Shakespeare.Text
 
-import Utils.Lens
-
 dispatchJobSendTestEmail :: Email -> MailContext -> Handler ()
 dispatchJobSendTestEmail jEmail jMailContext = mailT jMailContext $ do
   _mailTo .= [Address Nothing jEmail]

src/Jobs/Handler/TransactionLog.hs

@@ -4,7 +4,6 @@ module Jobs.Handler.TransactionLog
   ) where
 
 import Import hiding (currentYear)
-import Utils.Lens hiding ((<.))
 import Handler.Utils.DateTime
 
 import Database.Persist.Sql (updateWhereCount, deleteWhereCount)

src/Jobs/HealthReport.hs

@@ -14,8 +14,6 @@ import Data.Proxy (Proxy(..))
 
 import qualified Data.ByteArray as ByteArray
 
-import Utils.Lens
-
 import Network.HTTP.Simple (httpJSON, httpLBS)
 import qualified Network.HTTP.Simple as HTTP
 

src/Jobs/Queue.hs

@@ -11,7 +11,6 @@ module Jobs.Queue
 import Import hiding ((<>))
 
 import Utils.Sql
-import Utils.Lens
 import Jobs.Types
 
 import Control.Monad.Trans.Writer (WriterT, runWriterT)

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/Model/Types/DateTime.hs

@@ -9,7 +9,6 @@ module Model.Types.DateTime
   ) where
 
 import Import.NoModel
-import Control.Lens
 
 import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI

src/Model/Types/Exam.hs

@@ -14,7 +14,6 @@ import Model.Types.Common
 
 import qualified Data.Text as Text
 
-import Control.Lens hiding (universe)
 import Utils.Lens.TH
 
 import qualified Data.Csv as Csv

src/Model/Types/Misc.hs

@@ -8,7 +8,6 @@ module Model.Types.Misc
   ) where
 
 import Import.NoModel
-import Control.Lens
 
 import Data.Maybe (fromJust)
 

src/Model/Types/Sheet.hs

@@ -11,8 +11,6 @@ import Import.NoModel
 import Model.Types.Common
 import Utils.Lens.TH
 
-import Control.Lens
-import Control.Lens.Extras (is)
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
 import Data.Set (Set)

src/Model/Types/Submission.hs

@@ -20,8 +20,6 @@ import Data.Word.Word24
 
 import qualified Data.CaseInsensitive as CI
 
-import Control.Lens
-
 import qualified Data.Text as Text
 import qualified Data.Set as Set
 

src/Settings.hs

@@ -44,8 +44,6 @@ import qualified Data.Text.Encoding as Text
 
 import qualified Ldap.Client as Ldap
 
-import Control.Lens
-
 import qualified Network.HaskellNet.Auth as HaskellNet (UserName, Password, AuthType(..))
 import qualified Network.Socket as HaskellNet (PortNumber(..), HostName)
 import qualified Network

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

@@ -3,13 +3,18 @@
 
 module Utils.Lens ( module Utils.Lens ) where
 
-import ClassyPrelude.Yesod hiding (HasHttpManager(..))
+import Import.NoModel
-import qualified ClassyPrelude.Yesod as Yesod (HasHttpManager(..))
 import Model
+import qualified ClassyPrelude.Yesod as Yesod (HasHttpManager(..))
   
-import Control.Lens as Utils.Lens hiding ((<.>), universe, snoc)
+import Control.Lens as Utils.Lens
+  hiding ( (<.>)
+         , universe
+         , cons, uncons, snoc, unsnoc, (<|)
+         , 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(..))
@@ -42,6 +47,8 @@ _SchoolId = iso unSchoolKey SchoolKey
 -----------------------------------
 -- Lens Definitions for our Types
 
+makeClassyFor_ ''Term
+
 
 -- makeLenses_ ''Course
 makeClassyFor_ ''Course

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)

templates/exam-show.hamlet

@@ -126,7 +126,7 @@ $if not (null occurrences)
               $maybe desc <- examOccurrenceDescription
                 #{desc}
 
-$if gradingShown && not (null parts)
+$if gradingShown && not (null examParts)
   <section>
     <h2>
       _{MsgExamParts}
@@ -139,7 +139,7 @@ $if gradingShown && not (null parts)
           <th .table__th>_{MsgExamPartMaxPoints}
           <th .table__th>_{MsgExamPartResultPoints}
       <tbody>
-        $forall Entity partId ExamPart{examPartName, examPartWeight, examPartMaxPoints} <- parts
+        $forall Entity partId ExamPart{examPartName, examPartWeight, examPartMaxPoints} <- examParts
           <tr .table__row>
             <td .table__td>#{examPartName}
             <td .table__td>

templates/table/layout.hamlet

@@ -3,14 +3,16 @@ $if null rows && (dbsEmptyStyle == DBESNoHeading)
   _{dbsEmptyMessage}
 $else
   <div .table-header>
-    <div .table__row-count>
+    $if rowCount > 5
-      _{MsgRowCount rowCount}
+      <div .table__row-count>
+        _{MsgRowCount rowCount}
 
   ^{table}
 
   <div .table-footer>
-    <div .table__row-count>
+    $if rowCount > 5
-      _{MsgRowCount rowCount}
+      <div .table__row-count>
+        _{MsgRowCount rowCount}
     $# Since the current pagesize is always a member of pagesizeOptions we don't need to check `pageCount > 1`
     $if toEnum (fromIntegral rowCount) > minimum (pagesizeOptions referencePagesize)
       ^{pagesizeWdgt'}