Construct/traverse tree without Graph.Tree
This commit is contained in:
parent
287cb6664e
commit
e9079b640c
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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 []
|
||||||
|
|
Loading…
Reference in New Issue