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 @@ $# .

New… -