Insert links to DAG diagram

This commit is contained in:
fr33domlover 2016-06-28 22:19:48 +00:00
parent 5b4607e64d
commit 063caab86d
2 changed files with 8 additions and 4 deletions

View file

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

View file

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