permalink: support y and copy

Author: hojberg

src/Code2/Workspace/WorkspacePane.elm

@@ -567,6 +567,11 @@ openDependencies config paneId ({ workspaceItems } as model) dependenciesOfRef =
         )
 
 
+currentlyFocusedReference : Model -> Maybe WorkspaceItemRef
+currentlyFocusedReference model =
+    WorkspaceItems.focusedReference model.workspaceItems
+
+
 currentlyOpenReferences : Model -> List Reference
 currentlyOpenReferences model =
     WorkspaceItems.definitionReferences model.workspaceItems

src/Code2/Workspace/WorkspacePanes.elm

@@ -263,6 +263,16 @@ openDependenciesOf config model ref =
             ( { model | right = rightPane }, Cmd.map RightPaneMsg rightPaneCmd )
 
 
+currentlyFocusedReference : Model -> Maybe WorkspaceItemRef
+currentlyFocusedReference model =
+    case model.focusedPane of
+        LeftPaneFocus _ ->
+            WorkspacePane.currentlyFocusedReference model.left
+
+        RightPaneFocus ->
+            WorkspacePane.currentlyFocusedReference model.right
+
+
 currentlyOpenReferences : Model -> List Reference
 currentlyOpenReferences model =
     WorkspacePane.currentlyOpenReferences model.left

src/UnisonShare/Api.elm

@@ -19,7 +19,7 @@ import Maybe.Extra as MaybeE
 import Regex
 import Set exposing (Set)
 import UnisonShare.Account exposing (Account)
-import UnisonShare.CodeBrowsingContext exposing (CodeBrowsingContext(..))
+import UnisonShare.CodeBrowsingContext exposing (CodeBrowsingContext)
 import UnisonShare.Contribution exposing (ContributionStateToken(..))
 import UnisonShare.Contribution.ContributionRef as ContributionRef exposing (ContributionRef)
 import UnisonShare.Contribution.ContributionStatus as ContributionStatus exposing (ContributionStatus)
@@ -1308,19 +1308,17 @@ catalog =
 
 
 baseCodePathFromContext : CodeBrowsingContext -> List String
-baseCodePathFromContext context =
-    case context of
-        ProjectBranch pr br ->
-            let
-                ( handle, slug ) =
-                    ProjectRef.toApiStringParts pr
-            in
-            case br of
-                BranchRef.ReleaseBranchRef v ->
-                    [ "users", handle, "projects", slug, "releases", Version.toString v ]
+baseCodePathFromContext { projectRef, branchRef } =
+    let
+        ( handle, slug ) =
+            ProjectRef.toApiStringParts projectRef
+    in
+    case branchRef of
+        BranchRef.ReleaseBranchRef v ->
+            [ "users", handle, "projects", slug, "releases", Version.toString v ]
 
-                _ ->
-                    [ "users", handle, "projects", slug, "branches", BranchRef.toApiUrlString br ]
+        _ ->
+            [ "users", handle, "projects", slug, "branches", BranchRef.toApiUrlString branchRef ]
 
 
 namespace : CodeBrowsingContext -> Perspective -> FQN -> Endpoint

src/UnisonShare/CodeBrowsingContext.elm

@@ -4,15 +4,10 @@ import Code.BranchRef as BranchRef exposing (BranchRef)
 import UnisonShare.Project.ProjectRef as ProjectRef exposing (ProjectRef)
 
 
-type CodeBrowsingContext
-    = ProjectBranch ProjectRef BranchRef
-
-
-project : ProjectRef -> BranchRef -> CodeBrowsingContext
-project =
-    ProjectBranch
+type alias CodeBrowsingContext =
+    { projectRef : ProjectRef, branchRef : BranchRef }
 
 
 equals : CodeBrowsingContext -> CodeBrowsingContext -> Bool
-equals (ProjectBranch projectRefA branchRefA) (ProjectBranch projectRefB branchRefB) =
-    ProjectRef.equals projectRefA projectRefB && BranchRef.equals branchRefA branchRefB
+equals contextA contextB =
+    ProjectRef.equals contextA.projectRef contextB.projectRef && BranchRef.equals contextA.branchRef contextB.branchRef

src/UnisonShare/Page/CodePage.elm

@@ -1,5 +1,6 @@
-module UnisonShare.Page.CodePage exposing (..)
+port module UnisonShare.Page.CodePage exposing (..)
 
+import Code.BranchRef as BranchRef
 import Code.CodebaseTree as CodebaseTree
 import Code.Config exposing (Config)
 import Code.Definition.Reference exposing (Reference)
@@ -22,7 +23,7 @@ import UI.PageContent as PageContent exposing (PageContent)
 import UI.PageLayout as PageLayout exposing (PageLayout)
 import UI.Sidebar as Sidebar exposing (Sidebar)
 import UnisonShare.AppContext as AppContext exposing (AppContext)
-import UnisonShare.CodeBrowsingContext exposing (CodeBrowsingContext(..))
+import UnisonShare.CodeBrowsingContext exposing (CodeBrowsingContext)
 import UnisonShare.Page.CodePageContent as CodePageContent
 import UnisonShare.PageFooter as PageFooter
 import UnisonShare.Route as Route exposing (CodeRoute(..))
@@ -307,7 +308,7 @@ update appContext context codeRoute msg model =
                     ( model, Cmd.none )
 
         ( _, Keydown event ) ->
-            keydown appContext model event
+            keydown appContext context model event
 
         ( _, KeyboardShortcutMsg kMsg ) ->
             let
@@ -387,20 +388,43 @@ update appContext context codeRoute msg model =
 
                         WorkspacePanes.RequestPermalink ref ->
                             let
-                                perspective =
-                                    case model.config.perspective of
-                                        Perspective.Root { details } ->
-                                            case details of
-                                                RemoteData.Success (Namespace.Namespace _ hash _) ->
-                                                    Perspective.absoluteRootPerspective hash
-
-                                                _ ->
-                                                    model.config.perspective
-
-                                        _ ->
-                                            model.config.perspective
+                                nextRoute p =
+                                    Route.projectBranch
+                                        context.projectRef
+                                        context.branchRef
+                                        (Route.replacePerspective (Just ref) p)
                             in
-                            ( model, navigateToCode appContext context (Route.replacePerspective (Just ref) perspective) )
+                            if not (BranchRef.isReleaseBranchRef context.branchRef) && Perspective.isRootPerspective model.config.perspective then
+                                -- releases are already permalinks, so no need for
+                                -- permalinks when we are viewing a release
+                                let
+                                    perspective =
+                                        case model.config.perspective of
+                                            Perspective.Root { details } ->
+                                                case details of
+                                                    RemoteData.Success (Namespace.Namespace _ hash _) ->
+                                                        Perspective.absoluteRootPerspective hash
+
+                                                    _ ->
+                                                        model.config.perspective
+
+                                            _ ->
+                                                model.config.perspective
+                                in
+                                ( model
+                                , Cmd.batch
+                                    [ Route.navigate appContext.navKey (nextRoute perspective)
+                                    , copyToClipboard (Route.toUrlString (nextRoute perspective))
+                                    ]
+                                )
+
+                            else if BranchRef.isReleaseBranchRef context.branchRef then
+                                -- We do want to copy the release url though
+                                ( model, copyToClipboard (Route.toUrlString (nextRoute model.config.perspective)) )
+
+                            else
+                                -- Skip completely if within a perspective
+                                ( model, Cmd.none )
 
                         _ ->
                             ( model, Cmd.none )
@@ -572,8 +596,8 @@ routeReference route =
             Nothing
 
 
-keydown : AppContext -> Model -> KeyboardEvent -> ( Model, Cmd Msg )
-keydown appContext model keyboardEvent =
+keydown : AppContext -> CodeBrowsingContext -> Model -> KeyboardEvent -> ( Model, Cmd Msg )
+keydown appContext context model keyboardEvent =
     let
         shortcut =
             KeyboardShortcut.fromKeyboardEvent model.keyboardShortcut keyboardEvent
@@ -594,6 +618,43 @@ keydown appContext model keyboardEvent =
         KeyboardShortcut.Sequence _ Escape ->
             ( { model | modal = NoModal }, Cmd.none )
 
+        KeyboardShortcut.Sequence _ (Y _) ->
+            -- Releases are already permalinks, so no need for
+            -- permalinks when we are viewing a release
+            -- We also don't have the root hash from within a perspective
+            if not (BranchRef.isReleaseBranchRef context.branchRef) && Perspective.isRootPerspective model.config.perspective then
+                case model.content of
+                    WorkspacePage panes ->
+                        let
+                            perspective =
+                                case model.config.perspective of
+                                    Perspective.Root { details } ->
+                                        case details of
+                                            RemoteData.Success (Namespace.Namespace _ hash _) ->
+                                                Perspective.absoluteRootPerspective hash
+
+                                            _ ->
+                                                model.config.perspective
+
+                                    _ ->
+                                        model.config.perspective
+
+                            ref =
+                                case WorkspacePanes.currentlyFocusedReference panes of
+                                    Just (WorkspaceItemRef.DefinitionItemRef r) ->
+                                        Just r
+
+                                    _ ->
+                                        Nothing
+                        in
+                        ( model, navigateToCode appContext context (Route.replacePerspective ref perspective) )
+
+                    _ ->
+                        ( model, Cmd.none )
+
+            else
+                ( model, Cmd.none )
+
         _ ->
             if Finder.isShowFinderKeyboardShortcut appContext.operatingSystem shortcut then
                 let
@@ -611,15 +672,14 @@ keydown appContext model keyboardEvent =
 -- EFFECTS
 
 
+port copyToClipboard : String -> Cmd msg
+
+
 navigateToCode : AppContext -> CodeBrowsingContext -> CodeRoute -> Cmd Msg
-navigateToCode appContext context codeRoute =
-    let
-        route_ =
-            case context of
-                ProjectBranch ps bs ->
-                    Route.projectBranch ps bs codeRoute
-    in
-    Route.navigate appContext.navKey route_
+navigateToCode appContext { projectRef, branchRef } codeRoute =
+    Route.navigate
+        appContext.navKey
+        (Route.projectBranch projectRef branchRef codeRoute)
 
 
 

src/UnisonShare/Page/ProjectContributionChangesPage.elm

@@ -39,7 +39,6 @@ import UnisonShare.BranchDiff.DefinitionType as DefinitionType exposing (Definit
 import UnisonShare.BranchDiff.LibDep as LibDep exposing (LibDep)
 import UnisonShare.BranchDiff.ToggledChangeLines as ToggledChangeLines exposing (ToggledChangeLines)
 import UnisonShare.BranchDiffState as BranchDiffState exposing (BranchDiffState)
-import UnisonShare.CodeBrowsingContext as CodeBrowsingContext
 import UnisonShare.Contribution exposing (ContributionDetails)
 import UnisonShare.Contribution.ContributionRef exposing (ContributionRef)
 import UnisonShare.DefinitionDiff as DefinitionDiff
@@ -235,7 +234,7 @@ update appContext projectRef contribRef msg model =
                         config =
                             AppContext.toCodeConfig
                                 appContext
-                                (CodeBrowsingContext.ProjectBranch projectRef bd.oldBranch.ref)
+                                { projectRef = projectRef, branchRef = bd.oldBranch.ref }
                                 (Perspective.absoluteRootPerspective bd.oldBranch.hash)
 
                         ( definitionSummaryTooltip, tCmd ) =
@@ -255,7 +254,7 @@ update appContext projectRef contribRef msg model =
                         config =
                             AppContext.toCodeConfig
                                 appContext
-                                (CodeBrowsingContext.ProjectBranch projectRef bd.newBranch.ref)
+                                { projectRef = projectRef, branchRef = bd.newBranch.ref }
                                 (Perspective.absoluteRootPerspective bd.newBranch.hash)
 
                         ( definitionSummaryTooltip, tCmd ) =

src/UnisonShare/Page/ProjectOverviewPage.elm

@@ -46,7 +46,6 @@ import UI.Tag as Tag
 import UI.Tooltip as Tooltip
 import UnisonShare.Api as ShareApi
 import UnisonShare.AppContext as AppContext exposing (AppContext)
-import UnisonShare.CodeBrowsingContext as CodeBrowsingContext exposing (CodeBrowsingContext(..))
 import UnisonShare.Link as Link
 import UnisonShare.PageFooter as PageFooter
 import UnisonShare.Project as Project exposing (ProjectDetails)
@@ -171,12 +170,12 @@ update appContext projectRef project msg model =
             case project of
                 Success p ->
                     AppContext.toCodeConfig appContext
-                        (CodeBrowsingContext.project projectRef (Project.defaultBrowsingBranch p))
+                        { projectRef = projectRef, branchRef = Project.defaultBrowsingBranch p }
                         Perspective.relativeRootPerspective
 
                 _ ->
                     AppContext.toCodeConfig appContext
-                        (CodeBrowsingContext.project projectRef BranchRef.main_)
+                        { projectRef = projectRef, branchRef = BranchRef.main_ }
                         Perspective.relativeRootPerspective
     in
     case msg of
@@ -458,7 +457,7 @@ fetchDependencies : AppContext -> ProjectRef -> BranchRef -> Cmd Msg
 fetchDependencies appContext projectRef branchRef =
     let
         browsingContext =
-            ProjectBranch projectRef branchRef
+            { projectRef = projectRef, branchRef = branchRef }
 
         perspective =
             Perspective.relativeRootPerspective

src/UnisonShare/Page/ProjectPage.elm

@@ -33,7 +33,6 @@ import UnisonShare.Api as ShareApi
 import UnisonShare.AppContext exposing (AppContext)
 import UnisonShare.AppDocument exposing (AppDocument)
 import UnisonShare.AppHeader as AppHeader
-import UnisonShare.CodeBrowsingContext as CodeBrowsingContext
 import UnisonShare.Contribution.ContributionRef as ContributionRef exposing (ContributionRef)
 import UnisonShare.Contribution.ContributionStatus as ContributionStatus
 import UnisonShare.Page.CodePage as CodePage
@@ -116,7 +115,7 @@ init appContext projectRef route =
                 ProjectBranch branchRef codeRoute ->
                     let
                         codeBrowsingContext =
-                            CodeBrowsingContext.project projectRef branchRef
+                            { projectRef = projectRef, branchRef = branchRef }
 
                         ( codePage, codePageCmd ) =
                             CodePage.init appContext codeBrowsingContext codeRoute
@@ -233,8 +232,8 @@ type Msg
 update : AppContext -> ProjectRef -> ProjectRoute -> Msg -> Model -> ( Model, Cmd Msg )
 update appContext projectRef route msg model =
     let
-        codeBrowsingContext bs =
-            CodeBrowsingContext.project projectRef bs
+        codeBrowsingContext br =
+            { projectRef = projectRef, branchRef = br }
     in
     case ( model.subPage, msg ) of
         ( _, ChangeRouteTo r ) ->
@@ -746,7 +745,7 @@ updateSubPage : AppContext -> ProjectRef -> Model -> ProjectRoute -> ( Model, Cm
 updateSubPage appContext projectRef model route =
     let
         codeBrowsingContext br =
-            CodeBrowsingContext.project projectRef br
+            { projectRef = projectRef, branchRef = br }
 
         newCodePage branchRef codeRoute =
             let

src/UnisonShare/Page/ProjectReleasePage.elm

@@ -28,7 +28,6 @@ import UI.Placeholder as Placeholder
 import UI.StatusBanner as StatusBanner
 import UnisonShare.Api as ShareApi
 import UnisonShare.AppContext as AppContext exposing (AppContext)
-import UnisonShare.CodeBrowsingContext as CodeBrowsingContext
 import UnisonShare.InteractiveDoc as InteractiveDoc
 import UnisonShare.Link as Link
 import UnisonShare.PageFooter as PageFooter
@@ -124,7 +123,7 @@ update appContext projectRef msg model =
                         config =
                             AppContext.toCodeConfig
                                 appContext
-                                (CodeBrowsingContext.project projectRef (Release.branchRef release))
+                                { projectRef = projectRef, branchRef = Release.branchRef release }
                                 Perspective.relativeRootPerspective
 
                         ( interactiveDoc, cmd, iOutMsg ) =

src/UnisonShare/Page/ProjectReleasesPage.elm

@@ -38,7 +38,6 @@ import UI.Tag as Tag
 import UnisonShare.Api as ShareApi
 import UnisonShare.AppContext as AppContext exposing (AppContext)
 import UnisonShare.BranchSummary as BranchSummary exposing (BranchSummary)
-import UnisonShare.CodeBrowsingContext as CodeBrowsingContext
 import UnisonShare.InteractiveDoc as InteractiveDoc
 import UnisonShare.Link as Link
 import UnisonShare.PageFooter as PageFooter
@@ -275,7 +274,7 @@ update appContext projectRef msg model =
                                 config =
                                     AppContext.toCodeConfig
                                         appContext
-                                        (CodeBrowsingContext.project projectRef (Release.branchRef latest))
+                                        { projectRef = projectRef, branchRef = Release.branchRef latest }
                                         Perspective.relativeRootPerspective
 
                                 ( interactiveDoc, cmd, iOutMsg ) =