diff --git a/src/Client/App.fs b/src/Client/App.fs index 9bccd8a..5e836b4 100644 --- a/src/Client/App.fs +++ b/src/Client/App.fs @@ -123,13 +123,9 @@ let filterDeletedPaths (deleted: Set) (repos: RepoModel list) = { r with Worktrees = r.Worktrees |> List.filter (fun wt -> not (Set.contains (WorktreePath.value wt.Path) deleted)) }) let findWorktree (scopedKey: string) (model: Model) = - let parts = scopedKey.Split('/', 2) - if parts.Length < 2 then None - else - let repoId, branch = parts[0], parts[1] - model.Repos - |> List.tryFind (fun r -> RepoId.value r.RepoId = repoId) - |> Option.bind (fun r -> r.Worktrees |> List.tryFind (fun wt -> wt.Branch = branch)) + model.Repos + |> List.tryPick (fun r -> + r.Worktrees |> List.tryFind (fun wt -> WorktreePath.value wt.Path = scopedKey)) let removeFromRepos (path: WorktreePath) (repos: RepoModel list) = let pathStr = WorktreePath.value path @@ -258,7 +254,7 @@ let update msg model = if r.RepoId = repoId then { r with IsCollapsed = not r.IsCollapsed } else r) } let focusAdjusted = - if isCollapsing then adjustFocusAfterCollapse repoId updatedModel.FocusedElement + if isCollapsing then adjustFocusAfterCollapse repoId updatedModel.Repos updatedModel.FocusedElement else updatedModel.FocusedElement let collapsedRepos = updatedModel.Repos @@ -1109,12 +1105,13 @@ let prRow dispatch (cooldowns: Set) (wt: WorktreeStatus) (repoName let workMetricsView = Components.workMetricsView let workMetricsItems = Components.workMetricsItems let FitOrHide = Components.FitOrHide +let cardTitle = Components.cardTitle let compactWorktreeCard dispatch editorName (repoName: string) (baseBranch: string) (cooldowns: Set) (scopedKey: string) (isFocused: bool) (wt: WorktreeStatus) = let baseClass = cardClassName wt + " compact" let className = if isFocused then baseClass + " focused" else baseClass Html.div [ - prop.key wt.Branch + prop.key (WorktreePath.value wt.Path) prop.className className prop.onClick (fun _ -> dispatch (SetFocus (Some (Card scopedKey)))) prop.children [ @@ -1125,7 +1122,7 @@ let compactWorktreeCard dispatch editorName (repoName: string) (baseBranch: stri prop.className "header-info" prop.children [ Html.span [ prop.className ($"ct-dot {ctClassName wt.CodingTool}"); prop.title (ctTooltip wt.CodingTool) ] - Html.span [ prop.className "branch-name"; prop.text wt.Branch ] + Html.span [ prop.className "branch-name"; prop.text (cardTitle wt) ] FitOrHide (workMetricsItems wt.WorkMetrics) ] ] @@ -1155,7 +1152,7 @@ let worktreeCard dispatch editorName (repoName: string) (baseBranch: string) (co let hasContent = wt.LastUserMessage.IsSome || (not (List.isEmpty branchEvents)) let footerClass = if hasContent then "card-footer has-content" else "card-footer" Html.div [ - prop.key wt.Branch + prop.key (WorktreePath.value wt.Path) prop.className className prop.onClick (fun _ -> dispatch (SetFocus (Some (Card scopedKey)))) prop.children [ @@ -1169,7 +1166,7 @@ let worktreeCard dispatch editorName (repoName: string) (baseBranch: string) (co prop.className "header-info" prop.children [ Html.span [ prop.className ($"ct-dot {ctClassName wt.CodingTool}"); prop.title (ctTooltip wt.CodingTool) ] - Html.span [ prop.className "branch-name"; prop.text wt.Branch ] + Html.span [ prop.className "branch-name"; prop.text (cardTitle wt) ] FitOrHide (workMetricsItems wt.WorkMetrics) ] ] @@ -1218,7 +1215,7 @@ let worktreeCard dispatch editorName (repoName: string) (baseBranch: string) (co ] let renderCard dispatch editorName isCompact (focusedElement: FocusTarget option) repoId repoName baseBranch (branchEvents: Map) (syncPending: Set) (cooldowns: Set) (wt: WorktreeStatus) = - let scopedKey = $"{repoId}/{wt.Branch}" + let scopedKey = WorktreePath.value wt.Path let events = branchEvents |> Map.tryFind scopedKey |> Option.defaultValue [] let isPending = syncPending |> Set.contains scopedKey let isFocused = focusedElement = Some (Card scopedKey) diff --git a/src/Client/ArchiveViews.fs b/src/Client/ArchiveViews.fs index 9f0aec1..bd1ca5b 100644 --- a/src/Client/ArchiveViews.fs +++ b/src/Client/ArchiveViews.fs @@ -44,10 +44,10 @@ let archiveIcon = let archiveCard dispatch (wt: WorktreeStatus) = Html.div [ - prop.key wt.Branch + prop.key (WorktreePath.value wt.Path) prop.className "archive-card" prop.children [ - Html.span [ prop.className "branch-name"; prop.text wt.Branch ] + Html.span [ prop.className "branch-name"; prop.text (cardTitle wt) ] workMetricsView wt.WorkMetrics Html.span [ prop.className "commit-time"; prop.text (relativeTime System.DateTimeOffset.Now wt.LastCommitTime) ] Html.button [ diff --git a/src/Client/Components.fs b/src/Client/Components.fs index 8a21e29..dd152e8 100644 --- a/src/Client/Components.fs +++ b/src/Client/Components.fs @@ -13,6 +13,10 @@ let relativeTime (now: System.DateTimeOffset) (dt: System.DateTimeOffset) = | d when d.TotalHours < 24.0 -> $"{int d.TotalHours}h ago" | d -> $"{int d.TotalDays}d ago" +let cardTitle (wt: WorktreeStatus) = + if wt.Branch = WorktreeStatus.DetachedBranchName then WorktreePath.displayName wt.Path + else wt.Branch + // ResizeObserver interop [] let private createResizeObserver (callback: obj -> unit) : obj = jsNative diff --git a/src/Client/Navigation.fs b/src/Client/Navigation.fs index 4529c6f..d3bbfb3 100644 --- a/src/Client/Navigation.fs +++ b/src/Client/Navigation.fs @@ -6,7 +6,7 @@ open Fable.Core.JsInterop type FocusTarget = | RepoHeader of RepoId - | Card of scopedKey: string + | Card of path: string type RepoModel = { RepoId: RepoId @@ -31,11 +31,10 @@ type RepoNav = let visibleFocusTargets (repos: RepoModel list) = repos |> List.collect (fun repo -> - let repoId = RepoId.value repo.RepoId let header = RepoHeader repo.RepoId if repo.IsCollapsed then [ header ] else - header :: (repo.Worktrees |> List.map (fun wt -> Card $"{repoId}/{wt.Branch}"))) + header :: (repo.Worktrees |> List.map (fun wt -> Card (WorktreePath.value wt.Path)))) let getColumnCount () = Dom.document.querySelector ".card-grid" @@ -48,12 +47,11 @@ let getColumnCount () = let repoNavSections (repos: RepoModel list) = repos |> List.map (fun repo -> - let repoId = RepoId.value repo.RepoId { RepoId = repo.RepoId Header = RepoHeader repo.RepoId Cards = if repo.IsCollapsed then [] - else repo.Worktrees |> List.map (fun wt -> Card $"{repoId}/{wt.Branch}") }) + else repo.Worktrees |> List.map (fun wt -> Card (WorktreePath.value wt.Path)) }) let navigateLinear (direction: int) (targets: FocusTarget list) (current: FocusTarget option) = match targets, current with @@ -217,12 +215,13 @@ let navigateToLast (repos: RepoModel list) = | [] -> None | _ -> Some (List.last targets) -let adjustFocusAfterCollapse (collapsedRepoId: RepoId) (focusedElement: FocusTarget option) = +let adjustFocusAfterCollapse (collapsedRepoId: RepoId) (repos: RepoModel list) (focusedElement: FocusTarget option) = match focusedElement with - | Some (Card scopedKey) -> - let repoIdStr = RepoId.value collapsedRepoId - if scopedKey.StartsWith(repoIdStr + "/") then Some (RepoHeader collapsedRepoId) - else focusedElement + | Some (Card path) -> + repos + |> List.tryFind (fun r -> r.RepoId = collapsedRepoId) + |> Option.exists (fun r -> r.Worktrees |> List.exists (fun wt -> WorktreePath.value wt.Path = path)) + |> fun belongs -> if belongs then Some (RepoHeader collapsedRepoId) else focusedElement | other -> other let adjustFocusForVisibility (repos: RepoModel list) (focusedElement: FocusTarget option) = diff --git a/src/Server/DemoFixture.fs b/src/Server/DemoFixture.fs index b2dca6d..7848fcc 100644 --- a/src/Server/DemoFixture.fs +++ b/src/Server/DemoFixture.fs @@ -56,6 +56,10 @@ let private withCardEvt branch cardEvt (fix: FixtureData) = let private azDoEvt = "C:\\code\\CloudPlatform" let private githubEvt = "C:\\code\\DataPipeline" +let private retryKey = WorktreePath.value (azDoPath "feature-retry") +let private configKey = WorktreePath.value (azDoPath "refactor-config") +let private authKey = WorktreePath.value (azDoPath "feature-auth") +let private streamKey = WorktreePath.value (githubPath "streaming") // --- PRs (retry-logic cycles, others static) --- @@ -312,13 +316,13 @@ let private baseSchedulerEvents: CardEvent list = let private retryEvt msg secsAgo = evt "claude" msg secsAgo let private baseSyncStatus: Map = - [ $"{azDoEvt}/feature/retry-logic", + [ retryKey, [ retryEvt "Reading BlobStorageClient retry logic" 3 None None ] - $"{azDoEvt}/refactor/config-loading", + configKey, [ evt "claude" "Extracting config validation rules" 8 None None ] - $"{azDoEvt}/feature/auth-middleware", + authKey, [ evt "copilot" "All tests passing" 5 None None ] - $"{githubEvt}/feature/streaming-agg", + streamKey, [ evt "copilot" "Implementing tumbling window support" 5 None None ] ] |> Map.ofList @@ -378,7 +382,7 @@ let private f2 = let private f3 = f2 |> withAuth (fun wt -> { wt with CodingTool = Working }) - |> withCardEvt $"{azDoEvt}/feature/auth-middleware" + |> withCardEvt authKey (evt "copilot" "Reading authorization middleware" 1 None None) |> withCpu 45.0 14800 @@ -386,14 +390,14 @@ let private f3 = let private f4 = f3 |> withRetry (fun wt -> { wt with Pr = HasPr prRetryFailed }) - |> withCardEvt $"{azDoEvt}/feature/retry-logic" + |> withCardEvt retryKey (retryEvt "CI build failed — analyzing test results" 1 None None) |> withCpu 58.0 15200 // F5 (8-10s): Auth copilot progresses let private f5 = f4 - |> withCardEvt $"{azDoEvt}/feature/auth-middleware" + |> withCardEvt authKey (evt "copilot" "Generating role-based access checks" 1 None None) |> withCpu 72.0 16100 @@ -404,7 +408,7 @@ let private f6 = { wt with LastCommitMessage = "Fix flaky retry test timing" Pr = HasPr prRetryRebuilding }) - |> withCardEvt $"{azDoEvt}/feature/retry-logic" + |> withCardEvt retryKey (retryEvt "Pushed fix, waiting for CI" 1 None None) |> withCpu 84.0 17400 @@ -421,7 +425,7 @@ let private f7 = let private f8 = f7 |> withAuth (fun wt -> { wt with CodingTool = Done }) - |> withCardEvt $"{azDoEvt}/feature/auth-middleware" + |> withCardEvt authKey (evt "copilot" "All tests passing" 5 None None) |> withCpu 52.0 15800 @@ -429,7 +433,7 @@ let private f8 = let private f9 = f8 |> withRetry (fun wt -> { wt with Pr = HasPr prRetrySucceeded }) - |> withCardEvt $"{azDoEvt}/feature/retry-logic" + |> withCardEvt retryKey (retryEvt "All tests passing — task complete" 1 None None) |> withCpu 41.0 15200 @@ -447,7 +451,7 @@ let private f11 = f10 |> withRetry (fun wt -> { wt with LastUserMessage = Some("add request deduplication", baseTimestamp.AddMinutes(-1.0)) }) - |> withCardEvt $"{azDoEvt}/feature/retry-logic" + |> withCardEvt retryKey (retryEvt "Starting next task: request deduplication" 1 None None) |> withCpu 39.0 14400 diff --git a/src/Server/GitWorktree.fs b/src/Server/GitWorktree.fs index 4a3f8d4..92de810 100644 --- a/src/Server/GitWorktree.fs +++ b/src/Server/GitWorktree.fs @@ -4,8 +4,8 @@ open System open System.IO open System.Runtime.InteropServices open FsToolkit.ErrorHandling +open Shared -let [] DetachedBranchName = "(detached)" type WorktreeInfo = { Path: string @@ -231,7 +231,7 @@ let collectWorktreeGitData (worktreePath: string) (branch: string option) (mainR return { Path = worktreePath - Branch = branch |> Option.defaultValue DetachedBranchName + Branch = branch |> Option.defaultValue WorktreeStatus.DetachedBranchName LastCommitMessage = commit |> Option.map _.Message |> Option.defaultValue "" LastCommitTime = commit |> Option.map _.Time |> Option.defaultValue DateTimeOffset.MinValue UpstreamBranch = upstreamBranch diff --git a/src/Server/WorktreeApi.fs b/src/Server/WorktreeApi.fs index ec84a32..d609759 100644 --- a/src/Server/WorktreeApi.fs +++ b/src/Server/WorktreeApi.fs @@ -64,7 +64,7 @@ let private assembleFromState let pr = PrStatus.lookupPrStatus repo.PrData upstreamBranch { Path = PathUtils.toWorktreePath wt.Path - Branch = wt.Branch |> Option.defaultValue GitWorktree.DetachedBranchName + Branch = wt.Branch |> Option.defaultValue WorktreeStatus.DetachedBranchName LastCommitMessage = gitData |> Option.map (_.LastCommitMessage) |> Option.defaultValue "" LastCommitTime = gitData |> Option.map (_.LastCommitTime) |> Option.defaultValue DateTimeOffset.MinValue Beads = beads @@ -423,22 +423,22 @@ let worktreeApi async { let! state = agent.PostAndAsyncReply(RefreshScheduler.StateMsg.GetState) - let branchToScopedKey = + let syncKeyToPath = state.Repos |> Map.toList |> List.collect (fun (repoId, repo) -> repo.WorktreeList |> List.map (fun wt -> let branch = wt.Branch |> Option.defaultValue (detachedBranchLabel wt.Path) - let key = scopedBranchKey repoId branch - key, wt.Path)) + let syncKey = scopedBranchKey repoId branch + syncKey, wt.Path)) |> Map.ofList let! syncEvents = syncAgent.PostAndAsyncReply(SyncEngine.GetAllEvents) let allKeys = [ yield! syncEvents |> Map.keys - yield! branchToScopedKey |> Map.keys ] + yield! syncKeyToPath |> Map.keys ] |> List.distinct let cachedLastMessages = @@ -453,29 +453,31 @@ let worktreeApi return allKeys - |> List.choose (fun key -> + |> List.choose (fun syncKey -> + let wtPath = syncKeyToPath |> Map.tryFind syncKey + let syncEvts = syncEvents - |> Map.tryFind key + |> Map.tryFind syncKey |> Option.defaultValue [] let claudeEvt = - branchToScopedKey - |> Map.tryFind key - |> Option.bind (fun wtPath -> cachedLastMessages |> Map.tryFind wtPath) + wtPath + |> Option.bind (fun p -> cachedLastMessages |> Map.tryFind p) let merged = (claudeEvt |> Option.toList) @ syncEvts - match merged with - | [] -> None - | events -> + match merged, wtPath with + | [], _ -> None + | events, Some path -> let recent = events |> List.sortByDescending _.Timestamp |> List.truncate 2 |> List.rev - Some(key, recent)) + Some(path, recent) + | _, None -> None) |> Map.ofList } deleteWorktree = deleteWorktree agent rootPaths diff --git a/src/Shared/Types.fs b/src/Shared/Types.fs index 380c267..029c268 100644 --- a/src/Shared/Types.fs +++ b/src/Shared/Types.fs @@ -15,6 +15,10 @@ type WorktreePath = WorktreePath of string module WorktreePath = let value (WorktreePath p) = p + let displayName (WorktreePath p) = + let i = max (p.LastIndexOf '/') (p.LastIndexOf '\\') + if i < 0 then p else p[i + 1..] + type BranchName = BranchName of string module BranchName = @@ -123,6 +127,9 @@ type WorktreeStatus = IsMainWorktree: bool IsArchived: bool } +module WorktreeStatus = + let [] DetachedBranchName = "(detached)" + [] type StepStatus = | Pending diff --git a/src/Tests/ArchiveTests.fs b/src/Tests/ArchiveTests.fs index 88a2e5b..7d8ac53 100644 --- a/src/Tests/ArchiveTests.fs +++ b/src/Tests/ArchiveTests.fs @@ -276,10 +276,10 @@ type NavigationArchiveTests() = | Card key -> $"card:{key}") Assert.That(targetStrings, Does.Contain("header:TestRepo")) - Assert.That(targetStrings, Does.Contain("card:TestRepo/main")) - Assert.That(targetStrings, Does.Contain("card:TestRepo/feature-x")) - Assert.That(targetStrings, Does.Not.Contain("card:TestRepo/old-branch")) - Assert.That(targetStrings, Does.Not.Contain("card:TestRepo/stale-feature")) + Assert.That(targetStrings, Does.Contain("card:/repo/main")) + Assert.That(targetStrings, Does.Contain("card:/repo/feature-x")) + Assert.That(targetStrings, Does.Not.Contain("card:/repo/old-branch")) + Assert.That(targetStrings, Does.Not.Contain("card:/repo/stale-feature")) [] member _.``visibleFocusTargets with only archived worktrees shows only header``() = @@ -303,7 +303,7 @@ type NavigationArchiveTests() = let sections = repoNavSections repos Assert.That(sections.Length, Is.EqualTo(1)) - Assert.That(sections[0].Cards, Is.EqualTo([ Card "TestRepo/main" ])) + Assert.That(sections[0].Cards, Is.EqualTo([ Card "/repo/main" ])) [] member _.``visibleFocusTargets with collapsed repo containing archived worktrees shows only header``() = @@ -334,7 +334,7 @@ type NavigationArchiveTests() = targets |> List.choose (function Card key -> Some key | _ -> None) - Assert.That(cardKeys, Is.EqualTo([ "Repo1/main"; "Repo2/develop" ])) + Assert.That(cardKeys, Is.EqualTo([ "/repo/main"; "/repo/develop" ])) [] diff --git a/src/Tests/NavigationTests.fs b/src/Tests/NavigationTests.fs index dc58b86..6d75ae0 100644 --- a/src/Tests/NavigationTests.fs +++ b/src/Tests/NavigationTests.fs @@ -36,7 +36,7 @@ module NavHelpers = let scrollHint (_, _, hint) = hint - let cardTarget repoId branch = Card $"{repoId}/{branch}" + let cardTarget repoId branch = Card $"/repo/{branch}" [] [] diff --git a/src/Tests/fixtures/worktrees.json b/src/Tests/fixtures/worktrees.json index 0bb1ea9..b42358d 100644 --- a/src/Tests/fixtures/worktrees.json +++ b/src/Tests/fixtures/worktrees.json @@ -329,7 +329,7 @@ "AppVersion": "2026-02-16T22:50:00.000Z" }, "SyncStatus": { - "TestProject/feature-active": [ + "Q:/code/TestProject/feature-active": [ { "Source": "sync", "Message": "Merge main", @@ -345,7 +345,7 @@ "Duration": null } ], - "TestProject/feature-recent": [ + "Q:/code/TestProject/feature-recent": [ { "Source": "sync", "Message": "Pull", @@ -361,7 +361,7 @@ "Duration": null } ], - "TestProject/feature-draft": [ + "Q:/code/TestProject/feature-draft": [ { "Source": "claude", "Message": "Setting up API route handlers", @@ -379,7 +379,7 @@ "Duration": null } ], - "TestProject/feature-unknown": [ + "Q:/code/TestProject/feature-unknown": [ { "Source": "sync", "Message": "Check clean",