From 063caab86d2d053f3310704f445195e26213e712 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Tue, 28 Jun 2016 22:19:48 +0000
Subject: [PATCH] Insert links to DAG diagram

---
 src/Diagrams/IntransitiveDAG.hs | 10 ++++++----
 vervis.cabal                    |  2 ++
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/src/Diagrams/IntransitiveDAG.hs b/src/Diagrams/IntransitiveDAG.hs
index 7433c44..f2a3da4 100644
--- a/src/Diagrams/IntransitiveDAG.hs
+++ b/src/Diagrams/IntransitiveDAG.hs
@@ -23,12 +23,14 @@ where
 
 import Prelude
 
+import Control.Arrow ((&&&))
 import Data.Graph.Inductive.Graph
 import Data.Graph.Inductive.Query.Layer (rlayerWith)
 import Data.HashMap.Lazy (HashMap)
 import Data.IntMap.Lazy (IntMap)
 import Data.Tuple.Select (sel2)
 import Diagrams.Combinators (atop)
+import Diagrams.Core.Types (href)
 import Diagrams.TwoD.Attributes (fc, lc)
 import Diagrams.TwoD.Combinators (hcat, vcat)
 import Diagrams.TwoD.Path (stroke)
@@ -75,18 +77,18 @@ box w h =
             # fc black
             # lc plain
 
-roleBox s =
+roleBox s u =
     let h = 1
-        t = stroke $ textSVG' with {textFont = lin2, textHeight = h} s
+        t = href u $ stroke $ textSVG' with {textFont = lin2, textHeight = h} s
         t' = t # lc plain
         w = width t'
         b = box w h
     in  t' `atop` b
 
 -- intransDag :: Graph g => g a b -> QDiagram
-intransDag disp = --TODO connect the layers
+intransDag disp link = --TODO connect the layers
     vcat .
     I.elems .
-    fmap (hcat . map (roleBox . disp . sel2)) .
+    fmap (hcat . map (uncurry roleBox . (disp &&& link) . sel2)) .
     attachNumbers .
     layers
diff --git a/vervis.cabal b/vervis.cabal
index a25a86c..96626bb 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -201,6 +201,8 @@ library
                        -- for Data.Paginate.Local
                      , data-default-class
                        -- for drawing DAGs: RBAC role inheritance, etc.
+                     , diagrams-core
+                       -- for drawing DAGs: RBAC role inheritance, etc.
                      , diagrams-lib
                      , directory
                        -- for Data.Git.Local