Ensure Definitions are opened via Route changes

We want the URL to be main way definitions are opened and fetched.
Previously this was an afterthought such that we fetched a definition
and then changed the URL, resulting in broken back-button behavior.

This changes how we load definitions such that a URL is changed which,
in a route handler, causes the Workspace to open and fetch that
definition, with 1 exception: when a definition is opened from another
definition, it is important that we open the new definition relative to the
originating definition (above it or below it). In this case we open the
definition, then change the URL, which subsequently tries to open the
definition again; seeing that the definition has been opened already the
fetch attempt is cancelled.

Author: hojberg

src/App.elm

@@ -134,10 +134,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
@@ -165,7 +175,7 @@ update msg ({ env } as model) =
             keydown model event
 
         OpenDefinition ref ->
-            openDefinition model ref
+            navigateToDefinition model ref
 
         ShowModal modal ->
             ( { model | modal = modal }, Cmd.none )
@@ -200,7 +210,7 @@ update msg ({ env } as model) =
             in
             case outMsg of
                 PerspectiveLanding.OpenDefinition ref ->
-                    openDefinition model2 ref
+                    navigateToDefinition model2 ref
 
                 PerspectiveLanding.ShowFinderRequest ->
                     showFinder model2 Nothing
@@ -227,7 +237,7 @@ update msg ({ env } as model) =
                                 model4 =
                                     { model2 | sidebarToggled = False }
                             in
-                            openDefinition model4 ref
+                            navigateToDefinition model4 ref
 
                         CodebaseTree.ChangePerspectiveToNamespace fqn ->
                             fqn
@@ -251,7 +261,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 )
@@ -268,19 +278,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 )
@@ -333,7 +333,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