Role graph widget

This commit is contained in:
fr33domlover 2016-07-02 09:02:13 +00:00
parent 7be410f329
commit 1191a3c5cd
3 changed files with 68 additions and 0 deletions

View file

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

65
src/Vervis/Widget/Role.hs Normal file
View file

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

View file

@ -149,6 +149,7 @@ library
Vervis.Widget
Vervis.Widget.Discussion
Vervis.Widget.Repo
Vervis.Widget.Role
Vervis.Widget.Sharer
Vervis.Wiki
-- other-modules: