WIP for creating tree

ui/app/elm-package.json

@@ -8,6 +8,7 @@
     ],
     "exposed-modules": [],
     "dependencies": {
+        "elm-community/graph": "4.0.0 <= v < 5.0.0",
         "elm-lang/core": "5.0.0 <= v < 6.0.0",
         "elm-lang/dom": "1.1.1 <= v < 2.0.0",
         "elm-lang/html": "2.0.0 <= v < 3.0.0",

ui/app/src/Status/Api.elm

@@ -89,6 +89,7 @@ decodeRoute =
         |: (maybe (field "group_interval" int))
         |: (maybe (field "repeat_interval" int))
         |: (maybe (field "routes" (map Status.Types.Routes (list (lazy (\_ -> decodeRoute))))))
+        |: (succeed Nothing)
 
 
 matchers : Decoder (List Matcher)

ui/app/src/Status/Types.elm

@@ -45,8 +45,13 @@ type alias Route =
     , group_interval : Maybe Int
     , repeat_interval : Maybe Int
     , routes : Maybe Routes
+    , parent : Maybe Parent
     }
 
 
 type Routes
     = Routes (List Route)
+
+
+type Parent
+    = Parent Route

ui/app/src/Views/Status/Views.elm

@@ -2,11 +2,12 @@ module Views.Status.Views exposing (view)
 
 import Html exposing (..)
 import Html.Attributes exposing (class, style)
-import Status.Types exposing (StatusResponse, VersionInfo, MeshStatus, MeshPeer)
+import Status.Types exposing (StatusResponse, VersionInfo, MeshStatus, MeshPeer, Route, Parent)
 import Types exposing (Msg(MsgForStatus))
-import Utils.Types exposing (ApiData(Failure, Success, Loading, Initial))
+import Utils.Types exposing (ApiData(Failure, Success, Loading, Initial), Matcher)
 import Views.Status.Types exposing (StatusModel)
 import Utils.Views
+import Graph.Tree as Tree exposing (Tree)
 
 
 view : StatusModel -> Html Msg
@@ -36,9 +37,95 @@ viewStatusInfo status =
         , viewMeshStatus status.meshStatus
         , viewVersionInformation status.versionInfo
         , viewConfig status.config
+        , routingTree status.route
         ]
 
 
+makeTree : Route -> Maybe Status.Types.Parent -> Tree Route
+makeTree node parent =
+    let
+        newParent =
+            Just (Status.Types.Parent node)
+
+        leaves =
+            case node.routes of
+                Just (Status.Types.Routes routes) ->
+                    List.map (flip makeTree newParent) routes
+
+                Nothing ->
+                    []
+    in
+        Tree.inner { node | parent = parent } leaves
+
+
+type alias Node =
+    { matchers : List Matcher
+    , x : Int
+    , y : Int
+    }
+
+
+routingTree : Route -> Html Msg
+routingTree route =
+    let
+        tree =
+            makeTree route Nothing
+
+        x =
+            Tree.postOrder
+                (\route routes acc ->
+                    let
+                        new =
+                            case route.parent of
+                                Just (Status.Types.Parent parent) ->
+                                    let
+                                        x =
+                                            case parent.routes of
+                                                Just (Status.Types.Routes routes) ->
+                                                    indexOf route routes
+
+                                                Nothing ->
+                                                    0
+
+                                        depth =
+                                            1 + (findDepth parent)
+                                    in
+                                        { matchers = route.matchers, x = x, y = depth }
+
+                                Nothing ->
+                                    { matchers = route.matchers, x = 0, y = 0 }
+                    in
+                        new :: acc
+                )
+                []
+                tree
+    in
+        div [] []
+
+
+indexOf : Route -> List Route -> Int
+indexOf route routes =
+    case routes of
+        x :: xs ->
+            if route == x then
+                0
+            else
+                1 + (indexOf route xs)
+
+        [] ->
+            0
+
+
+findDepth : Route -> Int
+findDepth route =
+    case route.parent of
+        Just (Status.Types.Parent route) ->
+            1 + (findDepth route)
+
+        Nothing ->
+            0
+
+
 viewConfig : String -> Html Msg
 viewConfig config =
     div []