diff --git a/src/Vervis/Handler/Role.hs b/src/Vervis/Handler/Role.hs
index d0ea50d..70665af 100644
--- a/src/Vervis/Handler/Role.hs
+++ b/src/Vervis/Handler/Role.hs
@@ -50,7 +50,9 @@ import Vervis.Form.Role
import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident (ShrIdent, RlIdent, rl2text)
+import Vervis.Role
import Vervis.Settings (widgetFile)
+import Vervis.Widget.Role
getRepoRolesR :: ShrIdent -> Handler Html
getRepoRolesR shr = do
@@ -151,10 +153,13 @@ getRepoRoleOpNewR shr rl = do
getProjectRolesR :: ShrIdent -> Handler Html
getProjectRolesR shr = do
- roles <- runDB $ do
- Entity sid _ <- getBy404 $ UniqueSharer shr
- selectList [ProjectRoleSharer ==. sid] []
- defaultLayout $(widgetFile "project/role/list")
+ --roles <- runDB $ do
+ -- Entity sid _ <- getBy404 $ UniqueSharer shr
+ -- selectList [ProjectRoleSharer ==. sid] []
+ graph <- runDB $ do
+ Entity sid _s <- getBy404 $ UniqueSharer shr
+ getProjectRoleGraph sid
+ defaultLayout $(widgetFile "project/role/graph")
postProjectRolesR :: ShrIdent -> Handler Html
postProjectRolesR shr = do
diff --git a/src/Vervis/Role.hs b/src/Vervis/Role.hs
index b08dfc6..5cb6869 100644
--- a/src/Vervis/Role.hs
+++ b/src/Vervis/Role.hs
@@ -35,10 +35,9 @@ import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident
-getRepoRoleGraph :: AppDB SharerId -> Handler (Gr RlIdent ())
-getRepoRoleGraph getsid = do
- (roles, inhs) <- runDB $ do
- sid <- getsid
+getRepoRoleGraph :: SharerId -> AppDB (Gr RlIdent ())
+getRepoRoleGraph sid = do
+ (roles, inhs) <- do
rrs <- P.selectList [RepoRoleSharer P.==. sid] []
rrhs <- select $ from $ \ (rr `InnerJoin` rrh) -> do
on $ rr ^. RepoRoleId ==. rrh ^. RepoRoleInheritParent
@@ -62,10 +61,9 @@ getRepoRoleGraph getsid = do
inhs
return $ mkGraph nodes edges
-getProjectRoleGraph :: AppDB SharerId -> Handler (Gr RlIdent ())
-getProjectRoleGraph getsid = do
- (roles, inhs) <- runDB $ do
- sid <- getsid
+getProjectRoleGraph :: SharerId -> AppDB (Gr RlIdent ())
+getProjectRoleGraph sid = do
+ (roles, inhs) <- do
prs <- P.selectList [ProjectRoleSharer P.==. sid] []
prhs <- select $ from $ \ (pr `InnerJoin` prh) -> do
on $ pr ^. ProjectRoleId ==. prh ^. ProjectRoleInheritParent
diff --git a/templates/project/role/list.hamlet b/templates/project/role/graph.hamlet
similarity index 74%
rename from templates/project/role/list.hamlet
rename to templates/project/role/graph.hamlet
index 43d38cc..b04b040 100644
--- a/templates/project/role/list.hamlet
+++ b/templates/project/role/graph.hamlet
@@ -15,8 +15,10 @@ $#