Add a project route for Unison Share

Move the perspective routes into 1 route with 2 subroutes: Project with
ProjectRoute.

Author: hojberg

src/UnisonShare/App.elm

@@ -61,7 +61,7 @@ init env route navKey =
     let
         ( workspace, workspaceCmd ) =
             case route of
-                Route.Definition _ ref ->
+                Route.Project (Route.ProjectDefinition _ ref) ->
                     Workspace.init env (Just ref)
 
                 _ ->
@@ -156,7 +156,7 @@ update msg ({ env } as model) =
                     in
                     ( { model2 | catalog = catalog }, Cmd.map CatalogMsg cmd )
 
-                Route.Definition params ref ->
+                Route.Project (Route.ProjectDefinition params ref) ->
                     let
                         ( workspace, cmd ) =
                             Workspace.open (newEnv params) model.workspace ref
@@ -169,7 +169,7 @@ update msg ({ env } as model) =
                     in
                     ( model4, Cmd.batch [ Cmd.map WorkspaceMsg cmd, fetchPerspectiveCmd ] )
 
-                Route.Perspective params ->
+                Route.Project (Route.ProjectRoot params) ->
                     fetchPerspectiveAndCodebaseTree env.perspective { model2 | env = newEnv params }
 
         ( _, ChangePerspective perspective ) ->
@@ -233,27 +233,20 @@ update msg ({ env } as model) =
             in
             ( { model | catalog = catalog }, Cmd.map CatalogMsg cmd )
 
-        ( _, WorkspaceMsg wMsg ) ->
-            -- TODO: Clean this up, there should be a top level Project route
-            -- instead of 2 separate workspace routes (perspective and
-            -- definition)
-            if model.route /= Route.Catalog then
-                let
-                    ( workspace, wCmd, outMsg ) =
-                        Workspace.update env wMsg model.workspace
-
-                    model2 =
-                        { model | workspace = workspace }
+        ( Route.Project _, WorkspaceMsg wMsg ) ->
+            let
+                ( workspace, wCmd, outMsg ) =
+                    Workspace.update env wMsg model.workspace
 
-                    ( model3, cmd ) =
-                        handleWorkspaceOutMsg model2 outMsg
-                in
-                ( model3, Cmd.batch [ cmd, Cmd.map WorkspaceMsg wCmd ] )
+                model2 =
+                    { model | workspace = workspace }
 
-            else
-                ( model, Cmd.none )
+                ( model3, cmd ) =
+                    handleWorkspaceOutMsg model2 outMsg
+            in
+            ( model3, Cmd.batch [ cmd, Cmd.map WorkspaceMsg wCmd ] )
 
-        ( _, PerspectiveLandingMsg rMsg ) ->
+        ( Route.Project (Route.ProjectRoot _), PerspectiveLandingMsg rMsg ) ->
             let
                 ( perspectiveLanding, outMsg ) =
                     PerspectiveLanding.update rMsg model.perspectiveLanding
@@ -271,7 +264,7 @@ update msg ({ env } as model) =
                 PerspectiveLanding.None ->
                     ( model2, Cmd.none )
 
-        ( _, CodebaseTreeMsg cMsg ) ->
+        ( Route.Project _, CodebaseTreeMsg cMsg ) ->
             let
                 ( codebaseTree, cCmd, outMsg ) =
                     CodebaseTree.update env cMsg model.codebaseTree
@@ -690,7 +683,7 @@ view model =
                 Route.Catalog ->
                     Html.map CatalogMsg (Catalog.view model.catalog)
 
-                Route.Perspective _ ->
+                Route.Project (Route.ProjectRoot _) ->
                     Html.map PerspectiveLandingMsg
                         (PerspectiveLanding.view
                             model.env
@@ -699,7 +692,7 @@ view model =
                         |> withSidebar
                         |> PageLayout.view
 
-                Route.Definition _ _ ->
+                Route.Project (Route.ProjectDefinition _ _) ->
                     Html.map WorkspaceMsg (Workspace.view model.workspace)
                         |> withSidebar
                         |> PageLayout.view

src/UnisonShare/Route.elm

@@ -1,5 +1,6 @@
 module UnisonShare.Route exposing
-    ( Route(..)
+    ( ProjectRoute(..)
+    , Route(..)
     , forProject
     , fromUrl
     , navigate
@@ -73,10 +74,14 @@ import Url.Builder exposing (relative)
 -}
 
 
+type ProjectRoute
+    = ProjectRoot PerspectiveParams
+    | ProjectDefinition PerspectiveParams Reference
+
+
 type Route
     = Catalog
-    | Perspective PerspectiveParams
-    | Definition PerspectiveParams Reference
+    | Project ProjectRoute
 
 
 updatePerspectiveParams : Route -> PerspectiveParams -> Route
@@ -85,11 +90,11 @@ updatePerspectiveParams route params =
         Catalog ->
             Catalog
 
-        Perspective _ ->
-            Perspective params
+        Project (ProjectRoot _) ->
+            Project (ProjectRoot params)
 
-        Definition _ ref ->
-            Definition params ref
+        Project (ProjectDefinition _ ref) ->
+            Project (ProjectDefinition params ref)
 
 
 
@@ -103,12 +108,12 @@ catalog =
 
 perspective : Parser Route
 perspective =
-    succeed Perspective |. slash |= RP.perspectiveParams |. end
+    succeed (ProjectRoot >> Project) |. slash |= RP.perspectiveParams |. end
 
 
 definition : Parser Route
 definition =
-    succeed Definition |. slash |= RP.perspectiveParams |. slash |= reference |. end
+    succeed (\pp r -> Project (ProjectDefinition pp r)) |. slash |= RP.perspectiveParams |. slash |= reference |. end
 
 
 toRoute : Parser Route
@@ -149,7 +154,7 @@ fromUrl basePath url =
                 "/" ++ path
 
         parse url_ =
-            Result.withDefault (Perspective (ByCodebase Relative)) (Parser.run toRoute url_)
+            Result.withDefault (Project (ProjectRoot (ByCodebase Relative))) (Parser.run toRoute url_)
     in
     url
         |> .path
@@ -168,11 +173,11 @@ perspectiveParams route =
         Catalog ->
             Nothing
 
-        Perspective nsRef ->
-            Just nsRef
+        Project (ProjectRoot pp) ->
+            Just pp
 
-        Definition nsRef _ ->
-            Just nsRef
+        Project (ProjectDefinition pp _) ->
+            Just pp
 
 
 
@@ -185,7 +190,7 @@ forProject project_ =
         fqn =
             FQN.cons (Project.ownerToString project_.owner) project_.name
     in
-    Perspective (Perspective.ByNamespace Relative fqn)
+    Project (ProjectRoot (Perspective.ByNamespace Relative fqn))
 
 
 
@@ -200,7 +205,7 @@ toDefinition oldRoute ref =
                 |> perspectiveParams
                 |> Maybe.withDefault (ByCodebase Relative)
     in
-    Definition params ref
+    Project (ProjectDefinition params ref)
 
 
 toUrlString : Route -> String
@@ -253,10 +258,10 @@ toUrlString route =
                 Catalog ->
                     [ "catalog" ]
 
-                Perspective pp ->
+                Project (ProjectRoot pp) ->
                     perspectiveParamsToPath pp False
 
-                Definition pp ref ->
+                Project (ProjectDefinition pp ref) ->
                     case ref of
                         TypeReference hq ->
                             perspectiveParamsToPath pp True ++ ("types" :: hqToPath hq)
@@ -284,9 +289,13 @@ navigate navKey route =
         |> Nav.pushUrl navKey
 
 
+
+-- TODO: this should go away in UnisonShare
+
+
 navigateToPerspective : Nav.Key -> PerspectiveParams -> Cmd msg
 navigateToPerspective navKey perspectiveParams_ =
-    navigate navKey (Perspective perspectiveParams_)
+    navigate navKey (Project (ProjectRoot perspectiveParams_))
 
 
 navigateToCurrentPerspective : Nav.Key -> Route -> Cmd msg
@@ -310,6 +319,10 @@ navigateToDefinition navKey currentRoute reference =
     navigate navKey (toDefinition currentRoute reference)
 
 
+
+-- TODO: This should go away in UnisonShare
+
+
 replacePerspective : Nav.Key -> PerspectiveParams -> Route -> Cmd msg
 replacePerspective navKey perspectiveParams_ oldRoute =
     let
@@ -318,10 +331,10 @@ replacePerspective navKey perspectiveParams_ oldRoute =
                 Catalog ->
                     Catalog
 
-                Perspective _ ->
-                    Perspective perspectiveParams_
+                Project (ProjectRoot _) ->
+                    Project (ProjectRoot perspectiveParams_)
 
-                Definition _ ref ->
-                    Definition perspectiveParams_ ref
+                Project (ProjectDefinition _ ref) ->
+                    Project (ProjectDefinition perspectiveParams_ ref)
     in
     navigate navKey newRoute