foundation for new pathfinder

src/Config/Pathfinder.elm

@@ -0,0 +1,10 @@
+module Config.Pathfinder exposing (..)
+
+
+addressRadius : Float
+addressRadius =
+    50
+
+
+type alias Config =
+    {}

src/Css/Pathfinder.elm

@@ -0,0 +1,9 @@
+module Css.Pathfinder exposing (..)
+
+import Config.View as View
+import Css exposing (..)
+
+
+addressRoot : View.Config -> List Style
+addressRoot vc =
+    vc.theme.pathfinder.addressRoot

src/Effect.elm

@@ -8,6 +8,7 @@ import Config.UserSettings
 import Effect.Api
 import Effect.Graph as Graph
 import Effect.Locale as Locale
+import Effect.Pathfinder as Pathfinder
 import Effect.Search as Search
 import Http
 import Model exposing (Effect(..), Msg(..))
@@ -69,6 +70,25 @@ perform plugins key statusbarToken apiKey effect =
         ApiEffect eff ->
             Effect.Api.perform apiKey (BrowserGotResponseWithHeaders statusbarToken) eff
 
+        PathfinderEffect eff ->
+            case eff of
+                Pathfinder.ApiEffect apiEff ->
+                    Effect.Api.map PathfinderMsg apiEff
+                        |> Effect.Api.perform apiKey (BrowserGotResponseWithHeaders statusbarToken)
+
+                Pathfinder.NavPushRouteEffect route ->
+                    Route.pathfinderRoute route
+                        |> Route.toUrl
+                        |> Nav.pushUrl key
+
+                Pathfinder.PluginEffect _ ->
+                    Pathfinder.perform eff
+                        |> Cmd.map PathfinderMsg
+
+                Pathfinder.CmdEffect cmd ->
+                    cmd
+                        |> Cmd.map PathfinderMsg
+
         GraphEffect eff ->
             case eff of
                 Graph.ApiEffect apiEff ->

src/Effect/Pathfinder.elm

@@ -0,0 +1,32 @@
+module Effect.Pathfinder exposing (..)
+
+import Effect.Api as Api
+import Msg.Pathfinder exposing (Msg(..))
+import Plugin.Msg as Plugin
+import Route.Pathfinder exposing (Route)
+
+
+type Effect
+    = NavPushRouteEffect Route
+    | PluginEffect (Cmd Plugin.Msg)
+    | ApiEffect (Api.Effect Msg)
+    | CmdEffect (Cmd Msg)
+
+
+perform : Effect -> Cmd Msg
+perform eff =
+    case eff of
+        -- managed in Effect.elm
+        NavPushRouteEffect _ ->
+            Cmd.none
+
+        PluginEffect cmd ->
+            cmd
+                |> Cmd.map PluginMsg
+
+        CmdEffect cmd ->
+            cmd
+
+        -- managed in Effect.elm
+        ApiEffect _ ->
+            Cmd.none

src/Init.elm

@@ -7,6 +7,7 @@ import Dict
 import Effect.Api
 import Init.Graph as Graph
 import Init.Locale as Locale
+import Init.Pathfinder as Pathfinder
 import Init.Search as Search
 import Init.Statusbar as Statusbar
 import Json.Decode
@@ -43,6 +44,7 @@ init plugins uc flags url key =
       , page = Stats
       , search = Search.init (Search.initSearchAll Nothing)
       , graph = Graph.init settings flags.now
+      , pathfinder = Pathfinder.init
       , user =
             { apiKey = ""
             , auth = Unknown

src/Init/Graph/History.elm

@@ -1,10 +1,9 @@
 module Init.Graph.History exposing (..)
 
-import IntDict
 import Model.Graph.History exposing (Model)
 
 
-init : Model
+init : Model entry
 init =
     { past = []
     , future = []

src/Init/Graph/Transform.elm

@@ -7,7 +7,7 @@ import RecordSetter exposing (s_state)
 import Set
 
 
-init : Model
+init : Model id
 init =
     { collectingAddedEntityIds = Set.empty
     , bounce = Bounce.init
@@ -22,7 +22,7 @@ init =
     }
 
 
-initTransitioning : Bool -> Float -> Coords -> Coords -> Model
+initTransitioning : Bool -> Float -> Coords -> Coords -> Model id
 initTransitioning withEase duration from to =
     init
         |> s_state

src/Init/Pathfinder.elm

@@ -1,9 +1,17 @@
 module Init.Pathfinder exposing (..)
 
+import Init.Graph.History as History
+import Init.Graph.Transform as Transform
+import Model.Graph exposing (Dragging(..))
 import Model.Pathfinder exposing (Model)
+import Route.Pathfinder as Route
 
 
 init : Model
 init =
     { networks = []
+    , route = Route.Root
+    , dragging = NoDragging
+    , transform = Transform.init
+    , history = History.init
     }

src/Model.elm

@@ -9,17 +9,20 @@ import Dict exposing (Dict)
 import Effect.Api
 import Effect.Graph
 import Effect.Locale
+import Effect.Pathfinder
 import Effect.Search
 import Hovercard
 import Http
 import Json.Encode
 import Model.Dialog
 import Model.Graph
 import Model.Locale
+import Model.Pathfinder
 import Model.Search
 import Model.Statusbar
 import Msg.Graph
 import Msg.Locale
+import Msg.Pathfinder
 import Msg.Search
 import Plugin.Model as Plugin
 import Plugin.Msg as Plugin
@@ -46,6 +49,7 @@ type alias Model navigationKey =
     , locale : Model.Locale.Model
     , search : Model.Search.Model
     , graph : Model.Graph.Model
+    , pathfinder : Model.Pathfinder.Model
     , user : UserModel
     , stats : WebData Api.Data.Stats
     , width : Int
@@ -63,6 +67,7 @@ type Page
     = Home
     | Stats
     | Graph
+    | Pathfinder
     | Plugin Plugin.PluginType
 
 
@@ -95,6 +100,7 @@ type Msg
     | LocaleMsg Msg.Locale.Msg
     | SearchMsg Msg.Search.Msg
     | GraphMsg Msg.Graph.Msg
+    | PathfinderMsg Msg.Pathfinder.Msg
     | PluginMsg Plugin.Msg
     | UserClickedExampleSearch String
     | UserHovercardMsg Hovercard.Msg
@@ -135,6 +141,7 @@ type Effect
     | LocaleEffect Effect.Locale.Effect
     | SearchEffect Effect.Search.Effect
     | GraphEffect Effect.Graph.Effect
+    | PathfinderEffect Effect.Pathfinder.Effect
     | ApiEffect (Effect.Api.Effect Msg)
     | PluginEffect (Cmd Plugin.Msg)
     | PortsConsoleEffect String

src/Model/Graph.elm

@@ -15,6 +15,7 @@ import Model.Graph.ContextMenu as ContextMenu
 import Model.Graph.Coords exposing (Coords)
 import Model.Graph.Highlighter as Highlighter
 import Model.Graph.History as History
+import Model.Graph.History.Entry as Entry
 import Model.Graph.Id exposing (AddressId, EntityId, LinkId)
 import Model.Graph.Layer exposing (Layer)
 import Model.Graph.Search as Search
@@ -30,16 +31,16 @@ type alias Model =
     , route : Route.Graph.Route
     , browser : Browser.Model
     , adding : Adding.Model
-    , dragging : Dragging
-    , transform : Transform.Model
+    , dragging : Dragging EntityId
+    , transform : Transform.Model EntityId
     , selected : Selected
     , hovered : Hovered
     , contextMenu : Maybe ContextMenu.Model
     , tag : Maybe Tag.Model
     , search : Maybe Search.Model
     , userAddressTags : Dict ( String, String, String ) Tag.UserTag
     , activeTool : ActiveTool
-    , history : History.Model
+    , history : History.Model Entry.Model
     , highlights : Highlighter.Model
     , selectIfLoaded : Maybe SelectIfLoaded
     , hovercard : Maybe Hovercard.Model
@@ -80,9 +81,9 @@ type Hovered
     | HoveredNone
 
 
-type Dragging
+type Dragging id
     = NoDragging
-    | Dragging Transform.Model Coords Coords
+    | Dragging (Transform.Model id) Coords Coords
     | DraggingNode EntityId Coords Coords
 
 

src/Model/Graph/History.elm

@@ -1,37 +1,32 @@
 module Model.Graph.History exposing (..)
 
-import Color exposing (Color)
-import Init.Graph.History.Entry as Entry
-import IntDict exposing (IntDict)
 import List.Extra
-import Model.Graph.History.Entry as Entry
-import Model.Graph.Layer exposing (Layer)
 
 
-type alias Model =
-    { past : List Entry.Model
-    , future : List Entry.Model
+type alias Model entry =
+    { past : List entry
+    , future : List entry
     }
 
 
-hasPast : Model -> Entry.Model -> Bool
-hasPast { past } entry =
+hasPast : entry -> Model entry -> entry -> Bool
+hasPast init { past } entry =
     (List.isEmpty past |> not)
-        && ((past /= [ Entry.init ])
-                || (entry /= Entry.init)
+        && ((past /= [ init ])
+                || (entry /= init)
            )
 
 
-hasFuture : Model -> Bool
+hasFuture : Model entry -> Bool
 hasFuture { future } =
     List.isEmpty future |> not
 
 
-unconsPast : Model -> Maybe ( Entry.Model, List Entry.Model )
+unconsPast : Model entry -> Maybe ( entry, List entry )
 unconsPast { past } =
     List.Extra.uncons past
 
 
-unconsFuture : Model -> Maybe ( Entry.Model, List Entry.Model )
+unconsFuture : Model entry -> Maybe ( entry, List entry )
 unconsFuture { future } =
     List.Extra.uncons future

src/Model/Graph/Transform.elm

@@ -20,9 +20,9 @@ type alias Coords =
     }
 
 
-type alias Model =
+type alias Model comparable =
     { state : Transition
-    , collectingAddedEntityIds : Set Id.EntityId
+    , collectingAddedEntityIds : Set comparable
     , bounce : Bounce
     }
 
@@ -39,7 +39,7 @@ type Transition
     | Settled Coords
 
 
-getZ : Model -> Float
+getZ : Model comparable -> Float
 getZ model =
     case model.state of
         Transitioning { current } ->
@@ -49,7 +49,7 @@ getZ model =
             Bounded.value z
 
 
-getCurrent : Model -> Coords
+getCurrent : Model comparable -> Coords
 getCurrent model =
     case model.state of
         Transitioning { current } ->
@@ -59,7 +59,7 @@ getCurrent model =
             c
 
 
-getBoundingBox : Model -> { width : Float, height : Float } -> BBox
+getBoundingBox : Model comparable -> { width : Float, height : Float } -> BBox
 getBoundingBox model { width, height } =
     let
         current =

src/Model/Pathfinder.elm

@@ -1,8 +1,18 @@
 module Model.Pathfinder exposing (..)
 
+import Model.Graph exposing (Dragging)
+import Model.Graph.History as History
+import Model.Graph.Transform as Transform
+import Model.Pathfinder.History.Entry as Entry
+import Model.Pathfinder.Id exposing (Id)
 import Model.Pathfinder.Network exposing (Network)
+import Route.Pathfinder
 
 
 type alias Model =
     { networks : List Network
+    , route : Route.Pathfinder.Route
+    , dragging : Dragging Id
+    , transform : Transform.Model Id
+    , history : History.Model Entry.Model
     }

src/Model/Pathfinder/History/Entry.elm

@@ -0,0 +1,8 @@
+module Model.Pathfinder.History.Entry exposing (..)
+
+import Model.Pathfinder.Network exposing (Network)
+
+
+type alias Model =
+    { networks : List Network
+    }

src/Msg/Graph.elm

@@ -25,7 +25,7 @@ import Yaml.Decode
 
 
 type Msg
-    = UserClickedGraph Dragging
+    = UserClickedGraph (Dragging EntityId)
     | UserClickedAddress AddressId
     | UserRightClickedAddress AddressId Coords
     | UserClickedAddressActions AddressId Coords

src/Msg/Pathfinder.elm

@@ -0,0 +1,14 @@
+module Msg.Pathfinder exposing (..)
+
+import Model.Graph exposing (Dragging)
+import Model.Graph.Coords exposing (Coords)
+import Model.Pathfinder.Id exposing (Id)
+import Plugin.Msg as Plugin
+
+
+type Msg
+    = UserClickedGraph (Dragging Id)
+    | UserWheeledOnGraph Float Float Float
+    | UserPushesLeftMouseButtonOnGraph Coords
+    | UserMovesMouseOnGraph Coords
+    | PluginMsg Plugin.Msg