Add group members page and breadcrumbs for group routes
This commit is contained in:
parent
4c3aa8b269
commit
3687687457
4 changed files with 16 additions and 1 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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")
|
||||
|
|
Loading…
Reference in a new issue