Merge pull request #281 from unisonweb/route-driven-open-definitions

Ensure Definitions are opened via Route changes

Author: hojberg

src/App.elm

@@ -137,10 +137,20 @@ update msg ({ env } as model) =
             ( model, Cmd.none )
 
         UrlChanged url ->
-            -- URL changes happen when setting focus on a definitions.
-            -- Currently, the URL change is a result of that as oppose to focus
-            -- being a result of a URL change
-            ( { model | route = Route.fromUrl env.basePath url }, Cmd.none )
+            let
+                route =
+                    Route.fromUrl env.basePath url
+            in
+            case route of
+                Route.Definition _ ref ->
+                    let
+                        ( workspace, cmd ) =
+                            Workspace.open env model.workspace ref
+                    in
+                    ( { model | route = route, workspace = workspace }, Cmd.map WorkspaceMsg cmd )
+
+                _ ->
+                    ( { model | route = route }, Cmd.none )
 
         ChangePerspective perspective ->
             replacePerspective model perspective
@@ -168,7 +178,7 @@ update msg ({ env } as model) =
             keydown model event
 
         OpenDefinition ref ->
-            openDefinition model ref
+            navigateToDefinition model ref
 
         ShowModal modal ->
             ( { model | modal = modal }, Cmd.none )
@@ -203,7 +213,7 @@ update msg ({ env } as model) =
             in
             case outMsg of
                 PerspectiveLanding.OpenDefinition ref ->
-                    openDefinition model2 ref
+                    navigateToDefinition model2 ref
 
                 PerspectiveLanding.ShowFinderRequest ->
                     showFinder model2 Nothing
@@ -230,7 +240,7 @@ update msg ({ env } as model) =
                                 model4 =
                                     { model2 | sidebarToggled = False }
                             in
-                            openDefinition model4 ref
+                            navigateToDefinition model4 ref
 
                         CodebaseTree.ChangePerspectiveToNamespace fqn ->
                             fqn
@@ -254,7 +264,7 @@ update msg ({ env } as model) =
                             ( { model | modal = NoModal }, Cmd.none )
 
                         Finder.OpenDefinition ref ->
-                            openDefinition { model | modal = NoModal } ref
+                            navigateToDefinition { model | modal = NoModal } ref
 
                 _ ->
                     ( model, Cmd.none )
@@ -271,19 +281,9 @@ update msg ({ env } as model) =
 -- UPDATE HELPERS
 
 
-openDefinition : Model -> Reference -> ( Model, Cmd Msg )
-openDefinition model ref =
-    let
-        ( workspace, wCmd, outMsg ) =
-            Workspace.open model.env model.workspace ref
-
-        model2 =
-            { model | workspace = workspace }
-
-        ( model3, cmd ) =
-            handleWorkspaceOutMsg model2 outMsg
-    in
-    ( model3, Cmd.batch [ cmd, Cmd.map WorkspaceMsg wCmd ] )
+navigateToDefinition : Model -> Reference -> ( Model, Cmd Msg )
+navigateToDefinition model ref =
+    ( model, Route.navigateToDefinition model.navKey model.route ref )
 
 
 replacePerspective : Model -> Perspective -> ( Model, Cmd Msg )
@@ -336,7 +336,7 @@ handleWorkspaceOutMsg model out =
             showFinder model withinNamespace
 
         Workspace.Focused ref ->
-            ( model, Route.navigateToByReference model.navKey model.route ref )
+            ( model, Route.navigateToDefinition model.navKey model.route ref )
 
         Workspace.Emptied ->
             ( model, Route.navigateToCurrentPerspective model.navKey model.route )

src/Route.elm

@@ -2,8 +2,8 @@ module Route exposing
     ( Route(..)
     , fromUrl
     , navigate
-    , navigateToByReference
     , navigateToCurrentPerspective
+    , navigateToDefinition
     , navigateToLatestCodebase
     , navigateToPerspective
     , perspectiveParams
@@ -263,8 +263,8 @@ navigateToLatestCodebase navKey =
     navigateToPerspective navKey (ByCodebase Relative)
 
 
-navigateToByReference : Nav.Key -> Route -> Reference -> Cmd msg
-navigateToByReference navKey currentRoute reference =
+navigateToDefinition : Nav.Key -> Route -> Reference -> Cmd msg
+navigateToDefinition navKey currentRoute reference =
     navigate navKey (toDefinition currentRoute reference)
 
 

src/Workspace.elm

@@ -27,7 +27,7 @@ import Perspective exposing (Perspective)
 import Task
 import UI.Button as Button
 import UI.Icon as Icon
-import Workspace.WorkspaceItem as WorkspaceItem exposing (Item, WorkspaceItem(..))
+import Workspace.WorkspaceItem as WorkspaceItem exposing (Item, WorkspaceItem)
 import Workspace.WorkspaceItems as WorkspaceItems exposing (WorkspaceItems)
 
 
@@ -55,7 +55,7 @@ init env mRef =
 
         Just ref ->
             let
-                ( m, c, _ ) =
+                ( m, c ) =
                     open env model ref
             in
             ( m, c )
@@ -116,7 +116,7 @@ update env msg ({ workspaceItems } as model) =
             in
             ( { model | workspaceItems = nextWorkspaceItems }
             , cmd
-            , openDefinitionsFocusToOutMsg nextWorkspaceItems
+            , None
             )
 
         IsDocCropped ref res ->
@@ -157,7 +157,7 @@ update env msg ({ workspaceItems } as model) =
         WorkspaceItemMsg wiMsg ->
             case wiMsg of
                 WorkspaceItem.OpenReference relativeToRef ref ->
-                    openItem env model (Just relativeToRef) ref
+                    openReference env model relativeToRef ref
 
                 WorkspaceItem.Close ref ->
                     let
@@ -218,11 +218,6 @@ type alias WithWorkspaceItems m =
     { m | workspaceItems : WorkspaceItems }
 
 
-open : Env -> WithWorkspaceItems m -> Reference -> ( WithWorkspaceItems m, Cmd Msg, OutMsg )
-open env model ref =
-    openItem env model Nothing ref
-
-
 replaceWorkspaceItemReferencesWithHashOnly : Model -> Model
 replaceWorkspaceItemReferencesWithHashOnly model =
     let
@@ -232,7 +227,29 @@ replaceWorkspaceItemReferencesWithHashOnly model =
     { model | workspaceItems = workspaceItems }
 
 
-openItem : Env -> WithWorkspaceItems m -> Maybe Reference -> Reference -> ( WithWorkspaceItems m, Cmd Msg, OutMsg )
+open : Env -> WithWorkspaceItems m -> Reference -> ( WithWorkspaceItems m, Cmd Msg )
+open env model ref =
+    openItem env model Nothing ref
+
+
+{-| openReference opens a definition relative to another definition. This is
+done within Workspace, as opposed to from the outside via a URL change. This
+function returns a Focused command for the newly opened reference and as such
+changes the URL.
+-}
+openReference : Env -> WithWorkspaceItems m -> Reference -> Reference -> ( WithWorkspaceItems m, Cmd Msg, OutMsg )
+openReference env model relativeToRef ref =
+    let
+        ( newModel, cmd ) =
+            openItem env model (Just relativeToRef) ref
+
+        out =
+            openDefinitionsFocusToOutMsg newModel.workspaceItems
+    in
+    ( newModel, cmd, out )
+
+
+openItem : Env -> WithWorkspaceItems m -> Maybe Reference -> Reference -> ( WithWorkspaceItems m, Cmd Msg )
 openItem env ({ workspaceItems } as model) relativeToRef ref =
     -- We don't want to refetch or replace any already open definitions, but we
     -- do want to focus and scroll to it
@@ -243,7 +260,6 @@ openItem env ({ workspaceItems } as model) relativeToRef ref =
         in
         ( { model | workspaceItems = nextWorkspaceItems }
         , scrollToDefinition ref
-        , openDefinitionsFocusToOutMsg nextWorkspaceItems
         )
 
     else
@@ -261,24 +277,14 @@ openItem env ({ workspaceItems } as model) relativeToRef ref =
         in
         ( { model | workspaceItems = nextWorkspaceItems }
         , Cmd.batch [ Api.perform env.apiBasePath (fetchDefinition env.perspective ref), scrollToDefinition ref ]
-        , openDefinitionsFocusToOutMsg nextWorkspaceItems
         )
 
 
 openDefinitionsFocusToOutMsg : WorkspaceItems -> OutMsg
 openDefinitionsFocusToOutMsg openDefs =
-    let
-        toFocusedOut workspaceItem =
-            case workspaceItem of
-                Success ref _ ->
-                    Focused ref
-
-                _ ->
-                    None
-    in
     openDefs
-        |> WorkspaceItems.focus
-        |> Maybe.map toFocusedOut
+        |> WorkspaceItems.focusedReference
+        |> Maybe.map Focused
         |> Maybe.withDefault Emptied