Construct/traverse tree without Graph.Tree

This commit is contained in:
stuart nelson 2017-09-27 10:14:04 +02:00
parent 287cb6664e
commit e9079b640c
3 changed files with 36 additions and 61 deletions

View File

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

View File

@ -46,6 +46,9 @@ type alias Route =
, repeat_interval : Maybe Int , repeat_interval : Maybe Int
, routes : Maybe Routes , routes : Maybe Routes
, parent : Maybe Parent , parent : Maybe Parent
, x : Int
, y : Int
, mod : Int
} }

View File

@ -7,7 +7,6 @@ import Types exposing (Msg(MsgForStatus))
import Utils.Types exposing (ApiData(Failure, Success, Loading, Initial), Matcher) import Utils.Types exposing (ApiData(Failure, Success, Loading, Initial), Matcher)
import Views.Status.Types exposing (StatusModel) import Views.Status.Types exposing (StatusModel)
import Utils.Views import Utils.Views
import Graph.Tree as Tree exposing (Tree)
view : StatusModel -> Html Msg view : StatusModel -> Html Msg
@ -41,91 +40,61 @@ viewStatusInfo status =
] ]
makeTree : Route -> Maybe Status.Types.Parent -> Tree Route makeTree : Int -> Int -> Route -> Maybe Status.Types.Parent -> Route
makeTree node parent = makeTree idx depth node parent =
let let
newParent = newParent =
Just (Status.Types.Parent node) Just (Status.Types.Parent node)
leaves = ( routes, x ) =
case node.routes of case node.routes of
Just (Status.Types.Routes routes) -> 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 ->
[] ( Nothing, idx )
mod =
if idx == 0 then
0
else
idx - x
in in
Tree.inner { node | parent = parent } leaves { node
| x = x
, y = depth
, mod = mod
, parent = parent
, routes = routes
}
type alias Node = type alias Node =
{ matchers : List Matcher { matchers : List Matcher
, receiver : String
, x : Int , x : Int
, y : Int , y : Int
} }
routingTree : Route -> Html Msg routingTree : Route -> Html Msg
routingTree route = routingTree root =
let let
tree = tree =
makeTree route Nothing makeTree 0 0 root 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 in
div [] [] 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 : String -> Html Msg
viewConfig config = viewConfig config =
div [] div []