Skip to content
This repository was archived by the owner on Jul 19, 2022. It is now read-only.

Commit 42f3789

Browse files
hojberghojberg
committed
Drive perspective changes off of Route changes
Instead of changing perspectives directly and fetching details before changing the URL; first change the URL and then change the `Perspective`. Ensure that we don't fetch the `Perspective` when changing URLs to the same `Perspective` with a different definition and ensure we correctly dedupe `WorkspaceItems` when we change `Perspective`. To support this add a bunch of helper functions: * Equality and sameness functions to `Reference`, `Perspective`, and `HashQualified` * List-like functions; `find`, `any`, and `all` to `WorkspaceItems` With regards to deduping `WorkspaceItems`, this is needed because when we change `Perspective` with any open defintions, we migrate the `WorkspaceItems` to be indexed by `Hash` instead of `FQN`, and then when the user subsequently uses the back button to the previous URL that was `FQN` based, we want to avoid re-fetching and duplicating the same item (their `Reference` are technically different in that one is `Hash` based and one is `FQN` based for the same `WorkspaceItem`). So as soon as we get the data back from the server and can see that it includes the `Hash` of an already fetched definition, we dedupe.
1 parent 89589e9 commit 42f3789

File tree

7 files changed

+302
-51
lines changed

7 files changed

+302
-51
lines changed

‎src/App.elm

Lines changed: 42 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -140,20 +140,32 @@ update msg ({ env } as model) =
140140
let
141141
route =
142142
Route.fromUrl env.basePath url
143+
144+
model2 =
145+
{ model | route = route }
146+
147+
newEnv params =
148+
{ env | perspective = Perspective.nextFromParams env.perspective params }
143149
in
144150
case route of
145-
Route.Definition _ ref ->
151+
Route.Definition params ref ->
146152
let
147153
( workspace, cmd ) =
148-
Workspace.open env model.workspace ref
154+
Workspace.open (newEnv params) model.workspace ref
155+
156+
model3 =
157+
{ model2 | workspace = workspace, env = newEnv params }
158+
159+
( model4, fetchPerspectiveCmd ) =
160+
fetchPerspective model3
149161
in
150-
( { model | route = route, workspace = workspace }, Cmd.map WorkspaceMsg cmd )
162+
( model4, Cmd.batch [ Cmd.map WorkspaceMsg cmd, fetchPerspectiveCmd ] )
151163

152-
_ ->
153-
( { model | route = route }, Cmd.none )
164+
Route.Perspective params ->
165+
fetchPerspective { model2 | env = newEnv params }
154166

155167
ChangePerspective perspective ->
156-
replacePerspective model perspective
168+
navigateToPerspective model perspective
157169

158170
FetchPerspectiveNamespaceDetailsFinished fqn details ->
159171
let
@@ -245,7 +257,7 @@ update msg ({ env } as model) =
245257
CodebaseTree.ChangePerspectiveToNamespace fqn ->
246258
fqn
247259
|> Perspective.toNamespacePerspective model.env.perspective
248-
|> replacePerspective model
260+
|> navigateToPerspective model
249261
in
250262
( model3, Cmd.batch [ cmd, Cmd.map CodebaseTreeMsg cCmd ] )
251263

@@ -286,15 +298,9 @@ navigateToDefinition model ref =
286298
( model, Route.navigateToDefinition model.navKey model.route ref )
287299

288300

289-
replacePerspective : Model -> Perspective -> ( Model, Cmd Msg )
290-
replacePerspective ({ env } as model) perspective =
301+
navigateToPerspective : Model -> Perspective -> ( Model, Cmd Msg )
302+
navigateToPerspective model perspective =
291303
let
292-
newEnv =
293-
{ env | perspective = perspective }
294-
295-
( codebaseTree, codebaseTreeCmd ) =
296-
CodebaseTree.init newEnv
297-
298304
-- Update all open references to be hash based to ensure that we can
299305
-- refresh the page and fetch them appropriately even if they are
300306
-- outside of the current perspective
@@ -310,20 +316,32 @@ replacePerspective ({ env } as model) perspective =
310316

311317
changeRouteCmd =
312318
Route.replacePerspective model.navKey (Perspective.toParams perspective) focusedReferenceRoute
319+
in
320+
( { model | workspace = workspace }, changeRouteCmd )
321+
322+
323+
fetchPerspective : Model -> ( Model, Cmd Msg )
324+
fetchPerspective ({ env } as model) =
325+
let
326+
( codebaseTree, codebaseTreeCmd ) =
327+
CodebaseTree.init env
313328

314329
fetchNamespaceDetailsCmd =
315-
perspective
330+
env.perspective
316331
|> fetchNamespaceDetails
317332
|> Maybe.map (Api.perform env.apiBasePath)
318333
|> Maybe.withDefault Cmd.none
319334
in
320-
( { model | env = newEnv, codebaseTree = codebaseTree, workspace = workspace }
321-
, Cmd.batch
322-
[ Cmd.map CodebaseTreeMsg codebaseTreeCmd
323-
, changeRouteCmd
324-
, fetchNamespaceDetailsCmd
325-
]
326-
)
335+
if Perspective.needsFetching env.perspective then
336+
( { model | codebaseTree = codebaseTree }
337+
, Cmd.batch
338+
[ Cmd.map CodebaseTreeMsg codebaseTreeCmd
339+
, fetchNamespaceDetailsCmd
340+
]
341+
)
342+
343+
else
344+
( model, Cmd.none )
327345

328346

329347
handleWorkspaceOutMsg : Model -> Workspace.OutMsg -> ( Model, Cmd Msg )
@@ -344,7 +362,7 @@ handleWorkspaceOutMsg model out =
344362
Workspace.ChangePerspectiveToNamespace fqn ->
345363
fqn
346364
|> Perspective.toNamespacePerspective model.env.perspective
347-
|> replacePerspective model
365+
|> navigateToPerspective model
348366

349367

350368
keydown : Model -> KeyboardEvent -> ( Model, Cmd Msg )

‎src/Definition/Reference.elm

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module Definition.Reference exposing (..)
22

33
import FullyQualifiedName exposing (FQN)
4+
import Hash exposing (Hash)
45
import HashQualified as HQ exposing (HashQualified)
56
import UI.Icon as Icon exposing (Icon)
67
import Url.Parser
@@ -36,6 +37,47 @@ urlParser toRef =
3637
-- HELPERS
3738

3839

40+
equals : Reference -> Reference -> Bool
41+
equals a b =
42+
case ( a, b ) of
43+
( TermReference aHq, TermReference bHq ) ->
44+
HQ.equals aHq bHq
45+
46+
( TypeReference aHq, TypeReference bHq ) ->
47+
HQ.equals aHq bHq
48+
49+
( AbilityConstructorReference aHq, AbilityConstructorReference bHq ) ->
50+
HQ.equals aHq bHq
51+
52+
( DataConstructorReference aHq, DataConstructorReference bHq ) ->
53+
HQ.equals aHq bHq
54+
55+
_ ->
56+
False
57+
58+
59+
{-| Like `equals`, but compares deeper such that a HashQualified with the same
60+
Hash as a HashOnly are considered the same
61+
-}
62+
same : Reference -> Reference -> Bool
63+
same a b =
64+
case ( a, b ) of
65+
( TermReference aHq, TermReference bHq ) ->
66+
HQ.same aHq bHq
67+
68+
( TypeReference aHq, TypeReference bHq ) ->
69+
HQ.same aHq bHq
70+
71+
( AbilityConstructorReference aHq, AbilityConstructorReference bHq ) ->
72+
HQ.same aHq bHq
73+
74+
( DataConstructorReference aHq, DataConstructorReference bHq ) ->
75+
HQ.same aHq bHq
76+
77+
_ ->
78+
False
79+
80+
3981
hashQualified : Reference -> HashQualified
4082
hashQualified ref =
4183
case ref of
@@ -57,6 +99,11 @@ fqn =
5799
hashQualified >> HQ.name
58100

59101

102+
hash : Reference -> Maybe Hash
103+
hash =
104+
hashQualified >> HQ.hash
105+
106+
60107

61108
-- TRANSFORM
62109

‎src/HashQualified.elm

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,11 @@
11
module HashQualified exposing
22
( HashQualified(..)
3+
, equals
34
, fromString
45
, fromUrlString
56
, hash
67
, name
8+
, same
79
, toString
810
, toUrlString
911
, urlParser
@@ -77,6 +79,54 @@ urlParser =
7779
-- HELPERS
7880

7981

82+
equals : HashQualified -> HashQualified -> Bool
83+
equals a b =
84+
case ( a, b ) of
85+
( NameOnly aFqn, NameOnly bFqn ) ->
86+
FQN.equals aFqn bFqn
87+
88+
( HashOnly aH, HashOnly bH ) ->
89+
Hash.equals aH bH
90+
91+
( HashQualified aFqn aH, HashQualified bFqn bH ) ->
92+
FQN.equals aFqn bFqn && Hash.equals aH bH
93+
94+
_ ->
95+
False
96+
97+
98+
{-| Like `equals`, but compares deeper such that a HashQualified with the same
99+
Hash as a HashOnly are considered the same, and HashQualified with the same FQN
100+
as a NameOnly are considered the same.
101+
-}
102+
same : HashQualified -> HashQualified -> Bool
103+
same a b =
104+
case ( a, b ) of
105+
( NameOnly aFqn, NameOnly bFqn ) ->
106+
FQN.equals aFqn bFqn
107+
108+
( HashOnly aH, HashOnly bH ) ->
109+
Hash.equals aH bH
110+
111+
( HashQualified aFqn aH, HashQualified bFqn bH ) ->
112+
FQN.equals aFqn bFqn && Hash.equals aH bH
113+
114+
( HashQualified _ aH, HashOnly bH ) ->
115+
Hash.equals aH bH
116+
117+
( HashOnly aH, HashQualified _ bH ) ->
118+
Hash.equals aH bH
119+
120+
( HashQualified aFqn _, NameOnly bFqn ) ->
121+
FQN.equals aFqn bFqn
122+
123+
( NameOnly aFqn, HashQualified bFqn _ ) ->
124+
FQN.equals aFqn bFqn
125+
126+
_ ->
127+
False
128+
129+
80130
name : HashQualified -> Maybe FQN
81131
name hq =
82132
case hq of

‎src/Perspective.elm

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,19 @@ fqn perspective =
4646
d.fqn
4747

4848

49+
equals : Perspective -> Perspective -> Bool
50+
equals a b =
51+
case ( a, b ) of
52+
( Codebase ah, Codebase bh ) ->
53+
Hash.equals ah bh
54+
55+
( Namespace ans, Namespace bns ) ->
56+
Hash.equals ans.codebaseHash bns.codebaseHash && FQN.equals ans.fqn bns.fqn
57+
58+
_ ->
59+
False
60+
61+
4962
{-| Even when we have a Codebase hash, we always constructor Relative params.
5063
Absolute is currently not supported (until Unison Share includes historic
5164
codebase), though the model allows it.
@@ -76,6 +89,53 @@ fromParams params =
7689
Just (Namespace { codebaseHash = h, fqn = fqn_, details = NotAsked })
7790

7891

92+
{-| Similar to `fromParams`, but requires a previous `Perspective` (with a
93+
codebase hash) to migrate from
94+
-}
95+
nextFromParams : Perspective -> PerspectiveParams -> Perspective
96+
nextFromParams perspective params =
97+
let
98+
codebaseHash_ =
99+
codebaseHash perspective
100+
in
101+
case ( params, perspective ) of
102+
( ByNamespace Relative fqn_, Namespace d ) ->
103+
if Hash.equals codebaseHash_ d.codebaseHash && FQN.equals fqn_ d.fqn then
104+
Namespace d
105+
106+
else
107+
Namespace { codebaseHash = codebaseHash_, fqn = fqn_, details = NotAsked }
108+
109+
( ByNamespace (Absolute h) fqn_, Namespace d ) ->
110+
if Hash.equals h d.codebaseHash && FQN.equals fqn_ d.fqn then
111+
Namespace d
112+
113+
else
114+
Namespace { codebaseHash = h, fqn = fqn_, details = NotAsked }
115+
116+
( ByNamespace Relative fqn_, _ ) ->
117+
Namespace { codebaseHash = codebaseHash_, fqn = fqn_, details = NotAsked }
118+
119+
( ByNamespace (Absolute h) fqn_, _ ) ->
120+
Namespace { codebaseHash = h, fqn = fqn_, details = NotAsked }
121+
122+
( ByCodebase Relative, _ ) ->
123+
Codebase codebaseHash_
124+
125+
( ByCodebase (Absolute h), _ ) ->
126+
Codebase h
127+
128+
129+
needsFetching : Perspective -> Bool
130+
needsFetching perspective =
131+
case perspective of
132+
Namespace d ->
133+
d.details == NotAsked
134+
135+
_ ->
136+
False
137+
138+
79139
isCodebasePerspective : Perspective -> Bool
80140
isCodebasePerspective perspective =
81141
case perspective of

0 commit comments

Comments
 (0)