Role graph widget

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
 

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

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: