fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into feat/exercises

Browse Source
This commit is contained in:
SJost 2018-07-09 12:38:27 +02:00
commit 43f52fb9eb
24 changed files with 318 additions and 149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
messages/de.msg
View File

@ -3,6 +3,7 @@ BtnAbort: Abbrechen
BtnDelete: Löschen
BtnRegister: Anmelden
BtnDeregister: Abmelden
BtnHijack: Sitzung übernehmen
RegisterFrom: Anmeldungen von
RegisterTo: Anmeldungen bis
@ -187,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

1
models
View File

@ -12,6 +12,7 @@ User json
UserAdmin
user UserId
school SchoolId
UniqueUserAdmin user school
UserLecturer
user UserId
school SchoolId

1
routes
View File

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

11
src/Foundation.hs
View File

@ -459,7 +459,6 @@ instance Yesod UniWorX where
defaultLayout widget = do
master <- getYesod
mmsgs <- getMessages
messageRender <- getMessageRender -- needed, since there is no i18n interpolation in Julius
mcurrentRoute <- getCurrentRoute
@ -493,10 +492,10 @@ instance Yesod UniWorX where
in (c, courseRoute, ) <$> filterM (menuItemAccessCallback . menuItem) (pageActions courseRoute)
let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority
highlight = let crumbs = mcons mcurrentRoute $ fst <$> parents
actFav = List.intersect (snd3 <$> favourites) crumbs
highRs = if null actFav then crumbs else actFav
in \r -> r `elem` highRs
highlight = let crumbs = mcons mcurrentRoute $ fst <$> reverse parents
navItems = map snd3 favourites ++ map (menuItemRoute . menuItem) menuTypes
highR = find (`elem` navItems) . uncurry (++) $ partition (`elem` map snd3 favourites) crumbs
in \r -> Just r == highR
favouriteTerms :: [TermIdentifier]
favouriteTerms = Set.toDescList $ foldMap (\(Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites
favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [MenuTypes])]
@ -655,7 +654,7 @@ submissionList tid csh shn uid = E.select . E.from $ \(course `E.InnerJoin` shee
defaultLinks :: [MenuTypes]
defaultLinks = -- Define the menu items of the header.
[ NavbarRight $ MenuItem
[ NavbarAside $ MenuItem
{ menuItemLabel = "Home"
, menuItemIcon = Just "home"
, menuItemRoute = HomeR

2
src/Handler/Corrections.hs
View File

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

2
src/Handler/Course.hs
View File

@ -85,7 +85,7 @@ getTermCourseListR tid = do
)
]
, dbtFilter = mempty
, dbtAttrs = tableDefault
, dbtStyle = def
, dbtIdent = "courses" :: Text
}

4
src/Handler/Home.hs
View File

@ -95,7 +95,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")
@ -184,7 +184,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

2
src/Handler/Sheet.hs
View File

@ -232,7 +232,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

2
src/Handler/Submission.hs
View File

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

2
src/Handler/Term.hs
View File

@ -99,7 +99,7 @@ getTermShowR = do
E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs
)
]
, dbtAttrs = tableDefault
, dbtStyle = def
, dbtIdent = "terms" :: Text
}
defaultLayout $ do

118
src/Handler/Users.hs
View File

@ -4,6 +4,7 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
module Handler.Users where
@ -11,39 +12,100 @@ import Import
-- import Data.Text
import Handler.Utils
import Colonnade hiding (fromMaybe)
import Yesod.Colonnade
import qualified Data.Map as Map
import qualified Data.Set as Set
-- 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 .list--inline .list--comma-separated>
$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 .list--inline .list--comma-separated>
$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
myUid <- requireAuthId
User{..} <- runDB $ do
otherSchoolsAdmin <- Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. uid] []
otherSchoolsLecturer <- Set.fromList . map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] []
mySchools <- Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. myUid] []
when (not $ (otherSchoolsAdmin `Set.union` otherSchoolsLecturer) `Set.isSubsetOf` mySchools) $
permissionDenied "Cannot escalate admin status to additional schools"
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 ()

12
src/Handler/Utils/Form.hs
View File

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

145
src/Handler/Utils/Table/Pagination.hs
View File

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

4
templates/adminTest.hamlet
View File

@ -8,10 +8,10 @@
Der Handler sollte jeweils aktuelle Beispiele für alle möglichen Funktionalitäten enthalten, so dass man immer weiß, wo man nachschlagen kann.
<div .container>
<div .container.js-show-hide>
<h2 .js-show-hide__toggle>Teilweise funktionierende Abschnitte
<ul>
<ul .js-show-hide__target>
<li .list-group-item>
<a href=@{UsersR}>Benutzer Verwaltung

33
templates/default-layout.lucius
View File

@ -115,10 +115,6 @@ ul {
list-style-type: none;
}
.list--inline > li {
display: inline-block;
}
h1, h2, h3, h4, h5 {
font-weight: 600;
}
@ -214,14 +210,14 @@ h4 {
@media (max-width: 768px) {
.main__content-body {
padding: 0 20px 60px;
padding: 30px 20px 60px;
}
}
@media (max-width: 425px) {
.main__content-body {
padding: 0 10px 60px;
padding: 20px 10px 60px;
}
}
@ -280,7 +276,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 +302,6 @@ input[type="button"].btn-info:hover,
.table {
margin: 21px 0;
width: 100%;
a {
text-decoration: none;
}
}
.table--striped {
@ -368,6 +359,10 @@ input[type="button"].btn-info:hover,
padding-bottom: 10px;
font-weight: bold;
text-align: left;
a {
text-decoration: none;
}
}
@media (max-width: 1200px) {
@ -423,6 +418,22 @@ input[type="button"].btn-info:hover,
line-height: 25px;
}
/* LIST MODIFIERS */
.list--inline > li {
display: inline-block;
}
.list--comma-separated > li {
&::after {
content: ', ';
}
&:last-of-type::after {
content: none;
}
}
/* DEFINITION LIST */
.deflist {
display: grid;

1
templates/standalone/alerts.julius
View File

@ -11,7 +11,6 @@
autoDecay = parseInt(dataDecay, 10);
}
closeEl.classList.add('alert__close');
closeEl.innerText = #{String (messageRender MsgCloseAlert)};
closeEl.addEventListener('click', function(event) {
alertEl.classList.add('alert--invisible');
});

1
templates/standalone/alerts.lucius
View File

@ -72,6 +72,7 @@
.alert {
margin-left: 80px;
max-width: 420px;
}
}

50
templates/standalone/showHide.julius
View File

@ -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);
});
});

6
templates/table/colonnade.hamlet
View File

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

21
templates/table/layout.hamlet
View File

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

8
templates/users.hamlet
View File

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

6
templates/widgets/asidenav.hamlet
View File

@ -2,14 +2,14 @@ $newline never
<aside .main__aside>
<div .asidenav>
$forall tid@TermIdentifier{..} <- favouriteTerms
<div .asidenav__box>
<h3 .asidenav__box-title.js-show-hide__toggle>
<div .asidenav__box.js-show-hide>
<h3 .asidenav__box-title.js-show-hide__toggle data-sh-index="#{display season}-#{year}">
$case season
$of Winter
_{MsgWinterTermShort year}
$of Summer
_{MsgSummerTermShort year}
<ul .asidenav__list>
<ul .asidenav__list.js-show-hide__target>
$forall (Course{..}, courseRoute, pageActions) <- favouriteTerm tid
<li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
<a .asidenav__link-wrapper href=@{courseRoute}>

18
templates/widgets/asidenav.julius
View File

@ -19,15 +19,21 @@
document.addEventListener('DOMContentLoaded', function() {
var asidenavEl = document.querySelector('.main__aside');
var mainEl = document.querySelector('.main__content');
var mainContentEl = document.querySelector('.main__content');
asidenavEl.style.height = `${mainEl.clientHeight + 75}px`;
window.addEventListener('resize', function() {
function adjustHeight() {
window.requestAnimationFrame(function() {
asidenavEl.style.height = `${mainEl.clientHeight + 75}px`;
asidenavEl.style.height = mainContentEl.clientHeight + 'px';
});
});
}
// unbeknownst to the user (below the fold), this happes slightly delayed
// because of dynamic changes to the styles inside the main__content
setTimeout(function() {
adjustHeight();
}, 10);
window.addEventListener('resize', adjustHeight);
window.utils.aside(asidenavEl);

7
templates/widgets/asidenav.lucius
View File

@ -16,6 +16,13 @@
}
}
@media (max-width: 768px) {
.main__aside {
min-height: calc(100% - var(--header-height-collapsed));
}
}
@media (max-width: 425px) {
.main__aside {