Replace project role HTML flat list with an SVG diagram

This commit is contained in:
fr33domlover 2016-07-02 09:45:29 +00:00
parent 1191a3c5cd
commit 13afd17a40
3 changed files with 22 additions and 17 deletions

View file

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

View file

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

View file

@ -15,8 +15,10 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<p>
<a href=@{ProjectRoleNewR shr}>New…
<ul>
$forall Entity _rid role <- roles
<li>
<a href=@{ProjectRoleR shr $ projectRoleIdent role}>
#{rl2text $ projectRoleIdent role}
^{projectRoleGraphW shr graph}
$#<ul>
$# $forall Entity _rid role <- roles
$# <li>
$# <a href=@{ProjectRoleR shr $ projectRoleIdent role}>
$# #{rl2text $ projectRoleIdent role}