Merge branch 'master' into 'live'

Deploy Master

See merge request !42

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

routes

@@ -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

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

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
     }
 

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
+          regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
-            reg <- count [CourseParticipantCourse ==. cid]
+          when (isJust regOk) $ addMessageI "success" MsgCourseRegisterOk
-            if NTop (Just $ fromIntegral reg) < NTop (courseCapacity course)
+      | otherwise -> addMessageI "danger" MsgCourseSecretWrong
-              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!"
     (_other) -> return () -- TODO check this!
   redirect $ CourseR tid csh CShowR
 

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

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

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]

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

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 qualified Data.Map as Map
-import Yesod.Colonnade
 
--- import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto as E
--- import           Database.Esqueleto      ((^.))
 
 
+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
+  let
-  (users,schools) <- runDB $ (,)
+    colonnadeUsers = dbColonnade . mconcat $
-    <$> (selectList [] [Asc UserDisplayName]
+      [ dbRow
-        >>= mapM (\usr -> (,,)
+      , sortable (Just "display-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
-          <$> pure usr
+          (AdminUserR <$> encrypt uid)
-          <*> selectList [UserAdminUser    ==. entityKey usr] [Asc UserAdminSchool]
+          (toWidget . display $ userDisplayName)
-          <*> selectList [UserLecturerUser ==. entityKey usr] [Asc UserLecturerSchool]
+      , sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty
-        ))
+          { dbCellContents = do
-    <*> selectList [] [Asc SchoolShorthand]
+              schools <- E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do
-  let schoolnames = entities2map schools
+                E.on $ school E.^. SchoolId E.==. userAdmin E.^. UserAdminSchool
-  let getSchoolname = \sid ->
+                E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
-        case lookup sid schoolnames of
+                E.orderBy [E.asc $ school E.^. SchoolShorthand]
-          Nothing -> "???"
+                return $ school E.^. SchoolShorthand
-          (Just school) -> schoolShorthand school
+              return [whamlet|
-  let colonnadeUsers = mconcat $
+                  <ul>
-        [ headed "User" $ \u -> do
+                    $forall (E.Value sh) <- schools
-            cID <- encrypt $ entityKey $ fst3 u
+                      <li>#{sh}
-            let name = display $ userDisplayName $ entityVal $ fst3 u
+                |]
-            [whamlet|<a href=@{AdminUserR cID}>#{name}|]
+          }
-        , headed "Admin"   $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userAdminSchool   .entityVal) $ snd3 u)
+      , sortable Nothing (i18nCell MsgLecturerFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty
-        , headed "Lecturer" $ (\u -> text2widget $ intercalate ", " $ map (getSchoolname.userLecturerSchool.entityVal) $ trd3 u)
+          { 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"
+    setTitleI MsgUserListTitle
-    let userList = encodeWidgetTable tableSortable colonnadeUsers users
     $(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 ()

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)

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)]
+    { wgtCellAttrs :: [(Text, Text)]
-    , dbCellContents :: Widget
+    , wgtCellContents :: Widget
     }
-  cellAttrs = lens dbCellAttrs $ \w as -> w { dbCellAttrs = as }
+  cellAttrs = lens wgtCellAttrs $ \w as -> w { wgtCellAttrs = as }
-  cellContents = return . dbCellContents
+  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'
+    dbsAttrs'
-      | not $ null dbtIdent = Html5.id (fromString $ unpack dbtIdent) <> dbtAttrs
+      | not $ null dbtIdent = ("id", dbtIdent) : dbsAttrs
-      | otherwise           = dbtAttrs
+      | 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
+    let
-    rowCount
+      rowCount
-      | (E.Value n, _):_ <- rows' = n
+        | (E.Value n, _):_ <- rows' = n
-      | otherwise = 0
+        | otherwise = 0
-    rows = map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'
+      rows = map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'
 
-    table' :: WriterT x m Widget
+      table' :: WriterT x m Widget
-    table' = do
+      table' = do
-      getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
+        getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
 
-      let
+        let
-        tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams
+          tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams
 
-        genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do
+          genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do
-          widget <- cellContents sortableContent
+            widget <- cellContents sortableContent
-          let
+            let
-            directions = [dir | (k, dir) <- psSorting, Just k == sortableKey ]
+              directions = [dir | (k, dir) <- psSorting, Just k == sortableKey ]
-            isSortable = isJust sortableKey
+              isSortable = isJust sortableKey
-            isSorted = (`elem` directions)
+              isSorted = (`elem` directions)
-            attrs = sortableContent ^. cellAttrs
+              attrs = sortableContent ^. cellAttrs
-          return $(widgetFile "table/cell/header")
+            return $(widgetFile "table/cell/header")
 
-        columnCount :: Int64
+          columnCount :: Int64
-        columnCount = olength64 $ getColonnade dbtColonnade
+          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
+        wRows <- forM rows $ \row -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row) -> cell) -> do
-        widget <- cellContents cell
+          widget <- cellContents cell
-        let attrs = cell ^. cellAttrs
+          let attrs = cell ^. cellAttrs
-        return $(widgetFile "table/cell/body")
+          return $(widgetFile "table/cell/body")
       
-      let table = $(widgetFile "table/colonnade")
+        let table = $(widgetFile "table/colonnade")
-          pageCount = max 1 . ceiling $ rowCount % psLimit
+            pageCount = max 1 . ceiling $ rowCount % psLimit
-          pageNumbers = [0..pred pageCount]
+            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
+    bool return (sendResponse <=< tblLayout <=< dbWidget') psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
-    dbWidget' = dbWidget (Proxy :: Proxy m) (Proxy :: Proxy x)
-
-  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

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
+    $if NTop (Just 0) < NTop (courseCapacity course)
-    <dd .deflist__dd>
+      <dt .deflist__dt>Teilnehmer
-      <div>
-        #{participants}
-        $maybe capacity <- courseCapacity course
-          \ von #{capacity}
-    $maybe regFrom <- courseRegisterFrom course
-      <dt .deflist__dt>Anmeldezeitraum
       <dd .deflist__dd>
         <div>
-          Ab #{formatTimeGerWD regFrom}
+          #{participants}
-          $maybe regTo   <- courseRegisterTo   course
+          $maybe capacity <- courseCapacity course
-            \ bis #{formatTimeGerWD regTo}
+            \ 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>

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) {

templates/standalone/showHide.julius

@@ -8,29 +8,45 @@
 
 document.addEventListener('DOMContentLoaded', function() {
 
-  var elements = Array.from(document.querySelectorAll('.js-show-hide__toggle')),
+  var LSNAME = 'SHOW_HIDE';
-      toggles = [];
 
   function addEventHandler(el) {
     el.addEventListener('click', function elClickListener() {
-      var toggle = toggles[el.dataset.index];
+      var newState = el.parentElement.classList.toggle('js-show-hide--collapsed');
-      toggle.collapsed = !toggle.collapsed;
+      updateLSState(el.dataset.shIndex || null, newState);
-      toggle.parent.classList.toggle('js-show-hide--collapsed', toggle.collapsed);
     });
   }
 
-  elements.forEach(function(el, i) {
+  function updateLSState(index, state) {
-    el.dataset.index = i;
+    if (!index) {
-    var coll = el.dataset.collapsed === 'true';
+      return false;
-    if (coll) {
-      el.parentElement.classList.add('js-show-hide--collapsed')
     }
-    Array.from(el.parentElement.children).forEach(function(el) {
+    var lsData = fromLocalStorage();
-      if (!el.classList.contains('js-show-hide__toggle')) {
+    lsData[index] = state;
-        el.classList.add('js-show-hide__target');
+    window.localStorage.setItem(LSNAME, JSON.stringify(lsData));
-      }
+  }
-    });
+
-    toggles.push({index: i, collapsed: coll, parent: el.parentElement});
+  function collapsedStateInLocalStorage(index) {
-    addEventHandler(el);
+    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);
   });
 });

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>

templates/table/layout.hamlet

@@ -1,10 +1,13 @@
 $newline never
-<div ##{dbtIdent}-table-wrapper>
+$if null wRows && (dbsEmptyStyle == DBESNoHeading)
-  <div .scrolltable>
+  _{dbsEmptyMessage}
-    ^{table}
+$else
-  $if pageCount > 1
+  <div ##{wIdent "table-wrapper"}>
-    <ul ##{dbtIdent}-pagination .pagination>
+    <div .scrolltable>
-      $forall p <- pageNumbers
+      ^{table}
-        <li .pagination-link :p == psPage:.current>
+    $if pageCount > 1
-          <a href=#{tblLink $ setParam (wIdent "page") (Just $ tshow p)}>
+      <ul ##{wIdent "pagination"} .pagination>
-            _{MsgPage (succ p)}
+        $forall p <- pageNumbers
+          <li .pagination-link :p == psPage:.current>
+            <a href=#{tblLink $ setParam (wIdent "page") (Just $ tshow p)}>
+              _{MsgPage (succ p)}

templates/users.hamlet

@@ -1,8 +1,2 @@
 <div .ui.container>
-
+  ^{userList}
-    <p .bg-danger>
-      This page is only for development purposes.
-
-    <h1>
-      User list
-    ^{userList}

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}