feat(course-list): filter by allocation

Fixes #715
2021-06-17 17:08:21 +02:00 · 2021-06-17 17:08:21 +02:00 · de39686d89
commit de39686d89
parent 1e6f6e4296
13 changed files with 293 additions and 161 deletions
--- a/messages/uniworx/categories/courses/courses/de-de-formal.msg
+++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg
@ -6,6 +6,9 @@ FilterRegistered: Angemeldet
 FilterCourseSearch: Volltext-Suche
 FilterCourseRegistered: Registriert
 FilterCourseRegisterOpen: Anmeldung möglich
+FilterCourseAllocation: Zentralanmeldung
+FilterCourseAllocationNone: Keine Zentralanmeldung
+FilterCourseAllocationOption tid@TermId ssh@SchoolId aname@AllocationName !ident-ok: #{toPathPiece tid} #{ssh} #{aname}
 CourseRegistered: Angemeldet
 CourseRegistration: Anmeldung
 CourseDescription: Beschreibung
--- a/messages/uniworx/categories/courses/courses/en-eu.msg
+++ b/messages/uniworx/categories/courses/courses/en-eu.msg
@ -6,6 +6,9 @@ FilterRegistered: Enrolled
 FilterCourseSearch: Text search
 FilterCourseRegistered: Registered
 FilterCourseRegisterOpen: Enrolment is allowed
+FilterCourseAllocation: Central allocation
+FilterCourseAllocationNone: No allocation
+FilterCourseAllocationOption tid ssh aname: #{toPathPiece tid} #{ssh} #{aname}
 CourseRegistered: Enrolled
 CourseRegistration: Enrolment
 CourseDescription: Description
@ -274,4 +277,4 @@ MailSubjectLecturerInvitation tid ssh csh: [#{tid}-#{ssh}-#{csh}] Invitation to
 LecturerInvitationAccepted lType csh: You were registered as #{lType} for #{csh}
 CourseExamRegistrationTime: Registered since
 CourseParticipantStateIsActiveFilter: View
-CourseApply: Apply for course
+CourseApply: Apply for course
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@ -11,6 +11,7 @@ module Database.Esqueleto.Utils
  , any, all
  , subSelectAnd, subSelectOr
  , mkExactFilter, mkExactFilterWith
+  , mkExactFilterLast, mkExactFilterLastWith
  , mkContainsFilter, mkContainsFilterWith
  , mkExistsFilter
  , anyFilter, allFilter
@ -58,6 +59,8 @@ import Data.Time.Clock (NominalDiffTime)

 import qualified Data.Text.Lazy.Builder as Text.Builder

+import Data.Monoid (Last(..))
+
 {-# ANN any ("HLint: ignore Use any" :: String) #-}
 {-# ANN all ("HLint: ignore Use all" :: String) #-}

@ -217,6 +220,26 @@ mkExactFilterWith cast lenslike row criterias
  | Set.null criterias = true
  | otherwise = lenslike row `E.in_` E.valList (cast <$> Set.toList criterias)

+-- | generic filter creation for dbTable
+--   Given a lens-like function, make filter for exact matches against last element of a collection
+mkExactFilterLast :: (PersistField a)
+                  => (t -> E.SqlExpr (E.Value a))  -- ^ getter from query to searched element
+                  -> t                             -- ^ query row
+                  -> Last a                     -- ^ needle collection
+                  -> E.SqlExpr (E.Value Bool)
+mkExactFilterLast = mkExactFilterLastWith id
+
+-- | like `mkExactFilerLast` but allows for conversion; convenient in conjunction with `anyFilter` and `allFilter`
+mkExactFilterLastWith :: (PersistField b)
+                      => (a -> b)                      -- ^ type conversion
+                      -> (t -> E.SqlExpr (E.Value b))  -- ^ getter from query to searched element
+                      -> t                             -- ^ query row
+                      -> Last a                     -- ^ needle collection
+                      -> E.SqlExpr (E.Value Bool)
+mkExactFilterLastWith cast lenslike row criterias
+  | Last (Just crit) <- criterias = lenslike row E.==. E.val (cast crit)
+  | otherwise = true
+
 -- | generic filter creation for dbTable
 --   Given a lens-like function, make filter searching for needles in String-like elements
 --   (Keep Set here to ensure that there are no duplicates)
--- a/src/Foundation/Authorization.hs
+++ b/src/Foundation/Authorization.hs
@ -1144,7 +1144,7 @@ tagAccessPredicate AuthCourseTime = APDB $ \_ _ _mAuthId route _ -> case route o
      E.where_ $ course E.^. CourseTerm      E.==. E.val tid
           E.&&. course E.^. CourseSchool    E.==. E.val ssh
           E.&&. course E.^. CourseShorthand E.==. E.val csh
-           E.&&. courseIsVisible now course Nothing
+           E.&&. courseIsVisible now course E.nothing
    guardMExceptT courseVisible (unauthorizedI MsgUnauthorizedCourseTime)
    return Authorized
  r -> $unsupportedAuthPredicate AuthCourseTime r
--- a/src/Foundation/SiteLayout.hs
+++ b/src/Foundation/SiteLayout.hs
@ -154,9 +154,12 @@ siteLayout' overrideHeading widget = do
  (favourites', (title, parents), nav', contentHeadline, mmsgs, maxFavouriteTerms, currentTheme, storedReasonAndToggleRoute) <- do

    (favCourses, breadcrumbs'', nav', contentHeadline, mmsgs, storedReasonAndToggleRoute) <- runDB $ do
-      favCourses'' <- withReaderT (projectBackend @SqlReadBackend) . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do
+      favCourses'' <- withReaderT (projectBackend @SqlReadBackend) . E.select . E.from $ \(course `E.LeftOuterJoin` allocation `E.LeftOuterJoin` courseFavourite) -> do
        E.on $ E.just (course E.^. CourseId) E.==. courseFavourite E.?. CourseFavouriteCourse
         E.&&. courseFavourite E.?. CourseFavouriteUser E.==. E.val (view _1 <$> muid)
+        E.on . E.exists . E.from $ \allocationCourse ->
+          E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+               E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId

        let isFavourite = E.not_ . E.isNothing $ courseFavourite E.?. CourseFavouriteId
            isCurrent
@ -185,7 +188,7 @@ siteLayout' overrideHeading widget = do
               E.&&. tutorial E.^. TutorialCourse E.==. course E.^. CourseId
              E.where_ $ E.just (tutor E.^. TutorUser) E.==. E.val (view _1 <$> muid)
            isAssociated = isParticipant E.||. isLecturer E.||. isCorrector E.||. isTutor
-            courseVisible = courseIsVisible now course Nothing
+            courseVisible = courseIsVisible now course $ allocation E.?. AllocationId

            reason = E.case_
              [ E.when_ isCurrent    E.then_ . E.just $ E.val FavouriteCurrent
--- a/src/Handler/Allocation/List.hs
+++ b/src/Handler/Allocation/List.hs
@ -33,7 +33,7 @@ countCourses muid ata now addWhere allocation = E.subSelectCount . E.from $ \all
  E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId
       E.&&. E.exists (E.from $ \course -> E.where_ $ 
           course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse 
-           E.&&. mayViewCourse muid ata now course (Just (allocation E.^. AllocationId))
+           E.&&. mayViewCourse muid ata now course (E.just $ allocation E.^. AllocationId)
       ) E.&&. addWhere allocationCourse
  
 queryAvailable :: Maybe UserId -> AuthTagActive -> UTCTime
--- a/src/Handler/Allocation/Show.hs
+++ b/src/Handler/Allocation/Show.hs
@ -82,7 +82,7 @@ postAShowR tid ssh ash = do
      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
      E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
        E.&&. ( E.isJust (courseApplication E.?. CourseApplicationId)
-          E.||. mayViewCourse muid ata now course (Just $ E.val aId)
+          E.||. mayViewCourse muid ata now course (E.justVal aId)
        )
      E.orderBy [E.asc $ course E.^. CourseName]
      let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
@ -105,7 +105,7 @@ postAShowR tid ssh ash = do
             , courseApplication
             , hasTemplate
             , E.not_ . E.isNothing $ registration E.?. CourseParticipantId
-             , courseIsVisible now course . Just $ E.val aId
+             , courseIsVisible now course $ E.justVal aId
             , allocationCourse
             , participantCount
             , (ratingsCount, vetosCount)
--- a/src/Handler/Course/List.hs
+++ b/src/Handler/Course/List.hs
@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
 module Handler.Course.List
  ( makeCourseTable
  , getCourseListR
@ -15,70 +17,175 @@ import Utils.Form
 -- import Utils.DB
 import Handler.Utils hiding (colSchoolShort)

-import qualified Data.Set as Set
-import qualified Data.Map as Map
-
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E

+import qualified Data.CaseInsensitive as CI
+import qualified Data.Text as Text
+import qualified Data.Set as Set
+
+
+type CourseTableData = DBRow
+  ( Entity Course
+  , Bool -- isRegistered
+  , Entity School
+  , [Entity User]
+  , Maybe (Entity Allocation)
+  , Bool -- mayEditCourse
+  )
+
+resultCourse :: Lens' CourseTableData (Entity Course)
+resultCourse = _dbrOutput . _1
+
+resultSchool :: Lens' CourseTableData (Entity School)
+resultSchool = _dbrOutput . _3
+  
+resultIsRegistered :: Lens' CourseTableData Bool
+resultIsRegistered = _dbrOutput . _2
+
+resultLecturers :: Traversal' CourseTableData (Entity User)
+resultLecturers = _dbrOutput . _4 . traverse
+
+resultAllocation :: Traversal' CourseTableData (Entity Allocation)
+resultAllocation = _dbrOutput . _5 . _Just
+
+resultMayEditCourse :: Lens' CourseTableData Bool
+resultMayEditCourse = _dbrOutput . _6
+
+
+type CourseTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School))
+     `E.LeftOuterJoin`  E.SqlExpr (Maybe (Entity Allocation))
+
+queryCourse :: IndexPreservingGetter CourseTableExpr (E.SqlExpr (Entity Course))
+queryCourse = to $ $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 2 1)
+
+querySchool :: IndexPreservingGetter CourseTableExpr (E.SqlExpr (Entity School))
+querySchool = to $ $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 1)
+
+queryAllocation :: IndexPreservingGetter CourseTableExpr (E.SqlExpr (Maybe (Entity Allocation)))
+queryAllocation = to   $(E.sqlLOJproj 2 2)
+
+queryParticipants :: IndexPreservingGetter CourseTableExpr (E.SqlExpr (E.Value Int))
+queryParticipants = queryCourse . to (E.^. CourseId) . to numCourseParticipants
+
+queryIsRegistered :: Maybe UserId
+                  -> AuthTagActive
+                  -> IndexPreservingGetter CourseTableExpr (E.SqlExpr (E.Value Bool))
+queryIsRegistered muid ata = queryCourse . to (E.^. CourseId) . to (isCourseParticipant muid ata)
+
+queryMayViewCourse :: Maybe UserId
+                   -> AuthTagActive
+                   -> UTCTime -- ^ @now@
+                   -> IndexPreservingGetter CourseTableExpr (E.SqlExpr (E.Value Bool))
+queryMayViewCourse muid ata now = to . runReader $ do
+  course <- view queryCourse
+  allocation <- view queryAllocation
+
+  return $ mayViewCourse muid ata now course (allocation E.?. AllocationId)
+
+queryIsEditor :: Maybe UserId
+              -> AuthTagActive
+              -> IndexPreservingGetter CourseTableExpr (E.SqlExpr (E.Value Bool))
+queryIsEditor muid ata = queryCourse . to (mayEditCourse muid ata)

-- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
-type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School, [Entity User], Maybe (Entity Allocation), Bool)

 colCourse :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
 colCourse = sortable (Just "course") (i18nCell MsgFilterCourse)
-          $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _, _) } ->
+          $ \(view resultCourse -> Entity _ Course{..}) ->
            anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
              [whamlet|_{courseName}|]

 colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
 colDescription = sortable Nothing mempty
-          $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _, _) } ->
+          $ \(view resultCourse -> Entity _ Course{..}) ->
            case courseDescription of
              Nothing      -> mempty
              (Just descr) -> cell $ modal (toWidget $ hasComment True) (Right $ toWidget descr)

 colCShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
 colCShort = sortable (Just "cshort") (i18nCell MsgFilterCourseShort)
-          $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _, _) } ->
+          $ \(view resultCourse -> Entity _ Course{..}) ->
            anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|_{courseShorthand}|]

 colTerm :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
 colTerm = sortable (Just "term") (i18nCell MsgFilterTerm)
-          $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _, _, _, _) } ->
+          $ \(view resultCourse -> Entity _ Course{..}) ->
            anchorCell (TermCourseListR courseTerm) [whamlet|#{courseTerm}|]

 colSchoolShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
-colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgFilterCourseSchoolShort)
-          $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}, _, _, _) } ->
-            anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|_{schoolShorthand}|]
+colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgFilterCourseSchoolShort) $ \res
+  -> let Entity _ Course{..} = res ^. resultCourse
+         Entity _ School{..} = res ^. resultSchool
+      in anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|_{schoolShorthand}|]

 colRegistered :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
-colRegistered = sortable (Just "registered") (i18nCell MsgFilterRegistered)
-          $ \DBRow{ dbrOutput=(_, _, registered, _, _, _, _) } -> tickmarkCell registered
+colRegistered = sortable (Just "registered") (i18nCell MsgFilterRegistered) $ views resultIsRegistered tickmarkCell

-type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School)

-course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int)
-course2Participants (course `E.InnerJoin` _school) = numCourseParticipants $ course E.^. CourseId
+data AllocationSearch
+  = AllocationSearchNoAllocation
+  | AllocationSearchMatch TermId SchoolId AllocationShorthand
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)

-course2Registered :: Maybe UserId -> AuthTagActive -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
-course2Registered muid ata (course `E.InnerJoin` _school) = isCourseParticipant muid ata $ course E.^. CourseId
+instance PathPiece AllocationSearch where
+  toPathPiece AllocationSearchNoAllocation = "no-allocation"
+  toPathPiece (AllocationSearchMatch tid ssh ash) = pathPieceJoined "-" # [toPathPiece tid, toPathPiece ssh, toPathPiece ash]
+  fromPathPiece t
+    | CI.mk (Text.strip t) == "no-allocation" = pure AllocationSearchNoAllocation
+    | Just [tid, ssh, ash] <- t ^? pathPieceJoined "-"
+    = AllocationSearchMatch <$> fromPathPiece tid <*> fromPathPiece ssh <*> fromPathPiece ash
+    | otherwise = mzero
+
+
+makeCourseTable :: (ToSortable h, Functor h)
+                => Colonnade h CourseTableData (DBCell Handler ()) -> PSValidator Handler () -> DB Widget
+makeCourseTable colChoices psValidator' = do
+  let psValidator = psValidator'
+        & forceFilter "may-read" (Any True)

-makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h, DBResult m x ~ ((), Widget) )
-                     => _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> DB Widget
-makeCourseTable whereClause colChoices psValidator = do
  muid <- lift maybeAuthId
  now <- liftIO getCurrentTime
  ata <- getSessionActiveAuthTags
+
+  MsgRenderer mr <- getMsgRenderer
+  let allocSearchNoAllocOption = Option
+        { optionDisplay = mr MsgFilterCourseAllocationNone
+        , optionInternalValue
+        , optionExternalValue = toPathPiece optionInternalValue
+        }
+        where optionInternalValue = AllocationSearchNoAllocation
+  allocationSearchOptions <- mkOptionList . (allocSearchNoAllocOption :) <$> do
+    allocs <- E.select . E.from $ \allocation -> do
+      E.orderBy [ E.desc $ allocation E.^. AllocationTerm
+                , E.asc $ allocation E.^. AllocationSchool
+                , E.asc $ allocation E.^. AllocationName
+                ]
+      return ( allocation E.^. AllocationTerm, allocation E.^. AllocationSchool, allocation E.^. AllocationShorthand
+             , allocation E.^. AllocationName
+             )
+    return . flip map allocs $ \(E.Value tid, E.Value ssh, E.Value ash, E.Value aname)
+      -> let optionInternalValue = AllocationSearchMatch tid ssh ash
+          in Option
+               { optionDisplay = mr $ MsgFilterCourseAllocationOption tid ssh aname
+               , optionInternalValue
+               , optionExternalValue = toPathPiece optionInternalValue
+               }
+  
  let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
-      dbtSQLQuery qin@(course `E.InnerJoin` school) = do
-        E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
-        let participants = course2Participants qin
-        let registered   = course2Registered muid ata qin
-        let mayView      = mayViewCourse muid ata now course Nothing
-        E.where_ $ whereClause (course, participants, registered, mayView)
-        return (course, participants, registered, school)
+      dbtSQLQuery = runReaderT $ do
+        course <- view queryCourse
+        school <- view querySchool
+        allocation <- view queryAllocation
+
+        lift . E.on . E.exists . E.from $ \allocationCourse ->
+          E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+               E.&&. allocation E.?. AllocationId E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
+        lift . E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
+
+        registered <- view $ queryIsRegistered muid ata
+        isEditor <- view $ queryIsEditor muid ata
+
+        return (course, registered, school, allocation, isEditor)
      lecturerQuery cid (user `E.InnerJoin` lecturer) = do
        E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
        E.where_ $ cid E.==. lecturer E.^. LecturerCourse
@ -88,110 +195,86 @@ makeCourseTable whereClause colChoices psValidator = do
        E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
        E.where_ $ cid E.==. lecturer E.^. LecturerCourse
        return user
-      isEditorQuery course user = E.where_ $ mayEditCourse' muid ata course
-        E.&&. E.just (user E.^. UserId) E.==. E.val muid
      dbtProj :: _ CourseTableData
-      dbtProj = dbtProjSimple $ \(course, E.Value participants, E.Value registered, school) -> do
+      dbtProj = dbtProjSimple $ \(course, E.Value registered, school, allocation, E.Value isEditor) -> do
        lecturerList <- E.select $ E.from $ lecturerQuery $ E.val $ entityKey course
-        courseAlloc <- getBy (UniqueAllocationCourse $ entityKey course)
-                          >>= traverse (getJustEntity . allocationCourseAllocation . entityVal)
-        isEditorList <- E.select $ E.from $ isEditorQuery course
-        return (course, participants, registered, school, lecturerList, courseAlloc, not $ null isEditorList)
-  snd <$> dbTable psValidator DBTable
+        return (course, registered, school, lecturerList, allocation, isEditor)
+  
+  dbTableWidget' psValidator DBTable
    { dbtSQLQuery
-    , dbtRowKey = \(course `E.InnerJoin` _) -> course E.^. CourseId
+    , dbtRowKey = views queryCourse (E.^. CourseId)
    , dbtColonnade = colChoices
    , dbtProj
-    , dbtSorting = Map.fromList -- OverloadedLists does not work with the templates here
-        [ ( "course",        SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseName)
-        , ( "cshort",        SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseShorthand)
-        , ( "term"  ,        SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseTerm)
-        , ( "school",        SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolName)
-        , ( "schoolshort",   SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolShorthand)
-        , ( "register-from", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterFrom)
-        , ( "register-to",   SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterTo)
-        , ( "members",       SortColumn   course2Participants   )
-        , ( "registered",    SortColumn $ course2Registered muid ata)
-        ]
-    , dbtFilter = Map.fromList -- OverloadedLists does not work with the templates here
-        [ ( "course", FilterColumn $ \(course `E.InnerJoin` _school:: CourseTableExpr) criterias -> if
-                | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
-                | otherwise          -> course E.^. CourseName `E.in_` E.valList (Set.toList criterias)
-          )
-        , ( "cshort", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterias -> if
-                | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
-                | otherwise          -> course E.^. CourseShorthand `E.in_` E.valList (Set.toList criterias)
-          )
-        , ( "term"  , FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterias -> if
-                | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
-                | otherwise          -> course E.^. CourseTerm `E.in_` E.valList (Set.toList criterias)
-          )
--         , ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
--                 | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
--                 | otherwise          -> school E.^. SchoolName `E.in_` E.valList (Set.toList criterias)
--           )
-        , ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) ->
-              emptyOrIn $ school E.^. SchoolName -- TODO: Refactor all?!
-          )
-        , ( "schoolshort", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
-                | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
-                | otherwise          -> school E.^. SchoolShorthand `E.in_` E.valList (Set.toList criterias)
-          )
-        , ( "lecturer", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterias -> if
-                | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
-                | otherwise          -> E.exists $ E.from $ \t -> do
-                  user <- isCourseAdminQuery (course E.^. CourseId) t
-                  E.where_ $ E.any (E.hasInfix (user E.^. UserDisplayName) . E.val) (criterias :: Set.Set Text)
-          )
-        , ( "openregistration", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterion -> case getLast (criterion :: Last Bool) of
-              Nothing -> E.val True
-              Just b  -> let regTo   = course E.^. CourseRegisterTo
-                             regFrom = course E.^. CourseRegisterFrom
-                             courseOpen = E.maybe E.false (\f -> f E.<=. E.val now) regFrom
-                                    E.&&. E.maybe E.true  (\t -> E.val now E.<=. t) regTo
-                             alloc allocation = do
-                               E.where_ . E.exists . E.from $ \allocationCourse ->
-                                 E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
-                               return allocation
-                             allocOpen allocation = (      E.maybe E.false (\f -> f E.<=. E.val now) (allocation E.^. AllocationRegisterFrom)
-                                                     E.&&. E.maybe E.true  (\t -> E.val now E.<=. t) (allocation E.^. AllocationRegisterTo)
-                                                    )
-                                              E.||. (      courseOpen
-                                                     E.&&. E.maybe E.false (\f -> f E.<=. E.val now) (allocation E.^. AllocationRegisterByCourse)
-                                                    )
-                         in (E.==. E.val b) $ (      courseOpen
-                                               E.&&. E.not_ (E.exists . void $ E.from alloc)
-                                              )
-                                        E.||. E.exists (E.from $ E.where_ . allocOpen <=< alloc)
-          )
-        , ( "registered", FilterColumn $ \tExpr criterion -> case getLast (criterion :: Last Bool) of
-              Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
-              Just needle -> course2Registered muid ata tExpr E.==. E.val needle
-          )
-        , ( "search", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterion -> case getLast (criterion :: Last Text) of
-              Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
-              Just needle -> (E.castString (course E.^. CourseName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
-                       E.||. (E.castString (course E.^. CourseShorthand) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
-                       E.||. (E.maybe (E.val mempty) (E.castString . esqueletoMarkupOutput) (course E.^. CourseDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
-          )
-        ]
+    , dbtSorting = mconcat
+      [ singletonMap "course"         . SortColumn $ views queryCourse (E.^. CourseName)
+      , singletonMap "cshort"         . SortColumn $ views queryCourse (E.^. CourseShorthand)
+      , singletonMap "term"           . SortColumn $ views queryCourse (E.^. CourseTerm)
+      , singletonMap "school"         . SortColumn $ views querySchool (E.^. SchoolName)
+      , singletonMap "schoolshort"    . SortColumn $ views querySchool (E.^. SchoolShorthand)
+      , singletonMap "register-from"  . SortColumn $ views queryCourse (E.^. CourseRegisterFrom)
+      , singletonMap "register-to"    . SortColumn $ views queryCourse (E.^. CourseRegisterTo)
+      , singletonMap "members"        . SortColumn $ view queryParticipants
+      , singletonMap "registered"     . SortColumn . view $ queryIsRegistered muid ata
+      ]
+    , dbtFilter = mconcat
+      [ singletonMap "may-read" . FilterColumn $ \t (Any b) -> views (queryMayViewCourse muid ata now) (E.==. E.val b) t
+      , singletonMap "course" . FilterColumn . E.mkExactFilter $ views queryCourse (E.^. CourseName)
+      , singletonMap "cshort" . FilterColumn . E.mkExactFilter $ views queryCourse (E.^. CourseShorthand)
+      , singletonMap "term" . FilterColumn . E.mkExactFilter $ views queryCourse (E.^. CourseTerm)
+      , singletonMap "school" . FilterColumn . E.mkExactFilter $ views querySchool (E.^. SchoolName)
+      , singletonMap "schoolshort" . FilterColumn . E.mkExactFilter $ views querySchool (E.^. SchoolShorthand)
+      , singletonMap "lecturer" . FilterColumn . E.mkExistsFilter $ \t (c :: Text) -> E.from $ \t' -> do
+          user <- isCourseAdminQuery (view queryCourse t E.^. CourseId) t'
+          E.where_ $ user E.^. UserDisplayName `E.hasInfix` E.val c
+      , singletonMap "openregistration" . FilterColumn . E.mkExactFilterLast . runReader $ do
+          course <- view queryCourse
+          allocation <- view queryAllocation
+
+          let regTo   = course E.^. CourseRegisterTo
+              regFrom = course E.^. CourseRegisterFrom
+              courseOpen = E.maybe E.false (\f -> f E.<=. E.val now) regFrom
+                     E.&&. E.maybe E.true  (\t -> E.val now E.<=. t) regTo
+              allocOpen = (       E.maybe E.false (\f -> f E.<=. E.val now) (E.joinV $ allocation E.?. AllocationRegisterFrom)
+                            E.&&. E.maybe E.true  (\t -> E.val now E.<=. t) (E.joinV $ allocation E.?. AllocationRegisterTo)
+                          )
+                    E.||. (       courseOpen
+                            E.&&. E.maybe E.false (\f -> f E.<=. E.val now) (E.joinV $ allocation E.?. AllocationRegisterByCourse)
+                          )
+
+          return $ (       courseOpen
+                     E.&&. E.isNothing (allocation E.?. AllocationId)
+                   )
+             E.||. (       allocOpen
+                     E.&&. E.isJust (allocation E.?. AllocationId)
+                   )
+      , singletonMap "registered" . FilterColumn . E.mkExactFilterLast . view $ queryIsRegistered muid ata
+      , singletonMap "search" . FilterColumn $ \(view queryCourse -> course) criterion -> case getLast (criterion :: Last Text) of
+          Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
+          Just needle -> (E.castString (course E.^. CourseName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
+                   E.||. (E.castString (course E.^. CourseShorthand) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
+                   E.||. (E.maybe (E.val mempty) (E.castString . esqueletoMarkupOutput) (course E.^. CourseDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
+      , singletonMap "allocation" . FilterColumn $ \row (criteria :: Set AllocationSearch) -> if
+          | Set.null criteria -> E.true
+          | otherwise -> flip E.any criteria $ \case
+              AllocationSearchNoAllocation -> E.isNothing $ view queryAllocation row E.?. AllocationId
+              AllocationSearchMatch tid ssh ash
+                ->       view queryAllocation row E.?. AllocationTerm E.==. E.justVal tid
+                   E.&&. view queryAllocation row E.?. AllocationSchool E.==. E.justVal ssh
+                   E.&&. view queryAllocation row E.?. AllocationShorthand E.==. E.justVal ash
+      ]
    , dbtFilterUI = \mPrev -> mconcat $ catMaybes
-      [ Just  $ prismAForm (singletonFilter "term" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift termField) (fslI MsgTableTerm)
-      , Just  $ prismAForm (singletonFilter "schoolshort" . maybePrism (_PathPiece . from _SchoolId)) mPrev $ aopt (hoistField lift schoolField) (fslI MsgTableCourseSchool)
-      , Just  $ prismAForm (singletonFilter "lecturer") mPrev $ aopt textField (fslI MsgCourseLecturer)
-      , Just  $ prismAForm (singletonFilter "search") mPrev $ aopt textField (fslI MsgFilterCourseSearch)
-      , Just  $ prismAForm (singletonFilter "openregistration" . maybePrism _PathPiece) mPrev $ fmap (\x -> if isJust x && not (fromJust x) then Nothing else x) . aopt checkBoxField (fslI MsgFilterCourseRegisterOpen)
-      , muid $> prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterCourseRegistered))
+      [ pure $ prismAForm (singletonFilter "term" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift termField) (fslI MsgTableTerm)
+      , pure $ prismAForm (singletonFilter "schoolshort" . maybePrism (_PathPiece . from _SchoolId)) mPrev $ aopt (hoistField lift schoolField) (fslI MsgTableCourseSchool)
+      , pure $ prismAForm (singletonFilter "lecturer") mPrev $ aopt textField (fslI MsgCourseLecturer)
+      , pure $ prismAForm (singletonFilter "search") mPrev $ aopt textField (fslI MsgFilterCourseSearch)
+      , pure $ prismAForm (singletonFilter "openregistration" . maybePrism _PathPiece) mPrev $ fmap (\x -> if isJust x && not (fromJust x) then Nothing else x) . aopt checkBoxField (fslI MsgFilterCourseRegisterOpen)
+      , guardOn (is _Just muid)
+             $ prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterCourseRegistered))
+      , pure $ prismAForm (singletonFilter "allocation" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return allocationSearchOptions) (fslI MsgFilterCourseAllocation)
      ]
    , dbtStyle = def
      { dbsFilterLayout = defaultDBSFilterLayout
-      , dbsTemplate = DBSTCourse
-                        (_dbrOutput . _1)         -- course
-                        (_dbrOutput . _5)         -- lecturer list
-                        (_dbrOutput . _3)         -- isRegistered
-                        (_dbrOutput . _4)         -- school
-                        (_dbrOutput . _6 . _Just) -- allocation
-                        (_dbrOutput . _7)         -- mayEditCourse
+      , dbsTemplate = DBSTCourse resultCourse resultLecturers resultIsRegistered resultSchool resultAllocation resultMayEditCourse
      }
    , dbtParams = def
    , dbtIdent = "courses" :: Text
@ -211,10 +294,9 @@ getCourseListR = do
        , colCShort
        , maybe mempty (const colRegistered) muid
        ]
-      whereClause (_, _, _, mayView) = mayView
      validator = def
        & defaultSorting [SortDescBy "term",SortAscBy "course"]
-  coursesTable <- runDB $ makeCourseTable whereClause colonnade validator
+  coursesTable <- runDB $ makeCourseTable colonnade validator
  defaultLayout $ do
    setTitleI MsgCourseListTitle
    $(widgetFile "courses")
--- a/src/Handler/Course/Register.hs
+++ b/src/Handler/Course/Register.hs
@ -139,16 +139,19 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
      | otherwise
        -> aFormToWForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles (prevAppFiles <$> application)

-    mayViewCourseAfterDeregistration <- liftHandler . runDB $ E.selectExists . E.from $ \course -> E.where_ $
-      course E.^. CourseId E.==. E.val cid
-      E.&&. ( isSchoolAdminLike muid ata (course E.^. CourseSchool)
-        E.||. mayEditCourse muid ata course
-        E.||. courseIsVisible now course Nothing
-        E.||. isCourseLecturer muid ata (course E.^. CourseId)
-        E.||. isCourseTutor muid ata (course E.^. CourseId)
-        E.||. isCourseSheetCorrector muid ata (course E.^. CourseId)
-        E.||. isCourseExamCorrector muid ata (course E.^. CourseId)
-        )
+    mayViewCourseAfterDeregistration <- liftHandler . runDB $ E.selectExists . E.from $ \(course `E.LeftOuterJoin` allocation) -> do
+      E.on . E.exists . E.from $ \allocationCourse ->
+        E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+             E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId
+      E.where_ $  course E.^. CourseId E.==. E.val cid
+           E.&&. (       isSchoolAdminLike muid ata (course E.^. CourseSchool)
+                   E.||. mayEditCourse muid ata course
+                   E.||. courseIsVisible now course (allocation E.?. AllocationId)
+                   E.||. isCourseLecturer muid ata (course E.^. CourseId)
+                   E.||. isCourseTutor muid ata (course E.^. CourseId)
+                   E.||. isCourseSheetCorrector muid ata (course E.^. CourseId)
+                   E.||. isCourseExamCorrector muid ata (course E.^. CourseId)
+                 )

    mayReRegister <- liftHandler . runDB . courseMayReRegister $ Entity cid Course{..}

@ -270,9 +273,12 @@ postCRegisterR tid ssh csh = do
  muid <- maybeAuthId
  ata <- getSessionActiveAuthTags
  now <- liftIO getCurrentTime
-  courseVisible <- runDB . E.selectExists . E.from $ \c -> E.where_ $
-    c E.^. CourseId E.==. E.val cid
-    E.&&. mayViewCourse muid ata now c Nothing
+  courseVisible <- runDB . E.selectExists . E.from $ \(course' `E.LeftOuterJoin` allocation) -> do
+    E.on . E.exists . E.from $ \allocationCourse ->
+      E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course' E.^. CourseId
+           E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId
+    E.where_ $ course' E.^. CourseId E.==. E.val cid
+         E.&&. mayViewCourse muid ata now course' (allocation E.?. AllocationId)
  redirect $ bool NewsR (CourseR tid ssh csh CShowR) courseVisible

 deleteApplications :: UserId -> CourseId -> DB ()
--- a/src/Handler/Course/Show.hs
+++ b/src/Handler/Course/Show.hs
@ -33,10 +33,13 @@ getCShowR tid ssh csh = do
  (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,mApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen,mayReRegister,(mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial)) <- runDB . maybeT notFound $ do
    [(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration, E.Value hasAllocationRegistrationOpen)]
       <- lift . E.select . E.from $
-         \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
+         \((school `E.InnerJoin` course) `E.LeftOuterJoin` allocation `E.LeftOuterJoin` participant) -> do
            E.on $ E.just (course E.^. CourseId) E.==. participant E.?. CourseParticipantCourse
                E.&&. E.val mbAid E.==. participant E.?. CourseParticipantUser
                E.&&. participant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
+            E.on . E.exists . E.from $ \allocationCourse ->
+              E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+                   E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId
            E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
            E.where_ $ course E.^. CourseTerm      E.==. E.val tid
                 E.&&. course E.^. CourseSchool    E.==. E.val ssh
@ -46,7 +49,13 @@ getCShowR tid ssh csh = do
                numParticipants = E.subSelectCount . E.from $ \part ->
                  E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
                       E.&&. part E.^. CourseParticipantState E.==. E.val CourseParticipantActive
-            return (course, courseIsVisible now course Nothing, school E.^. SchoolName, numParticipants, participant, courseAllocationRegistrationOpen now (course E.^. CourseId) Nothing)
+            return ( course
+                   , courseIsVisible now course $ allocation E.?. AllocationId
+                   , school E.^. SchoolName
+                   , numParticipants
+                   , participant
+                   , courseAllocationRegistrationOpen now (course E.^. CourseId) $ allocation E.?. AllocationId
+                   )
    staff <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
      E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
      E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@ -73,9 +73,12 @@ getTermShowR = do
  table <- runDB $
    let termDBTable = DBTable{..}
          where dbtSQLQuery term = return (term, courseCount, isActive)
-                  where courseCount = E.subSelectCount . E.from $ \course ->
+                  where courseCount = E.subSelectCount . E.from $ \(course `E.LeftOuterJoin` allocation) -> do
+                          E.on . E.exists . E.from $ \allocationCourse ->
+                            E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+                                 E.&&. E.just (allocationCourse E.^. AllocationCourseAllocation) E.==. allocation E.?. AllocationId
                          E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm
-                            E.&&. mayViewCourse muid ata now course Nothing
+                            E.&&. mayViewCourse muid ata now course (allocation E.?. AllocationId)
                        isActive = termIsActiveE (E.val now) (E.val muid) (term E.^. TermId)
                dbtRowKey = (E.^. TermId)
                dbtProj = dbrOutput <$> dbtProjId
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@ -579,7 +579,7 @@ data DBStyle r = DBStyle
 data DBSTemplateMode r = DBSTDefault { dbstmNumber :: Int64 -> Bool, dbstmShowNumber :: Int64 -> Bool }
                       | DBSTCourse 
                           (Lens' r (Entity Course))           -- course
-                           (Lens' r [Entity User])             -- lecturers
+                           (Traversal' r (Entity User))        -- lecturers
                           (Lens' r Bool)                      -- isRegistered
                           (Lens' r (Entity School))           -- school
                           (Traversal' r (Entity Allocation))  -- allocation
@ -1510,7 +1510,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
          DBSTCourse c l r s a e -> do
            wRows <- forM rows $ \row' -> let
              Course{..}       = row' ^. c . _entityVal
-              lecturerUsers    = row' ^. l
+              lecturerUsers    = row' ^.. l
              courseLecturers  = userSurname . entityVal <$> lecturerUsers
              isRegistered     = row' ^. r
              mayEdit          = row' ^. e
--- a/src/Utils/Course.hs
+++ b/src/Utils/Course.hs
@ -15,7 +15,7 @@ import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E


-mayViewCourse :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
+mayViewCourse :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
 mayViewCourse muid ata now course maid = 
        isSchoolAdminLike  muid ata (course E.^. CourseSchool)
  E.||. mayEditCourse      muid ata  course
@ -26,7 +26,7 @@ mayViewCourse' :: Maybe UserId -> AuthTagActive -> UTCTime -> Entity Course -> M
 mayViewCourse' muid ata now c@(Entity cid Course{courseSchool}) maid = 
        isSchoolAdminLike  muid ata (E.val courseSchool)
  E.||. mayEditCourse'     muid ata  c
-  E.||. isCourseAssociated muid ata (E.val cid) (E.val <$> maid)
+  E.||. isCourseAssociated muid ata (E.val cid) (E.val maid)
  E.||. courseIsVisible'        now  c           maid


@ -107,17 +107,17 @@ isCourseParticipant muid AuthTagActive{..} cid
    E.&&. E.val (authTagIsActive AuthCourseRegistered)
  | otherwise = E.false

-isCourseApplicant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
+isCourseApplicant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
 isCourseApplicant muid AuthTagActive{..} cid maid
  | Just uid <- muid, authTagIsActive AuthApplicant = E.exists . E.from $ \courseApplication -> E.where_ $
          courseApplication E.^. CourseApplicationUser   E.==. E.val uid
    E.&&. courseApplication E.^. CourseApplicationCourse E.==. cid
-    E.&&. maybe E.true
+    E.&&. E.maybe E.true
            (\aid -> E.just aid E.==. courseApplication E.^. CourseApplicationAllocation)
            maid
  | otherwise = E.false

-isCourseAssociated :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
+isCourseAssociated :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
 isCourseAssociated muid ata cid maid = 
        isCourseLecturer       muid ata cid
  E.||. isCourseTutor          muid ata cid
@ -127,7 +127,7 @@ isCourseAssociated muid ata cid maid =
  E.||. isCourseApplicant      muid ata cid maid


-courseIsVisible :: UTCTime -> E.SqlExpr (Entity Course) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
+courseIsVisible :: UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
 courseIsVisible now course maid = 
  (E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (course E.^. CourseVisibleFrom)
    E.&&. E.maybe E.true (\visibleTo -> E.val now E.<=. visibleTo) (course E.^. CourseVisibleTo)
@ -136,11 +136,11 @@ courseIsVisible now course maid =
 courseIsVisible' :: UTCTime -> Entity Course -> Maybe AllocationId -> E.SqlExpr (E.Value Bool)
 courseIsVisible' now (Entity cid Course{..}) maid = 
        E.val (NTop courseVisibleFrom <= now' && now' <= NTop courseVisibleTo)
-  E.||. courseAllocationRegistrationOpen now (E.val cid) (E.val <$> maid)
+  E.||. courseAllocationRegistrationOpen now (E.val cid) (E.val maid)
  where now' = NTop $ Just now


-courseAllocationRegistrationOpen :: UTCTime -> E.SqlExpr (E.Value CourseId) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
+courseAllocationRegistrationOpen :: UTCTime -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
 courseAllocationRegistrationOpen now cid maid = E.exists . E.from $ \(allocationCourse `E.InnerJoin` allocation) -> do
  E.on $ allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId
  E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. cid
@ -152,7 +152,7 @@ courseAllocationRegistrationOpen now cid maid = E.exists . E.from $ \(allocation
            E.true
            (\registerTo   -> E.val now    E.<=. registerTo)
            (allocation E.^. AllocationRegisterTo)
-    E.&&. maybe E.true (\aid -> aid E.==. allocation E.^. AllocationId) maid
+    E.&&. E.maybe E.true (\aid -> aid E.==. allocation E.^. AllocationId) maid


 numCourseParticipants :: E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Int)