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 . + - + - ♡ 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 + - . + -} + +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: