diff --git a/docs/spec/future/code-improvements.md b/docs/spec/future/code-improvements.md index 737ee88..13d13b2 100644 --- a/docs/spec/future/code-improvements.md +++ b/docs/spec/future/code-improvements.md @@ -37,15 +37,22 @@ its own worktree. This file is the entry point; detailed designs live in their o | 2 | **Port management** — centralize/derive the dev/prod/canvas/vite port assignments | `docs/spec/future/port-management.md` | Idea | | 3 | **Canvas roadmap items** — follow-on canvas-pane enhancements | `docs/spec/future/canvas-roadmap.md` | Idea | | 4 | **Process: guard against spec drift** — a lightweight check (or review rule) that flags `Key Files` references to moved/renamed modules so docs can't silently rot after refactors | — | Idea | -| 5 | **Survey other large modules** — apply the same view/state/update extraction lens to the next-largest files (server-side `RefreshScheduler.fs`, `WorktreeApi.fs`, etc.) if they mix concerns | — | Idea (needs investigation) | +| 5 | **Survey other large modules** — *investigated.* The two largest production modules are `WorktreeApi.fs` (870 L) and `RefreshScheduler.fs` (741 L); both mix concerns. Concrete splits broken out as #8 below (and #7, the `GlobalConfig` extract, now *Done*). (Strict-FP smells are already clean: no stray `let mutable`/loops/`null` in production; `Dictionary` only at cache/registry boundaries.) | — | Done (survey) | | 6 | **Remoting CSRF / Origin hardening** — pipeline-level Origin/Referer (and optional custom-header) check so a cross-origin browser page can't drive the unauthenticated loopback Fable.Remoting API (covers the dangerous pre-existing process-launching endpoints, not just watched-roots) | `docs/spec/future/remoting-csrf-hardening.md` | Idea (from focused-review) | +| 8 | **Split `RefreshScheduler.fs`** — the scheduler module also carries the `DashboardState`/`StateMsg`/`processMessage` state slice (~190 L) and an embedded `CanvasWatchers` filesystem-watcher module (~110 L). Lift one or both out of the scheduling loop into their own files (vertical-slice seam, like canvas/mascot/activity). Behavior-preserving but heavier ripple (26 refs to `RefreshScheduler.DashboardState`/`StateMsg`/`PerRepoState` in `WorktreeApi.fs`). | — | Idea (from survey) | > Add new candidates here as they surface (often from focused-review findings). Keep the list > honest: remove ones that turn out not to be worth it, and record why in the relevant spec. ## Done -- **App.fs view extraction** — `src/Client/App.fs` 1861 → 795 lines. Extracted +- **`GlobalConfig` store extraction** — lifted the machine-level `~/.treemon/config.json` + read/modify/write (single-writer lock, atomic temp-file replace, missing-vs-empty + `worktreeRoots` semantics, plus the canvas / collapsed-repos / last-viewed-hashes / editor + accessors) out of `WorktreeApi.fs` into `src/Server/GlobalConfig.fs`, leaving the + API module with just `IWorktreeApi` wiring + `DashboardResponse` assembly. Behavior-preserving; + see `docs/spec/worktree-monitor.md` (Configuration Store). +- **App.fs view extraction** — split `src/Client/App.fs` into smaller modules. Extracted `OverviewViews.fs`, `CardViews.fs` (with `CardViewProps`/`CardCallbacks` records), `MascotState.fs`/`MascotView.fs`, and `CanvasView.fs`; flat `Msg` + single `update` preserved. Branch `code-improvement`. diff --git a/docs/spec/worktree-monitor.md b/docs/spec/worktree-monitor.md index be32d69..9fe37b8 100644 --- a/docs/spec/worktree-monitor.md +++ b/docs/spec/worktree-monitor.md @@ -30,6 +30,14 @@ - Scheduler picks most-overdue task globally across all repos - Branch events scoped by `{repoId}/{branch}` to prevent cross-repo collisions +### Configuration Store + +Machine-level state persists in `~/.treemon/config.json` (or `$TREEMON_CONFIG_DIR` when set, for tests). `src/Server/GlobalConfig.fs` is the sole owner of that file — a single JSON store fronted by typed accessors, with these invariants: + +- **Single serialized writer, atomic on disk.** Every mutation funnels through one in-process lock and writes via a temp-file-then-replace; no write bypasses the lock, so concurrent updates can't interleave or leave a partially written file. +- **Never destroy data.** An unparseable `config.json` is backed up to a timestamped `*.corrupt-` sibling before a fresh object is started, and each write touches only its own named keys — every unrelated key is left intact. +- **Typed accessors over one store.** Watched roots (with the missing-vs-empty distinction the startup resolver depends on — see Multi-Repo above), canvas pane open/position, collapsed repos, last-viewed hashes, and the editor command/name reader are thin wrappers over the same locked store. + ### Worktree Identification - All `IWorktreeApi` methods use `WorktreePath` (filesystem path) as the worktree identifier — no branch name ambiguity across repos @@ -153,7 +161,7 @@ Windows Terminal integration for spawning, tracking, and focusing terminal windo ### Demo Mode -`treemon.ps1 demo` launches the server with `--demo` flag, cycling through pre-built `FixtureData` frames (~10s loop) that cover all dashboard features. No client changes — same poll-based rendering. See `src/Server/DemoFixture.fs`. +`treemon.ps1 demo` launches the server with `--demo` flag, cycling through pre-built `FixtureData` frames (~24s loop) that cover all dashboard features. No client changes — same poll-based rendering. See `src/Server/DemoFixture.fs`. ### Resilience @@ -228,7 +236,8 @@ After the burst, `lastRuns` is pre-populated and the normal sequential loop take | `src/Server/PrStatus.fs` | Provider routing, AzDo PR/thread/build fetching | | `src/Server/GithubPrStatus.fs` | GitHub PR/Actions fetching via `gh` CLI | | `src/Server/GitWorktree.fs` | Worktree enumeration, commit data, dirty detection, work metrics | -| `src/Server/WorktreeApi.fs` | API implementation, `DashboardResponse` assembly | +| `src/Server/GlobalConfig.fs` | Machine-level `config.json` store + typed accessors (watched roots, canvas, collapsed repos, last-viewed hashes, editor) | +| `src/Server/WorktreeApi.fs` | `IWorktreeApi` wiring + `DashboardResponse` assembly | | `src/Server/SyncEngine.fs` | Branch sync pipeline, provider-aware conflict resolution | | `src/Server/SessionManager.fs` | MailboxProcessor session agent, spawn/focus/kill, persistence | | `src/Server/Win32.fs` | P/Invoke: EnumWindows, SetForegroundWindow, WM_CLOSE | @@ -262,6 +271,7 @@ After the burst, `lastRuns` is pre-populated and the normal sequential loop take - Windows Terminal per-window tracking via HWND: tabs aren't reliably addressable, one window per worktree is simple and predictable - Upstream remote auto-detection over config-only: `upstream` remote name is the universal convention for fork workflows; config override available for non-standard setups - Watched roots are server-owned and restart-to-apply (not live-updated): `tm add`/`remove` persist to the global config and take effect on the next server (re)start (the `treemon.ps1` shims trigger it when prod is running). Chosen for simpler code — no per-root scheduler-state machinery; live application remains a clean future extension. The server is the single writer of `config.json` (with an internal write lock); the online-only CLI never writes config files, which removes the cross-process clobber hazard. +- `GlobalConfig` vs `TreemonConfig` — the machine-level `~/.treemon/config.json` and the per-worktree `.treemon.json` (`testCommand`, `baseBranch`, `upstreamRemote`) are deliberately separate stores in separate modules, named so the machine-vs-worktree scope is obvious and the two never collide. ## Related Specs diff --git a/src/Server/GlobalConfig.fs b/src/Server/GlobalConfig.fs new file mode 100644 index 0000000..f1a42b0 --- /dev/null +++ b/src/Server/GlobalConfig.fs @@ -0,0 +1,305 @@ +module Server.GlobalConfig + +open System +open System.IO +open System.Text.RegularExpressions +open Shared +open Shared.PathUtils + +/// Directory holding the machine-level Treemon config (`config.json`), normally `~/.treemon`. +/// The `TREEMON_CONFIG_DIR` override exists for test isolation: on Windows +/// `Environment.GetFolderPath(UserProfile)` ignores the USERPROFILE/HOME env vars, so an +/// in-process test can only redirect the config dir via this explicit override. +let internal globalConfigDir () = + Environment.GetEnvironmentVariable("TREEMON_CONFIG_DIR") + |> Option.ofObj + |> Option.filter (fun d -> d <> "") + |> Option.defaultWith (fun () -> + Path.Combine( + Environment.GetFolderPath(Environment.SpecialFolder.UserProfile), + ".treemon")) + +let private globalConfigPath () = + Path.Combine(globalConfigDir (), "config.json") + +let private withConfigDocument (defaultValue: 'a) (f: System.Text.Json.JsonElement -> 'a) : 'a = + let path = globalConfigPath () + if not (File.Exists path) then defaultValue + else + try + let json = File.ReadAllText path + use doc = System.Text.Json.JsonDocument.Parse json + f doc.RootElement + with ex -> + Log.log "Config" $"Failed to read config: {ex.Message}" + defaultValue + +let private readGlobalConfig () = + withConfigDocument Map.empty (fun root -> + root.EnumerateObject() + |> Seq.choose (fun prop -> + if prop.Value.ValueKind = System.Text.Json.JsonValueKind.String + then Some (prop.Name, prop.Value.GetString()) + else None) + |> Map.ofSeq) + +let internal readCollapsedRepos () : Set = + withConfigDocument Set.empty (fun root -> + match root.TryGetProperty("collapsedRepos") with + | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.Array -> + prop.EnumerateArray() + |> Seq.choose (fun el -> + if el.ValueKind = System.Text.Json.JsonValueKind.String then Some (RepoId (el.GetString())) + else None) + |> Set.ofSeq + | _ -> Set.empty) + +/// Reads `ignoreWorktreePatterns` from the machine-level config — the regexes for worktrees the +/// dashboard should hide. Lives here so all global-config reads share the one +/// `TREEMON_CONFIG_DIR`-aware path. +let readIgnoreWorktreePatterns () : string list = + withConfigDocument [] (fun root -> + match root.TryGetProperty("ignoreWorktreePatterns") with + | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.Array -> + prop.EnumerateArray() + |> Seq.choose (fun el -> + if el.ValueKind = System.Text.Json.JsonValueKind.String then Some (el.GetString()) + else None) + |> Seq.toList + | _ -> []) + +let buildIgnorePredicate (patterns: string list) : string -> bool = + let regexes = + patterns + |> List.filter (not << String.IsNullOrWhiteSpace) + |> List.choose (fun pattern -> + try Some (Regex($"^(?:{pattern})$", RegexOptions.Compiled)) + with :? ArgumentException -> + Log.log "Config" $"Invalid ignore worktree pattern: '{pattern}'" + None) + match regexes with + | [] -> fun _ -> false + | _ -> fun value -> regexes |> List.exists _.IsMatch(value) + +/// Serializes every write to the machine-level `config.json`. All global-config writers +/// (collapsedRepos, canvas state, lastViewedHashes, worktreeRoots) funnel through +/// `updateConfigAtPath`, so this lock makes the server the single serialized writer and stops +/// concurrent read-modify-write cycles from clobbering each other's keys. +let private globalConfigLock = obj () + +let private tryParseJsonObject (text: string) : System.Text.Json.Nodes.JsonObject option = + try + match System.Text.Json.Nodes.JsonNode.Parse(text) with + | :? System.Text.Json.Nodes.JsonObject as root -> Some root + | _ -> None + with _ -> None + +/// Read-modify-write a JSON config file safely. Serialized by an in-process lock, +/// written atomically (temp file in the same directory, then replace), and never +/// discarding existing data: an unparseable file is backed up to a timestamped sibling +/// rather than overwritten. Updates are described as (key, node) pairs, applied as the only +/// mutation of the JSON tree. Takes the path so it can be unit-tested against a temp file. +let internal updateConfigAtPath (configPath: string) (updates: (string * System.Text.Json.Nodes.JsonNode) list) : Result = + lock globalConfigLock (fun () -> + try + let dir = Path.GetDirectoryName(configPath) + if not (String.IsNullOrEmpty dir) && not (Directory.Exists dir) then Directory.CreateDirectory dir |> ignore + + let root = + if not (File.Exists(configPath)) then + System.Text.Json.Nodes.JsonObject() + else + match File.ReadAllText(configPath) |> tryParseJsonObject with + | Some existing -> existing + | None -> + let timestamp = DateTime.Now.ToString("yyyyMMddHHmmss") + let backupPath = $"{configPath}.corrupt-{timestamp}" + Log.log "Config" $"Config at {configPath} is unparseable; backing up to {backupPath} and starting fresh" + File.Copy(configPath, backupPath, overwrite = true) + System.Text.Json.Nodes.JsonObject() + + updates |> List.iter (fun (key, value) -> root[key] <- value) + + let options = System.Text.Json.JsonSerializerOptions(WriteIndented = true) + let tempPath = configPath + ".tmp" + File.WriteAllText(tempPath, root.ToJsonString(options)) + File.Move(tempPath, configPath, overwrite = true) + Ok() + with ex -> + Error ex.Message) + +let private updateGlobalConfig (description: string) (updates: (string * System.Text.Json.Nodes.JsonNode) list) = + match updateConfigAtPath (globalConfigPath ()) updates with + | Ok() -> () + | Error msg -> Log.log "Config" $"Failed to save {description}: {msg}" + +let internal writeCollapsedRepos (repos: RepoId list) = + let repoArray = + System.Text.Json.Nodes.JsonArray(repos |> List.map (fun (RepoId s) -> System.Text.Json.Nodes.JsonValue.Create(s) :> System.Text.Json.Nodes.JsonNode) |> List.toArray) + updateGlobalConfig "collapsed repos" [ "collapsedRepos", repoArray :> System.Text.Json.Nodes.JsonNode ] + +/// Reads the machine-level set of watched worktree roots (`worktreeRoots` in `config.json`), +/// distinguishing a MISSING key (`None`) from a present-but-empty list (`Some []`). The startup +/// resolver depends on that distinction: an explicit `worktreeRoots:[]` means the user curated +/// every root away, so it must NOT be treated like a fresh install and repopulated from CLI args +/// or a stale orphan `roots.json`. A malformed (non-array) value is reported as `None` — absent — +/// matching the original lenient behavior. `internal` so the resolver (`Program.fs`) shares it. +let internal tryReadWorktreeRootsConfig () : string list option = + withConfigDocument None (fun root -> + match root.TryGetProperty("worktreeRoots") with + | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.Array -> + prop.EnumerateArray() + |> Seq.choose (fun el -> + if el.ValueKind = System.Text.Json.JsonValueKind.String then Some(el.GetString()) + else None) + |> List.ofSeq + |> Some + | _ -> None) + +/// Flattens `tryReadWorktreeRootsConfig` to a plain list (missing key -> `[]`) for callers that +/// don't need the missing-vs-empty distinction: the `getRoots` endpoint and the add/remove +/// read-modify-write. `internal` so the startup resolver and the endpoint can share the reader. +let internal readWorktreeRootsConfig () : string list = + tryReadWorktreeRootsConfig () |> Option.defaultValue [] + +/// Persists the watched worktree roots through the locked, atomic single-writer path +/// (`updateConfigAtPath`), leaving every other global-config key untouched. Returns the write +/// outcome so the `addRoot`/`removeRoot` endpoints can surface a persistence failure to the CLI +/// instead of reporting a false success. `internal` so the startup resolver can also write +/// through this one helper. +let internal writeWorktreeRoots (roots: string list) : Result = + let rootArray = + System.Text.Json.Nodes.JsonArray( + roots + |> List.map (fun r -> System.Text.Json.Nodes.JsonValue.Create(r) :> System.Text.Json.Nodes.JsonNode) + |> List.toArray) + updateConfigAtPath (globalConfigPath ()) [ "worktreeRoots", rootArray :> System.Text.Json.Nodes.JsonNode ] + +/// Canonical comparison form for a worktree root: absolute path with trailing separators +/// trimmed. Total (never throws) so it is safe to fold over already-stored roots — a malformed +/// stored entry falls back to its raw value rather than aborting the whole add/remove. +let private canonicalRoot (path: string) = + try Path.GetFullPath(path).TrimEnd(Path.DirectorySeparatorChar, Path.AltDirectorySeparatorChar) + with _ -> path + +/// Normalizes a caller-supplied root path (absolute, trailing separators trimmed), surfacing a +/// readable error for blank or malformed input so the CLI can report it. +let private tryNormalizeRoot (path: string) : Result = + if String.IsNullOrWhiteSpace path then Error "Path is empty." + else + try Ok(Path.GetFullPath(path).TrimEnd(Path.DirectorySeparatorChar, Path.AltDirectorySeparatorChar)) + with ex -> Error $"Invalid path '{path}': {ex.Message}" + +/// Adds a worktree root to the global config (restart-to-apply). Normalizes and verifies the +/// path is an existing directory, then read-modify-writes the roots list via the locked +/// single-writer helpers, surfacing a persistence failure rather than a false success. Adding an +/// already-watched path is a no-op success. add/remove are driven by the (serialized) +/// `tm add`/`tm remove` CLI, so the read-then-write is not contended in practice; the write +/// itself is serialized by `globalConfigLock`. +let internal addRootToConfig (path: string) : Result = + tryNormalizeRoot path + |> Result.bind (fun normalized -> + if not (Directory.Exists normalized) then + Error $"Path does not exist or is not a directory: {normalized}" + else + let existing = readWorktreeRootsConfig () + if existing |> List.exists (fun r -> pathEquals (canonicalRoot r) normalized) then + Ok() + else + writeWorktreeRoots (existing @ [ normalized ])) + +/// Removes a worktree root from the global config (restart-to-apply). Does not require the path +/// to still exist on disk (a deleted root is removable); reports an error when the path is not +/// currently watched, and surfaces a persistence failure instead of a false success. +let internal removeRootFromConfig (path: string) : Result = + tryNormalizeRoot path + |> Result.bind (fun normalized -> + let existing = readWorktreeRootsConfig () + let remaining = existing |> List.filter (fun r -> not (pathEquals (canonicalRoot r) normalized)) + if List.length remaining = List.length existing then + Error $"Not a watched root: {normalized}" + else + writeWorktreeRoots remaining) + +let internal readCanvasPaneOpen () : bool = + withConfigDocument false (fun root -> + match root.TryGetProperty("canvasPaneOpen") with + | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.True -> true + | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.False -> false + | _ -> false) + +let internal writeCanvasPaneOpen (isOpen: bool) = + updateGlobalConfig "canvas pane open state" [ "canvasPaneOpen", System.Text.Json.Nodes.JsonValue.Create(isOpen) :> System.Text.Json.Nodes.JsonNode ] + +let internal readCanvasPosition () : CanvasPosition = + withConfigDocument CanvasPosition.Right (fun root -> + let found, prop = root.TryGetProperty("canvasPosition") + let s = if found && prop.ValueKind = System.Text.Json.JsonValueKind.String then prop.GetString() else "" + match found, s with + | true, "left" -> CanvasPosition.Left + | true, "right" -> CanvasPosition.Right + | true, "top" -> CanvasPosition.Top + | true, "bottom" -> CanvasPosition.Bottom + | _ -> CanvasPosition.Right) + +let internal writeCanvasPosition (position: CanvasPosition) = + let value = + match position with + | CanvasPosition.Left -> "left" + | CanvasPosition.Right -> "right" + | CanvasPosition.Top -> "top" + | CanvasPosition.Bottom -> "bottom" + updateGlobalConfig "canvas position" [ "canvasPosition", System.Text.Json.Nodes.JsonValue.Create(value) :> System.Text.Json.Nodes.JsonNode ] + +let internal readCanvasSize () : CanvasSize = + withConfigDocument CanvasSize.Ratio1To1 (fun root -> + let found, prop = root.TryGetProperty("canvasSize") + let s = if found && prop.ValueKind = System.Text.Json.JsonValueKind.String then prop.GetString() else "" + match found, s with + | true, "2to1" -> CanvasSize.Ratio2To1 + | _ -> CanvasSize.Ratio1To1) + +let internal writeCanvasSize (size: CanvasSize) = + let value = + match size with + | CanvasSize.Ratio1To1 -> "1to1" + | CanvasSize.Ratio2To1 -> "2to1" + updateGlobalConfig "canvas size" [ "canvasSize", System.Text.Json.Nodes.JsonValue.Create(value) :> System.Text.Json.Nodes.JsonNode ] + +let internal readLastViewedHashes () : Map> = + withConfigDocument Map.empty (fun root -> + match root.TryGetProperty("lastViewedHashes") with + | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.Object -> + prop.EnumerateObject() + |> Seq.choose (fun worktreeProp -> + if worktreeProp.Value.ValueKind = System.Text.Json.JsonValueKind.Object then + let fileHashes = + worktreeProp.Value.EnumerateObject() + |> Seq.choose (fun fileProp -> + if fileProp.Value.ValueKind = System.Text.Json.JsonValueKind.String + then Some (fileProp.Name, fileProp.Value.GetString()) + else None) + |> Map.ofSeq + Some (worktreeProp.Name, fileHashes) + else None) + |> Map.ofSeq + | _ -> Map.empty) + +let internal writeLastViewedHashes (hashes: Map>) = + let outerObj = System.Text.Json.Nodes.JsonObject() + hashes |> Map.iter (fun worktreePath fileHashes -> + let innerObj = System.Text.Json.Nodes.JsonObject() + fileHashes |> Map.iter (fun filename hash -> + innerObj[filename] <- System.Text.Json.Nodes.JsonValue.Create(hash)) + outerObj[worktreePath] <- innerObj) + updateGlobalConfig "last viewed hashes" [ "lastViewedHashes", outerObj :> System.Text.Json.Nodes.JsonNode ] + +let internal getEditorConfig () = + let config = readGlobalConfig () + let command = config |> Map.tryFind "editor" |> Option.defaultValue "code" + let name = + match config |> Map.tryFind "editorName", command with + | Some n, _ -> n + | None, "code" -> "VS Code" + | None, cmd -> cmd + command, name diff --git a/src/Server/Program.fs b/src/Server/Program.fs index 73162b0..28c5f9d 100644 --- a/src/Server/Program.fs +++ b/src/Server/Program.fs @@ -138,7 +138,7 @@ let private buildRemotingHandler (api: IWorktreeApi) = /// Path of the orphan `roots.json` under the (TREEMON_CONFIG_DIR-aware) global config dir. The /// file is a stale migration artifact read by nothing per the config investigation. let private orphanRootsPath () = - System.IO.Path.Combine(WorktreeApi.globalConfigDir (), "roots.json") + System.IO.Path.Combine(GlobalConfig.globalConfigDir (), "roots.json") /// Reads the orphan `roots.json` (schema `{ "WorktreeRoots": [...] }`), returning its roots or /// `[]` when absent/unreadable. Pure read — the file is deleted only after its roots are durably @@ -197,7 +197,7 @@ let internal resolveWorktreeRoots (cliRoots: string list) : RootsResolution = // the key is present (possibly an explicit empty list). Gating migration on KEY ABSENCE — not // `List.isEmpty` — is what stops an explicit `worktreeRoots:[]` from being resurrected by a // stale orphan `roots.json` or overwritten by CLI args on restart. - let configRoots = WorktreeApi.tryReadWorktreeRootsConfig () + let configRoots = GlobalConfig.tryReadWorktreeRootsConfig () let configHasKey = Option.isSome configRoots let resolved, cameFromOrphan = @@ -218,7 +218,7 @@ let internal resolveWorktreeRoots (cliRoots: string list) : RootsResolution = /// failed write can never drop the migration). A no-op when the resolution needs no persistence. let internal persistResolvedRoots (resolution: RootsResolution) = if resolution.PersistRoots then - match WorktreeApi.writeWorktreeRoots resolution.Roots with + match GlobalConfig.writeWorktreeRoots resolution.Roots with | Ok () -> Log.log "Startup" $"Persisted {List.length resolution.Roots} worktree root(s) to global config" if resolution.ConsumeOrphan then deleteOrphanRoots () diff --git a/src/Server/RefreshScheduler.fs b/src/Server/RefreshScheduler.fs index b698df9..867936b 100644 --- a/src/Server/RefreshScheduler.fs +++ b/src/Server/RefreshScheduler.fs @@ -518,7 +518,7 @@ let runInitialBurst (agent: MailboxProcessor) (rootPaths: Map TreemonConfig.buildIgnorePredicate + let ignorePredicate = GlobalConfig.readIgnoreWorktreePatterns () |> GlobalConfig.buildIgnorePredicate let ignoredPaths = resolveIgnoredPaths ignorePredicate state.Repos let filters = { Archived = archivedPaths; Ignored = ignoredPaths } Log.log "Scheduler" "Starting initial burst — Phase 2 (local data + fetch)" @@ -694,7 +694,7 @@ let start (agent: MailboxProcessor) (worktreeRoots: string list) (ct: let archivedBranchSets = readArchivedBranchSets rootPaths let archivedPaths = resolveArchivedPaths archivedBranchSets repos - let ignorePredicate = TreemonConfig.readIgnoreWorktreePatterns () |> TreemonConfig.buildIgnorePredicate + let ignorePredicate = GlobalConfig.readIgnoreWorktreePatterns () |> GlobalConfig.buildIgnorePredicate let ignoredPaths = resolveIgnoredPaths ignorePredicate repos let tasks = buildTaskList { Archived = archivedPaths; Ignored = ignoredPaths } repos let now = DateTimeOffset.UtcNow diff --git a/src/Server/Server.fsproj b/src/Server/Server.fsproj index 39900ea..9fd4ea8 100644 --- a/src/Server/Server.fsproj +++ b/src/Server/Server.fsproj @@ -18,6 +18,7 @@ + diff --git a/src/Server/TreemonConfig.fs b/src/Server/TreemonConfig.fs index e77fa69..dc221ba 100644 --- a/src/Server/TreemonConfig.fs +++ b/src/Server/TreemonConfig.fs @@ -102,45 +102,3 @@ let readBaseBranch (repoRoot: string) : string = let readTestCommand (repoRoot: string) : string option = readStringConfig repoRoot "testCommand" - -let globalConfigPath () = - Path.Combine( - Environment.GetFolderPath(Environment.SpecialFolder.UserProfile), - ".treemon", - "config.json") - -let private withGlobalConfig (defaultValue: 'a) (f: JsonElement -> 'a) : 'a = - let path = globalConfigPath () - if not (File.Exists path) then defaultValue - else - try - let json = File.ReadAllText path - use doc = JsonDocument.Parse json - f doc.RootElement - with ex -> - Log.log "TreemonConfig" $"Failed to read global config: {ex.Message}" - defaultValue - -let readIgnoreWorktreePatterns () : string list = - withGlobalConfig [] (fun root -> - match root.TryGetProperty("ignoreWorktreePatterns") with - | true, prop when prop.ValueKind = JsonValueKind.Array -> - prop.EnumerateArray() - |> Seq.choose (fun el -> - if el.ValueKind = JsonValueKind.String then Some (el.GetString()) - else None) - |> Seq.toList - | _ -> []) - -let buildIgnorePredicate (patterns: string list) : string -> bool = - let regexes = - patterns - |> List.filter (not << String.IsNullOrWhiteSpace) - |> List.choose (fun pattern -> - try Some (Regex($"^(?:{pattern})$", RegexOptions.Compiled)) - with :? ArgumentException -> - Log.log "TreemonConfig" $"Invalid ignore worktree pattern: '{pattern}'" - None) - match regexes with - | [] -> fun _ -> false - | _ -> fun value -> regexes |> List.exists _.IsMatch(value) diff --git a/src/Server/WorktreeApi.fs b/src/Server/WorktreeApi.fs index 12d09fc..fd58f26 100644 --- a/src/Server/WorktreeApi.fs +++ b/src/Server/WorktreeApi.fs @@ -9,6 +9,7 @@ open Shared.EventUtils open Shared.PathUtils open Newtonsoft.Json open FsToolkit.ErrorHandling +open Server.GlobalConfig let private canvasSpawnInFlight = ConcurrentDictionary() @@ -176,279 +177,6 @@ let private resolveProvider (state: RefreshScheduler.DashboardState) (path: stri |> Map.tryFind path |> Option.bind (fun data -> data.Provider |> Option.orElse data.LastMessageProvider)) -/// Directory holding the machine-level Treemon config (`config.json`), normally `~/.treemon`. -/// The `TREEMON_CONFIG_DIR` override exists for test isolation: on Windows -/// `Environment.GetFolderPath(UserProfile)` ignores the USERPROFILE/HOME env vars, so an -/// in-process test can only redirect the config dir via this explicit override. -let internal globalConfigDir () = - Environment.GetEnvironmentVariable("TREEMON_CONFIG_DIR") - |> Option.ofObj - |> Option.filter (fun d -> d <> "") - |> Option.defaultWith (fun () -> - Path.Combine( - Environment.GetFolderPath(Environment.SpecialFolder.UserProfile), - ".treemon")) - -let private globalConfigPath () = - Path.Combine(globalConfigDir (), "config.json") - -let private withConfigDocument (defaultValue: 'a) (f: System.Text.Json.JsonElement -> 'a) : 'a = - let path = globalConfigPath () - if not (File.Exists path) then defaultValue - else - try - let json = File.ReadAllText path - use doc = System.Text.Json.JsonDocument.Parse json - f doc.RootElement - with ex -> - Log.log "Config" $"Failed to read config: {ex.Message}" - defaultValue - -let private readGlobalConfig () = - withConfigDocument Map.empty (fun root -> - root.EnumerateObject() - |> Seq.choose (fun prop -> - if prop.Value.ValueKind = System.Text.Json.JsonValueKind.String - then Some (prop.Name, prop.Value.GetString()) - else None) - |> Map.ofSeq) - -let private readCollapsedRepos () : Set = - withConfigDocument Set.empty (fun root -> - match root.TryGetProperty("collapsedRepos") with - | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.Array -> - prop.EnumerateArray() - |> Seq.choose (fun el -> - if el.ValueKind = System.Text.Json.JsonValueKind.String then Some (RepoId (el.GetString())) - else None) - |> Set.ofSeq - | _ -> Set.empty) - -/// Serializes every write to the machine-level `config.json`. All global-config writers -/// (collapsedRepos, canvas state, lastViewedHashes, worktreeRoots) funnel through -/// `updateConfigAtPath`, so this lock makes the server the single serialized writer and stops -/// concurrent read-modify-write cycles from clobbering each other's keys. -let private globalConfigLock = obj () - -let private tryParseJsonObject (text: string) : System.Text.Json.Nodes.JsonObject option = - try - match System.Text.Json.Nodes.JsonNode.Parse(text) with - | :? System.Text.Json.Nodes.JsonObject as root -> Some root - | _ -> None - with _ -> None - -/// Read-modify-write a JSON config file safely. Serialized by an in-process lock, -/// written atomically (temp file in the same directory, then replace), and never -/// discarding existing data: an unparseable file is backed up to a timestamped sibling -/// rather than overwritten. Updates are described as (key, node) pairs, applied as the only -/// mutation of the JSON tree. Takes the path so it can be unit-tested against a temp file. -let internal updateConfigAtPath (configPath: string) (updates: (string * System.Text.Json.Nodes.JsonNode) list) : Result = - lock globalConfigLock (fun () -> - try - let dir = Path.GetDirectoryName(configPath) - if not (Directory.Exists(dir)) then Directory.CreateDirectory(dir) |> ignore - - let root = - if not (File.Exists(configPath)) then - System.Text.Json.Nodes.JsonObject() - else - match File.ReadAllText(configPath) |> tryParseJsonObject with - | Some existing -> existing - | None -> - let timestamp = DateTime.Now.ToString("yyyyMMddHHmmss") - let backupPath = $"{configPath}.corrupt-{timestamp}" - Log.log "Config" $"Config at {configPath} is unparseable; backing up to {backupPath} and starting fresh" - File.Copy(configPath, backupPath, overwrite = true) - System.Text.Json.Nodes.JsonObject() - - updates |> List.iter (fun (key, value) -> root[key] <- value) - - let options = System.Text.Json.JsonSerializerOptions(WriteIndented = true) - let tempPath = configPath + ".tmp" - File.WriteAllText(tempPath, root.ToJsonString(options)) - File.Move(tempPath, configPath, overwrite = true) - Ok() - with ex -> - Error ex.Message) - -let private updateGlobalConfig (description: string) (updates: (string * System.Text.Json.Nodes.JsonNode) list) = - match updateConfigAtPath (globalConfigPath ()) updates with - | Ok() -> () - | Error msg -> Log.log "Config" $"Failed to save {description}: {msg}" - -let private writeCollapsedRepos (repos: RepoId list) = - let repoArray = - System.Text.Json.Nodes.JsonArray(repos |> List.map (fun (RepoId s) -> System.Text.Json.Nodes.JsonValue.Create(s) :> System.Text.Json.Nodes.JsonNode) |> List.toArray) - updateGlobalConfig "collapsed repos" [ "collapsedRepos", repoArray :> System.Text.Json.Nodes.JsonNode ] - -/// Reads the machine-level set of watched worktree roots (`worktreeRoots` in `config.json`), -/// distinguishing a MISSING key (`None`) from a present-but-empty list (`Some []`). The startup -/// resolver depends on that distinction: an explicit `worktreeRoots:[]` means the user curated -/// every root away, so it must NOT be treated like a fresh install and repopulated from CLI args -/// or a stale orphan `roots.json`. A malformed (non-array) value is reported as `None` — absent — -/// matching the original lenient behavior. `internal` so the resolver (`Program.fs`) shares it. -let internal tryReadWorktreeRootsConfig () : string list option = - withConfigDocument None (fun root -> - match root.TryGetProperty("worktreeRoots") with - | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.Array -> - prop.EnumerateArray() - |> Seq.choose (fun el -> - if el.ValueKind = System.Text.Json.JsonValueKind.String then Some(el.GetString()) - else None) - |> List.ofSeq - |> Some - | _ -> None) - -/// Flattens `tryReadWorktreeRootsConfig` to a plain list (missing key -> `[]`) for callers that -/// don't need the missing-vs-empty distinction: the `getRoots` endpoint and the add/remove -/// read-modify-write. `internal` so the startup resolver and the endpoint can share the reader. -let internal readWorktreeRootsConfig () : string list = - tryReadWorktreeRootsConfig () |> Option.defaultValue [] - -/// Persists the watched worktree roots through the locked, atomic single-writer path -/// (`updateConfigAtPath`), leaving every other global-config key untouched. Returns the write -/// outcome so the `addRoot`/`removeRoot` endpoints can surface a persistence failure to the CLI -/// instead of reporting a false success. `internal` so the startup resolver can also write -/// through this one helper. -let internal writeWorktreeRoots (roots: string list) : Result = - let rootArray = - System.Text.Json.Nodes.JsonArray( - roots - |> List.map (fun r -> System.Text.Json.Nodes.JsonValue.Create(r) :> System.Text.Json.Nodes.JsonNode) - |> List.toArray) - updateConfigAtPath (globalConfigPath ()) [ "worktreeRoots", rootArray :> System.Text.Json.Nodes.JsonNode ] - -/// Canonical comparison form for a worktree root: absolute path with trailing separators -/// trimmed. Total (never throws) so it is safe to fold over already-stored roots — a malformed -/// stored entry falls back to its raw value rather than aborting the whole add/remove. -let private canonicalRoot (path: string) = - try Path.GetFullPath(path).TrimEnd(Path.DirectorySeparatorChar, Path.AltDirectorySeparatorChar) - with _ -> path - -/// Normalizes a caller-supplied root path (absolute, trailing separators trimmed), surfacing a -/// readable error for blank or malformed input so the CLI can report it. -let private tryNormalizeRoot (path: string) : Result = - if String.IsNullOrWhiteSpace path then Error "Path is empty." - else - try Ok(Path.GetFullPath(path).TrimEnd(Path.DirectorySeparatorChar, Path.AltDirectorySeparatorChar)) - with ex -> Error $"Invalid path '{path}': {ex.Message}" - -/// Adds a worktree root to the global config (restart-to-apply). Normalizes and verifies the -/// path is an existing directory, then read-modify-writes the roots list via the locked -/// single-writer helpers, surfacing a persistence failure rather than a false success. Adding an -/// already-watched path is a no-op success. add/remove are driven by the (serialized) -/// `tm add`/`tm remove` CLI, so the read-then-write is not contended in practice; the write -/// itself is serialized by `globalConfigLock`. -let internal addRootToConfig (path: string) : Result = - tryNormalizeRoot path - |> Result.bind (fun normalized -> - if not (Directory.Exists normalized) then - Error $"Path does not exist or is not a directory: {normalized}" - else - let existing = readWorktreeRootsConfig () - if existing |> List.exists (fun r -> pathEquals (canonicalRoot r) normalized) then - Ok() - else - writeWorktreeRoots (existing @ [ normalized ])) - -/// Removes a worktree root from the global config (restart-to-apply). Does not require the path -/// to still exist on disk (a deleted root is removable); reports an error when the path is not -/// currently watched, and surfaces a persistence failure instead of a false success. -let internal removeRootFromConfig (path: string) : Result = - tryNormalizeRoot path - |> Result.bind (fun normalized -> - let existing = readWorktreeRootsConfig () - let remaining = existing |> List.filter (fun r -> not (pathEquals (canonicalRoot r) normalized)) - if List.length remaining = List.length existing then - Error $"Not a watched root: {normalized}" - else - writeWorktreeRoots remaining) - -let private readCanvasPaneOpen () : bool = - withConfigDocument false (fun root -> - match root.TryGetProperty("canvasPaneOpen") with - | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.True -> true - | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.False -> false - | _ -> false) - -let private writeCanvasPaneOpen (isOpen: bool) = - updateGlobalConfig "canvas pane open state" [ "canvasPaneOpen", System.Text.Json.Nodes.JsonValue.Create(isOpen) :> System.Text.Json.Nodes.JsonNode ] - -let private readCanvasPosition () : CanvasPosition = - withConfigDocument CanvasPosition.Right (fun root -> - match root.TryGetProperty("canvasPosition") with - | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.String -> - match prop.GetString() with - | "left" -> CanvasPosition.Left - | "right" -> CanvasPosition.Right - | "top" -> CanvasPosition.Top - | "bottom" -> CanvasPosition.Bottom - | _ -> CanvasPosition.Right - | _ -> CanvasPosition.Right) - -let private writeCanvasPosition (position: CanvasPosition) = - let value = - match position with - | CanvasPosition.Left -> "left" - | CanvasPosition.Right -> "right" - | CanvasPosition.Top -> "top" - | CanvasPosition.Bottom -> "bottom" - updateGlobalConfig "canvas position" [ "canvasPosition", System.Text.Json.Nodes.JsonValue.Create(value) :> System.Text.Json.Nodes.JsonNode ] - -let private readCanvasSize () : CanvasSize = - withConfigDocument CanvasSize.Ratio1To1 (fun root -> - match root.TryGetProperty("canvasSize") with - | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.String -> - match prop.GetString() with - | "2to1" -> CanvasSize.Ratio2To1 - | _ -> CanvasSize.Ratio1To1 - | _ -> CanvasSize.Ratio1To1) - -let private writeCanvasSize (size: CanvasSize) = - let value = - match size with - | CanvasSize.Ratio1To1 -> "1to1" - | CanvasSize.Ratio2To1 -> "2to1" - updateGlobalConfig "canvas size" [ "canvasSize", System.Text.Json.Nodes.JsonValue.Create(value) :> System.Text.Json.Nodes.JsonNode ] - -let private readLastViewedHashes () : Map> = - withConfigDocument Map.empty (fun root -> - match root.TryGetProperty("lastViewedHashes") with - | true, prop when prop.ValueKind = System.Text.Json.JsonValueKind.Object -> - prop.EnumerateObject() - |> Seq.choose (fun worktreeProp -> - if worktreeProp.Value.ValueKind = System.Text.Json.JsonValueKind.Object then - let fileHashes = - worktreeProp.Value.EnumerateObject() - |> Seq.choose (fun fileProp -> - if fileProp.Value.ValueKind = System.Text.Json.JsonValueKind.String - then Some (fileProp.Name, fileProp.Value.GetString()) - else None) - |> Map.ofSeq - Some (worktreeProp.Name, fileHashes) - else None) - |> Map.ofSeq - | _ -> Map.empty) - -let private writeLastViewedHashes (hashes: Map>) = - let outerObj = System.Text.Json.Nodes.JsonObject() - hashes |> Map.iter (fun worktreePath fileHashes -> - let innerObj = System.Text.Json.Nodes.JsonObject() - fileHashes |> Map.iter (fun filename hash -> - innerObj[filename] <- System.Text.Json.Nodes.JsonValue.Create(hash)) - outerObj[worktreePath] <- innerObj) - updateGlobalConfig "last viewed hashes" [ "lastViewedHashes", outerObj :> System.Text.Json.Nodes.JsonNode ] - -let private getEditorConfig () = - let config = readGlobalConfig () - let command = config |> Map.tryFind "editor" |> Option.defaultValue "code" - let name = - match config |> Map.tryFind "editorName", command with - | Some n, _ -> n - | None, "code" -> "VS Code" - | None, cmd -> cmd - command, name - let getWorktrees (agent: MailboxProcessor) (sessionAgent: SessionManager.SessionAgent) @@ -461,7 +189,7 @@ let getWorktrees let! activeSessions = SessionManager.getActiveSessions sessionAgent let activeSessionPaths = activeSessions |> Map.keys |> Set.ofSeq - let ignorePredicate = TreemonConfig.readIgnoreWorktreePatterns () |> TreemonConfig.buildIgnorePredicate + let ignorePredicate = GlobalConfig.readIgnoreWorktreePatterns () |> GlobalConfig.buildIgnorePredicate let repos = state.Repos diff --git a/src/Tests/ConfigWriterTests.fs b/src/Tests/ConfigWriterTests.fs index 4fc0880..53907d0 100644 --- a/src/Tests/ConfigWriterTests.fs +++ b/src/Tests/ConfigWriterTests.fs @@ -5,7 +5,7 @@ open System.IO open System.Text.Json open System.Text.Json.Nodes open NUnit.Framework -open Server.WorktreeApi +open Server.GlobalConfig open Tests.TestUtils let private withTempDir (action: string -> unit) = diff --git a/src/Tests/DemoModeTests.fs b/src/Tests/DemoModeTests.fs index acddc78..f36247c 100644 --- a/src/Tests/DemoModeTests.fs +++ b/src/Tests/DemoModeTests.fs @@ -234,8 +234,11 @@ type DemoModeTests() = TestContext.Out.WriteLine( $"Initial state - working: {initialWorking}, waiting: {initialWaiting}, done: {initialDone}") - // Wait for a state transition (up to 12s = full cycle + buffer) - let deadline = DateTime.UtcNow.AddSeconds(12.0) + // The demo loops every 24s (12 frames x 2s); the only coding-tool dot that toggles is + // the auth card (Done <-> Working), which stays in one state for up to 14s across the + // cycle wrap. Wait a full cycle plus buffer so the opposite state is observed no matter + // which phase the page loaded in. + let deadline = DateTime.UtcNow.AddSeconds(26.0) let mutable transitioned = false while DateTime.UtcNow < deadline && not transitioned do diff --git a/src/Tests/SchedulerTests.fs b/src/Tests/SchedulerTests.fs index 5d83b60..5a79c4d 100644 --- a/src/Tests/SchedulerTests.fs +++ b/src/Tests/SchedulerTests.fs @@ -1041,7 +1041,7 @@ type ResolveIgnoredPathsTests() = [ RepoId "Repo1", makeRepo [ makeWorktree "/r1/main" "main"; makeWorktree "/r1/feat" "feature/abc" ] ] |> Map.ofList - let predicate = Server.TreemonConfig.buildIgnorePredicate [ "feature/.*" ] + let predicate = Server.GlobalConfig.buildIgnorePredicate [ "feature/.*" ] let result = resolveIgnoredPaths predicate repos let ignored = result |> Map.find (RepoId "Repo1") @@ -1054,7 +1054,7 @@ type ResolveIgnoredPathsTests() = [ RepoId "Repo1", makeRepo [ makeWorktree "/r1/main" "main"; makeWorktree "/r1/archive-foo" "feature/abc" ] ] |> Map.ofList - let predicate = Server.TreemonConfig.buildIgnorePredicate [ "archive-.*" ] + let predicate = Server.GlobalConfig.buildIgnorePredicate [ "archive-.*" ] let result = resolveIgnoredPaths predicate repos let ignored = result |> Map.find (RepoId "Repo1") @@ -1069,7 +1069,7 @@ type ResolveIgnoredPathsTests() = KnownPaths = Set.ofList [ "/r1/detached" ] } let repos = [ RepoId "Repo1", repo ] |> Map.ofList - let predicate = Server.TreemonConfig.buildIgnorePredicate [ "detached" ] + let predicate = Server.GlobalConfig.buildIgnorePredicate [ "detached" ] let result = resolveIgnoredPaths predicate repos let ignored = result |> Map.find (RepoId "Repo1") @@ -1083,7 +1083,7 @@ type ResolveIgnoredPathsTests() = KnownPaths = Set.ofList [ "/r1/detached" ] } let repos = [ RepoId "Repo1", repo ] |> Map.ofList - let predicate = Server.TreemonConfig.buildIgnorePredicate [ "archive-.*" ] + let predicate = Server.GlobalConfig.buildIgnorePredicate [ "archive-.*" ] let result = resolveIgnoredPaths predicate repos let ignored = result |> Map.find (RepoId "Repo1") @@ -1095,7 +1095,7 @@ type ResolveIgnoredPathsTests() = [ RepoId "Repo1", makeRepo [ makeWorktree "/r1/main" "main"; makeWorktree "/r1/feat" "feat" ] ] |> Map.ofList - let predicate = Server.TreemonConfig.buildIgnorePredicate [] + let predicate = Server.GlobalConfig.buildIgnorePredicate [] let result = resolveIgnoredPaths predicate repos let ignored = result |> Map.find (RepoId "Repo1") @@ -1109,13 +1109,13 @@ type BuildIgnorePredicateTests() = [] member _.``Empty patterns matches nothing``() = - let predicate = Server.TreemonConfig.buildIgnorePredicate [] + let predicate = Server.GlobalConfig.buildIgnorePredicate [] Assert.That(predicate "main", Is.False) Assert.That(predicate "feature/abc", Is.False) [] member _.``Regex pattern matches values``() = - let predicate = Server.TreemonConfig.buildIgnorePredicate [ "feature/.*"; "hotfix/.*" ] + let predicate = Server.GlobalConfig.buildIgnorePredicate [ "feature/.*"; "hotfix/.*" ] Assert.That(predicate "feature/abc", Is.True) Assert.That(predicate "hotfix/urgent", Is.True) Assert.That(predicate "main", Is.False) @@ -1123,19 +1123,19 @@ type BuildIgnorePredicateTests() = [] member _.``Pattern is anchored``() = - let predicate = Server.TreemonConfig.buildIgnorePredicate [ "feat" ] + let predicate = Server.GlobalConfig.buildIgnorePredicate [ "feat" ] Assert.That(predicate "feat", Is.True) Assert.That(predicate "feature", Is.False) Assert.That(predicate "my-feat", Is.False) [] member _.``Invalid regex is skipped``() = - let predicate = Server.TreemonConfig.buildIgnorePredicate [ "[invalid"; "main" ] + let predicate = Server.GlobalConfig.buildIgnorePredicate [ "[invalid"; "main" ] Assert.That(predicate "main", Is.True) [] member _.``Whitespace-only patterns are skipped``() = - let predicate = Server.TreemonConfig.buildIgnorePredicate [ ""; " "; "main" ] + let predicate = Server.GlobalConfig.buildIgnorePredicate [ ""; " "; "main" ] Assert.That(predicate "main", Is.True) Assert.That(predicate "", Is.False) @@ -1244,4 +1244,4 @@ type ExpediteRefreshTests() = Assert.That(state2.ExpeditedRepos |> Set.contains repo1, Is.False) Assert.That(state2.ExpeditedRepos |> Set.contains repo2, Is.True) } - |> Async.RunSynchronously \ No newline at end of file + |> Async.RunSynchronously diff --git a/src/Tests/ServerStartupResolutionTests.fs b/src/Tests/ServerStartupResolutionTests.fs index 6179ff0..df6f7f5 100644 --- a/src/Tests/ServerStartupResolutionTests.fs +++ b/src/Tests/ServerStartupResolutionTests.fs @@ -68,13 +68,13 @@ type ServerStartupResolutionTests() = Assert.That(resolution.ConsumeOrphan, Is.False) // Applying the resolution at the boundary writes it to the global config. persistResolvedRoots resolution - Assert.That(Server.WorktreeApi.readWorktreeRootsConfig (), Is.EqualTo(cliRoots))) + Assert.That(Server.GlobalConfig.readWorktreeRootsConfig (), Is.EqualTo(cliRoots))) [] member _.``resolveWorktreeRoots prefers CLI args but does not overwrite a populated config``() = withTempConfigDir "treemon-startup-test" (fun _ -> let configured = [ @"C:\code\configured" ] - match Server.WorktreeApi.writeWorktreeRoots configured with + match Server.GlobalConfig.writeWorktreeRoots configured with | Ok () -> () | Error msg -> Assert.Fail $"setup write failed: {msg}" @@ -85,13 +85,13 @@ type ServerStartupResolutionTests() = Assert.That(resolution.PersistRoots, Is.False) persistResolvedRoots resolution // ...so a populated config is an ephemeral override, not clobbered. - Assert.That(Server.WorktreeApi.readWorktreeRootsConfig (), Is.EqualTo(configured))) + Assert.That(Server.GlobalConfig.readWorktreeRootsConfig (), Is.EqualTo(configured))) [] member _.``resolveWorktreeRoots reads global config when no CLI args``() = withTempConfigDir "treemon-startup-test" (fun _ -> let configured = [ @"C:\code\x"; @"C:\code\y" ] - match Server.WorktreeApi.writeWorktreeRoots configured with + match Server.GlobalConfig.writeWorktreeRoots configured with | Ok () -> () | Error msg -> Assert.Fail $"setup write failed: {msg}" @@ -116,7 +116,7 @@ type ServerStartupResolutionTests() = persistResolvedRoots resolution // Migrated set persisted into the global config... - Assert.That(Server.WorktreeApi.readWorktreeRootsConfig (), Is.EqualTo(orphanRoots)) + Assert.That(Server.GlobalConfig.readWorktreeRootsConfig (), Is.EqualTo(orphanRoots)) // ...and the orphan file is consumed (deleted) only after a successful persist. Assert.That(File.Exists(Path.Combine(tempDir, "roots.json")), Is.False)) @@ -128,7 +128,7 @@ type ServerStartupResolutionTests() = Assert.That(resolution.PersistRoots, Is.False) persistResolvedRoots resolution // Nothing to persist, so the config stays absent/empty. - Assert.That(Server.WorktreeApi.readWorktreeRootsConfig (), Is.Empty)) + Assert.That(Server.GlobalConfig.readWorktreeRootsConfig (), Is.Empty)) // ----- Regression (tm-config-audit-rf1): an explicit `worktreeRoots:[]` must stay empty ----- // The bug: readWorktreeRootsConfig() returned [] for BOTH a missing key and a present-but-empty @@ -139,7 +139,7 @@ type ServerStartupResolutionTests() = member _.``resolveWorktreeRoots leaves an explicit empty config empty despite an orphan roots.json``() = withTempConfigDir "treemon-startup-test" (fun tempDir -> // The user removed every root: the key is PRESENT but empty (not absent). - match Server.WorktreeApi.writeWorktreeRoots [] with + match Server.GlobalConfig.writeWorktreeRoots [] with | Ok () -> () | Error msg -> Assert.Fail $"setup write failed: {msg}" // A stale orphan roots.json from a legacy upgrade still lingers on disk. @@ -154,7 +154,7 @@ type ServerStartupResolutionTests() = persistResolvedRoots resolution // ...the explicit empty config is preserved (present key, still empty — not None, not // repopulated with the orphan's roots)... - match Server.WorktreeApi.tryReadWorktreeRootsConfig () with + match Server.GlobalConfig.tryReadWorktreeRootsConfig () with | Some [] -> () | other -> Assert.Fail $"expected the config to stay an explicit empty (Some []), got %A{other}" // ...and the unconsumed orphan is left untouched (it is only migrated when the key is absent). @@ -163,7 +163,7 @@ type ServerStartupResolutionTests() = [] member _.``resolveWorktreeRoots does not persist CLI args over an explicit empty config``() = withTempConfigDir "treemon-startup-test" (fun _ -> - match Server.WorktreeApi.writeWorktreeRoots [] with + match Server.GlobalConfig.writeWorktreeRoots [] with | Ok () -> () | Error msg -> Assert.Fail $"setup write failed: {msg}" @@ -174,6 +174,6 @@ type ServerStartupResolutionTests() = Assert.That(resolution.PersistRoots, Is.False) persistResolvedRoots resolution // ...but the explicit empty config is not clobbered, so a restart with no args stays empty. - match Server.WorktreeApi.tryReadWorktreeRootsConfig () with + match Server.GlobalConfig.tryReadWorktreeRootsConfig () with | Some [] -> () | other -> Assert.Fail $"expected the config to stay an explicit empty (Some []), got %A{other}") diff --git a/src/Tests/SmokeTests.fs b/src/Tests/SmokeTests.fs index a45e0a3..ab7b238 100644 --- a/src/Tests/SmokeTests.fs +++ b/src/Tests/SmokeTests.fs @@ -35,7 +35,7 @@ let private startSmokeServerProc (configDir: string) (args: string) = // Isolate the smoke server's machine-level config dir. Startup root-resolution now persists // the resolved worktreeRoots into config.json when it has none yet, so without this override a // normal-mode smoke run would write the developer's real ~/.treemon. Point it at a caller-owned - // throwaway dir instead (WorktreeApi.globalConfigDir honors TREEMON_CONFIG_DIR); the fixture + // throwaway dir instead (GlobalConfig.globalConfigDir honors TREEMON_CONFIG_DIR); the fixture // deletes it in teardown. psi.EnvironmentVariables["TREEMON_CONFIG_DIR"] <- configDir diff --git a/src/Tests/WorktreeRootsConfigTests.fs b/src/Tests/WorktreeRootsConfigTests.fs index c0688c7..3694ec4 100644 --- a/src/Tests/WorktreeRootsConfigTests.fs +++ b/src/Tests/WorktreeRootsConfigTests.fs @@ -4,7 +4,7 @@ open System open System.IO open System.Text.Json open NUnit.Framework -open Server.WorktreeApi +open Server.GlobalConfig open Tests.TestUtils /// Compares two roots the way the endpoints do: absolute, trailing separators trimmed,