From e9079b640c73dbff2c03c6fc1cdcd67a8441efbc Mon Sep 17 00:00:00 2001 From: stuart nelson Date: Wed, 27 Sep 2017 10:14:04 +0200 Subject: [PATCH] Construct/traverse tree without Graph.Tree --- ui/app/src/Status/Api.elm | 3 + ui/app/src/Status/Types.elm | 3 + ui/app/src/Views/Status/Views.elm | 91 ++++++++++--------------------- 3 files changed, 36 insertions(+), 61 deletions(-) diff --git a/ui/app/src/Status/Api.elm b/ui/app/src/Status/Api.elm index b95c2e99..b61740c4 100644 --- a/ui/app/src/Status/Api.elm +++ b/ui/app/src/Status/Api.elm @@ -90,6 +90,9 @@ decodeRoute = |: (maybe (field "repeat_interval" int)) |: (maybe (field "routes" (map Status.Types.Routes (list (lazy (\_ -> decodeRoute)))))) |: (succeed Nothing) + |: (succeed 0) + |: (succeed 0) + |: (succeed 0) matchers : Decoder (List Matcher) diff --git a/ui/app/src/Status/Types.elm b/ui/app/src/Status/Types.elm index af32187a..54e78a8f 100644 --- a/ui/app/src/Status/Types.elm +++ b/ui/app/src/Status/Types.elm @@ -46,6 +46,9 @@ type alias Route = , repeat_interval : Maybe Int , routes : Maybe Routes , parent : Maybe Parent + , x : Int + , y : Int + , mod : Int } diff --git a/ui/app/src/Views/Status/Views.elm b/ui/app/src/Views/Status/Views.elm index cddf9e27..4d144895 100644 --- a/ui/app/src/Views/Status/Views.elm +++ b/ui/app/src/Views/Status/Views.elm @@ -7,7 +7,6 @@ import Types exposing (Msg(MsgForStatus)) 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 @@ -41,91 +40,61 @@ viewStatusInfo status = ] -makeTree : Route -> Maybe Status.Types.Parent -> Tree Route -makeTree node parent = +makeTree : Int -> Int -> Route -> Maybe Status.Types.Parent -> Route +makeTree idx depth node parent = let newParent = Just (Status.Types.Parent node) - leaves = + ( routes, x ) = case node.routes of Just (Status.Types.Routes routes) -> - List.map (flip makeTree newParent) routes + ( (List.indexedMap + (\idx route -> + (flip (makeTree idx (depth + 1)) newParent) route + ) + routes + ) + |> Status.Types.Routes + |> Just + , (List.length routes) // 2 + ) Nothing -> - [] + ( Nothing, idx ) + + mod = + if idx == 0 then + 0 + else + idx - x in - Tree.inner { node | parent = parent } leaves + { node + | x = x + , y = depth + , mod = mod + , parent = parent + , routes = routes + } type alias Node = { matchers : List Matcher + , receiver : String , x : Int , y : Int } routingTree : Route -> Html Msg -routingTree route = +routingTree root = 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 + makeTree 0 0 root Nothing 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 []