From 3e6b259aceceba3361e04ca6e29882e3e3885762 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Mon, 22 Jun 2026 17:43:03 +0200 Subject: [PATCH 1/3] Make Treemon own worktree forking; add post-fork hook Treemon now creates worktrees itself instead of delegating forking to repo fork scripts. Base resolution is upstream-aware: it fetches the base branch and prefers the remote-tracking ref (/) over a possibly-stale local branch, falling back to the local branch when no remote-tracking ref exists. This fixes "new worktree from main" forking from a stale local main in fork workflows, and removes the prior bugs where a fork script silently ignored the selected base or failed resolution it never used. After creation, an optional post-fork.ps1/.sh runs inside the new worktree for setup only (symlinks, dependency install); its failure is a non-fatal warning since the worktree already exists. Legacy fork.ps1/.sh are no longer executed. If one is present, creation still succeeds but returns a warning to migrate setup into post-fork.*. createWorktree now returns Result, with warnings surfaced in the create modal (UI) and on the console (CLI). Migrate Treemon's own fork.ps1 into post-fork.ps1 (setup half) and review-worktree.ps1 (the remote review-branch workflow, which reuses post-fork.ps1), and delete fork.ps1. --- docs/spec/worktree-monitor.md | 7 +- fork.ps1 | 75 ------- post-fork.ps1 | 61 ++++++ review-worktree.ps1 | 29 +++ src/Cli/Program.fs | 20 +- src/Client/CreateWorktreeModal.fs | 39 +++- src/Client/index.html | 5 + src/Server/GitWorktree.fs | 128 +++++++++--- src/Server/WorktreeApi.fs | 15 +- src/Shared/Types.fs | 2 +- src/Tests/CreateWorktreeServerTests.fs | 264 +++++++++++++++++++++++++ src/Tests/CreateWorktreeTests.fs | 21 +- src/Tests/Tests.fsproj | 1 + 13 files changed, 535 insertions(+), 132 deletions(-) delete mode 100644 fork.ps1 create mode 100644 post-fork.ps1 create mode 100644 review-worktree.ps1 create mode 100644 src/Tests/CreateWorktreeServerTests.fs diff --git a/docs/spec/worktree-monitor.md b/docs/spec/worktree-monitor.md index a7e77706..681ed8b9 100644 --- a/docs/spec/worktree-monitor.md +++ b/docs/spec/worktree-monitor.md @@ -118,8 +118,11 @@ Timeline replay tests verify status transitions against checked-in fixture data A "+" button on each repo header opens a modal to create new worktrees without leaving the dashboard. - **Name input** (auto-focused) + **source branch dropdown** (sorted: main > master > develop > dev* > alphabetical from dashboard worktrees) -- If `fork.ps1` (Windows) or `fork.sh` (Unix) exists in repo root, delegates to it with branch name as sole argument (runs from source worktree directory). Otherwise falls back to `git worktree add -b {name} {parentDir}/tm-{name}`. -- Modal shows creating animation, then auto-closes on success or displays error +- Treemon creates the worktree itself: it fetches the base branch from the upstream remote, then forks via `git worktree add -b {name} {parentDir}/tm-{name} {baseRef}`. `baseRef` prefers the remote-tracking ref `{remote}/{base}` — so a new worktree forks from the upstream tip rather than a possibly-stale local branch — falling back to the local `{base}` branch when no remote-tracking ref exists. No worktree needs the base checked out; fetch/remote failures fall back to whatever ref is available. +- After creation, an optional `post-fork.ps1` (Windows) / `post-fork.sh` (Unix) in the repo root runs **inside the new worktree**, receiving `{worktreePath} {sourceRepoRoot} {baseRef} {branchName}`. It is for setup only (symlinks, dependency install); a failure is reported as a non-fatal warning since the worktree already exists. +- Legacy `fork.ps1`/`fork.sh` scripts are **no longer executed** — Treemon now owns forking. If one is present, creation still succeeds but returns a warning to migrate setup steps into `post-fork.*`. +- Warnings (legacy fork script present, post-fork failure) flow back through `createWorktree` (`Result`) and are surfaced in the modal (UI) or console (CLI). +- Modal shows creating animation, then auto-closes on clean success, or shows warnings / error - Server expedites worktree list refresh for the repo so the new card appears quickly ### Native Session Management diff --git a/fork.ps1 b/fork.ps1 deleted file mode 100644 index 73fc016e..00000000 --- a/fork.ps1 +++ /dev/null @@ -1,75 +0,0 @@ -param( - [Parameter(Mandatory=$true, Position=0)] - [string]$Branch, - [string]$Remote = "" -) - -$ErrorActionPreference = "Stop" - -$repoRoot = $PSScriptRoot - -$dirSafeBranch = $Branch -replace '/', '-' - -if ($Remote) { - $worktreePath = Join-Path (Split-Path $repoRoot -Parent) "tm-review-$dirSafeBranch" - Write-Host "Fetching from $Remote..." - git fetch $Remote - $localBranch = "review/$Branch" - Write-Host "Creating review worktree at $worktreePath (branch $localBranch tracking $Remote/$Branch)..." - git worktree add -b $localBranch $worktreePath "$Remote/$Branch" -} else { - $worktreePath = Join-Path (Split-Path $repoRoot -Parent) "tm-$dirSafeBranch" - Write-Host "Creating worktree at $worktreePath with branch $Branch..." - git worktree add -b $Branch $worktreePath -} -Set-Location $worktreePath - -Write-Host "Creating .claude symlink..." -$claudeTarget = Join-Path $repoRoot ".claude" -try { - New-Item -ItemType SymbolicLink -Path ".claude" -Target $claudeTarget -ErrorAction Stop | Out-Null - Write-Host " Symlink created successfully." -} catch { - Write-Host " Symlink creation failed (needs admin). Requesting elevation..." - $escapedDest = (Join-Path $worktreePath ".claude") -replace "'", "''" - $escapedTarget = $claudeTarget -replace "'", "''" - Start-Process pwsh -Verb RunAs -Wait -ArgumentList "-NoProfile", "-Command", "New-Item -ItemType SymbolicLink -Path '$escapedDest' -Target '$escapedTarget'" - if (Test-Path ".claude") { - Write-Host " Symlink created with elevation." - } else { - Write-Host " Warning: Failed to create symlink. Copy manually or enable developer mode." - } -} - -Write-Host "Creating data symlink..." -$dataTarget = Join-Path $repoRoot "data" -if (Test-Path $dataTarget) { - try { - New-Item -ItemType SymbolicLink -Path "data" -Target $dataTarget -ErrorAction Stop | Out-Null - Write-Host " Symlink created successfully." - } catch { - Write-Host " Symlink creation failed (needs admin). Requesting elevation..." - $escapedDest = (Join-Path $worktreePath "data") -replace "'", "''" - $escapedTarget = $dataTarget -replace "'", "''" - Start-Process pwsh -Verb RunAs -Wait -ArgumentList "-NoProfile", "-Command", "New-Item -ItemType SymbolicLink -Path '$escapedDest' -Target '$escapedTarget'" - if (Test-Path "data") { - Write-Host " Symlink created with elevation." - } else { - Write-Host " Warning: Failed to create symlink. Copy manually or enable developer mode." - } - } -} else { - Write-Host " No data folder found in source worktree, skipping." -} - -if (Get-Command bd -ErrorAction SilentlyContinue) { - Write-Host "Initializing beads..." - bd init --skip-hooks --skip-merge-driver --no-daemon --quiet -} else { - Write-Host "Skipping beads init (bd not found)." -} - -Write-Host "Installing npm dependencies..." -npm install - -Write-Host "Done! Worktree created at: $worktreePath" diff --git a/post-fork.ps1 b/post-fork.ps1 new file mode 100644 index 00000000..4e6b0a4d --- /dev/null +++ b/post-fork.ps1 @@ -0,0 +1,61 @@ +# Post-fork setup hook. Treemon creates the worktree itself, then runs this +# script inside the new worktree to wire up local-only dependencies. +# +# Treemon invokes it as: +# pwsh -NoProfile -File post-fork.ps1 +# with the working directory set to the new worktree. +param( + [Parameter(Position = 0)] + [string]$WorktreePath = (Get-Location).Path, + [Parameter(Position = 1)] + [string]$SourceRoot = $PSScriptRoot, + [Parameter(Position = 2)] + [string]$BaseRef = "", + [Parameter(Position = 3)] + [string]$Branch = "" +) + +$ErrorActionPreference = "Stop" + +Set-Location $WorktreePath + +function New-RepoSymlink { + param([string]$Name) + + $target = Join-Path $SourceRoot $Name + if (-not (Test-Path $target)) { + Write-Host " No '$Name' in source repo, skipping." + return + } + + Write-Host "Creating $Name symlink..." + try { + New-Item -ItemType SymbolicLink -Path $Name -Target $target -ErrorAction Stop | Out-Null + Write-Host " Symlink created successfully." + } catch { + Write-Host " Symlink creation failed (needs admin). Requesting elevation..." + $escapedDest = (Join-Path $WorktreePath $Name) -replace "'", "''" + $escapedTarget = $target -replace "'", "''" + Start-Process pwsh -Verb RunAs -Wait -ArgumentList "-NoProfile", "-Command", "New-Item -ItemType SymbolicLink -Path '$escapedDest' -Target '$escapedTarget'" + if (Test-Path $Name) { + Write-Host " Symlink created with elevation." + } else { + Write-Host " Warning: Failed to create '$Name' symlink. Copy manually or enable developer mode." + } + } +} + +New-RepoSymlink ".claude" +New-RepoSymlink "data" + +if (Get-Command bd -ErrorAction SilentlyContinue) { + Write-Host "Initializing beads..." + bd init --skip-hooks --skip-merge-driver --no-daemon --quiet +} else { + Write-Host "Skipping beads init (bd not found)." +} + +Write-Host "Installing npm dependencies..." +npm install + +Write-Host "Done! Worktree ready at: $WorktreePath" diff --git a/review-worktree.ps1 b/review-worktree.ps1 new file mode 100644 index 00000000..f2da60de --- /dev/null +++ b/review-worktree.ps1 @@ -0,0 +1,29 @@ +# Creates a worktree for reviewing someone else's contribution: fetches a remote +# and forks a `review/` worktree that tracks `/`, then runs +# the standard post-fork setup. This is a manual workflow — Treemon's own +# "create worktree" feature no longer forks from arbitrary remotes. +# +# Usage: +# pwsh -File review-worktree.ps1 +param( + [Parameter(Mandatory = $true, Position = 0)] + [string]$Branch, + [Parameter(Mandatory = $true, Position = 1)] + [string]$Remote +) + +$ErrorActionPreference = "Stop" + +$repoRoot = $PSScriptRoot +$dirSafeBranch = $Branch -replace '/', '-' +$worktreePath = Join-Path (Split-Path $repoRoot -Parent) "tm-review-$dirSafeBranch" +$localBranch = "review/$Branch" + +Write-Host "Fetching from $Remote..." +git fetch $Remote + +Write-Host "Creating review worktree at $worktreePath (branch $localBranch tracking $Remote/$Branch)..." +git worktree add -b $localBranch $worktreePath "$Remote/$Branch" + +# Reuse the same setup Treemon runs after creating a worktree. +& (Join-Path $repoRoot "post-fork.ps1") $worktreePath $repoRoot "$Remote/$Branch" $localBranch diff --git a/src/Cli/Program.fs b/src/Cli/Program.fs index d920f0b6..51fd829f 100644 --- a/src/Cli/Program.fs +++ b/src/Cli/Program.fs @@ -164,14 +164,18 @@ let launchCmd = let newCmd = let handler (repo: string, branch: string, baseBranch: string, port: int option) = withPort port (fun port -> - runApi - port - (fun api -> - api.createWorktree - { RepoId = repo - BranchName = BranchName.create branch - BaseBranch = BranchName.create baseBranch }) - $"Worktree created for branch '%s{branch}'") + tryCallServer port (fun api -> + let request = + { RepoId = repo + BranchName = BranchName.create branch + BaseBranch = BranchName.create baseBranch } + + match api.createWorktree request |> Async.RunSynchronously with + | Ok warnings -> + printfn $"✓ Worktree created for branch '%s{branch}'" + warnings |> List.iter (fun w -> eprintfn $"⚠ %s{w}") + 0 + | Error e -> eprintfn $"Error: %s{e}"; 1)) command "new" { description "Create a new worktree" diff --git a/src/Client/CreateWorktreeModal.fs b/src/Client/CreateWorktreeModal.fs index 2b09d74d..e9db416b 100644 --- a/src/Client/CreateWorktreeModal.fs +++ b/src/Client/CreateWorktreeModal.fs @@ -17,6 +17,7 @@ type ModalState = | Open of CreateWorktreeForm | Creating of RepoId | CreateError of repoId: RepoId * message: string + | CreateWarning of repoId: RepoId * messages: string list type Msg = | OpenCreateWorktree of RepoId @@ -24,7 +25,7 @@ type Msg = | SetNewWorktreeName of string | SetBaseBranch of string | SubmitCreateWorktree - | CreateWorktreeCompleted of Result + | CreateWorktreeCompleted of Result | CloseCreateModal let repoId = @@ -34,6 +35,7 @@ let repoId = | Open form -> Some form.RepoId | Creating repoId -> Some repoId | CreateError (repoId, _) -> Some repoId + | CreateWarning (repoId, _) -> Some repoId let isOpen = function @@ -87,9 +89,13 @@ let update (api: Lazy) (msg: Msg) (modal: ModalState) : UpdateResu Cmd.OfAsync.perform api.Value.createWorktree request CreateWorktreeCompleted | _ -> just modal - | CreateWorktreeCompleted (Ok _) -> - let restored = repoId modal |> Option.map RepoHeader - { Modal = Closed; RestoredFocus = restored; RefreshWorktrees = true }, Cmd.none + | CreateWorktreeCompleted (Ok warnings) -> + match modal with + | Creating rid when not (List.isEmpty warnings) -> + { Modal = CreateWarning (rid, warnings); RestoredFocus = None; RefreshWorktrees = true }, Cmd.none + | _ -> + let restored = repoId modal |> Option.map RepoHeader + { Modal = Closed; RestoredFocus = restored; RefreshWorktrees = true }, Cmd.none | CreateWorktreeCompleted (Error errorMsg) -> match modal with @@ -199,3 +205,28 @@ let view (dispatch: Msg -> unit) (modal: ModalState) = ] ] ] + + | CreateWarning (_, messages) -> + modalOverlay dispatch true [ + Html.div [ + prop.className "modal-header warning" + prop.text "Worktree created — with warnings" + ] + Html.div [ + prop.className "modal-body" + prop.children [ + for message in messages -> + Html.div [ prop.className "modal-warning-message"; prop.text message ] + ] + ] + Html.div [ + prop.className "modal-footer" + prop.children [ + Html.button [ + prop.className "modal-btn cancel" + prop.onClick (fun _ -> dispatch CloseCreateModal) + prop.text "Close" + ] + ] + ] + ] diff --git a/src/Client/index.html b/src/Client/index.html index 2d35a4f0..8404654b 100644 --- a/src/Client/index.html +++ b/src/Client/index.html @@ -354,6 +354,7 @@ padding: 14px 18px 0; font-weight: 600; font-size: 1.05em; color: #cdd6f4; } .modal-header.error { color: #f38ba8; } + .modal-header.warning { color: #f9e2af; } .modal-body { padding: 14px 18px; display: flex; flex-direction: column; gap: 10px; } .modal-body code { color: #89b4fa; font-family: 'Consolas', 'Cascadia Mono', monospace; } .modal-body.creating { @@ -396,6 +397,10 @@ color: #f38ba8; font-size: 0.9em; white-space: pre-wrap; word-break: break-word; background: #1e1e2e; padding: 10px; border-radius: 6px; } + .modal-warning-message { + color: #f9e2af; font-size: 0.9em; white-space: pre-wrap; word-break: break-word; + background: #1e1e2e; padding: 10px; border-radius: 6px; + } .creating-dots::after { content: ''; diff --git a/src/Server/GitWorktree.fs b/src/Server/GitWorktree.fs index 92de8107..15e774c2 100644 --- a/src/Server/GitWorktree.fs +++ b/src/Server/GitWorktree.fs @@ -337,32 +337,106 @@ let validateBranchName (branchName: string) = else Error $"Invalid branch name: '{branchName}'" -let resolveWorktreeCommand (repoRoot: string) (sourceWorktreePath: string) (branchName: string) (forkScript: string option) = - match forkScript with - | Some scriptPath -> - let fileName, arguments = - if RuntimeInformation.IsOSPlatform(OSPlatform.Windows) then "pwsh", $"-NoProfile -File \"{scriptPath}\" \"{branchName}\"" - else "bash", $"\"{scriptPath}\" \"{branchName}\"" - - fileName, arguments, Some sourceWorktreePath - | None -> - let parentDir = Path.GetDirectoryName(repoRoot) - let dirName = branchName.Replace('/', '-') - let worktreePath = Path.Combine(parentDir, $"tm-{dirName}") - "git", $"-C \"{sourceWorktreePath}\" worktree add -b \"{branchName}\" \"{worktreePath}\"", None - -let createWorktree (repoRoot: string) (sourceWorktreePath: string) (branchName: string) = +let private gitRefExists (repoRoot: string) (gitRef: string) = async { - match validateBranchName branchName with - | Error msg -> return Error msg - | Ok name -> - let scriptPath = - if RuntimeInformation.IsOSPlatform(OSPlatform.Windows) then Path.Combine(repoRoot, "fork.ps1") - else Path.Combine(repoRoot, "fork.sh") - - let forkScript = if File.Exists(scriptPath) then Some scriptPath else None - let fileName, arguments, workingDir = resolveWorktreeCommand repoRoot sourceWorktreePath name forkScript - - let! result = ProcessRunner.runResult "CreateWorktree" fileName arguments workingDir - return result |> Result.map ignore + let! output = runGit repoRoot $"rev-parse --verify --quiet \"{gitRef}\"" + return output |> Option.exists (fun s -> s.Trim().Length > 0) + } + +/// Resolves the base branch to a concrete git ref to fork from. Prefers the +/// remote-tracking ref (e.g. `upstream/main`) so a new worktree forks from the +/// upstream tip rather than a possibly-stale local branch, falling back to the +/// local branch when no remote-tracking ref exists. Does not require any worktree +/// to currently have the base checked out. +let resolveBaseRef (repoRoot: string) (upstreamRemote: string) (baseBranch: string) = + async { + let remoteRef = mainRef upstreamRemote baseBranch + let! remoteExists = gitRefExists repoRoot $"refs/remotes/{remoteRef}" + + if remoteExists then + return Ok remoteRef + else + let! localExists = gitRefExists repoRoot $"refs/heads/{baseBranch}" + + return + if localExists then Ok baseBranch + else Error $"Base branch '{baseBranch}' not found as '{remoteRef}' or as a local branch" + } + +/// Best-effort fetch of the base branch from upstream so the remote-tracking ref +/// reflects the latest upstream tip. Connectivity/remote failures are ignored — +/// worktree creation must not depend on the network. +let private fetchBaseBranch (repoRoot: string) (upstreamRemote: string) (baseBranch: string) = + async { + let! _ = runGit repoRoot $"fetch {upstreamRemote} {baseBranch}" + return () + } + +let private worktreeDir (repoRoot: string) (branchName: string) = + let parentDir = Path.GetDirectoryName(repoRoot) + let dirName = branchName.Replace('/', '-') + Path.Combine(parentDir, $"tm-{dirName}") + +/// Builds the git command that forks `branchName` from `baseRef` into a +/// `tm-`prefixed sibling of the repo root. Returns the command and the new +/// worktree path. +let resolveWorktreeCommand (repoRoot: string) (baseRef: string) (branchName: string) = + let worktreePath = worktreeDir repoRoot branchName + let arguments = $"-C \"{repoRoot}\" worktree add -b \"{branchName}\" \"{worktreePath}\" \"{baseRef}\"" + "git", arguments, worktreePath + +let private legacyForkScriptWarning (repoRoot: string) = + let scriptName = if RuntimeInformation.IsOSPlatform(OSPlatform.Windows) then "fork.ps1" else "fork.sh" + + if File.Exists(Path.Combine(repoRoot, scriptName)) then + Some $"'{scriptName}' is no longer used — Treemon now creates worktrees itself. Move any setup steps into 'post-fork.ps1'/'post-fork.sh'." + else + None + +/// Runs an optional `post-fork` setup script inside the freshly created worktree, +/// passing the worktree path, the source repo root, the base ref and the branch +/// name. A failure is reported as a warning, never a hard error — the worktree +/// already exists at this point. +let private runPostFork (repoRoot: string) (worktreePath: string) (baseRef: string) (branchName: string) = + async { + let isWindows = RuntimeInformation.IsOSPlatform(OSPlatform.Windows) + let scriptName = if isWindows then "post-fork.ps1" else "post-fork.sh" + let scriptPath = Path.Combine(repoRoot, scriptName) + + if not (File.Exists scriptPath) then + return None + else + let fileName, arguments = + if isWindows then "pwsh", $"-NoProfile -File \"{scriptPath}\" \"{worktreePath}\" \"{repoRoot}\" \"{baseRef}\" \"{branchName}\"" + else "bash", $"\"{scriptPath}\" \"{worktreePath}\" \"{repoRoot}\" \"{baseRef}\" \"{branchName}\"" + + let! result = ProcessRunner.runResult "PostFork" fileName arguments (Some worktreePath) + + return + match result with + | Ok _ -> None + | Error msg -> Some $"Worktree created, but '{scriptName}' failed: {msg}" + } + +/// Creates a new worktree, forking `branchName` from `baseBranch`. Treemon owns +/// the forking: it fetches the base from upstream, forks from the remote-tracking +/// ref when available, then runs an optional `post-fork` setup script. Returns any +/// non-fatal warnings (a legacy fork script is present, or post-fork failed). +let createWorktree (repoRoot: string) (baseBranch: string) (branchName: string) = + asyncResult { + let! name = validateBranchName branchName + let! validBase = validateBranchName baseBranch + let! upstreamRemote = resolveUpstreamRemote repoRoot + do! fetchBaseBranch repoRoot upstreamRemote validBase + let! baseRef = resolveBaseRef repoRoot upstreamRemote validBase + + let fileName, arguments, worktreePath = resolveWorktreeCommand repoRoot baseRef name + + do! + ProcessRunner.runResult "CreateWorktree" fileName arguments None + |> AsyncResult.ignore + + let! postForkWarning = runPostFork repoRoot worktreePath baseRef name + + return List.choose id [ legacyForkScriptWarning repoRoot; postForkWarning ] } diff --git a/src/Server/WorktreeApi.fs b/src/Server/WorktreeApi.fs index d6097593..c122f609 100644 --- a/src/Server/WorktreeApi.fs +++ b/src/Server/WorktreeApi.fs @@ -379,7 +379,7 @@ let worktreeApi (fun () -> async { return f.SyncStatus }) with getBranches = fun _ -> async { return [ "main"; "develop"; "feature/sample" ] } - createWorktree = fun _ -> async { return Ok() } } + createWorktree = fun _ -> async { return Ok [] } } | None -> { getWorktrees = fun () -> getWorktrees agent sessionAgent rootPaths appVersion deployBranch openTerminal = openTerminal validatePath sessionAgent @@ -521,18 +521,9 @@ let worktreeApi |> Map.tryFind repoId |> Result.requireSome $"Unknown repo: {req.RepoId}" - let! state = agent.PostAndAsyncReply(RefreshScheduler.StateMsg.GetState) - - let! wt = - state.Repos - |> Map.tryFind repoId - |> Option.bind (fun repo -> - repo.WorktreeList - |> List.tryFind (fun wt -> wt.Branch = Some (BranchName.value req.BaseBranch))) - |> Result.requireSome $"No worktree found for branch '{BranchName.value req.BaseBranch}'" - - do! GitWorktree.createWorktree root wt.Path (BranchName.value req.BranchName) + let! warnings = GitWorktree.createWorktree root (BranchName.value req.BaseBranch) (BranchName.value req.BranchName) agent.Post(RefreshScheduler.StateMsg.ExpediteRefresh repoId) + return warnings } openNewTab = fun wtPath -> withValidatedPath wtPath "openNewTab" (fun () -> diff --git a/src/Shared/Types.fs b/src/Shared/Types.fs index 029c268b..35232502 100644 --- a/src/Shared/Types.fs +++ b/src/Shared/Types.fs @@ -195,7 +195,7 @@ type IWorktreeApi = archiveWorktree: WorktreePath -> Async> unarchiveWorktree: WorktreePath -> Async> getBranches: string -> Async - createWorktree: CreateWorktreeRequest -> Async> + createWorktree: CreateWorktreeRequest -> Async> openNewTab: WorktreePath -> Async> launchAction: ActionRequest -> Async> reportActivity: ActivityLevel -> Async diff --git a/src/Tests/CreateWorktreeServerTests.fs b/src/Tests/CreateWorktreeServerTests.fs new file mode 100644 index 00000000..ac4d7731 --- /dev/null +++ b/src/Tests/CreateWorktreeServerTests.fs @@ -0,0 +1,264 @@ +module Tests.CreateWorktreeServerTests + +open System +open System.IO +open System.Runtime.InteropServices +open NUnit.Framework +open Server.GitWorktree + +// ─── git test helpers ─── + +let private runGitProc (workingDir: string) (args: string) = + let psi = + Diagnostics.ProcessStartInfo( + "git", + args, + WorkingDirectory = workingDir, + RedirectStandardOutput = true, + RedirectStandardError = true, + UseShellExecute = false, + CreateNoWindow = true + ) + + use proc = Diagnostics.Process.Start(psi) + let stdout = proc.StandardOutput.ReadToEnd() + proc.StandardError.ReadToEnd() |> ignore + proc.WaitForExit() + proc.ExitCode, stdout.Trim() + +let private gitAssert (workingDir: string) (args: string) = + let exitCode, _ = runGitProc workingDir args + Assert.That(exitCode, Is.EqualTo(0), $"git {args} failed (exit {exitCode})") + +let private gitOut (workingDir: string) (args: string) = + let _, stdout = runGitProc workingDir args + stdout + +/// Creates a fresh repo with a single commit and a `main` branch checked out. +let private initRepoOnMain (repoDir: string) = + Directory.CreateDirectory(repoDir) |> ignore + gitAssert repoDir "init" + gitAssert repoDir "config user.name test" + gitAssert repoDir "config user.email test@test.com" + gitAssert repoDir "commit --allow-empty -m init" + gitAssert repoDir "branch -M main" + +/// Creates a `repo` on main with a bare `origin` remote that has `main` pushed, +/// so both a local `main` and `refs/remotes/origin/main` exist. +let private initRepoWithOrigin (tempDir: string) = + let repoDir = Path.Combine(tempDir, "repo") + let originDir = Path.Combine(tempDir, "origin.git") + initRepoOnMain repoDir + Directory.CreateDirectory(originDir) |> ignore + gitAssert originDir "init --bare" + gitAssert repoDir $"remote add origin \"{originDir}\"" + gitAssert repoDir "push origin main" + repoDir, originDir + + +// ─── resolveWorktreeCommand: pure command construction ─── + +[] +[] +[] +type ResolveWorktreeCommandTests() = + + [] + member _.``forks the new branch from the base ref``() = + let _, args, _ = resolveWorktreeCommand "Q:\\code\\repo" "origin/main" "my-branch" + Assert.That(args, Does.Contain("worktree add -b \"my-branch\"")) + Assert.That(args, Does.Contain("\"origin/main\""), "base ref must be passed as the fork point") + + [] + member _.``runs git against the repo root``() = + let fileName, args, _ = resolveWorktreeCommand "Q:\\code\\repo" "main" "my-branch" + Assert.That(fileName, Is.EqualTo("git")) + Assert.That(args, Does.Contain("-C \"Q:\\code\\repo\"")) + + [] + member _.``places the worktree as a tm-prefixed sibling of the repo root``() = + let _, args, worktreePath = resolveWorktreeCommand "Q:\\code\\repo" "main" "my-branch" + Assert.That(args, Does.Contain("tm-my-branch")) + Assert.That(worktreePath, Does.EndWith("tm-my-branch")) + + [] + member _.``slashes in the branch name become dashes in the worktree dir``() = + let _, args, worktreePath = resolveWorktreeCommand "Q:\\code\\repo" "main" "feature/foo" + Assert.That(worktreePath, Does.EndWith("tm-feature-foo")) + Assert.That(args, Does.Contain("worktree add -b \"feature/foo\""), "branch keeps its slash") + + +// ─── resolveBaseRef: ref resolution precedence ─── + +[] +[] +[] +type ResolveBaseRefTests() = + /// NUnit lifecycle field — reassigned per test by []/[]. + let mutable tempDir = "" + + [] + member _.Setup() = + tempDir <- Path.Combine(Path.GetTempPath(), $"treemon-baseref-{Guid.NewGuid():N}") + Directory.CreateDirectory(tempDir) |> ignore + + [] + member _.TearDown() = + if Directory.Exists(tempDir) then + try Directory.Delete(tempDir, recursive = true) + with _ -> () + + [] + member _.``prefers the remote-tracking ref over a local base branch``() = + let repoDir, _ = initRepoWithOrigin tempDir + + let result = resolveBaseRef repoDir "origin" "main" |> Async.RunSynchronously + Assert.That((result = Ok "origin/main"), Is.True, $"Expected Ok \"origin/main\" but got: {result}") + + [] + member _.``uses the remote ref when only the remote has the base branch``() = + let repoDir, _ = initRepoWithOrigin tempDir + gitAssert repoDir "checkout -b feature" + gitAssert repoDir "branch -D main" + + let result = resolveBaseRef repoDir "origin" "main" |> Async.RunSynchronously + Assert.That((result = Ok "origin/main"), Is.True, $"Expected Ok \"origin/main\" but got: {result}") + + [] + member _.``falls back to the local base branch when there is no remote-tracking ref``() = + let repoDir = Path.Combine(tempDir, "repo") + initRepoOnMain repoDir + + let result = resolveBaseRef repoDir "origin" "main" |> Async.RunSynchronously + Assert.That((result = Ok "main"), Is.True, $"Expected Ok \"main\" but got: {result}") + + [] + member _.``errors when the base branch exists neither locally nor on the remote``() = + let repoDir = Path.Combine(tempDir, "repo") + initRepoOnMain repoDir + + let result = resolveBaseRef repoDir "origin" "does-not-exist" |> Async.RunSynchronously + Assert.That(Result.isError result, Is.True, $"Expected Error but got: {result}") + + +// ─── createWorktree: end-to-end against real git repos ─── + +[] +[] +[] +type CreateWorktreeIntegrationTests() = + /// NUnit lifecycle field — reassigned per test by []/[]. + let mutable tempDir = "" + + [] + member _.Setup() = + tempDir <- Path.Combine(Path.GetTempPath(), $"treemon-newwt-{Guid.NewGuid():N}") + Directory.CreateDirectory(tempDir) |> ignore + + [] + member _.TearDown() = + if Directory.Exists(tempDir) then + try Directory.Delete(tempDir, recursive = true) + with _ -> () + + [] + member _.``succeeds when no worktree has the base branch checked out``() = + let repoDir = Path.Combine(tempDir, "repo") + initRepoOnMain repoDir + // Switch the only worktree off main so nothing has the base checked out. + gitAssert repoDir "checkout -b canvas-review-report" + + let result = createWorktree repoDir "main" "resolve-model-slugs" |> Async.RunSynchronously + Assert.That(Result.isOk result, Is.True, $"Expected Ok but got: {result}") + + let newWt = Path.Combine(tempDir, "tm-resolve-model-slugs") + Assert.That(Directory.Exists(newWt), Is.True, "new worktree should be created as a sibling of the repo") + Assert.That(gitOut newWt "rev-parse --abbrev-ref HEAD", Is.EqualTo("resolve-model-slugs")) + Assert.That(gitOut newWt "rev-parse HEAD", Is.EqualTo(gitOut repoDir "rev-parse main"), "forked from main's tip") + + [] + member _.``forks from the remote base when only the remote has the base branch``() = + let repoDir, _ = initRepoWithOrigin tempDir + gitAssert repoDir "checkout -b feature" + gitAssert repoDir "branch -D main" + + let result = createWorktree repoDir "main" "from-origin" |> Async.RunSynchronously + Assert.That(Result.isOk result, Is.True, $"Expected Ok but got: {result}") + + let newWt = Path.Combine(tempDir, "tm-from-origin") + Assert.That(Directory.Exists(newWt), Is.True) + Assert.That(gitOut newWt "rev-parse --abbrev-ref HEAD", Is.EqualTo("from-origin")) + Assert.That(gitOut newWt "rev-parse HEAD", Is.EqualTo(gitOut repoDir "rev-parse origin/main")) + + [] + member _.``forks from the upstream tip when the local base branch is stale``() = + let repoDir, _ = initRepoWithOrigin tempDir + // Advance origin/main one commit ahead of the local main, then rewind local main. + gitAssert repoDir "commit --allow-empty -m second" + gitAssert repoDir "push origin main" + gitAssert repoDir "reset --hard HEAD~1" + + let staleLocal = gitOut repoDir "rev-parse main" + let upstreamTip = gitOut repoDir "rev-parse origin/main" + Assert.That(upstreamTip, Is.Not.EqualTo(staleLocal), "test setup: origin/main must be ahead of local main") + + let result = createWorktree repoDir "main" "feat" |> Async.RunSynchronously + Assert.That(Result.isOk result, Is.True, $"Expected Ok but got: {result}") + + let newWt = Path.Combine(tempDir, "tm-feat") + Assert.That(gitOut newWt "rev-parse HEAD", Is.EqualTo(upstreamTip), "should fork from the upstream tip, not stale local main") + + [] + member _.``preserves the happy path when the base is checked out``() = + let repoDir = Path.Combine(tempDir, "repo") + initRepoOnMain repoDir + + let result = createWorktree repoDir "main" "happy-branch" |> Async.RunSynchronously + Assert.That(Result.isOk result, Is.True, $"Expected Ok but got: {result}") + + let newWt = Path.Combine(tempDir, "tm-happy-branch") + Assert.That(Directory.Exists(newWt), Is.True) + Assert.That(gitOut newWt "rev-parse --abbrev-ref HEAD", Is.EqualTo("happy-branch")) + + [] + member _.``returns Error and creates nothing when the base branch is missing``() = + let repoDir = Path.Combine(tempDir, "repo") + initRepoOnMain repoDir + gitAssert repoDir "checkout -b feature" + + let result = createWorktree repoDir "no-such-base" "should-not-exist" |> Async.RunSynchronously + Assert.That(Result.isError result, Is.True, $"Expected Error but got: {result}") + Assert.That(Directory.Exists(Path.Combine(tempDir, "tm-should-not-exist")), Is.False) + + [] + member _.``warns but still creates the worktree when a legacy fork script is present``() = + let repoDir = Path.Combine(tempDir, "repo") + initRepoOnMain repoDir + let scriptName = if RuntimeInformation.IsOSPlatform(OSPlatform.Windows) then "fork.ps1" else "fork.sh" + File.WriteAllText(Path.Combine(repoDir, scriptName), "# legacy fork script") + + match createWorktree repoDir "main" "with-legacy" |> Async.RunSynchronously with + | Error e -> Assert.Fail($"Expected Ok but got Error: {e}") + | Ok warnings -> + Assert.That(Directory.Exists(Path.Combine(tempDir, "tm-with-legacy")), Is.True, "worktree should still be created") + Assert.That(warnings |> List.exists _.Contains("no longer used"), Is.True, $"Expected a legacy-fork-script warning but got: {warnings}") + + [] + member _.``runs the post-fork script inside the new worktree``() = + if not (RuntimeInformation.IsOSPlatform(OSPlatform.Windows)) then + Assert.Ignore("post-fork execution test targets Windows/pwsh") + + let repoDir = Path.Combine(tempDir, "repo") + initRepoOnMain repoDir + let script = "param($wt, $root, $baseRef, $branch)\n\"$branch|$root\" | Out-File -FilePath (Join-Path $wt 'pf-args.txt')" + File.WriteAllText(Path.Combine(repoDir, "post-fork.ps1"), script) + + let result = createWorktree repoDir "main" "with-postfork" |> Async.RunSynchronously + Assert.That(Result.isOk result, Is.True, $"Expected Ok but got: {result}") + + let newWt = Path.Combine(tempDir, "tm-with-postfork") + let argsFile = Path.Combine(newWt, "pf-args.txt") + Assert.That(File.Exists(argsFile), Is.True, "post-fork script should run in the new worktree") + let contents = File.ReadAllText(argsFile) + Assert.That(contents, Does.Contain("with-postfork"), "post-fork should receive the branch name") + Assert.That(contents, Does.Contain("repo"), "post-fork should receive the source repo root") diff --git a/src/Tests/CreateWorktreeTests.fs b/src/Tests/CreateWorktreeTests.fs index def53534..379e9fe0 100644 --- a/src/Tests/CreateWorktreeTests.fs +++ b/src/Tests/CreateWorktreeTests.fs @@ -361,10 +361,25 @@ type CreateWorktreeCompletedTests() = [] member _.``CreateWorktreeCompleted Ok closes modal``() = let creating = { defaultModel with CreateModal = Modal.Creating testRepoId } - let model = tryUpdateModel (ModalMsg (Modal.CreateWorktreeCompleted (Ok ()))) creating + let model = tryUpdateModel (ModalMsg (Modal.CreateWorktreeCompleted (Ok []))) creating Assert.That(model.CreateModal, Is.EqualTo(Modal.Closed)) + [] + member _.``CreateWorktreeCompleted Ok with warnings shows CreateWarning``() = + let result, _ = + Modal.update + (lazy Unchecked.defaultof) + (Modal.CreateWorktreeCompleted (Ok [ "fork.ps1 is no longer used" ])) + (Modal.Creating testRepoId) + + match result.Modal with + | Modal.CreateWarning (repoId, messages) -> + Assert.That(repoId, Is.EqualTo(testRepoId)) + Assert.That(messages, Is.EqualTo([ "fork.ps1 is no longer used" ])) + | other -> + Assert.Fail($"Expected CreateWarning but got {other}") + [] member _.``CreateWorktreeCompleted Error transitions to CreateError``() = let creating = { defaultModel with CreateModal = Modal.Creating testRepoId } @@ -515,7 +530,7 @@ type FullStateMachineRoundtripTests() = let m5 = tryUpdateModel (ModalMsg Modal.SubmitCreateWorktree) m4 Assert.That((match m5.CreateModal with Modal.Creating _ -> true | _ -> false), Is.True) - let m6 = tryUpdateModel (ModalMsg (Modal.CreateWorktreeCompleted (Ok ()))) m5 + let m6 = tryUpdateModel (ModalMsg (Modal.CreateWorktreeCompleted (Ok []))) m5 Assert.That(m6.CreateModal, Is.EqualTo(Modal.Closed)) [] @@ -706,7 +721,7 @@ type FocusRestorationTests() = [] member _.``CreateWorktreeCompleted Ok restores focus to RepoHeader``() = let creating = { modelWithFocusAndModal with CreateModal = Modal.Creating repoId } - let model = tryUpdateModel (ModalMsg (Modal.CreateWorktreeCompleted (Ok ()))) creating + let model = tryUpdateModel (ModalMsg (Modal.CreateWorktreeCompleted (Ok []))) creating Assert.That(model.FocusedElement, Is.EqualTo(Some (RepoHeader repoId)), "Successful creation should restore focus to RepoHeader") diff --git a/src/Tests/Tests.fsproj b/src/Tests/Tests.fsproj index 3b77993d..110f063f 100644 --- a/src/Tests/Tests.fsproj +++ b/src/Tests/Tests.fsproj @@ -25,6 +25,7 @@ + From cf64ec091dc2ce226dc19ad1d2ae201e206d3cea Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Wed, 24 Jun 2026 17:38:11 +0200 Subject: [PATCH 2/3] Harden worktree forking from review feedback - post-fork.ps1: create directory junctions instead of symlinks with UAC elevation, so the hook works when spawned by the server (no interactive prompt) and without Developer Mode. - GitWorktree: reject leading-dash branch names (align regex with TreemonConfig) and pass "--" before the fetch refspec to prevent git argument injection. - ProcessRunner: add runResultWithTimeout; give the post-fork hook a 10-minute budget so npm install / bd init are not killed by the 60s git default, and make the timeout warning state that dependencies may be incomplete. - Tests: extract shared git helpers into GitTestHelpers.fs and dedupe CreateWorktreeServerTests and RemoveWorktreeTests. - CreateWorktreeModal: flatten update into a single (msg, modal) tuple match. - Make legacyForkScriptWarning pure by hoisting File.Exists to the CE boundary. - Name the createWorktree success channel via CreateWorktreeWarnings. --- post-fork.ps1 | 25 +++----- src/Client/CreateWorktreeModal.fs | 84 +++++++++++--------------- src/Server/GitWorktree.fs | 25 +++++--- src/Server/ProcessRunner.fs | 31 ++++++---- src/Shared/Types.fs | 6 +- src/Tests/CreateWorktreeServerTests.fs | 50 +-------------- src/Tests/GitTestHelpers.fs | 59 ++++++++++++++++++ src/Tests/RemoveWorktreeTests.fs | 29 +-------- src/Tests/Tests.fsproj | 1 + 9 files changed, 147 insertions(+), 163 deletions(-) create mode 100644 src/Tests/GitTestHelpers.fs diff --git a/post-fork.ps1 b/post-fork.ps1 index 4e6b0a4d..26590afb 100644 --- a/post-fork.ps1 +++ b/post-fork.ps1 @@ -19,7 +19,10 @@ $ErrorActionPreference = "Stop" Set-Location $WorktreePath -function New-RepoSymlink { +# Directory junctions (not symbolic links) so this works without elevation or +# Developer Mode — important because Treemon spawns this hook from the server +# process, where no one is present to approve a UAC prompt. +function New-RepoJunction { param([string]$Name) $target = Join-Path $SourceRoot $Name @@ -28,25 +31,17 @@ function New-RepoSymlink { return } - Write-Host "Creating $Name symlink..." + Write-Host "Creating $Name junction..." try { - New-Item -ItemType SymbolicLink -Path $Name -Target $target -ErrorAction Stop | Out-Null - Write-Host " Symlink created successfully." + New-Item -ItemType Junction -Path $Name -Target $target -ErrorAction Stop | Out-Null + Write-Host " Junction created successfully." } catch { - Write-Host " Symlink creation failed (needs admin). Requesting elevation..." - $escapedDest = (Join-Path $WorktreePath $Name) -replace "'", "''" - $escapedTarget = $target -replace "'", "''" - Start-Process pwsh -Verb RunAs -Wait -ArgumentList "-NoProfile", "-Command", "New-Item -ItemType SymbolicLink -Path '$escapedDest' -Target '$escapedTarget'" - if (Test-Path $Name) { - Write-Host " Symlink created with elevation." - } else { - Write-Host " Warning: Failed to create '$Name' symlink. Copy manually or enable developer mode." - } + Write-Host " Warning: Failed to create '$Name' junction: $($_.Exception.Message). Create it manually if needed." } } -New-RepoSymlink ".claude" -New-RepoSymlink "data" +New-RepoJunction ".claude" +New-RepoJunction "data" if (Get-Command bd -ErrorAction SilentlyContinue) { Write-Host "Initializing beads..." diff --git a/src/Client/CreateWorktreeModal.fs b/src/Client/CreateWorktreeModal.fs index e9db416b..b1f1a427 100644 --- a/src/Client/CreateWorktreeModal.fs +++ b/src/Client/CreateWorktreeModal.fs @@ -51,58 +51,44 @@ let private just modal = { Modal = modal; RestoredFocus = None; RefreshWorktrees = false }, Cmd.none let update (api: Lazy) (msg: Msg) (modal: ModalState) : UpdateResult * Cmd = - match msg with - | OpenCreateWorktree rid -> + match msg, modal with + | OpenCreateWorktree rid, _ -> { Modal = LoadingBranches rid; RestoredFocus = None; RefreshWorktrees = false }, Cmd.OfAsync.either api.Value.getBranches (RepoId.value rid) (Ok >> BranchesLoaded) (Error >> BranchesLoaded) - | BranchesLoaded (Ok branches) -> - match modal with - | LoadingBranches rid -> - let baseBranch = branches |> List.tryHead |> Option.defaultValue "" - just (Open { RepoId = rid; Branches = branches; Name = ""; BaseBranch = baseBranch }) - | _ -> just modal - - | BranchesLoaded (Error _) -> - match modal with - | LoadingBranches rid -> just (CreateError (rid, "Failed to load branches")) - | _ -> just modal - - | SetNewWorktreeName name -> - match modal with - | Open form -> just (Open { form with Name = name }) - | _ -> just modal - - | SetBaseBranch branch -> - match modal with - | Open form -> just (Open { form with BaseBranch = branch }) - | _ -> just modal - - | SubmitCreateWorktree -> - match modal with - | Open form when form.Name.Trim().Length > 0 -> - let request: CreateWorktreeRequest = - { RepoId = RepoId.value form.RepoId - BranchName = BranchName.create (form.Name.Trim()) - BaseBranch = BranchName.create form.BaseBranch } - { Modal = Creating form.RepoId; RestoredFocus = None; RefreshWorktrees = false }, - Cmd.OfAsync.perform api.Value.createWorktree request CreateWorktreeCompleted - | _ -> just modal - - | CreateWorktreeCompleted (Ok warnings) -> - match modal with - | Creating rid when not (List.isEmpty warnings) -> - { Modal = CreateWarning (rid, warnings); RestoredFocus = None; RefreshWorktrees = true }, Cmd.none - | _ -> - let restored = repoId modal |> Option.map RepoHeader - { Modal = Closed; RestoredFocus = restored; RefreshWorktrees = true }, Cmd.none - - | CreateWorktreeCompleted (Error errorMsg) -> - match modal with - | Creating rid -> just (CreateError (rid, errorMsg)) - | _ -> just modal - - | CloseCreateModal -> + | BranchesLoaded (Ok branches), LoadingBranches rid -> + let baseBranch = branches |> List.tryHead |> Option.defaultValue "" + just (Open { RepoId = rid; Branches = branches; Name = ""; BaseBranch = baseBranch }) + | BranchesLoaded (Ok _), _ -> just modal + + | BranchesLoaded (Error _), LoadingBranches rid -> just (CreateError (rid, "Failed to load branches")) + | BranchesLoaded (Error _), _ -> just modal + + | SetNewWorktreeName name, Open form -> just (Open { form with Name = name }) + | SetNewWorktreeName _, _ -> just modal + + | SetBaseBranch branch, Open form -> just (Open { form with BaseBranch = branch }) + | SetBaseBranch _, _ -> just modal + + | SubmitCreateWorktree, Open form when form.Name.Trim().Length > 0 -> + let request: CreateWorktreeRequest = + { RepoId = RepoId.value form.RepoId + BranchName = BranchName.create (form.Name.Trim()) + BaseBranch = BranchName.create form.BaseBranch } + { Modal = Creating form.RepoId; RestoredFocus = None; RefreshWorktrees = false }, + Cmd.OfAsync.perform api.Value.createWorktree request CreateWorktreeCompleted + | SubmitCreateWorktree, _ -> just modal + + | CreateWorktreeCompleted (Ok warnings), Creating rid when not (List.isEmpty warnings) -> + { Modal = CreateWarning (rid, warnings); RestoredFocus = None; RefreshWorktrees = true }, Cmd.none + | CreateWorktreeCompleted (Ok _), _ -> + let restored = repoId modal |> Option.map RepoHeader + { Modal = Closed; RestoredFocus = restored; RefreshWorktrees = true }, Cmd.none + + | CreateWorktreeCompleted (Error errorMsg), Creating rid -> just (CreateError (rid, errorMsg)) + | CreateWorktreeCompleted (Error _), _ -> just modal + + | CloseCreateModal, _ -> let restored = repoId modal |> Option.map RepoHeader { Modal = Closed; RestoredFocus = restored; RefreshWorktrees = false }, Cmd.none diff --git a/src/Server/GitWorktree.fs b/src/Server/GitWorktree.fs index 15e774c2..7528e24b 100644 --- a/src/Server/GitWorktree.fs +++ b/src/Server/GitWorktree.fs @@ -124,7 +124,7 @@ let mainRef (upstreamRemote: string) (baseBranch: string) = $"{upstreamRemote}/{ let fetchUpstream (repoRoot: string) (upstreamRemote: string) (baseBranch: string) = async { - let! _ = runGit repoRoot $"fetch {upstreamRemote} {baseBranch}" + let! _ = runGit repoRoot $"fetch {upstreamRemote} -- {baseBranch}" do! tryFastForwardMain repoRoot baseBranch (mainRef upstreamRemote baseBranch) } @@ -329,7 +329,7 @@ let branchSortKey (baseBranch: string) (name: string) = | n when n.StartsWith("dev") -> (3, name) | _ -> (4, name) -let private validBranchNamePattern = System.Text.RegularExpressions.Regex(@"^[a-zA-Z0-9._/-]+$") +let private validBranchNamePattern = System.Text.RegularExpressions.Regex(@"^[a-zA-Z0-9][a-zA-Z0-9._/-]*$") let validateBranchName (branchName: string) = if validBranchNamePattern.IsMatch(branchName) then @@ -368,7 +368,7 @@ let resolveBaseRef (repoRoot: string) (upstreamRemote: string) (baseBranch: stri /// worktree creation must not depend on the network. let private fetchBaseBranch (repoRoot: string) (upstreamRemote: string) (baseBranch: string) = async { - let! _ = runGit repoRoot $"fetch {upstreamRemote} {baseBranch}" + let! _ = runGit repoRoot $"fetch {upstreamRemote} -- {baseBranch}" return () } @@ -385,14 +385,16 @@ let resolveWorktreeCommand (repoRoot: string) (baseRef: string) (branchName: str let arguments = $"-C \"{repoRoot}\" worktree add -b \"{branchName}\" \"{worktreePath}\" \"{baseRef}\"" "git", arguments, worktreePath -let private legacyForkScriptWarning (repoRoot: string) = - let scriptName = if RuntimeInformation.IsOSPlatform(OSPlatform.Windows) then "fork.ps1" else "fork.sh" - - if File.Exists(Path.Combine(repoRoot, scriptName)) then +let private legacyForkScriptWarning (scriptName: string) (exists: bool) = + if exists then Some $"'{scriptName}' is no longer used — Treemon now creates worktrees itself. Move any setup steps into 'post-fork.ps1'/'post-fork.sh'." else None +/// Generous timeout for the post-fork setup hook — it runs `npm install` and +/// `bd init`, which can far exceed the short default used for quick git probes. +let private postForkTimeoutMs = 10 * 60 * 1000 + /// Runs an optional `post-fork` setup script inside the freshly created worktree, /// passing the worktree path, the source repo root, the base ref and the branch /// name. A failure is reported as a warning, never a hard error — the worktree @@ -410,12 +412,12 @@ let private runPostFork (repoRoot: string) (worktreePath: string) (baseRef: stri if isWindows then "pwsh", $"-NoProfile -File \"{scriptPath}\" \"{worktreePath}\" \"{repoRoot}\" \"{baseRef}\" \"{branchName}\"" else "bash", $"\"{scriptPath}\" \"{worktreePath}\" \"{repoRoot}\" \"{baseRef}\" \"{branchName}\"" - let! result = ProcessRunner.runResult "PostFork" fileName arguments (Some worktreePath) + let! result = ProcessRunner.runResultWithTimeout postForkTimeoutMs "PostFork" fileName arguments (Some worktreePath) return match result with | Ok _ -> None - | Error msg -> Some $"Worktree created, but '{scriptName}' failed: {msg}" + | Error msg -> Some $"Worktree created, but '{scriptName}' setup failed: {msg}. Dependencies may be incomplete — re-run setup in the worktree." } /// Creates a new worktree, forking `branchName` from `baseBranch`. Treemon owns @@ -438,5 +440,8 @@ let createWorktree (repoRoot: string) (baseBranch: string) (branchName: string) let! postForkWarning = runPostFork repoRoot worktreePath baseRef name - return List.choose id [ legacyForkScriptWarning repoRoot; postForkWarning ] + let legacyScriptName = if RuntimeInformation.IsOSPlatform(OSPlatform.Windows) then "fork.ps1" else "fork.sh" + let legacyScriptExists = File.Exists(Path.Combine(repoRoot, legacyScriptName)) + + return List.choose id [ legacyForkScriptWarning legacyScriptName legacyScriptExists; postForkWarning ] } diff --git a/src/Server/ProcessRunner.fs b/src/Server/ProcessRunner.fs index cedafb09..80ce1de7 100644 --- a/src/Server/ProcessRunner.fs +++ b/src/Server/ProcessRunner.fs @@ -3,12 +3,12 @@ module Server.ProcessRunner open System.Diagnostics open System.Threading -let private processTimeoutMs = 60_000 +let private defaultTimeoutMs = 60_000 let private truncate (s: string) = if s.Length > 200 then s[..199] + "..." else s -let private startAndCapture (context: string) (fileName: string) (arguments: string) (workingDirectory: string option) = +let private startAndCapture (timeoutMs: int) (context: string) (fileName: string) (arguments: string) (workingDirectory: string option) = async { let cmdString = $"{fileName} {arguments}" @@ -26,7 +26,7 @@ let private startAndCapture (context: string) (fileName: string) (arguments: str workingDirectory |> Option.iter (fun dir -> psi.WorkingDirectory <- dir) use proc = Process.Start(psi) - use cts = new CancellationTokenSource(processTimeoutMs) + use cts = new CancellationTokenSource(timeoutMs) let ct = cts.Token let! waitResult = @@ -40,7 +40,7 @@ let private startAndCapture (context: string) (fileName: string) (arguments: str return Ok(proc.ExitCode, stdout.TrimEnd(), stderr.TrimEnd()) with :? System.OperationCanceledException -> try proc.Kill(entireProcessTree = true) with _ -> () - return Error $"Timed out after {processTimeoutMs}ms" + return Error $"Timed out after {timeoutMs}ms" } match waitResult with @@ -57,7 +57,7 @@ let private startAndCapture (context: string) (fileName: string) (arguments: str let run (context: string) (fileName: string) (arguments: string) = async { - let! result = startAndCapture context fileName arguments None + let! result = startAndCapture defaultTimeoutMs context fileName arguments None return match result with @@ -65,13 +65,22 @@ let run (context: string) (fileName: string) (arguments: string) = | _ -> None } +let private toResult result = + match result with + | Ok(0, stdout, _) -> Ok stdout + | Ok(_, _, stderr) -> Error stderr + | Error msg -> Error msg + let runResult (context: string) (fileName: string) (arguments: string) (workingDirectory: string option) = async { - let! result = startAndCapture context fileName arguments workingDirectory + let! result = startAndCapture defaultTimeoutMs context fileName arguments workingDirectory + return toResult result + } - return - match result with - | Ok(0, stdout, _) -> Ok stdout - | Ok(_, _, stderr) -> Error stderr - | Error msg -> Error msg +/// Like `runResult` but with an explicit timeout, for long-running setup hooks +/// (e.g. `npm install`) that would otherwise be killed by the short default. +let runResultWithTimeout (timeoutMs: int) (context: string) (fileName: string) (arguments: string) (workingDirectory: string option) = + async { + let! result = startAndCapture timeoutMs context fileName arguments workingDirectory + return toResult result } diff --git a/src/Shared/Types.fs b/src/Shared/Types.fs index 5b671a6b..879205d7 100644 --- a/src/Shared/Types.fs +++ b/src/Shared/Types.fs @@ -166,6 +166,10 @@ type CreateWorktreeRequest = BranchName: BranchName BaseBranch: BranchName } +/// Non-fatal advisories surfaced after a worktree is created (e.g. a legacy fork +/// script is present, or the post-fork setup hook failed). Empty means a clean create. +type CreateWorktreeWarnings = string list + type WorktreeStatus = { Path: WorktreePath Branch: string @@ -259,7 +263,7 @@ type IWorktreeApi = archiveWorktree: WorktreePath -> Async> unarchiveWorktree: WorktreePath -> Async> getBranches: string -> Async - createWorktree: CreateWorktreeRequest -> Async> + createWorktree: CreateWorktreeRequest -> Async> openNewTab: WorktreePath -> Async> launchAction: ActionRequest -> Async> reportActivity: ActivityLevel -> Async diff --git a/src/Tests/CreateWorktreeServerTests.fs b/src/Tests/CreateWorktreeServerTests.fs index ac4d7731..51a410ab 100644 --- a/src/Tests/CreateWorktreeServerTests.fs +++ b/src/Tests/CreateWorktreeServerTests.fs @@ -5,55 +5,7 @@ open System.IO open System.Runtime.InteropServices open NUnit.Framework open Server.GitWorktree - -// ─── git test helpers ─── - -let private runGitProc (workingDir: string) (args: string) = - let psi = - Diagnostics.ProcessStartInfo( - "git", - args, - WorkingDirectory = workingDir, - RedirectStandardOutput = true, - RedirectStandardError = true, - UseShellExecute = false, - CreateNoWindow = true - ) - - use proc = Diagnostics.Process.Start(psi) - let stdout = proc.StandardOutput.ReadToEnd() - proc.StandardError.ReadToEnd() |> ignore - proc.WaitForExit() - proc.ExitCode, stdout.Trim() - -let private gitAssert (workingDir: string) (args: string) = - let exitCode, _ = runGitProc workingDir args - Assert.That(exitCode, Is.EqualTo(0), $"git {args} failed (exit {exitCode})") - -let private gitOut (workingDir: string) (args: string) = - let _, stdout = runGitProc workingDir args - stdout - -/// Creates a fresh repo with a single commit and a `main` branch checked out. -let private initRepoOnMain (repoDir: string) = - Directory.CreateDirectory(repoDir) |> ignore - gitAssert repoDir "init" - gitAssert repoDir "config user.name test" - gitAssert repoDir "config user.email test@test.com" - gitAssert repoDir "commit --allow-empty -m init" - gitAssert repoDir "branch -M main" - -/// Creates a `repo` on main with a bare `origin` remote that has `main` pushed, -/// so both a local `main` and `refs/remotes/origin/main` exist. -let private initRepoWithOrigin (tempDir: string) = - let repoDir = Path.Combine(tempDir, "repo") - let originDir = Path.Combine(tempDir, "origin.git") - initRepoOnMain repoDir - Directory.CreateDirectory(originDir) |> ignore - gitAssert originDir "init --bare" - gitAssert repoDir $"remote add origin \"{originDir}\"" - gitAssert repoDir "push origin main" - repoDir, originDir +open Tests.GitTestHelpers // ─── resolveWorktreeCommand: pure command construction ─── diff --git a/src/Tests/GitTestHelpers.fs b/src/Tests/GitTestHelpers.fs new file mode 100644 index 00000000..3e8d9bfb --- /dev/null +++ b/src/Tests/GitTestHelpers.fs @@ -0,0 +1,59 @@ +module Tests.GitTestHelpers + +open System.Diagnostics +open System.IO +open NUnit.Framework + +/// Runs `git args` in `workingDir`, returning the exit code and trimmed stdout. +let runGit (workingDir: string) (args: string) = + let psi = + ProcessStartInfo( + "git", + args, + WorkingDirectory = workingDir, + RedirectStandardOutput = true, + RedirectStandardError = true, + UseShellExecute = false, + CreateNoWindow = true + ) + + use proc = Process.Start(psi) + let stdout = proc.StandardOutput.ReadToEnd() + proc.StandardError.ReadToEnd() |> ignore + proc.WaitForExit() + proc.ExitCode, stdout.Trim() + +/// Runs `git args`, asserting it exits 0. +let gitAssert (workingDir: string) (args: string) = + let exitCode, _ = runGit workingDir args + Assert.That(exitCode, Is.EqualTo(0), $"git {args} failed (exit {exitCode})") + +/// Runs `git args` and returns its trimmed stdout. +let gitOut (workingDir: string) (args: string) = + let _, stdout = runGit workingDir args + stdout + +/// Creates a fresh git repo with an identity configured (no commits yet). +let initRepo (repoDir: string) = + Directory.CreateDirectory(repoDir) |> ignore + gitAssert repoDir "init" + gitAssert repoDir "config user.name test" + gitAssert repoDir "config user.email test@test.com" + +/// Creates a fresh repo with a single commit and a `main` branch checked out. +let initRepoOnMain (repoDir: string) = + initRepo repoDir + gitAssert repoDir "commit --allow-empty -m init" + gitAssert repoDir "branch -M main" + +/// Creates a `repo` on main with a bare `origin` remote that has `main` pushed, +/// so both a local `main` and `refs/remotes/origin/main` exist. +let initRepoWithOrigin (tempDir: string) = + let repoDir = Path.Combine(tempDir, "repo") + let originDir = Path.Combine(tempDir, "origin.git") + initRepoOnMain repoDir + Directory.CreateDirectory(originDir) |> ignore + gitAssert originDir "init --bare" + gitAssert repoDir $"remote add origin \"{originDir}\"" + gitAssert repoDir "push origin main" + repoDir, originDir diff --git a/src/Tests/RemoveWorktreeTests.fs b/src/Tests/RemoveWorktreeTests.fs index 9369a6eb..16b87342 100644 --- a/src/Tests/RemoveWorktreeTests.fs +++ b/src/Tests/RemoveWorktreeTests.fs @@ -4,34 +4,7 @@ open System open System.IO open NUnit.Framework open Server.GitWorktree - -let private git (workingDir: string) (args: string) = - let psi = - Diagnostics.ProcessStartInfo( - "git", - args, - WorkingDirectory = workingDir, - RedirectStandardOutput = true, - RedirectStandardError = true, - UseShellExecute = false, - CreateNoWindow = true - ) - - use proc = Diagnostics.Process.Start(psi) - proc.StandardOutput.ReadToEnd() |> ignore - proc.StandardError.ReadToEnd() |> ignore - proc.WaitForExit() - proc.ExitCode - -let private gitAssert (workingDir: string) (args: string) = - let exitCode = git workingDir args - Assert.That(exitCode, Is.EqualTo(0), $"git {args} failed with exit code {exitCode}") - -let private initRepo (repoDir: string) = - Directory.CreateDirectory(repoDir) |> ignore - gitAssert repoDir "init" - gitAssert repoDir "config user.name test" - gitAssert repoDir "config user.email test@test.com" +open Tests.GitTestHelpers [] [] diff --git a/src/Tests/Tests.fsproj b/src/Tests/Tests.fsproj index b184766f..f2fb2ee9 100644 --- a/src/Tests/Tests.fsproj +++ b/src/Tests/Tests.fsproj @@ -7,6 +7,7 @@ + From 82c8194169decc463a69355e0df5ef354c8b06a6 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 25 Jun 2026 10:35:34 +0200 Subject: [PATCH 3/3] Address PR review comments - CreateWorktreeModal: render warning messages with List.map instead of a for-comprehension, matching the branch dropdown and the no-loops style rule. - CreateWorktreeServerTests: make the post-fork execution test portable so it runs on Linux CI via post-fork.sh/bash (was Assert.Ignore'd off Windows), and add a test for the post-fork failure-to-warning path. --- src/Client/CreateWorktreeModal.fs | 8 ++++---- src/Tests/CreateWorktreeServerTests.fs | 28 +++++++++++++++++++++----- 2 files changed, 27 insertions(+), 9 deletions(-) diff --git a/src/Client/CreateWorktreeModal.fs b/src/Client/CreateWorktreeModal.fs index b1f1a427..57a87f31 100644 --- a/src/Client/CreateWorktreeModal.fs +++ b/src/Client/CreateWorktreeModal.fs @@ -200,10 +200,10 @@ let view (dispatch: Msg -> unit) (modal: ModalState) = ] Html.div [ prop.className "modal-body" - prop.children [ - for message in messages -> - Html.div [ prop.className "modal-warning-message"; prop.text message ] - ] + prop.children ( + messages + |> List.map (fun message -> + Html.div [ prop.className "modal-warning-message"; prop.text message ])) ] Html.div [ prop.className "modal-footer" diff --git a/src/Tests/CreateWorktreeServerTests.fs b/src/Tests/CreateWorktreeServerTests.fs index 51a410ab..4a95a4a1 100644 --- a/src/Tests/CreateWorktreeServerTests.fs +++ b/src/Tests/CreateWorktreeServerTests.fs @@ -197,13 +197,15 @@ type CreateWorktreeIntegrationTests() = [] member _.``runs the post-fork script inside the new worktree``() = - if not (RuntimeInformation.IsOSPlatform(OSPlatform.Windows)) then - Assert.Ignore("post-fork execution test targets Windows/pwsh") - let repoDir = Path.Combine(tempDir, "repo") initRepoOnMain repoDir - let script = "param($wt, $root, $baseRef, $branch)\n\"$branch|$root\" | Out-File -FilePath (Join-Path $wt 'pf-args.txt')" - File.WriteAllText(Path.Combine(repoDir, "post-fork.ps1"), script) + + if RuntimeInformation.IsOSPlatform(OSPlatform.Windows) then + let script = "param($wt, $root, $baseRef, $branch)\n\"$branch|$root\" | Out-File -FilePath (Join-Path $wt 'pf-args.txt')" + File.WriteAllText(Path.Combine(repoDir, "post-fork.ps1"), script) + else + let script = "#!/usr/bin/env bash\nprintf '%s|%s' \"$4\" \"$2\" > \"$1/pf-args.txt\"\n" + File.WriteAllText(Path.Combine(repoDir, "post-fork.sh"), script) let result = createWorktree repoDir "main" "with-postfork" |> Async.RunSynchronously Assert.That(Result.isOk result, Is.True, $"Expected Ok but got: {result}") @@ -214,3 +216,19 @@ type CreateWorktreeIntegrationTests() = let contents = File.ReadAllText(argsFile) Assert.That(contents, Does.Contain("with-postfork"), "post-fork should receive the branch name") Assert.That(contents, Does.Contain("repo"), "post-fork should receive the source repo root") + + [] + member _.``warns but still creates the worktree when the post-fork script fails``() = + let repoDir = Path.Combine(tempDir, "repo") + initRepoOnMain repoDir + + if RuntimeInformation.IsOSPlatform(OSPlatform.Windows) then + File.WriteAllText(Path.Combine(repoDir, "post-fork.ps1"), "exit 1") + else + File.WriteAllText(Path.Combine(repoDir, "post-fork.sh"), "#!/usr/bin/env bash\nexit 1\n") + + match createWorktree repoDir "main" "postfork-fails" |> Async.RunSynchronously with + | Error e -> Assert.Fail($"Expected Ok but got Error: {e}") + | Ok warnings -> + Assert.That(Directory.Exists(Path.Combine(tempDir, "tm-postfork-fails")), Is.True, "worktree should still be created") + Assert.That(warnings |> List.exists _.Contains("setup failed"), Is.True, $"Expected a post-fork failure warning but got: {warnings}")