Merge branch 'master' into 'live'

Deploy Master See merge request !42
2018-07-08 19:37:00 +02:00 · 2018-07-08 19:37:00 +02:00 · fdbf926a2f
commit fdbf926a2f
parent c7b02f304b 442c0a9a00
19 changed files with 292 additions and 149 deletions
--- a/messages/de.msg
+++ b/messages/de.msg
@ -3,6 +3,7 @@ BtnAbort: Abbrechen
 BtnDelete: Löschen
 BtnRegister: Anmelden
 BtnDeregister: Abmelden
+BtnHijack: Sitzung übernehmen

 RegisterFrom: Anmeldungen von
 RegisterTo: Anmeldungen bis
@ -29,6 +30,9 @@ LectureStart: Beginn Vorlesungen

 Course: Kurs
 CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
+CourseRegisterOk: Sie wurden angemeldet
+CourseDeregisterOk: Sie wurden abgemeldet
+CourseSecretWrong: Falsches Kennwort
 CourseSecret: Zugangspasswort
 CourseNewOk        tid@TermId courseShortHand@Text: Kurs #{display tid}-#{courseShortHand} wurde erfolgreich erstellt.
 CourseEditOk       tid@TermId courseShortHand@Text: Kurs #{display tid}-#{courseShortHand} wurde erfolgreich geändert.
@ -184,4 +188,11 @@ RatingFilesUpdated: Korrigierte Dateien überschrieben

 CourseMembers: Teilnehmer
 CourseMembersCount num@Int64: #{display num}
-CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max}
+CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max}
+
+NoTableContent: Kein Tabelleninhalt
+NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
+
+AdminFor: Administrator
+LecturerFor: Dozent
+UserListTitle: Komprehensive Benutzerliste
--- a/4
+++ b/4
@ -15,6 +15,7 @@
 --    !corrector  -- corrector   for this sheet  (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course)
 --    !registered -- participant for this course (no effect outside of courses)
 --    !owner      -- part of the group of owners of this submission
+--    !capacity   -- course this route is associated with has at least one unit of participant capacity
 --
 --    !materials  -- only if course allows all materials to be free (no meaning outside of courses)
 --    !time       -- access depends on time somehow
@ -34,6 +35,7 @@
 /users                      UsersR            GET             -- no tags, i.e. admins only
 /admin/test                 AdminTestR        GET POST
 /admin/user/#CryptoUUIDUser AdminUserR        GET
+/admin/user/#CryptoUUIDUser/hijack AdminHijackUserR POST
 /info                       VersionR          GET             !free

 /profile                    ProfileR          GET POST        !free                             !free
@ -50,7 +52,7 @@
 !/course/new                CourseNewR        GET POST        !lecturer
 /course/#TermId/#Text       CourseR                           !lecturer:
  /                           CShowR          GET             !free
-  /register                   CRegisterR          POST        !time
+  /register                   CRegisterR          POST        !timeANDcapacity
  /edit                       CEditR          GET POST
  /subs                       CCorrectionsR   GET POST
  /ex                         SheetListR      GET             !registered !materials
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@ -342,6 +342,16 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
         $logErrorS "AccessControl" $ "'!registered' used on route that doesn't support it: " <> tshow r
         unauthorizedI MsgUnauthorized
   )
+  ,("capacity", APDB $ \route _ -> case route of
+       CourseR tid csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do
+         Entity cid Course{..} <- MaybeT . getBy $ CourseTermShort tid csh
+         registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
+         guard $ NTop courseCapacity > NTop (Just registered)
+         return Authorized
+       r -> do
+         $logErrorS "AccessControl" $ "'!capacity' used on route that doesn't support it: " <> tshow r
+         unauthorizedI MsgUnauthorized
+   )
  ,("materials", APDB $ \route _ -> case route of
      CourseR tid csh _ -> maybeT (unauthorizedI MsgUnfreeMaterials) $ do
        Entity _ Course{..} <- MaybeT . getBy $ CourseTermShort tid csh
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@ -170,7 +170,7 @@ makeCorrectionsTable whereClause colChoices psValidator = do
                                          E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False)
                       )
                     ]
-    , dbtAttrs     = tableDefault
+    , dbtStyle     = def
    , dbtIdent     = "corrections" :: Text
    }

--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@ -85,7 +85,7 @@ getTermCourseListR tid = do
          )
        ]
    , dbtFilter = mempty
-    , dbtAttrs = tableDefault
+    , dbtStyle = def
    , dbtIdent = "courses" :: Text
    }
  
@ -139,19 +139,12 @@ postCRegisterR tid csh = do
    (FormSuccess codeOk)
      | registered -> do
          runDB $ deleteBy $ UniqueParticipant aid cid
-          addMessage "info" "Sie wurden abgemeldet."
+          addMessageI "info" MsgCourseDeregisterOk
      | codeOk -> do
          actTime <- liftIO $ getCurrentTime
-          regOk <- runDB $ do
-            reg <- count [CourseParticipantCourse ==. cid]
-            if NTop (Just $ fromIntegral reg) < NTop (courseCapacity course)
-              then -- current capacity has room
-                insertUnique $ CourseParticipant cid aid actTime
-              else do -- no space left
-                addMessageI "danger" MsgCourseNoCapacity
-                return Nothing
-          when (isJust regOk) $ addMessage "success" "Erfolgreich angemeldet!"
-      | otherwise -> addMessage "danger" "Falsches Kennwort!"
+          regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
+          when (isJust regOk) $ addMessageI "success" MsgCourseRegisterOk
+      | otherwise -> addMessageI "danger" MsgCourseSecretWrong
    (_other) -> return () -- TODO check this!
  redirect $ CourseR tid csh CShowR

--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@ -99,7 +99,7 @@ homeAnonymous = do
                            | otherwise     -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
                        )
                        ] -}
-    , dbtAttrs     = tableDefault
+    , dbtStyle     = def
    , dbtIdent     = "upcomingdeadlines" :: Text
    }
  let features = $(widgetFile "featureList")
@ -188,7 +188,7 @@ homeUser uid = do
                            | otherwise     -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
                        )
                        ] -}
-    , dbtAttrs     = tableDefault
+    , dbtStyle     = def { dbsEmptyStyle = DBESNoHeading, dbsEmptyMessage = MsgNoUpcomingSheetDeadlines }
    , dbtIdent     = "upcomingdeadlines" :: Text
    }
  defaultLayout $ do
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@ -227,7 +227,7 @@ getSShowR tid csh shn = do
  fileTable <- dbTable def $ DBTable
    { dbtSQLQuery = fileData
    , dbtColonnade = colonnadeFiles
-    , dbtAttrs = tableDefault
+    , dbtStyle = def
    , dbtFilter = Map.empty
    , dbtIdent = "files" :: Text
    -- TODO: Add column for and visibility date
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@ -288,7 +288,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
      smid2ArchiveTable (smid,cid) = DBTable
        { dbtSQLQuery = submissionFiles smid
        , dbtColonnade = colonnadeFiles cid
-        , dbtAttrs = tableDefault
+        , dbtStyle = def
        , dbtIdent = "files" :: Text
        , dbtSorting =  [ ( "path"
                          , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle]
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@ -99,7 +99,7 @@ getTermShowR = do
                                   E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs
                        )
                      ]
-        , dbtAttrs = tableDefault
+        , dbtStyle = def
        , dbtIdent = "terms" :: Text
        }
      defaultLayout $ do
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@ -4,6 +4,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RecordWildCards #-}

 module Handler.Users where

@ -11,39 +12,91 @@ import Import
 -- import Data.Text
 import Handler.Utils

-import Colonnade hiding (fromMaybe)
-import Yesod.Colonnade
+import qualified Data.Map as Map

-- import qualified Database.Esqueleto as E
-- import           Database.Esqueleto      ((^.))
+import qualified Database.Esqueleto as E


+hijackUserForm :: UserId -> Form UserId
+hijackUserForm uid csrf = do
+  cID <- encrypt uid
+  (uidResult, uidView) <- mforced hiddenField "" (cID :: CryptoUUIDUser)
+  (btnResult, btnView) <- mreq (buttonField BtnHijack) "" Nothing 
+
+  return (uid <$ uidResult <* btnResult, mconcat [toWidget csrf, fvInput uidView, fvInput btnView])
+
 getUsersR :: Handler Html
 getUsersR = do
-  -- TODO: Esqueleto, combine the two queries into one
-  (users,schools) <- runDB $ (,)
-    <$> (selectList [] [Asc UserDisplayName]
-        >>= mapM (\usr -> (,,)
-          <$> pure usr
-          <*> selectList [UserAdminUser    ==. entityKey usr] [Asc UserAdminSchool]
-          <*> selectList [UserLecturerUser ==. entityKey usr] [Asc UserLecturerSchool]
-        ))
-    <*> selectList [] [Asc SchoolShorthand]
-  let schoolnames = entities2map schools
-  let getSchoolname = \sid ->
-        case lookup sid schoolnames of
-          Nothing -> "???"
-          (Just school) -> schoolShorthand school
-  let colonnadeUsers = mconcat $
-        [ headed "User" $ \u -> do
-            cID <- encrypt $ entityKey $ fst3 u
-            let name = display $ userDisplayName $ entityVal $ fst3 u
-            [whamlet|<a href=@{AdminUserR cID}>#{name}|]
-        , headed "Admin"   $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userAdminSchool   .entityVal) $ snd3 u)
-        , headed "Lecturer" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userLecturerSchool.entityVal) $ trd3 u)
+  let
+    colonnadeUsers = dbColonnade . mconcat $
+      [ dbRow
+      , sortable (Just "display-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
+          (AdminUserR <$> encrypt uid)
+          (toWidget . display $ userDisplayName)
+      , sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty
+          { dbCellContents = do
+              schools <- E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do
+                E.on $ school E.^. SchoolId E.==. userAdmin E.^. UserAdminSchool
+                E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
+                E.orderBy [E.asc $ school E.^. SchoolShorthand]
+                return $ school E.^. SchoolShorthand
+              return [whamlet|
+                  <ul>
+                    $forall (E.Value sh) <- schools
+                      <li>#{sh}
+                |]
+          }
+      , sortable Nothing (i18nCell MsgLecturerFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty
+          { dbCellContents = do
+              schools <- E.select . E.from $ \(school `E.InnerJoin` userLecturer) -> do
+                E.on $ school E.^. SchoolId E.==. userLecturer E.^. UserLecturerSchool
+                E.where_ $ userLecturer E.^. UserLecturerUser E.==. E.val uid
+                E.orderBy [E.asc $ school E.^. SchoolShorthand]
+                return $ school E.^. SchoolShorthand
+              return [whamlet|
+                  <ul>
+                    $forall (E.Value sh) <- schools
+                      <li>#{sh}
+                |]
+          }
+      , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity uid _ } -> cell $ do
+          (hijackView, hijackEnctype) <- liftHandlerT . generateFormPost $ hijackUserForm uid
+          cID <- encrypt uid
+          [whamlet|
+            <form method=POST action=@{AdminHijackUserR cID} enctype=#{hijackEnctype}>
+              ^{hijackView}
+          |]
+      ]
+    psValidator = def
+      & defaultSorting [("display-name", SortAsc)]
+  
+  userList <- dbTable psValidator $ DBTable
+    { dbtSQLQuery  = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User))
+    , dbtColonnade = colonnadeUsers
+    , dbtSorting   = Map.fromList
+        [ ( "display-name"
+          , SortColumn $ \user -> user E.^. UserDisplayName
+          )
        ]
-        -- ++  map (\school -> headed (text2widget $ schoolName $ entityVal school) (\u -> "xx")) schools
+    , dbtFilter    = mempty
+    , dbtStyle     = def
+    , dbtIdent     = "users" :: Text
+    }
+  
  defaultLayout $ do
-    setTitle "Comprehensive User List"
-    let userList = encodeWidgetTable tableSortable colonnadeUsers users
+    setTitleI MsgUserListTitle
    $(widgetFile "users")
+
+postAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent
+postAdminHijackUserR cID = do
+  uid <- decrypt cID
+  ((hijackRes, _), _) <- runFormPost $ hijackUserForm uid
+
+  case hijackRes of
+    FormSuccess uid'
+      | uid' == uid -> do
+          User{..} <- runDB $ get404 uid
+          setCredsRedirect $ Creds "dummy" (userPlugin <> ":" <> userIdent) []
+      | otherwise -> error "This should be impossible by definition of `hijackUserForm`"
+    FormFailure errs -> toTypedContent <$> mapM_ (addMessage "error" . toHtml) errs
+    FormMissing -> return $ toTypedContent ()
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@ -142,6 +142,18 @@ instance Button RegisterButton where
  cssClass BtnRegister   = BCPrimary
  cssClass BtnDeregister = BCDanger

+data AdminHijackUserButton = BtnHijack
+  deriving (Enum, Eq, Ord, Bounded, Read, Show)
+
+instance PathPiece AdminHijackUserButton where
+  toPathPiece   = showToPathPiece
+  fromPathPiece = readFromPathPiece
+
+instance Button AdminHijackUserButton where
+  label BtnHijack = [whamlet|_{MsgBtnHijack}|]
+
+  cssClass BtnHijack = BCDefault
+

 -- -- Looks like a button, but is just a link (e.g. for create course, etc.)
 -- data LinkButton = LinkButton (Route UniWorX)
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@ -21,17 +21,19 @@ module Handler.Utils.Table.Pagination
  ( SortColumn(..), SortDirection(..)
  , FilterColumn(..), IsFilterColumn
  , DBRow(..), DBOutput
-  , DBTable(..), IsDBTable(..)
+  , DBStyle(..), DBEmptyStyle(..)
+  , DBTable(..), IsDBTable(..), DBCell(..)
  , PaginationSettings(..), PaginationInput(..), piIsUnset
  , PSValidator(..)
  , defaultFilter, defaultSorting
  , restrictFilter, restrictSorting
  , ToSortable(..), Sortable(..), sortable
  , dbTable
-  , widgetColonnade, formColonnade
+  , widgetColonnade, formColonnade, dbColonnade
  , textCell, stringCell, i18nCell, anchorCell, anchorCell', anchorCellM
  , formCell, DBFormResult, getDBFormResult
  , dbRow, dbSelect
+  , (&)
  ) where

 import Handler.Utils.Table.Pagination.Types
@ -53,6 +55,7 @@ import qualified Data.CaseInsensitive as CI

 import Control.Monad.RWS hiding ((<>), Foldable(..), mapM_, forM_)
 import Control.Monad.Writer hiding ((<>), Foldable(..), mapM_, forM_)
+import Control.Monad.Reader (ReaderT(..), mapReaderT)

 import Data.Map (Map, (!))
 import qualified Data.Map as Map
@ -128,6 +131,25 @@ instance DBOutput (DBRow r) r where
 instance DBOutput (DBRow r) (Int64, r) where
  dbProj = (,) <$> dbrIndex <*> dbrOutput

+data DBEmptyStyle = DBESNoHeading | DBESHeading
+  deriving (Enum, Bounded, Ord, Eq, Show, Read)
+
+instance Default DBEmptyStyle where
+  def = DBESHeading
+
+data DBStyle = DBStyle
+  { dbsEmptyStyle :: DBEmptyStyle
+  , dbsEmptyMessage :: UniWorXMessage
+  , dbsAttrs :: [(Text, Text)]
+  }
+
+instance Default DBStyle where
+  def = DBStyle
+    { dbsEmptyStyle = def
+    , dbsEmptyMessage = MsgNoTableContent
+    , dbsAttrs = [ ("class", "table table--striped table--hover table--sortable") ]
+    }
+
 data DBTable m x = forall a r r' h i t.
  ( ToSortable h, Functor h
  , E.SqlSelect a r, DBOutput (DBRow r) r'
@ -138,7 +160,7 @@ data DBTable m x = forall a r r' h i t.
  , dbtColonnade :: Colonnade h r' (DBCell m x)
  , dbtSorting :: Map (CI Text) (SortColumn t)
  , dbtFilter :: Map (CI Text) (FilterColumn t)
-  , dbtAttrs :: Attribute -- FIXME: currently unused
+  , dbtStyle :: DBStyle
  , dbtIdent :: i
  }

@ -231,18 +253,18 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *)
    
  -- dbWidget :: Proxy m -> Proxy x -> Iso' (DBResult m x) (Widget, DBResult' m x)
  dbWidget :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Proxy m -> Proxy x -> DBResult m x -> m' Widget
-  runDBTable :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => m (x, Widget) -> m' (DBResult m x)
+  runDBTable :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => m (x, Widget) -> ReaderT SqlBackend m' (DBResult m x)

 instance IsDBTable (WidgetT UniWorX IO) () where
  type DBResult (WidgetT UniWorX IO) () = Widget
  -- type DBResult' (WidgetT UniWorX IO) () = ()

  data DBCell (WidgetT UniWorX IO) () = WidgetCell
-    { dbCellAttrs :: [(Text, Text)]
-    , dbCellContents :: Widget
+    { wgtCellAttrs :: [(Text, Text)]
+    , wgtCellContents :: Widget
    }
-  cellAttrs = lens dbCellAttrs $ \w as -> w { dbCellAttrs = as }
-  cellContents = return . dbCellContents
+  cellAttrs = lens wgtCellAttrs $ \w as -> w { wgtCellAttrs = as }
+  cellContents = return . wgtCellContents

  cell = WidgetCell []
  
@ -254,6 +276,27 @@ instance Monoid (DBCell (WidgetT UniWorX IO) ()) where
  mempty = WidgetCell mempty mempty
  (WidgetCell a c) `mappend` (WidgetCell a' c') = WidgetCell (mappend a a') (mappend c c')

+instance IsDBTable (ReaderT SqlBackend (HandlerT UniWorX IO)) () where
+  type DBResult (ReaderT SqlBackend (HandlerT UniWorX IO)) () = Widget
+
+  data DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) () = DBCell
+    { dbCellAttrs :: [(Text, Text)]
+    , dbCellContents :: ReaderT SqlBackend (HandlerT UniWorX IO) Widget
+    }
+
+  cellAttrs = lens dbCellAttrs $ \w as -> w { dbCellAttrs = as }
+  cellContents = lift . dbCellContents
+
+  cell = DBCell [] . return
+
+  dbWidget Proxy Proxy = return
+  -- runDBTable :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX) => ReaderT SqlBackend (HandlerT UniWorX IO) ((), Widget) -> m (Widget)
+  runDBTable = fmap snd . mapReaderT liftHandlerT
+
+instance Monoid (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) ()) where
+  mempty = DBCell mempty $ return mempty
+  (DBCell a c) `mappend` (DBCell a' c') = DBCell (mappend a a') (mappend <$> c <*> c')
+
 instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) where
  -- type DBResult (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) = ((FormResult a, Widget), Enctype)
  type DBResult (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a) = Form a
@ -285,7 +328,7 @@ instance IsDBTable m a => IsString (DBCell m a) where
      

 dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> Handler (DBResult m x)
-dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent), dbtColonnade = (lmap dbProj -> dbtColonnade), .. }) = do
+dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent), dbtColonnade = (lmap dbProj -> dbtColonnade), dbtStyle = DBStyle{..}, .. }) = do
  let
    sortingOptions = mkOptionList
      [ Option t' (t, d) t'
@ -297,9 +340,9 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
    wIdent n
      | not $ null dbtIdent = dbtIdent <> "-" <> n
      | otherwise           = n
-    dbtAttrs'
-      | not $ null dbtIdent = Html5.id (fromString $ unpack dbtIdent) <> dbtAttrs
-      | otherwise           = dbtAttrs
+    dbsAttrs'
+      | not $ null dbtIdent = ("id", dbtIdent) : dbsAttrs
+      | otherwise           = dbsAttrs
    multiTextField = Field
      { fieldParse = \ts _ -> return . Right $ Just ts
      , fieldView = undefined
@ -334,54 +377,55 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),

  mapM_ (addMessageI "warning") errs

-  rows' <- runDB . E.select $ (,) <$> pure (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64)) <*> sqlQuery'
+  runDB $ do
+    rows' <- E.select $ (,) <$> pure (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64)) <*> sqlQuery'

-  let
-    rowCount
-      | (E.Value n, _):_ <- rows' = n
-      | otherwise = 0
-    rows = map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'
+    let
+      rowCount
+        | (E.Value n, _):_ <- rows' = n
+        | otherwise = 0
+      rows = map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'

-    table' :: WriterT x m Widget
-    table' = do
-      getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
+      table' :: WriterT x m Widget
+      table' = do
+        getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest

-      let
-        tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams
+        let
+          tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams

-        genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do
-          widget <- cellContents sortableContent
-          let
-            directions = [dir | (k, dir) <- psSorting, Just k == sortableKey ]
-            isSortable = isJust sortableKey
-            isSorted = (`elem` directions)
-            attrs = sortableContent ^. cellAttrs
-          return $(widgetFile "table/cell/header")
+          genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do
+            widget <- cellContents sortableContent
+            let
+              directions = [dir | (k, dir) <- psSorting, Just k == sortableKey ]
+              isSortable = isJust sortableKey
+              isSorted = (`elem` directions)
+              attrs = sortableContent ^. cellAttrs
+            return $(widgetFile "table/cell/header")

-        columnCount :: Int64
-        columnCount = olength64 $ getColonnade dbtColonnade
+          columnCount :: Int64
+          columnCount = olength64 $ getColonnade dbtColonnade

-      wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable
+        wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable

-      wRows <- forM rows $ \row -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row) -> cell) -> do
-        widget <- cellContents cell
-        let attrs = cell ^. cellAttrs
-        return $(widgetFile "table/cell/body")
+        wRows <- forM rows $ \row -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row) -> cell) -> do
+          widget <- cellContents cell
+          let attrs = cell ^. cellAttrs
+          return $(widgetFile "table/cell/body")
      
-      let table = $(widgetFile "table/colonnade")
-          pageCount = max 1 . ceiling $ rowCount % psLimit
-          pageNumbers = [0..pred pageCount]
+        let table = $(widgetFile "table/colonnade")
+            pageCount = max 1 . ceiling $ rowCount % psLimit
+            pageNumbers = [0..pred pageCount]

-      return $(widgetFile "table/layout")
+        return $(widgetFile "table/layout")
+    
+      dbWidget' :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBResult m x -> m' Widget
+      dbWidget' = dbWidget (Proxy :: Proxy m) (Proxy :: Proxy x)

-    dbWidget' :: DBResult m x -> Handler Widget
-    dbWidget' = dbWidget (Proxy :: Proxy m) (Proxy :: Proxy x)
-
-  bool return (sendResponse <=< tblLayout <=< dbWidget') psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
+    bool return (sendResponse <=< tblLayout <=< dbWidget') psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
  where
-    tblLayout :: Widget -> Handler Html
+    tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html
    tblLayout tbl' = do
-      tbl <- widgetToPageContent tbl'
+      tbl <- liftHandlerT $ widgetToPageContent tbl'
      withUrlRenderer $(hamletFile "templates/table/layout-wrapper.hamlet")

    setParam :: Text -> Maybe Text -> QueryText -> QueryText
@ -399,6 +443,11 @@ formColonnade :: (Headedness h, Monoid a)
              -> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a))
 formColonnade = id

+dbColonnade :: Headedness h
+            => Colonnade h r (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) ())
+            -> Colonnade h r (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) ())
+dbColonnade = id
+
 textCell, stringCell, i18nCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
 stringCell = textCell
 i18nCell = textCell
--- a/templates/course.hamlet
+++ b/templates/course.hamlet
@ -15,19 +15,20 @@
      <dd .deflist__dd>
        <div>
          <a href=#{link} target="_blank" rel="noopener" title="Website des Kurses">#{link}
-    <dt .deflist__dt>Teilnehmer
-    <dd .deflist__dd>
-      <div>
-        #{participants}
-        $maybe capacity <- courseCapacity course
-          \ von #{capacity}
-    $maybe regFrom <- courseRegisterFrom course
-      <dt .deflist__dt>Anmeldezeitraum
+    $if NTop (Just 0) < NTop (courseCapacity course)
+      <dt .deflist__dt>Teilnehmer
      <dd .deflist__dd>
        <div>
-          Ab #{formatTimeGerWD regFrom}
-          $maybe regTo   <- courseRegisterTo   course
-            \ bis #{formatTimeGerWD regTo}
+          #{participants}
+          $maybe capacity <- courseCapacity course
+            \ von #{capacity}
+      $maybe regFrom <- courseRegisterFrom course
+        <dt .deflist__dt>Anmeldezeitraum
+        <dd .deflist__dd>
+          <div>
+            Ab #{formatTimeGerWD regFrom}
+            $maybe regTo   <- courseRegisterTo   course
+              \ bis #{formatTimeGerWD regTo}
    $if registrationOpen
      <dt .deflist__dt>
      <dd .deflist__dd>
--- a/templates/default-layout.lucius
+++ b/templates/default-layout.lucius
@ -280,7 +280,6 @@ input[type="button"]:not([disabled]):hover,
 button:not([disabled]):hover,
 .btn:not([disabled]):hover {
  background-color: var(--color-light);
-  text-decoration: underline;
  color: white;
 }

@ -307,10 +306,6 @@ input[type="button"].btn-info:hover,
 .table {
  margin: 21px 0;
  width: 100%;
-
-  a {
-    text-decoration: none;
-  }
 }

 .table--striped {
@ -368,6 +363,10 @@ input[type="button"].btn-info:hover,
  padding-bottom: 10px;
  font-weight: bold;
  text-align: left;
+
+  a {
+    text-decoration: none;
+  }
 }

@media (max-width: 1200px) {
--- a/templates/standalone/showHide.julius
+++ b/templates/standalone/showHide.julius
@ -8,29 +8,45 @@

 document.addEventListener('DOMContentLoaded', function() {

-  var elements = Array.from(document.querySelectorAll('.js-show-hide__toggle')),
-      toggles = [];
+  var LSNAME = 'SHOW_HIDE';

  function addEventHandler(el) {
    el.addEventListener('click', function elClickListener() {
-      var toggle = toggles[el.dataset.index];
-      toggle.collapsed = !toggle.collapsed;
-      toggle.parent.classList.toggle('js-show-hide--collapsed', toggle.collapsed);
+      var newState = el.parentElement.classList.toggle('js-show-hide--collapsed');
+      updateLSState(el.dataset.shIndex || null, newState);
    });
  }

-  elements.forEach(function(el, i) {
-    el.dataset.index = i;
-    var coll = el.dataset.collapsed === 'true';
-    if (coll) {
-      el.parentElement.classList.add('js-show-hide--collapsed')
+  function updateLSState(index, state) {
+    if (!index) {
+      return false;
    }
-    Array.from(el.parentElement.children).forEach(function(el) {
-      if (!el.classList.contains('js-show-hide__toggle')) {
-        el.classList.add('js-show-hide__target');
-      }
-    });
-    toggles.push({index: i, collapsed: coll, parent: el.parentElement});
-    addEventHandler(el);
+    var lsData = fromLocalStorage();
+    lsData[index] = state;
+    window.localStorage.setItem(LSNAME, JSON.stringify(lsData));
+  }
+
+  function collapsedStateInLocalStorage(index) {
+    return fromLocalStorage()[index] || null;
+  }
+
+  function fromLocalStorage() {
+    return JSON.parse(window.localStorage.getItem(LSNAME)) || {};
+  }
+
+  Array
+    .from(document.querySelectorAll('.js-show-hide__toggle'))
+    .forEach(function(el) {
+      var index = el.dataset.shIndex || null;
+      el.parentElement.classList.toggle(
+        'js-show-hide--collapsed',
+        collapsedStateInLocalStorage(index) || el.dataset.collapsed === 'true'
+      );
+      Array.from(el.parentElement.children).forEach(function(el) {
+        if (!el.classList.contains('js-show-hide__toggle')) {
+          el.classList.add('js-show-hide__target');
+        }
+      });
+      addEventHandler(el);
  });
 });
--- a/templates/table/colonnade.hamlet
+++ b/templates/table/colonnade.hamlet
@ -1,5 +1,5 @@
 $newline never
-<table id="#{dbtIdent}" .table.table--striped.table--hover>
+<table *{dbsAttrs'}>
  $maybe wHeaders' <- wHeaders
    <thead>
      <tr .table__row.table__row--head>
@ -8,10 +8,10 @@ $newline never
          ^{widget}
  $nothing
  <tbody>
-    $if null wRows
+    $if null wRows && (dbsEmptyStyle == DBESHeading)
      <tr>
        <td colspan=#{show columnCount}>
-          Kein Inhalt.
+          _{dbsEmptyMessage}
    $else
      $forall row <- wRows
        <tr .table__row>
--- a/templates/table/layout.hamlet
+++ b/templates/table/layout.hamlet
@ -1,10 +1,13 @@
 $newline never
-<div ##{dbtIdent}-table-wrapper>
-  <div .scrolltable>
-    ^{table}
-  $if pageCount > 1
-    <ul ##{dbtIdent}-pagination .pagination>
-      $forall p <- pageNumbers
-        <li .pagination-link :p == psPage:.current>
-          <a href=#{tblLink $ setParam (wIdent "page") (Just $ tshow p)}>
-            _{MsgPage (succ p)}
+$if null wRows && (dbsEmptyStyle == DBESNoHeading)
+  _{dbsEmptyMessage}
+$else
+  <div ##{wIdent "table-wrapper"}>
+    <div .scrolltable>
+      ^{table}
+    $if pageCount > 1
+      <ul ##{wIdent "pagination"} .pagination>
+        $forall p <- pageNumbers
+          <li .pagination-link :p == psPage:.current>
+            <a href=#{tblLink $ setParam (wIdent "page") (Just $ tshow p)}>
+              _{MsgPage (succ p)}
--- a/templates/users.hamlet
+++ b/templates/users.hamlet
@ -1,8 +1,2 @@
 <div .ui.container>
-
-    <p .bg-danger>
-      This page is only for development purposes.
-
-    <h1>
-      User list
-    ^{userList}
+  ^{userList}
--- a/templates/widgets/asidenav.hamlet
+++ b/templates/widgets/asidenav.hamlet
@ -3,7 +3,7 @@ $newline never
  <div .asidenav>
    $forall tid@TermIdentifier{..} <- favouriteTerms
      <div .asidenav__box>
-        <h3 .asidenav__box-title.js-show-hide__toggle>
+        <h3 .asidenav__box-title.js-show-hide__toggle data-sh-index="#{display season}-#{year}">
          $case season
            $of Winter
              _{MsgWinterTermShort year}