From 13afd17a40bab80f95314d2eee73802abece56ce Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Sat, 2 Jul 2016 09:45:29 +0000
Subject: [PATCH] Replace project role HTML flat list with an SVG diagram

---
 src/Vervis/Handler/Role.hs                         | 13 +++++++++----
 src/Vervis/Role.hs                                 | 14 ++++++--------
 .../project/role/{list.hamlet => graph.hamlet}     | 12 +++++++-----
 3 files changed, 22 insertions(+), 17 deletions(-)
 rename templates/project/role/{list.hamlet => graph.hamlet} (74%)

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