/
Ports.elm
92 lines (64 loc) · 2.65 KB
/
Ports.elm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
port module Ports exposing
( receiveGraphVizPlain
, requestBoundingBoxesForContext
, requestBoundingBoxesForEverything
, requestEdgeTextBoundingBox
, requestGraphVizPlain
, requestNodeTextBoundingBox
, setBoundingBox
)
import Data.Layout as Layout
import Export
import Graph exposing (NodeContext, NodeId)
import IntDict
import Json.Decode as Decode
import Types exposing (BBox, EdgeLabel, ModelGraph, Msg, NodeLabel)
requestNodeTextBoundingBox : NodeId -> Cmd msg
requestNodeTextBoundingBox nodeId =
requestBoundingBox (String.fromInt nodeId)
requestEdgeTextBoundingBox : NodeId -> NodeId -> Cmd msg
requestEdgeTextBoundingBox fromId toId =
requestBoundingBox (String.fromInt fromId ++ ":" ++ String.fromInt toId)
requestBoundingBoxesForEverything : ModelGraph -> Cmd Msg
requestBoundingBoxesForEverything graph =
let
nodeBbReqs =
Graph.nodeIds graph
|> List.map requestNodeTextBoundingBox
|> Cmd.batch
edgeBbReqs =
Graph.edges graph
|> List.map (\e -> requestEdgeTextBoundingBox e.from e.to)
|> Cmd.batch
in
Cmd.batch [ nodeBbReqs, edgeBbReqs ]
requestBoundingBoxesForContext : Maybe (NodeContext NodeLabel EdgeLabel) -> Cmd Msg
requestBoundingBoxesForContext mctx =
Maybe.map requestBoundingBoxesForContextHelper mctx
|> Maybe.withDefault Cmd.none
requestBoundingBoxesForContextHelper : NodeContext NodeLabel EdgeLabel -> Cmd Msg
requestBoundingBoxesForContextHelper ctx =
let
nodeId =
ctx.node.id
in
Cmd.batch
[ requestNodeTextBoundingBox nodeId
, IntDict.keys ctx.outgoing |> List.map (\to -> requestEdgeTextBoundingBox nodeId to) |> Cmd.batch
, IntDict.keys ctx.incoming |> List.map (\from -> requestEdgeTextBoundingBox from nodeId) |> Cmd.batch
]
-- request bounding box of svg element with given String id
port requestBoundingBox : String -> Cmd msg
-- receive Bounding Box from js
port setBoundingBox : (BBox -> msg) -> Sub msg
{-| Request to transform Graphviz dot String to Graphviz plain.
The resulting plain output will contain additional info about node layout which we'll parse out and adjust node positions for nicer layout.
-}
port requestGraphVizPlain_Impl : { layoutEngine : String, graphvizSource : String } -> Cmd msg
requestGraphVizPlain : Layout.LayoutEngine -> ModelGraph -> Cmd msg
requestGraphVizPlain layoutEngine graph =
requestGraphVizPlain_Impl
{ layoutEngine = Layout.engineToString layoutEngine
, graphvizSource = Export.toDot graph
}
port receiveGraphVizPlain : (Decode.Value -> msg) -> Sub msg