From 1191a3c5cd33d2dde14aa964e3834448aa864b2a Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Sat, 2 Jul 2016 09:02:13 +0000
Subject: [PATCH] Role graph widget

---
 src/Diagrams/IntransitiveDAG.hs |  2 +
 src/Vervis/Widget/Role.hs       | 65 +++++++++++++++++++++++++++++++++
 vervis.cabal                    |  1 +
 3 files changed, 68 insertions(+)
 create mode 100644 src/Vervis/Widget/Role.hs

diff --git a/src/Diagrams/IntransitiveDAG.hs b/src/Diagrams/IntransitiveDAG.hs
index f2a3da4..e037f5b 100644
--- a/src/Diagrams/IntransitiveDAG.hs
+++ b/src/Diagrams/IntransitiveDAG.hs
@@ -39,9 +39,11 @@ import Diagrams.TwoD.Size (width)
 import Diagrams.Util ((#), with)
 import Graphics.SVGFonts.Fonts (lin2)
 import Graphics.SVGFonts.Text (textSVG', TextOpts (..))
+--import Yesod.Core.Handler (toTextUrl)
 
 import qualified Data.HashMap.Lazy as H
 import qualified Data.IntMap.Lazy as I
+--import qualified Data.Text as T (unpack)
 
 import Vervis.Colour
 
diff --git a/src/Vervis/Widget/Role.hs b/src/Vervis/Widget/Role.hs
new file mode 100644
index 0000000..ddc316e
--- /dev/null
+++ b/src/Vervis/Widget/Role.hs
@@ -0,0 +1,65 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Vervis.Widget.Role
+    ( repoRoleGraphW
+    , projectRoleGraphW
+    )
+where
+
+import Prelude
+
+import Data.Graph.Inductive.Graph (Graph)
+import Diagrams.Backend.SVG
+import Diagrams.Core.Compile (renderDia)
+import Diagrams.Core.Types (Diagram)
+import Diagrams.TwoD.Size (mkWidth)
+import Graphics.Svg.Core (renderText)
+import Text.Blaze.Html (preEscapedToHtml)
+import Yesod.Core (Route)
+import Yesod.Core.Handler (getUrlRender)
+import Yesod.Core.Widget (toWidget)
+
+import qualified Data.Text as T (unpack)
+
+import Diagrams.IntransitiveDAG
+import Vervis.Foundation
+import Vervis.Model.Ident
+
+roleGraph
+    :: Graph g
+    => (ShrIdent -> RlIdent -> Route App)
+    -> ShrIdent
+    -> g RlIdent ()
+    -> Widget
+roleGraph link shr g = do
+    r <- getUrlRender
+    let dia :: Diagram SVG
+        dia = intransDag (T.unpack . rl2text) (T.unpack . r . link shr) g
+        opts = SVGOptions
+            { _size            = mkWidth 480
+            , _svgDefinitions  = Nothing
+            , _idPrefix        = ""
+            , _svgAttributes   = []
+            , _generateDoctype = False
+            }
+        svg = renderDia SVG opts dia
+    toWidget $ preEscapedToHtml $ renderText svg
+
+repoRoleGraphW :: Graph g => ShrIdent -> g RlIdent () -> Widget
+repoRoleGraphW = roleGraph RepoRoleR
+
+projectRoleGraphW :: Graph g => ShrIdent -> g RlIdent () -> Widget
+projectRoleGraphW = roleGraph ProjectRoleR
diff --git a/vervis.cabal b/vervis.cabal
index ed6e12a..deede81 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -149,6 +149,7 @@ library
                        Vervis.Widget
                        Vervis.Widget.Discussion
                        Vervis.Widget.Repo
+                       Vervis.Widget.Role
                        Vervis.Widget.Sharer
                        Vervis.Wiki
   -- other-modules: