Add group members page and breadcrumbs for group routes

This commit is contained in:
fr33domlover 2016-05-25 16:03:58 +00:00
parent 4c3aa8b269
commit 3687687457
4 changed files with 16 additions and 1 deletions

View file

@ -42,6 +42,7 @@
/g GroupsR GET POST
/g/!new GroupNewR GET
/g/#ShrIdent GroupR GET
/g/#ShrIdent/m GroupMembersR GET
/k KeysR GET POST
/k/!new KeyNewR GET

View file

@ -263,6 +263,11 @@ instance YesodBreadcrumbs App where
PersonNewR -> ("New", Just PeopleR)
PersonR shar -> (shr2text shar, Just PeopleR)
GroupsR -> ("Groups", Just HomeR)
GroupNewR -> ("New", Just GroupsR)
GroupR shar -> (shr2text shar, Just GroupsR)
GroupMembersR shar -> ("Members", Just $ GroupR shar)
KeysR -> ("Keys", Just HomeR)
KeyNewR -> ("New", Just KeysR)
KeyR key -> (ky2text key, Just KeysR)

View file

@ -18,6 +18,7 @@ module Vervis.Handler.Group
, postGroupsR
, getGroupNewR
, getGroupR
, getGroupMembersR
)
where
@ -91,6 +92,14 @@ getGroupNewR = do
getGroupR :: ShrIdent -> Handler Html
getGroupR shar = do
group <- runDB $ do
Entity sid _s <- getBy404 $ UniqueSharer shar
Entity _gid g <- getBy404 $ UniqueGroup sid
return g
defaultLayout $ return ()
getGroupMembersR :: ShrIdent -> Handler Html
getGroupMembersR shar = do
(group, members) <- runDB $ do
Entity sid s <- getBy404 $ UniqueSharer shar
Entity gid _g <- getBy404 $ UniqueGroup sid
@ -105,4 +114,4 @@ getGroupR shar = do
]
return sharer
return (s, ms)
defaultLayout $(widgetFile "group/one")
defaultLayout $(widgetFile "group/members")