diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,48 @@ +-- | Module: Main +-- Description: Executable entry point for the gachi CLI tool +-- +-- This module serves as the physical binary entry point for the @gachi@ command-line +-- utility. It handles top-level process execution, argument consumption, and exit code +-- normalization by delegating immediately to 'Gachi.CLI.defaultMain'. +-- +-- = Architectural Context & Invariants +-- +-- In Gachi's infrastructure model (per Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization]), the CLI executable provides turnkey +-- operations for repository scaffolding, configuration synchronization, codebase +-- retrofitting, and strategic planning. +-- +-- == Process Execution Model +-- +-- 1. __Environment Agnostic:__ +-- The binary does not rely on ambient bash or Python scripts for execution logic; +-- all schema evaluation, filesystem synthesis, and Git configuration occur within +-- compiled Haskell runtime space. +-- +-- 2. __Hermetic Process Termination:__ +-- Process termination strictly reflects the outcome of the invoked subcommand. +-- Successful operations exit cleanly with 'System.Exit.ExitSuccess' (code 0). +-- Any syntax failure, schema mismatch, or filesystem collision terminates +-- immediately with 'System.Exit.ExitFailure' (code 1), preventing partial or +-- unstable workspaces from misleading downstream CI runners. +-- +-- = Usage Summary +-- +-- Invoked directly from the terminal or launcher scripts: +-- +-- @ +-- $ gachi init my-project +-- $ gachi init --config project.dhall --target-dir ./target +-- $ gachi version +-- @ +module Main (main) where + +import Gachi.CLI (defaultMain) + +-- | Primary operating system process entry point. +-- +-- Evaluates command-line flags and dispatches across operational subcommands via +-- 'Gachi.CLI.defaultMain'. Terminates the calling process with the appropriate +-- exit code upon completion. +main :: IO () +main = defaultMain diff --git a/gachi-cli.cabal b/gachi-cli.cabal new file mode 100644 --- /dev/null +++ b/gachi-cli.cabal @@ -0,0 +1,89 @@ +cabal-version: 3.0 +name: gachi-cli +version: 0.1.0.0 +synopsis: Unified command-line interface for the gachi ecosystem engine +description: + Turnkey command-line interface providing declarative project initialization ('gachi init'), + harmonic configuration propagation ('gachi sync'), non-destructive codebase retrofitting + ('gachi retrofit'), and ecosystem roadmap governance ('gachi plan'). +license: EUPL-1.2 +author: Nadia Yvette Chambers +maintainer: nadia.yvette.chambers@ik.me +category: Development, CLI, Tools +build-type: Simple +tested-with: GHC == 9.14.1 + +library + exposed-modules: + Gachi.CLI + Gachi.CLI.Doctor + Gachi.CLI.Init + Gachi.CLI.Options + Gachi.CLI.Retrofit + Gachi.CLI.Sync + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: + OverloadedStrings + DerivingStrategies + ghc-options: + -Wall + -Wcompat + -Wredundant-constraints + build-depends: + base >= 4.14 && < 5, + text >= 2.0, + directory >= 1.3, + filepath >= 1.4, + process >= 1.6, + optparse-applicative >= 0.17, + gachi-core >= 0.1, + gachi-schema >= 0.1, + gachi-scaffold >= 0.1, + gachi-sync >= 0.1, + gachi-retrofit >= 0.1 + +executable gachi + main-is: Main.hs + hs-source-dirs: app + default-language: Haskell2010 + default-extensions: + OverloadedStrings + ghc-options: + -Wall + -Wcompat + -Wredundant-constraints + -threaded + -rtsopts + -with-rtsopts=-N + build-depends: + base >= 4.14 && < 5, + gachi-cli + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + default-language: Haskell2010 + default-extensions: + OverloadedStrings + DerivingStrategies + ghc-options: + -Wall + -Wcompat + -Wredundant-constraints + -threaded + build-depends: + base >= 4.14 && < 5, + gachi-cli, + gachi-schema, + gachi-scaffold, + gachi-sync, + gachi-retrofit, + text >= 2.0, + directory >= 1.3, + filepath >= 1.4, + process >= 1.6, + optparse-applicative >= 0.17, + time >= 1.9, + hspec >= 2.10 diff --git a/src/Gachi/CLI.hs b/src/Gachi/CLI.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/CLI.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Module: Gachi.CLI +-- Description: Unified front-door dispatcher and entry point for gachi +-- +-- This is the root library module for @gachi-cli@. It provides top-level command +-- line argument parsing, dispatching, version reporting, and error handling. +-- +-- = Architectural Context & Invariants +-- +-- Gachi serves as the foundational project skeleton generator and configuration +-- propagation engine across the ecosystem (per Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization]). +-- +-- == Operational Architecture +-- +-- This module acts as the primary orchestrator and dispatcher across all CLI subcommands: +-- +-- 1. __Argument Processing:__ +-- Uses @optparse-applicative@ configured with 'showHelpOnEmpty' to display context-aware +-- usage hints whenever an empty invocation or ambiguous argument sequence is detected. +-- +-- 2. __Execution Lifecycle:__ +-- Dispatches parsed 'Command' representations to their specialized execution modules. +-- 'CmdInit' delegates to 'runInit' in "Gachi.CLI.Init", while placeholder routines +-- for Phase 3 ('CmdSync'), Phase 4 ('CmdRetrofit'), and Phase 5 ('CmdPlan') provide +-- informative scheduling notices without failing abruptly. +-- +-- 3. __Exit Code Normalization:__ +-- Every subcommand produces a deterministic 'ExitCode' ('ExitSuccess' or 'ExitFailure'), +-- ensuring predictable interaction with shell scripts, CI runners, and pre-commit hooks. +-- +-- = Command Matrix +-- +-- * 'gachi init': Full turnkey multi-package repository materialization (Milestone 2.3). +-- * 'gachi sync': Bidirectional configuration synchronization (Phase 3). +-- * 'gachi retrofit': Non-destructive legacy codebase upgrade (Phase 4). +-- * 'gachi plan': Detached git snapshotting and rollback (Phase 5). +-- * 'gachi version': Compiler and tooling pinning diagnostics. +-- +-- = Worked Example +-- +-- >>> import Gachi.CLI +-- >>> -- Invoked from executable Main: +-- >>> -- defaultMain +module Gachi.CLI + ( -- * Main CLI Dispatcher + defaultMain + , runCommand + + -- * Package Metadata + , gachiVersion + + -- * Re-exports + , module Gachi.CLI.Doctor + , module Gachi.CLI.Init + , module Gachi.CLI.Options + , module Gachi.CLI.Retrofit + , module Gachi.CLI.Sync + ) where + +import Data.Text (Text) +import qualified Data.Text.IO as TIO +import Options.Applicative (customExecParser, prefs, showHelpOnEmpty) +import System.Exit (ExitCode(..), exitWith) + +import Gachi.CLI.Doctor + ( checkBinaryVersion + , checkToolchainHealth + , formatToolchainStatus + , runDoctor + , runSheafAudit + ) +import Gachi.CLI.Init + ( detectGitAuthor + , executeScaffolding + , initializeGitRepository + , promptUser + , resolveProject + , runInit + ) +import Gachi.CLI.Options + ( Command(..) + , DoctorOptions(..) + , InitOptions(..) + , PlanOptions(..) + , RetrofitOptions(..) + , SyncOptions(..) + , commandParser + , doctorOptionsParser + , initOptionsParser + , parseMode + , parsePackageList + , planOptionsParser + , retrofitOptionsParser + , syncOptionsParser + ) +import Gachi.CLI.Retrofit (runRetrofit) +import Gachi.CLI.Sync (runSync) + +-------------------------------------------------------------------------------- +-- 1. Metadata +-------------------------------------------------------------------------------- + +-- | Canonical version identifier for the gachi toolchain. +gachiVersion :: Text +gachiVersion = "0.1.0.0" + +-------------------------------------------------------------------------------- +-- 2. Top-Level Entry Points +-------------------------------------------------------------------------------- + +-- | High-level executable entry point. +-- +-- Parses ambient command-line arguments using 'commandParser' and delegates +-- to 'runCommand', terminating the process with the resulting 'ExitCode'. +defaultMain :: IO () +defaultMain = do + let parserPrefs = prefs showHelpOnEmpty + cmd <- customExecParser parserPrefs (commandParser gachiVersion) + code <- runCommand cmd + exitWith code + +-- | Pure/IO command dispatcher executing a parsed 'Command'. +-- +-- Maps high-level AST commands to operational routines: +-- +-- * 'CmdInit': Dispatches directly to 'runInit', executing the complete project +-- synthesis, filesystem materialization, and Git governance lifecycle. +-- * 'CmdSync': Dispatches directly to 'runSync', harmonizing configuration and +-- governance stanzas across single repositories or the entire ecosystem. +-- * 'CmdRetrofit': Dispatches directly to 'runRetrofit', executing diagnostic +-- repository inspection (Milestone 4.1) and non-destructive overlay synthesis (Phase 4). +-- * 'CmdPlan': Emits roadmap schedule notice for Phase 5 detached Git ledger governance. +-- * 'CmdVersion': Outputs compiler pinning, Cabal target, and EUPL-1.2 licensing stanzas. +-- +-- Guarantees total evaluation with deterministic exit code propagation. +runCommand :: Command -> IO ExitCode +runCommand (CmdInit opts) = runInit opts +runCommand (CmdSync opts) = runSync opts +runCommand (CmdDoctor opts) = runDoctor opts +runCommand (CmdRetrofit opts) = runRetrofit opts +runCommand (CmdPlan _opts) = do + TIO.putStrLn "gachi plan: Detached Git store & snapshot rollback engine (Phase 5 - Scheduled)" + pure ExitSuccess +runCommand CmdVersion = do + TIO.putStrLn ("gachi v" <> gachiVersion <> " (GHC 9.14.1 / Cabal 3.18 / EUPL-1.2)") + pure ExitSuccess diff --git a/src/Gachi/CLI/Doctor.hs b/src/Gachi/CLI/Doctor.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/CLI/Doctor.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Module: Gachi.CLI.Doctor +-- Description: Diagnostic health checks and cellular sheaf coherence auditing +-- +-- This module implements the operational dispatch for the @gachi doctor@ command, +-- including ambient toolchain verification and 1-dimensional cellular sheaf +-- cohomology auditing across ecosystem checkouts (~/src/PLAN.md §1.A, Milestone 3.5). +-- +-- = Architectural Context & Homological Invariants +-- +-- Per Note [Cellular Sheaf Coherence and Homological Obstruction Localization] +-- [ref:note-cellular-sheaf-coherence], @gachi doctor@ evaluates the structural +-- health of single repositories or the entire multi-repository ecosystem: +-- +-- 1. __Toolchain Health Verification:__ +-- Audits ambient system binaries required by the physical verification harnesses: +-- * GHC compiler (pinned to 9.14.1) +-- * Cabal build tool (pinned to 3.18) +-- * HLint static analyzer (zero-hint policy) +-- * Tagref cross-reference validator (zero dangling tags) +-- +-- 2. __Cellular Sheaf Coherence Audit ('doctorSheaf'):__ +-- Constructs the 1-D cellular sheaf \(\mathcal{F}\) over cell complex \(G = (V, E)\) +-- where vertices \(V\) represent repository checkouts and edges \(E\) represent +-- ten standardization contract dimensions. +-- * Evaluates the sheaf coboundary operator \(\delta^0\). +-- * Confirms 0-th cohomology \(H^0(G; \mathcal{F}) = \ker \delta^0\) harmonic equilibrium (0 drift). +-- * Localizes 1-st cohomology \(H^1(G; \mathcal{F}) = \operatorname{coker} \delta^0\) +-- boundary obstructions, reporting exact drifting repositories, breached contracts, +-- and actionable remediation instructions. +-- +-- = Worked Example +-- +-- >>> import Gachi.CLI.Options (DoctorOptions(..)) +-- >>> -- Invoked via CLI: +-- >>> -- code <- runDoctor (DoctorOptions Nothing True False) +-- >>> -- code == ExitSuccess +module Gachi.CLI.Doctor + ( -- * High-Level Doctor Command Runners + runDoctor + , runSheafAudit + , checkToolchainHealth + + -- * Helper Binary Inspection + , checkBinaryVersion + , formatToolchainStatus + ) where + +import Control.Exception (SomeException, catch) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Directory (doesDirectoryExist, doesFileExist, findExecutable, getHomeDirectory) +import System.Exit (ExitCode(..)) +import System.FilePath (()) +import System.Process (readProcessWithExitCode) + +import Gachi.CLI.Options (DoctorOptions(..)) +import Gachi.Sync.Sheaf + ( SheafReport(..) + , auditEcosystemSheaf + , auditSheafTarget + , formatSheafReport + ) + +-------------------------------------------------------------------------------- +-- 1. Doctor Command Dispatcher +-------------------------------------------------------------------------------- + +-- | Main execution entry point for 'gachi doctor'. +-- +-- Dispatches based on 'DoctorOptions': +-- +-- * When @--all@ / @-a@ is specified: Executes whole-ecosystem cellular sheaf +-- coherence auditing across all discovered checkouts in the parent directory. +-- * When @--sheaf@ / @-s@ is specified: Executes targeted cellular sheaf +-- coherence auditing on the designated or current repository. +-- * Default mode: Evaluates ambient toolchain binaries, checks repository +-- governance pinning, and performs the cellular sheaf coherence audit. +-- +-- Produces 'ExitSuccess' if all boundary restrictions are in harmonic equilibrium, +-- or 'ExitFailure 1' if fatal cohomological obstructions are detected. +runDoctor :: DoctorOptions -> IO ExitCode +runDoctor opts = do + if doctorAll opts + then do + let parentDir = fromMaybe ".." (doctorTargetDir opts) + runSheafAudit parentDir True + else do + let targetDir = fromMaybe "." (doctorTargetDir opts) + if doctorSheaf opts + then runSheafAudit targetDir False + else do + toolchainOk <- checkToolchainHealth + sheafExit <- runSheafAudit targetDir False + if toolchainOk && sheafExit == ExitSuccess + then pure ExitSuccess + else pure (ExitFailure 1) + +-------------------------------------------------------------------------------- +-- 2. Cellular Sheaf Coherence Audit Dispatcher +-------------------------------------------------------------------------------- + +-- | Executes 1-D cellular sheaf cohomology auditing and formats results. +-- +-- When 'isEcosystem' is 'True', iterates over all checkouts discovered via +-- 'discoverEcosystemRepositories'. Otherwise, inspects a single target repository. +runSheafAudit :: FilePath -> Bool -> IO ExitCode +runSheafAudit targetPath isEcosystem = do + isDir <- doesDirectoryExist targetPath + if not isDir + then do + TIO.putStrLn ("[-] Error: Target directory does not exist: " <> T.pack targetPath) + pure (ExitFailure 1) + else do + report <- if isEcosystem + then auditEcosystemSheaf targetPath + else auditSheafTarget targetPath + + TIO.putStr (formatSheafReport report) + + if reportIsHarmonic report + then pure ExitSuccess + else pure (ExitFailure 1) + +-------------------------------------------------------------------------------- +-- 3. Ambient Toolchain Health Checks +-------------------------------------------------------------------------------- + +-- | Status descriptor for an ambient system binary. +data ToolStatus = ToolStatus + { toolName :: !Text + -- ^ Command binary name (e.g. @"ghc"@). + , toolExpected :: !Text + -- ^ Pinned target version or requirement. + , toolDetected :: !(Maybe Text) + -- ^ Detected version string on PATH. + , toolIsCompliant :: !Bool + -- ^ Whether detected version satisfies ecosystem pinning. + } deriving stock (Eq, Show) + +-- | Audits ambient system toolchains required by the 5 physical verification gates. +-- +-- Verifies availability and version compliance of GHC (9.14.1), Cabal (3.18), +-- HLint, and Tagref. Outputs an aligned status table. +checkToolchainHealth :: IO Bool +checkToolchainHealth = do + ghcVer <- checkBinaryVersion "ghc" ["--numeric-version"] + cabalVer <- checkBinaryVersion "cabal" ["--numeric-version"] + hlintVer <- checkBinaryVersion "hlint" ["--numeric-version"] + tagrefVer <- checkBinaryVersion "tagref" ["--version"] + + let tools = + [ ToolStatus "GHC Compiler" "9.14.1" ghcVer (ghcVer == Just "9.14.1") + , ToolStatus "Cabal Tool" "3.18" cabalVer (checkPrefix "3." cabalVer) + , ToolStatus "HLint Linter" "Clean (>=3.5)" hlintVer (checkPresent hlintVer) + , ToolStatus "Tagref Engine" "Active (>=1.4)" tagrefVer (checkPresent tagrefVer) + ] + + TIO.putStr (formatToolchainStatus tools) + pure (all toolIsCompliant tools) + where + checkPrefix pfx (Just v) = pfx `T.isPrefixOf` v + checkPrefix _ Nothing = False + + checkPresent (Just _) = True + checkPresent Nothing = False + +-- | Inspects an external binary on @PATH@ or fallback paths, executing arguments and returning stdout. +checkBinaryVersion :: String -> [String] -> IO (Maybe Text) +checkBinaryVersion bin args = do + mbExec <- findExecutable bin >>= \case + Just p -> pure (Just p) + Nothing -> do + home <- getHomeDirectory + let candidates = + [ home ".local" "bin" bin + , home ".ghcup" "bin" bin + ] + findExisting candidates + case mbExec of + Nothing -> pure Nothing + Just execPath -> do + (code, out, _) <- readProcessWithExitCode execPath args "" `catch` (\(_ :: SomeException) -> pure (ExitFailure 1, "", "")) + case code of + ExitSuccess -> + let firstLine = case T.lines (T.strip (T.pack out)) of + (l:_) -> l + [] -> "" + in pure (if T.null firstLine then Nothing else Just firstLine) + ExitFailure _ -> pure Nothing + where + findExisting [] = pure Nothing + findExisting (c:cs) = do + exists <- doesFileExist c + if exists then pure (Just c) else findExisting cs + +-- | Formats toolchain audit results as an aligned ASCII diagnostic table. +formatToolchainStatus :: [ToolStatus] -> Text +formatToolchainStatus tools = T.unlines $ + [ "================================================================================" + , " Gachi Ambient Toolchain Health Diagnostics" + , "================================================================================" + , " Tool | Expected Version | Detected Version | Status" + , "---------------------+------------------+--------------------------+------------" + ] + ++ map formatRow tools + ++ + [ "================================================================================" ] + where + formatRow t = + let nameCol = T.justifyLeft 20 ' ' (toolName t) + expCol = T.justifyLeft 17 ' ' (toolExpected t) + detCol = T.justifyLeft 25 ' ' (fromMaybe "Not Found on PATH" (toolDetected t)) + statCol = if toolIsCompliant t then "[+] OK" else "[-] DRIFT" + in nameCol <> "| " <> expCol <> "| " <> detCol <> "| " <> statCol diff --git a/src/Gachi/CLI/Init.hs b/src/Gachi/CLI/Init.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/CLI/Init.hs @@ -0,0 +1,413 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Module: Gachi.CLI.Init +-- Description: Core execution engine and interactive wizard for 'gachi init' +-- +-- This module implements the operational workflow for 'gachi init', providing +-- turnkey generation of standardized Haskell repositories from Dhall schemas, +-- command-line options, or interactive terminal prompts. +-- +-- = Architectural Context & Invariants +-- +-- {- +-- Note [CLI Ergonomics and Non-Destructive Initialization] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- [tag:note-cli-init-ergonomics] +-- +-- The `gachi init` command serves as the turnkey front door for the entire ecosystem. +-- To satisfy the ecosystem standardization matrix (Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization]), the CLI must uphold four foundational ergonomic invariants: +-- +-- 1. Dual-Path Specification: +-- The generator must support both declarative, machine-readable specifications via +-- Dhall configuration files (`--config project.dhall`), and zero-overhead CLI flags / +-- interactive wizardry for rapid prototyping. +-- +-- 2. Non-Destructive Safety: +-- File materialization is governed by explicit execution modes ('FailOnExisting', +-- 'SkipExisting', 'OverwriteExisting'). The default mode is 'FailOnExisting' to prevent +-- accidental data loss. Dry-run mode (`--dry-run`) previews all file paths, sizes, +-- and permissions without touching the filesystem. +-- +-- 3. Turnkey Git Governance: +-- Immediately upon materializing files, `gachi init` executes hermetic Git initialization +-- unless explicitly disabled via `--no-git`. It pins `core.hooksPath` to `.githooks` and +-- `commit.template` to `.gitmessage`, enforcing Sarutahiko RFC 2822 commit trailer +-- discipline from commit zero. +-- +-- 4. Five-Gate Verification Readiness: +-- Any workspace instantiated by `gachi init` must immediately pass all five physical +-- verification gates (`./bin/-verify`) without requiring manual fixes or edits. +-- -} +-- +-- = Worked Example +-- +-- >>> import Gachi.CLI.Options +-- >>> import Gachi.Scaffold +-- >>> let opts = InitOptions (Just "sample") Nothing (Just "/tmp/sample") FailOnExisting Nothing Nothing Nothing [] True True False +-- >>> exitCode <- runInit opts +-- >>> exitCode == ExitSuccess +-- True +module Gachi.CLI.Init + ( -- * High-Level Execution Entry Point + runInit + + -- * Project Resolution Operations + , resolveProject + , detectGitAuthor + , promptUser + + -- * Filesystem Materialization & Git Setup + , executeScaffolding + , initializeGitRepository + ) where + +import Control.Exception (SomeException, catch, try) +import Control.Monad (forM_, unless, when) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Directory + ( createDirectoryIfMissing + , doesDirectoryExist + , doesFileExist + ) +import System.Exit (ExitCode(..)) +import System.FilePath (()) +import System.IO (hFlush, stderr, stdout) +import System.Process (readProcessWithExitCode) + +import Gachi.CLI.Options (InitOptions(..)) +import Gachi.Schema.Dhall (decodeProjectFile) +import Gachi.Schema.Project + ( Author(..) + , PackageSpec(..) + , Project(..) + , authorEmail + , authorName + , defaultProject + , projectAuthor + , projectDescription + , projectName + , projectPackages + ) +import Gachi.Scaffold + ( FileEntry(..) + , ScaffoldError(..) + , ScaffoldResult(..) + , generateAndWriteScaffold + , generateProjectScaffold + ) + +-------------------------------------------------------------------------------- +-- 1. Main Subcommand Dispatcher +-------------------------------------------------------------------------------- + +-- | Executes the complete 'gachi init' lifecycle. +-- +-- Dispatches across Dhall configuration decoding, interactive terminal wizardry, +-- filesystem materialization, and hermetic Git repository setup. +-- +-- Returns 'ExitSuccess' upon successful completion, or 'ExitFailure 1' on error. +runInit :: InitOptions -> IO ExitCode +runInit opts = do + res <- resolveProject opts + case res of + Left err -> do + TIO.hPutStrLn stderr ("[-] Error: " <> err) + pure (ExitFailure 1) + Right (proj, targetDir) -> do + handleScaffold proj targetDir opts + +-- | Encapsulates scaffolding execution and exception handling. +-- +-- Catches known 'ScaffoldError' exceptions ('DestinationExists' and 'FileWriteFailure') +-- and renders user-friendly diagnostic messages to stderr rather than crashing with an +-- unhandled runtime exception stack trace. +-- +-- Returns 'ExitFailure 1' on error, or 'ExitSuccess' upon complete materialization. +handleScaffold :: Project -> FilePath -> InitOptions -> IO ExitCode +handleScaffold proj targetDir opts = + executeScaffolding proj targetDir opts `catch` handler + where + handler :: ScaffoldError -> IO ExitCode + handler (DestinationExists path) = do + TIO.hPutStrLn stderr + ( "[-] Error: Target file or directory already exists: " + <> T.pack path + <> "\n Use '--mode overwrite' or '--mode skip' to permit writing to existing trees." + ) + pure (ExitFailure 1) + handler (FileWriteFailure path msg) = do + TIO.hPutStrLn stderr + ( "[-] Filesystem I/O Error at " + <> T.pack path + <> ": " + <> T.pack msg + ) + pure (ExitFailure 1) + +-------------------------------------------------------------------------------- +-- 2. Project Specification Resolution +-------------------------------------------------------------------------------- + +-- | Resolves a strongly-typed 'Project' specification and target destination directory. +-- +-- Evaluates initialization configuration across three strictly prioritized channels: +-- +-- 1. __Declarative Dhall File (@--config FILE@):__ +-- Evaluates a user-supplied Dhall specification file on disk via 'decodeProjectFile'. +-- Relative schema imports are resolved hermetically relative to the file. +-- Any command-line flags provided simultaneously (@--author-name@, @--desc@, etc.) +-- are overlaid as overrides onto the resulting 'Project'. +-- +-- 2. __Interactive Wizard (@--interactive@ / @-i@):__ +-- Launches a friendly interactive terminal dialogue prompting for missing or +-- customized parameters, using ambient Git defaults as baseline suggestions. +-- +-- 3. __CLI Flags & Ambient Defaults:__ +-- When neither a configuration file nor interactive mode is specified, synthesizes +-- a canonical 'Project' using 'defaultProject', reading ambient Git author metadata +-- and applying CLI overrides. +-- +-- Returns 'Left error' on missing configuration files or decoding failure, or +-- 'Right (project, targetDirectory)' ready for filesystem materialization. +resolveProject :: InitOptions -> IO (Either Text (Project, FilePath)) +resolveProject opts = case initConfigFile opts of + Just cfgPath -> do + exists <- doesFileExist cfgPath + if not exists + then pure (Left ("Dhall configuration file not found: " <> T.pack cfgPath)) + else do + try (decodeProjectFile cfgPath) >>= \case + Left (err :: SomeException) -> pure (Left ("Failed to decode Dhall specification: " <> T.show err)) + Right baseProj -> do + let proj = applyCliOverrides opts baseProj + targetDir = case initTargetDir opts of + Just d -> d + Nothing -> T.unpack (projectName proj) + pure (Right (proj, targetDir)) + Nothing + | initInteractive opts -> do + (proj, targetDir) <- runInteractiveWizard opts + pure (Right (proj, targetDir)) + | otherwise -> do + gitAuthor <- detectGitAuthor + let pName = fromMaybe "my-project" (initProjectName opts) + baseProj = defaultProject pName gitAuthor + proj = applyCliOverrides opts baseProj + targetDir = case initTargetDir opts of + Just d -> d + Nothing -> T.unpack pName + pure (Right (proj, targetDir)) + +-- | Overlays optional CLI command-line flags onto an existing 'Project' record. +-- +-- Merges CLI flag inputs into the baseline specification according to precedence: +-- * 'initProjectName': Updates canonical project slug 'name' if provided. +-- * 'initDescription': Overrides 'description' if specified. +-- * 'initAuthorName' / 'initAuthorEmail': Overlays contact fields onto 'author'. +-- * 'initPackages': Replaces package list with new 'PackageSpec' records when non-empty. +-- +-- Preserves all non-overridden fields (such as pinned toolchain versions, licenses, +-- and git remote mirrors). +applyCliOverrides :: InitOptions -> Project -> Project +applyCliOverrides opts proj = + let pName = fromMaybe (projectName proj) (initProjectName opts) + pDesc = fromMaybe (projectDescription proj) (initDescription opts) + curAuth = projectAuthor proj + aName = fromMaybe (authorName curAuth) (initAuthorName opts) + aEmail = fromMaybe (authorEmail curAuth) (initAuthorEmail opts) + auth = Author { name = aName, email = aEmail } + pkgs = case initPackages opts of + [] -> projectPackages proj + ps -> [ PackageSpec p ("Domain package for " <> p) [] | p <- ps ] + in proj + { name = pName + , description = pDesc + , author = auth + , packages = pkgs + } + +-- | Inspects ambient Git user configuration to auto-populate author metadata. +-- +-- Queries @git config --get user.name@ and @git config --get user.email@ via +-- 'readProcessWithExitCode'. If either call fails (for example, when Git is not +-- installed or no global Git config exists), falls back to canonical ecosystem +-- defaults: +-- +-- * Name: @"Nadia Yvette Chambers"@ +-- * Email: @"nadia.yvette.chambers@ik.me"@ +-- +-- This ensures that automated CI environments and container builds always succeed +-- with reproducible author metadata. +detectGitAuthor :: IO Author +detectGitAuthor = do + (cName, oName, _) <- readProcessWithExitCode "git" ["config", "--get", "user.name"] "" + `catch` (\(_ :: SomeException) -> pure (ExitFailure 1, "", "")) + (cEmail, oEmail, _) <- readProcessWithExitCode "git" ["config", "--get", "user.email"] "" + `catch` (\(_ :: SomeException) -> pure (ExitFailure 1, "", "")) + let nameTrimmed = T.strip (T.pack oName) + emailTrimmed = T.strip (T.pack oEmail) + authName = if cName == ExitSuccess && not (T.null nameTrimmed) + then nameTrimmed + else "Nadia Yvette Chambers" + authEmail = if cEmail == ExitSuccess && not (T.null emailTrimmed) + then emailTrimmed + else "nadia.yvette.chambers@ik.me" + pure Author { name = authName, email = authEmail } + +-------------------------------------------------------------------------------- +-- 3. Interactive Wizard +-------------------------------------------------------------------------------- + +-- | Interactive terminal prompt wizard gathering project initialization parameters. +runInteractiveWizard :: InitOptions -> IO (Project, FilePath) +runInteractiveWizard opts = do + TIO.putStrLn "================================================================================" + TIO.putStrLn " gachi init — Interactive Workspace Scaffolding Wizard" + TIO.putStrLn "================================================================================" + defaultAuth <- detectGitAuthor + + let defaultName = fromMaybe "my-project" (initProjectName opts) + pName <- promptUser "Project identifier slug" defaultName + + let defaultDesc = fromMaybe "Standardized multi-package Haskell workspace" (initDescription opts) + pDesc <- promptUser "Project synopsis" defaultDesc + + let defaultAName = fromMaybe (authorName defaultAuth) (initAuthorName opts) + aName <- promptUser "Author full name" defaultAName + + let defaultAEmail = fromMaybe (authorEmail defaultAuth) (initAuthorEmail opts) + aEmail <- promptUser "Author email address" defaultAEmail + + let defaultPkgs = case initPackages opts of + [] -> pName <> "-core" + ps -> T.intercalate "," ps + pkgsRaw <- promptUser "Packages to scaffold (comma-separated)" defaultPkgs + let pkgNames = filter (not . T.null) (map T.strip (T.splitOn "," pkgsRaw)) + pkgSpecs = [ PackageSpec p ("Domain implementation for " <> p) [] | p <- pkgNames ] + + let defaultTarget = maybe pName T.pack (initTargetDir opts) + targetRaw <- promptUser "Destination directory" defaultTarget + + let proj = Project + { name = pName + , description = pDesc + , license = "EUPL-1.2" + , author = Author { name = aName, email = aEmail } + , ghcVersion = "9.14.1" + , cabalVersion = "3.18" + , packages = pkgSpecs + , remotes = [] + } + pure (proj, T.unpack targetRaw) + +-- | Prompts the user on stdout with a default value fallback. +promptUser :: Text -> Text -> IO Text +promptUser label defVal = do + TIO.putStr (label <> " [" <> defVal <> "]: ") + hFlush stdout + line <- TIO.getLine + let trimmed = T.strip line + pure (if T.null trimmed then defVal else trimmed) + +-------------------------------------------------------------------------------- +-- 4. Scaffolding & Filesystem Materialization +-------------------------------------------------------------------------------- + +-- | Materializes project assets or prints dry-run execution preview. +-- +-- Evaluates execution branching: +-- * __Dry-Run Mode ('initDryRun' is True):__ +-- Presents an in-memory preview of all planned files, their sizes in characters, +-- and executable permission flags without performing any disk mutations. +-- * __Materialization Mode ('initDryRun' is False):__ +-- Creates the destination directory tree, writes files according to 'initMode' +-- ('FailOnExisting', 'SkipExisting', or 'OverwriteExisting'), initializes Git +-- governance unless disabled via 'initNoGit', and outputs the quick-start guide. +-- +-- Returns 'ExitSuccess' upon successful execution, or raises 'ScaffoldError'. +executeScaffolding :: Project -> FilePath -> InitOptions -> IO ExitCode +executeScaffolding proj targetDir opts + | initDryRun opts = do + let entries = generateProjectScaffold proj + TIO.putStrLn "--------------------------------------------------------------------------------" + TIO.putStrLn ("DRY RUN: Simulating workspace generation for '" <> projectName proj <> "'") + TIO.putStrLn ("Target directory: " <> T.pack targetDir) + TIO.putStrLn "Planned file materialization:" + forM_ entries \e -> do + let execMark = if entryExecutable e then " [executable]" else "" + size = T.show (T.length (entryContent e)) + TIO.putStrLn (" - " <> T.pack (entryPath e) <> " (" <> size <> " chars)" <> execMark) + TIO.putStrLn ("Total: " <> T.show (length entries) <> " files planned.") + TIO.putStrLn "--------------------------------------------------------------------------------" + pure ExitSuccess + | otherwise = do + createDirectoryIfMissing True targetDir + res <- generateAndWriteScaffold targetDir (initMode opts) proj + TIO.putStrLn ("[+] Successfully materialized " <> T.show (length (writtenFiles res)) <> " files in " <> T.pack targetDir) + unless (null (skippedFiles res)) $ do + TIO.putStrLn ("[!] Skipped " <> T.show (length (skippedFiles res)) <> " pre-existing files (mode: SkipExisting)") + + unlessNoGit (initNoGit opts) $ do + initializeGitRepository targetDir + + printNextSteps proj targetDir + pure ExitSuccess + where + unlessNoGit True _ = pure () + unlessNoGit False act = act + +-- | Configures canonical Git governance (.githooks and .gitmessage) within target directory. +-- +-- Executes hermetic Git setup steps: +-- 1. Checks if a @.git@ directory exists; if not, invokes @git init @. +-- 2. Sets local repository configuration @core.hooksPath = .githooks@ to activate +-- the Sarutahiko RFC 2822 commit message hook and pre-commit validation hook. +-- 3. Sets @commit.template = .gitmessage@ to standardize commit metadata prompts. +-- +-- Silently handles failures if the @git@ executable is absent, allowing offline +-- workspace bootstrapping to proceed gracefully. +initializeGitRepository :: FilePath -> IO () +initializeGitRepository targetDir = do + let dotGit = targetDir ".git" + gitExists <- doesDirectoryExist dotGit + unless gitExists $ do + (cInit, _, _) <- readProcessWithExitCode "git" ["init", targetDir] "" + `catch` (\(_ :: SomeException) -> pure (ExitFailure 1, "", "")) + when (cInit == ExitSuccess) $ do + TIO.putStrLn " [+] Initialized new Git repository." + + -- Configure Git hooks and commit template + (cHooks, _, _) <- readProcessWithExitCode "git" ["-C", targetDir, "config", "core.hooksPath", ".githooks"] "" + `catch` (\(_ :: SomeException) -> pure (ExitFailure 1, "", "")) + (cTmpl, _, _) <- readProcessWithExitCode "git" ["-C", targetDir, "config", "commit.template", ".gitmessage"] "" + `catch` (\(_ :: SomeException) -> pure (ExitFailure 1, "", "")) + + when (cHooks == ExitSuccess && cTmpl == ExitSuccess) $ do + TIO.putStrLn " [+] Configured Git governance (.githooks and .gitmessage commit trailer template)." + +-- | Outputs standard quick-start instructions for the newly scaffolded project. +-- +-- Displays terminal navigation commands and the canonical verification script +-- invocation (@./bin/-verify@) to guide the developer immediately to +-- successful compilation and test execution. +printNextSteps :: Project -> FilePath -> IO () +printNextSteps proj targetDir = do + let pName = projectName proj + TIO.putStrLn "================================================================================" + TIO.putStrLn (" Workspace '" <> pName <> "' is ready!") + TIO.putStrLn "" + TIO.putStrLn " Quick Start:" + TIO.putStrLn (" cd " <> T.pack targetDir) + TIO.putStrLn " cabal build all" + TIO.putStrLn " cabal test all" + TIO.putStrLn (" ./bin/" <> pName <> "-verify") + TIO.putStrLn "================================================================================" diff --git a/src/Gachi/CLI/Options.hs b/src/Gachi/CLI/Options.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/CLI/Options.hs @@ -0,0 +1,470 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Module: Gachi.CLI.Options +-- Description: Command-line option parsing and data structures for gachi +-- +-- This module defines the complete command hierarchy, flags, execution modes, +-- and applicative parsers for the unified @gachi@ command-line interface. +-- +-- = Architectural Context & Invariants +-- +-- Per Note [CLI Ergonomics and Non-Destructive Initialization] +-- [ref:note-cli-init-ergonomics], the command-line interface balances declarative +-- precision (loading typed Dhall schemas) with rapid-prototyping convenience +-- (CLI flags and interactive prompts). +-- +-- == Command Hierarchy and Strategic Roadmap +-- +-- The Gachi CLI establishes five primary operational subcommands designed to +-- govern the entire repository lifecycle across the ecosystem: +-- +-- 1. __Workspace Initialization ('init'):__ +-- Bootstraps a complete, standardized multi-package repository skeleton adhering to +-- all five verification gates immediately upon creation (Milestone 2.3). +-- Supports declarative Dhall files (@--config FILE@), CLI flag overrides, and +-- an interactive step-by-step terminal wizard (@--interactive@ / @-i@). +-- +-- 2. __Harmonic Configuration Propagation ('sync'):__ +-- Propagates unified toolchain pins, linters, pre-commit hooks, and verification +-- harnesses across heterogeneous repositories (Phase 3). Evaluates differential +-- changes using a bidirectional merge strategy without manual editing. +-- +-- 3. __Non-Destructive Codebase Retrofitting ('retrofit'):__ +-- Migrates legacy or non-standard Haskell repositories into the canonical Gachi +-- multi-package workspace layout (Phase 4). Preserves existing business logic while +-- inserting the universal verification infrastructure. +-- +-- 4. __Roadmap & Snapshot Governance ('plan'):__ +-- Interacts with detached Git storage and immutable ledger checkpoints (Phase 5). +-- Maintains atomic session states, branch histories, and multi-step rollbacks. +-- +-- 5. __Version & Toolchain Diagnostics ('version'):__ +-- Emits detailed build metadata, including active GHC compiler pinning (GHC 9.14.1), +-- Cabal specification target (Cabal 3.18), and licensing status (EUPL-1.2). +-- +-- == Safety & Verification Invariants +-- +-- * __Fail-Safe Defaults:__ All filesystem mutations default to 'FailOnExisting' +-- mode, preventing accidental clobbering of uncommitted user files or directories. +-- * __Dry-Run Capability:__ Every mutating subcommand provides a @--dry-run@ flag +-- enabling developers to inspect planned actions and file trees prior to execution. +-- * __Total Failure Modes:__ Option parsers fail cleanly with informative usage +-- diagnostics on invalid inputs rather than terminating with runtime exceptions. +-- +-- = Worked Example +-- +-- >>> import Options.Applicative +-- >>> let parseArgs = execParserPure defaultPrefs (info (commandParser "0.1.0.0") idm) +-- >>> case parseArgs ["init", "my-project", "--no-git"] of { Success (CmdInit opts) -> initNoGit opts; _ -> False } +-- True +module Gachi.CLI.Options + ( -- * High-Level CLI Command Types + Command(..) + , InitOptions(..) + , SyncOptions(..) + , DoctorOptions(..) + , RetrofitOptions(..) + , PlanOptions(..) + + -- * Mode and List Parsers + , parseMode + , parsePackageList + + -- * Optparse-Applicative Parsers + , commandParser + , initOptionsParser + , syncOptionsParser + , doctorOptionsParser + , retrofitOptionsParser + , planOptionsParser + ) where + +import Data.Char (toLower) +import Data.Text (Text) +import qualified Data.Text as T +import Options.Applicative + ( Parser + , ParserInfo + , command + , eitherReader + , fullDesc + , header + , help + , helper + , hsubparser + , info + , long + , many + , metavar + , option + , optional + , progDesc + , short + , strArgument + , strOption + , switch + , value + ) + +import Gachi.Scaffold (ScaffoldMode(..)) + +-------------------------------------------------------------------------------- +-- 1. Command-Line AST & Option Types +-------------------------------------------------------------------------------- + +-- | Top-level command dispatcher covering all ecosystem operational subcommands. +data Command + = CmdInit !InitOptions + -- ^ Initialize a new standardized multi-package workspace ('gachi init'). + | CmdSync !SyncOptions + -- ^ Harmonically synchronize configuration across repositories ('gachi sync'). + | CmdDoctor !DoctorOptions + -- ^ Diagnose workspace health, toolchain binaries, and 1-D cellular sheaf coherence ('gachi doctor'). + | CmdRetrofit !RetrofitOptions + -- ^ Non-destructively retrofit an existing codebase ('gachi retrofit'). + | CmdPlan !PlanOptions + -- ^ Manage ecosystem strategic roadmaps and rollback ('gachi plan'). + | CmdVersion + -- ^ Print toolchain version, GHC pinning, and licensing stanzas. + deriving stock (Eq, Show) + +-- | Configuration parameters controlling the 'gachi init' scaffolding engine. +-- +-- Governs pure specification resolution, terminal interaction, target destination paths, +-- filesystem write modes, and automated Git governance bootstrapping. +data InitOptions = InitOptions + { initProjectName :: !(Maybe Text) + -- ^ Positional project name (e.g., @"gongju"@). When supplied, defines the canonical + -- project identifier, directory basename, Cabal workspace name, and verification harness slug. + , initConfigFile :: !(Maybe FilePath) + -- ^ Optional path to declarative Dhall configuration file (@--config FILE@ / @-c FILE@). + -- When specified, the schema is hermetically evaluated from disk, superseding positional defaults. + , initTargetDir :: !(Maybe FilePath) + -- ^ Destination directory path (@--target-dir DIR@ / @-d DIR@). + -- Defaults to @./@ when omitted. Created recursively if non-existent. + , initMode :: !ScaffoldMode + -- ^ Filesystem write mode: 'FailOnExisting' (abort on collision), 'SkipExisting' (preserve + -- pre-existing files untouched), or 'OverwriteExisting' (clobber existing destination files). + , initAuthorName :: !(Maybe Text) + -- ^ Override for author full personal or organizational name (@--author-name NAME@). + -- Overrides values detected from ambient Git configuration (@user.name@). + , initAuthorEmail :: !(Maybe Text) + -- ^ Override for author contact email address (@--author-email EMAIL@). + -- Overrides values detected from ambient Git configuration (@user.email@). + , initDescription :: !(Maybe Text) + -- ^ Override for high-level project synopsis or mission description (@--desc TEXT@). + -- Embedded directly in generated README.md, cabal files, and package documentation. + , initPackages :: ![Text] + -- ^ Optional comma-separated list of satellite packages to instantiate in the workspace. + -- Each package receives a dedicated cabal manifest, test suite, and module hierarchy. + , initNoGit :: !Bool + -- ^ Skip hermetic Git repository initialization and .githooks configuration (@--no-git@). + -- Intended for generating sub-trees inside existing Git working copies or container sandboxes. + , initDryRun :: !Bool + -- ^ Preview file tree generation and permissions without writing to disk (@--dry-run@). + -- Prints an audit table containing relative paths, character counts, and executable marks. + , initInteractive :: !Bool + -- ^ Interactively prompt for missing project parameters (@--interactive@ / @-i@). + -- Launches terminal wizard offering intelligent defaults drawn from ambient Git configuration. + } deriving stock (Eq, Show) + +-- | Configuration parameters controlling Phase 3 'gachi sync'. +-- +-- Used to synchronize standardized ecosystem configuration across disparate repositories. +data SyncOptions = SyncOptions + { syncTargetDir :: !(Maybe FilePath) + -- ^ Target repository checkout directory to synchronize (@--target DIR@ / @-t DIR@). + -- Defaults to current working directory when omitted. + , syncDryRun :: !Bool + -- ^ Preview differential synchronization changes without mutating filesystem (@--dry-run@). + -- Displays unified diffs and file permission updates planned by the synchronization engine. + , syncAll :: !Bool + -- ^ Discover and synchronize all sibling repositories across the ecosystem parent directory (@--all@ / @-a@). + , syncRemotes :: !Bool + -- ^ Audit and synchronize git remote replication topology (@--remotes@ / @-r@). + } deriving stock (Eq, Show) + +-- | Configuration parameters controlling the 'gachi doctor' diagnostic command. +-- +-- Evaluates ambient system toolchains, repository health, and executes 1-D cellular +-- sheaf cohomology audits to detect and localize cross-repository contract drift. +data DoctorOptions = DoctorOptions + { doctorTargetDir :: !(Maybe FilePath) + -- ^ Target repository directory to inspect (@--target DIR@ / @-t DIR@). + -- Defaults to current working directory when omitted. + , doctorSheaf :: !Bool + -- ^ Run 1-D cellular sheaf cohomology coherence audit (@--sheaf@ / @-s@). + , doctorAll :: !Bool + -- ^ Discover and audit all sibling repositories across ecosystem parent directory (@--all@ / @-a@). + } deriving stock (Eq, Show) + +-- | Configuration parameters controlling Phase 4 'gachi retrofit'. +-- +-- Used to migrate legacy or ad-hoc Haskell codebases into the standardized ecosystem hierarchy. +data RetrofitOptions = RetrofitOptions + { retrofitTargetDir :: !(Maybe FilePath) + -- ^ Legacy repository checkout directory to inspect and overlay (@--target DIR@ / @-t DIR@). + -- Defaults to current working directory when omitted. + , retrofitDryRun :: !Bool + -- ^ Preview retrofitting actions without modifying existing source files (@--dry-run@). + -- Reports missing verification harnesses, hooks, and documentation skeletons. + , retrofitMarkdown :: !Bool + -- ^ Output diagnostic report in GitHub-Flavored Markdown format (@--markdown@ / @-m@). + } deriving stock (Eq, Show) + +-- | Configuration parameters controlling Phase 5 'gachi plan'. +-- +-- Interacts with immutable ledger checkpoints and atomic rollback via detached git storage. +data PlanOptions = PlanOptions + { planSubcommand :: !Text + -- ^ Plan governance subcommand (e.g. @"checkpoint"@, @"diff"@, @"log"@, @"rollback"@). + -- Dictates state store transitions and audit trail queries. + , planArgs :: ![Text] + -- ^ Additional positional or keyword arguments supplied to the plan action. + -- Passed verbatim to the underlying detached Git storage engine. + } deriving stock (Eq, Show) + +-------------------------------------------------------------------------------- +-- 2. Parsing Helpers +-------------------------------------------------------------------------------- + +-- | Parses a textual write mode into a canonical 'ScaffoldMode'. +-- +-- Accepts case-insensitive strings: @"fail"@, @"skip"@, or @"overwrite"@. +parseMode :: String -> Either String ScaffoldMode +parseMode raw = case map toLower raw of + "fail" -> Right FailOnExisting + "skip" -> Right SkipExisting + "overwrite" -> Right OverwriteExisting + other -> Left ("Invalid write mode '" ++ other ++ "'. Expected 'fail', 'skip', or 'overwrite'.") + +-- | Parses a comma-delimited string of package names into a cleaned list. +parsePackageList :: String -> Either String [Text] +parsePackageList raw = + let pieces = map T.strip (T.splitOn "," (T.pack raw)) + filtered = filter (not . T.null) pieces + in Right filtered + +-------------------------------------------------------------------------------- +-- 3. Top-Level Optparse Parser +-------------------------------------------------------------------------------- + +-- | Constructs the top-level 'ParserInfo' for the @gachi@ executable. +commandParser :: Text -> ParserInfo Command +commandParser ver = + info (helper <*> mainParser) + ( fullDesc + <> header ("gachi v" ++ T.unpack ver ++ " — Ecosystem Skeleton Generator & Chattering Synchronizer") + <> progDesc "Declarative Haskell project scaffolding, configuration propagation, and plan governance." + ) + +-- | Dispatches across CLI subcommands. +mainParser :: Parser Command +mainParser = hsubparser + ( command "init" + (info (CmdInit <$> initOptionsParser) + (progDesc "Initialize a new standardized multi-package Haskell workspace or satellite package")) + <> command "sync" + (info (CmdSync <$> syncOptionsParser) + (progDesc "Harmonically synchronize configuration and governance stanzas across repositories (Phase 3)")) + <> command "doctor" + (info (CmdDoctor <$> doctorOptionsParser) + (progDesc "Diagnose workspace health, toolchain binaries, and 1-D cellular sheaf coherence (Milestone 3.5)")) + <> command "retrofit" + (info (CmdRetrofit <$> retrofitOptionsParser) + (progDesc "Non-destructively retrofit an existing codebase into the canonical ecosystem skeleton (Phase 4)")) + <> command "plan" + (info (CmdPlan <$> planOptionsParser) + (progDesc "Manage ecosystem strategic roadmaps and atomic rollback via detached git storage (Phase 5)")) + <> command "version" + (info (pure CmdVersion) + (progDesc "Display gachi version, compiler pinning, and licensing stanzas")) + ) + +-------------------------------------------------------------------------------- +-- 4. Subcommand Parsers +-------------------------------------------------------------------------------- + +-- | Applicative parser for 'InitOptions'. +-- +-- Assembles options governing the 'gachi init' subcommand: +-- * Positional argument: Optional project identifier slug (e.g. @"gongju"@). +-- * Configuration flag (@--config@ / @-c@): Path to declarative Dhall schema file. +-- * Target directory (@--target-dir@ / @-d@): Output path (defaults to @./@). +-- * Write mode (@--mode@ / @-m@): Safety policy ('FailOnExisting', 'SkipExisting', 'OverwriteExisting'). +-- * Metadata overrides: @--author-name@, @--author-email@, and @--desc@. +-- * Satellite packages (@--packages@): Comma-delimited list of packages to instantiate. +-- * Operational switches: @--no-git@ (skip VCS setup), @--dry-run@ (simulation), @-i@ (interactive wizard). +initOptionsParser :: Parser InitOptions +initOptionsParser = InitOptions + <$> optional + ( strArgument + ( metavar "PROJECT_NAME" + <> help "Name of the project to initialize (e.g., 'gongju')" + ) + ) + <*> optional + ( strOption + ( long "config" + <> short 'c' + <> metavar "FILE" + <> help "Path to declarative Dhall project specification file (.dhall)" + ) + ) + <*> optional + ( strOption + ( long "target-dir" + <> short 'd' + <> metavar "DIR" + <> help "Destination directory for generated workspace (defaults to ./)" + ) + ) + <*> option (eitherReader parseMode) + ( long "mode" + <> short 'm' + <> metavar "MODE" + <> value FailOnExisting + <> help "Filesystem write mode: 'fail', 'skip', or 'overwrite' (default: 'fail')" + ) + <*> optional + ( strOption + ( long "author-name" + <> metavar "NAME" + <> help "Author full name override" + ) + ) + <*> optional + ( strOption + ( long "author-email" + <> metavar "EMAIL" + <> help "Author email address override" + ) + ) + <*> optional + ( strOption + ( long "desc" + <> metavar "TEXT" + <> help "High-level project synopsis or description override" + ) + ) + <*> option (eitherReader parsePackageList) + ( long "packages" + <> metavar "PKG1,PKG2,..." + <> value [] + <> help "Comma-separated list of satellite packages to instantiate" + ) + <*> switch + ( long "no-git" + <> help "Skip Git repository initialization and .githooks configuration" + ) + <*> switch + ( long "dry-run" + <> help "Simulate scaffolding generation and print summary without writing to disk" + ) + <*> switch + ( long "interactive" + <> short 'i' + <> help "Interactively prompt for missing configuration values" + ) + +-- | Applicative parser for 'SyncOptions'. +-- +-- Parses flags for cross-repository configuration synchronization (Phase 3): +-- * Target repository directory (@--target@ / @-t@). +-- * Dry-run simulation switch (@--dry-run@). +-- * All repositories discovery switch (@--all@ / @-a@). +syncOptionsParser :: Parser SyncOptions +syncOptionsParser = SyncOptions + <$> optional + ( strOption + ( long "target" + <> short 't' + <> metavar "DIR" + <> help "Target repository directory to synchronize" + ) + ) + <*> switch + ( long "dry-run" + <> help "Preview synchronization diffs without mutating filesystem" + ) + <*> switch + ( long "all" + <> short 'a' + <> help "Discover and synchronize all repositories across the ecosystem parent directory" + ) + <*> switch + ( long "remotes" + <> short 'r' + <> help "Audit and synchronize git remote replication topology" + ) + +-- | Applicative parser for 'DoctorOptions'. +-- +-- Parses flags for workspace diagnostics and cellular sheaf coherence auditing (Milestone 3.5): +-- * Target repository directory (@--target@ / @-t@). +-- * Cellular sheaf coherence audit switch (@--sheaf@ / @-s@). +-- * All ecosystem repositories switch (@--all@ / @-a@). +doctorOptionsParser :: Parser DoctorOptions +doctorOptionsParser = DoctorOptions + <$> optional + ( strOption + ( long "target" + <> short 't' + <> metavar "DIR" + <> help "Target repository directory to diagnose (defaults to current directory)" + ) + ) + <*> switch + ( long "sheaf" + <> short 's' + <> help "Evaluate 1-D cellular sheaf coherence and localize H^1 boundary obstructions" + ) + <*> switch + ( long "all" + <> short 'a' + <> help "Audit all discovered ecosystem repositories across the parent directory" + ) + +-- | Applicative parser for 'RetrofitOptions'. +-- +-- Parses flags for non-destructive legacy codebase migration (Phase 4): +-- * Target codebase directory (@--target@ / @-t@). +-- * Dry-run simulation switch (@--dry-run@). +retrofitOptionsParser :: Parser RetrofitOptions +retrofitOptionsParser = RetrofitOptions + <$> optional + ( strOption + ( long "target" + <> short 't' + <> metavar "DIR" + <> help "Legacy repository directory to inspect and overlay" + ) + ) + <*> switch + ( long "dry-run" + <> help "Preview retrofitting actions without modifying existing files" + ) + <*> switch + ( long "markdown" + <> short 'm' + <> help "Format diagnostic inspection report as GitHub-Flavored Markdown" + ) + +-- | Applicative parser for 'PlanOptions'. +-- +-- Parses commands and arguments for detached Git state store management (Phase 5): +-- * Action subcommand (@checkpoint@, @diff@, @log@, @rollback@). +-- * Trailing positional arguments supplied directly to the plan engine. +planOptionsParser :: Parser PlanOptions +planOptionsParser = PlanOptions + <$> strArgument + ( metavar "SUBCOMMAND" + <> help "Plan action: checkpoint, diff, log, or rollback" + ) + <*> many + ( strArgument + ( metavar "ARGS..." + <> help "Arguments supplied to the plan action" + ) + ) diff --git a/src/Gachi/CLI/Retrofit.hs b/src/Gachi/CLI/Retrofit.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/CLI/Retrofit.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Module: Gachi.CLI.Retrofit +-- Description: Command execution engine for 'gachi retrofit' +-- +-- This module coordinates the diagnostic inspection and non-destructive overlay +-- workflows for the @gachi retrofit@ subcommand (Milestones 4.1 & 4.2, Phase 4). +-- +-- = Architectural Context & Invariants +-- +-- Per Note [Non-Destructive Skeleton Overlay] [ref:note-nondestructive-retrofit], +-- retrofitting operations adopt legacy, single-package, or external repositories +-- into the canonical ecosystem skeleton without altering domain code. +-- +-- == Operational Workflow +-- +-- The retrofitting execution lifecycle unfolds in two stages: +-- +-- 1. __Diagnostic Inspection (Milestone 4.1):__ +-- Executes the comprehensive 'DiagnosticReport' scanner, evaluating: +-- - Programming language distribution and file percentages. +-- - Build tool manifests and workspace topography. +-- - Test infrastructure and declared test suites. +-- - Documentation gaps relative to @DOC_STRATEGY.md@. +-- - Git governance, hook executability, and RFC 2822 @Assisted-by:@ trailer validation. +-- - Physical verification harnesses and quality gates. +-- +-- 2. __Non-Destructive Overlay (Milestone 4.2):__ +-- Computes the 'OverlayPlan', categorizing missing standardized assets as 'ActionCreate' +-- and pre-existing files as 'ActionPreserve'. In live execution mode, writes missing +-- documentation, agent rules, Git hooks, and verification runners with executable permissions +-- and configures Git governance without touching domain source files. +-- +-- == Formatting & Execution Modes +-- +-- * __Standard Terminal Mode (Default):__ Emits an 80-column aligned ASCII terminal +-- dashboard featuring boxed sections, Unicode score progress bars, and aligned checklists. +-- * __Markdown Mode (@--markdown@ / @-m@):__ Emits clean GitHub-Flavored Markdown tables +-- suitable for piping into @RETROFIT_PLAN.md@ or CI workflow artifacts. +-- * __Simulation Mode (@--dry-run@):__ Previews the diagnostic inspection report and +-- the proposed non-destructive overlay plan without modifying any filesystem files. +-- * __Materialization Mode (Live):__ Materializes the overlay plan and activates Git +-- governance hooks in the target repository. +-- +-- = Worked Example +-- +-- >>> import Gachi.CLI.Options (RetrofitOptions(..)) +-- >>> let opts = RetrofitOptions (Just ".") True False +-- >>> code <- runRetrofit opts +-- >>> code == ExitSuccess +-- True +module Gachi.CLI.Retrofit + ( -- * High-Level Subcommand Runner + runRetrofit + + -- * Operational Execution Routines + , runInspectionAndOverlay + ) where + +import Control.Exception (SomeException, catch) +import Control.Monad (unless) +import Data.Maybe (fromMaybe) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Directory (doesDirectoryExist) +import System.Exit (ExitCode(..)) +import System.IO (stderr) + +import Gachi.CLI.Options (RetrofitOptions(..)) +import Gachi.Retrofit + ( OverlayResult(..) + , computeOverlayPlan + , evaluateQualityGates + , executeOverlayPlan + , formatDiagnosticMarkdown + , formatDiagnosticReport + , formatOverlayPlan + , formatOverlayPlanMarkdown + , formatOverlayResult + , formatQualityGateMarkdown + , formatQualityGateReport + , scanRepository + ) + +-------------------------------------------------------------------------------- +-- 1. High-Level Subcommand Runner +-------------------------------------------------------------------------------- + +-- | Executes the @gachi retrofit@ subcommand from parsed 'RetrofitOptions'. +-- +-- === Execution Steps +-- +-- 1. Resolves target directory from 'retrofitTargetDir', defaulting to current working +-- directory (@.@) when omitted. +-- 2. Verifies physical existence of the target directory on disk, failing cleanly +-- with 'ExitFailure 1' if missing. +-- 3. Dispatches to 'runInspectionAndOverlay' to execute diagnostic analysis, compute +-- the non-destructive overlay plan, and optionally apply disk materializations. +-- +-- === Exit Codes +-- +-- * 'ExitSuccess': Inspection and overlay completed successfully. +-- * 'ExitFailure 1': Target directory does not exist or was inaccessible. +runRetrofit :: RetrofitOptions -> IO ExitCode +runRetrofit opts = do + let targetDir = fromMaybe "." (retrofitTargetDir opts) + isDir <- doesDirectoryExist targetDir `catch` (\(_ :: SomeException) -> pure False) + if not isDir + then do + TIO.hPutStrLn stderr ("gachi retrofit error: Target directory '" <> T.pack targetDir <> "' does not exist.") + pure (ExitFailure 1) + else runInspectionAndOverlay targetDir (retrofitDryRun opts) (retrofitMarkdown opts) + +-------------------------------------------------------------------------------- +-- 2. Operational Routines +-------------------------------------------------------------------------------- + +-- | Performs the static diagnostic analysis of the target directory, computes +-- the non-destructive overlay plan, and conditionally executes the materialization. +-- +-- Observes Note [Non-Destructive Skeleton Overlay] [ref:note-nondestructive-retrofit]: +-- in simulation mode (@--dry-run@), displays the proposed overlay actions without disk mutations; +-- in materialization mode, writes missing standardized assets and pins Git governance. +runInspectionAndOverlay :: FilePath -> Bool -> Bool -> IO ExitCode +runInspectionAndOverlay targetDir isDryRun isMarkdown = do + -- 1. Milestone 4.1 Diagnostic Inspection + report <- scanRepository targetDir + if isMarkdown + then TIO.putStr (formatDiagnosticMarkdown report) + else TIO.putStr (formatDiagnosticReport report) + + -- 2. Milestone 4.2 Non-Destructive Overlay Plan Computation + plan <- computeOverlayPlan targetDir report + + -- 3. Execution or Simulation Branching + if isDryRun + then do + if isMarkdown + then TIO.putStr (formatOverlayPlanMarkdown plan) + else TIO.putStr (formatOverlayPlan plan) + TIO.putStrLn " [*] Simulation mode (--dry-run): No filesystem changes planned or applied." + else do + unlessMarkdown $ TIO.putStr (formatOverlayPlan plan) + result <- executeOverlayPlan plan + if isMarkdown + then do + TIO.putStrLn "" + TIO.putStrLn "## Overlay Materialization Result" + TIO.putStrLn "" + TIO.putStrLn ("- **Files Created:** " <> T.pack (show (length (resultCreatedFiles result)))) + TIO.putStrLn ("- **Files Preserved:** " <> T.pack (show (length (resultPreservedFiles result)))) + TIO.putStrLn ("- **Git Actions:** " <> T.pack (show (length (resultGitActions result)))) + else TIO.putStr (formatOverlayResult result) + TIO.putStrLn " [+] Milestone 4.2 Non-Destructive Skeleton Overlay applied successfully." + + -- 4. Milestone 4.3 Progressive Quality Gate Evaluation + qgReport <- evaluateQualityGates targetDir + if isMarkdown + then TIO.putStr (formatQualityGateMarkdown qgReport) + else TIO.putStr (formatQualityGateReport qgReport) + + pure ExitSuccess + where + unlessMarkdown = unless isMarkdown diff --git a/src/Gachi/CLI/Sync.hs b/src/Gachi/CLI/Sync.hs new file mode 100644 --- /dev/null +++ b/src/Gachi/CLI/Sync.hs @@ -0,0 +1,373 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Module: Gachi.CLI.Sync +-- Description: Command execution engine for 'gachi sync' +-- +-- This module implements the operational workflow for the @gachi sync@ subcommand. +-- It coordinates differential scanning, plan calculation, and atomic propagation +-- across single repositories or the entire multi-repository ecosystem. +-- +-- = Architectural Context & Invariants +-- +-- In accordance with Note [Harmonic Chattering Synchronization and Differential Propagation] +-- [ref:note-harmonic-sync] and Note [Ecosystem Standardization Invariants] +-- [ref:note-ecosystem-standardization], @gachi sync@ provides the automated mechanism +-- that brings disparate repositories into structural resonance with the canonical +-- Standardization Matrix. +-- +-- == Operational Workflow +-- +-- The synchronization command executes through the following phased sequence: +-- +-- 1. __Target Resolution:__ +-- Resolves whether the user intends to synchronize a single target repository +-- (the default, pointing to current working directory or explicit @--target@) +-- or perform ecosystem-wide orchestration via @--all@. +-- +-- 2. __Differential Scan & Plan Construction:__ +-- Evaluates each target checkout against the 9-dimensional canonical matrix +-- ('canonicalMatrix'), computing a pure 'SyncPlan' that categorizes every asset +-- into 'ActionCreate', 'ActionUpdate', 'ActionChmod', or 'ActionNoOp'. +-- +-- 3. __Execution Mode Enforcement:__ +-- * __'DryRun' (@--dry-run@):__ Emits ASCII audit tables detailing proposed +-- creations, diffs, and permission adjustments without mutating disk. +-- * __'ApplySync' (Default):__ Materializes missing files, writes updated +-- canonical contents, and sets owner executable bits where required. +-- +-- 4. __Idempotency Verification:__ +-- All updates are deterministic and mathematically idempotent. A secondary +-- invocation over a synchronized workspace results in zero modifications. +-- +-- = Worked Example +-- +-- >>> import Gachi.CLI.Options (SyncOptions(..)) +-- >>> let opts = SyncOptions (Just "/home/nyc/src/gachi") True False +-- >>> code <- runSync opts +-- >>> code == ExitSuccess +-- True +module Gachi.CLI.Sync + ( -- * High-Level Subcommand Runner + runSync + + -- * Operational Execution Routines + , runSingleSync + , runEcosystemSync + , runRemoteSync + , runEcosystemRemoteSync + + -- * Summary Formatting + , formatEcosystemSummary + ) where + +import Control.Monad (forM, forM_, unless, when) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Directory (doesDirectoryExist) +import System.Exit (ExitCode(..)) +import System.FilePath (takeFileName) +import System.IO (stderr) + +import Gachi.CLI.Options (SyncOptions(..)) +import Gachi.Sync + ( StandardizationMatrix + , SyncMode(..) + , SyncResult(..) + , canonicalMatrix + , computeRemoteSyncPlan + , discoverEcosystemRepositories + , formatRemoteReport + , formatRemoteSyncPlan + , formatSyncResult + , planRemoteActions + , syncEcosystem + , syncRemoteTopologyQuick + , syncRepositoryQuick + ) + +-------------------------------------------------------------------------------- +-- 1. High-Level Subcommand Runner +-------------------------------------------------------------------------------- + +-- | Executes the @gachi sync@ subcommand from parsed 'SyncOptions'. +-- +-- === Dispatch Strategy & Flags +-- +-- 1. __Execution Mode Selection:__ +-- Evaluates 'syncDryRun': +-- * When @--dry-run@ is specified, selects 'DryRun' mode, performing read-only +-- cryptographic differential auditing without disk mutation. +-- * Otherwise, selects 'ApplySync' mode to write canonical contents and enforce +-- executable bit permissions. +-- +-- 2. __Scope Resolution:__ +-- * __Remote Topology Synchronization (@--remotes@ / @-r@):__ +-- Delegates to 'runRemoteSync' (or 'runEcosystemRemoteSync' when @--all@ is active), +-- auditing configured Git remotes against Note [Multi-Remote Replication Topology and Provider Compliance] +-- [ref:note-remote-topology] and reconciling missing or drifted remotes. +-- * __Ecosystem Scope (@--all@ / @-a@):__ +-- Delegates to 'runEcosystemSync', discovering all sibling repositories in the +-- target directory and harmonizing each discovered checkout in sequence. +-- * __Targeted Repository Scope (Default):__ +-- Delegates to 'runSingleSync', synchronizing only the specified directory. +-- +-- 3. __Exit Code Normalization:__ +-- * Returns 'ExitSuccess' when all planned synchronization tasks conclude without +-- disk writing exceptions or unparseable schema files. +-- * Returns 'ExitFailure 1' if unrecoverable filesystem errors or schema errors occur. +runSync :: SyncOptions -> IO ExitCode +runSync opts = do + let mode = if syncDryRun opts then DryRun else ApplySync + target = fromMaybe "." (syncTargetDir opts) + if syncRemotes opts + then if syncAll opts + then runEcosystemRemoteSync mode target + else runRemoteSync mode target + else if syncAll opts + then runEcosystemSync mode target canonicalMatrix + else runSingleSync mode target + +-------------------------------------------------------------------------------- +-- 2. Single Repository Synchronization +-------------------------------------------------------------------------------- + +-- | Synchronizes a single repository checkout against 'canonicalMatrix'. +-- +-- Automatically locates and decodes @project.dhall@ if present, or infers +-- default project identity from directory naming. Emits detailed diagnostic +-- ASCII summary tables describing all executed or simulated actions. +-- +-- === Operational Safety +-- +-- * Checks for target directory existence prior to performing any operations. +-- * Delegates to 'syncRepositoryQuick', which runs under pure SHA-256 differential +-- scanning. +-- * Emits the formatted plan/result table via 'formatSyncResult'. +-- * Returns 'ExitSuccess' if all actions succeeded, or 'ExitFailure 1' on errors. +runSingleSync :: SyncMode -> FilePath -> IO ExitCode +runSingleSync mode targetDir = do + exists <- doesDirectoryExist targetDir + if not exists + then do + TIO.hPutStrLn stderr ("Target directory does not exist: " <> T.pack targetDir) + pure (ExitFailure 1) + else do + syncRepositoryQuick mode targetDir >>= \case + Left err -> do + TIO.hPutStrLn stderr ("Synchronization failed for " <> T.pack targetDir <> ": " <> err) + pure (ExitFailure 1) + Right result -> do + TIO.putStrLn (formatSyncResult result) + pure if resultSuccess result then ExitSuccess else ExitFailure 1 + +-------------------------------------------------------------------------------- +-- 3. Ecosystem-Wide Multi-Repository Orchestration +-------------------------------------------------------------------------------- + +-- | Discovers and harmonically synchronizes all repositories in a parent directory. +-- +-- Scans the specified parent directory for sibling repository checkouts, evaluates +-- differential synchronization plans for each repository, and renders a consolidated +-- audit matrix detailing the health and synchronization status across the ecosystem. +-- +-- === Discovery and Batch Processing +-- +-- 1. Verifies existence of the parent directory. +-- 2. Discovers child repositories via 'discoverEcosystemRepositories', identifying +-- folders containing @.git@, @cabal.project@, or @project.dhall@. +-- 3. Displays discovered repository paths and begins sequential synchronization. +-- 4. Emits a consolidated ecosystem table via 'formatEcosystemSummary'. +-- 5. Returns 'ExitSuccess' if every repository synchronized without error, or +-- 'ExitFailure 1' if any repository encountered failures. +runEcosystemSync :: SyncMode -> FilePath -> StandardizationMatrix -> IO ExitCode +runEcosystemSync mode parentDir matrix = do + exists <- doesDirectoryExist parentDir + if not exists + then do + TIO.hPutStrLn stderr ("Ecosystem directory does not exist: " <> T.pack parentDir) + pure (ExitFailure 1) + else do + repos <- discoverEcosystemRepositories parentDir + if null repos + then do + TIO.putStrLn ("No repositories discovered under: " <> T.pack parentDir) + pure ExitSuccess + else do + TIO.putStrLn ("Discovered " <> T.show (length repos) <> " repositories under " <> T.pack parentDir <> ":") + forM_ repos \repo -> + TIO.putStrLn (" • " <> T.pack (takeFileName repo) <> " (" <> T.pack repo <> ")") + TIO.putStrLn "" + + results <- syncEcosystem mode parentDir matrix + let summary = formatEcosystemSummary mode results + TIO.putStrLn summary + + let allSuccessful = all isResultSuccess results + pure if allSuccessful then ExitSuccess else ExitFailure 1 + where + isResultSuccess :: (FilePath, Either Text SyncResult) -> Bool + isResultSuccess (_, Right res) = resultSuccess res + isResultSuccess (_, Left _) = False + +-------------------------------------------------------------------------------- +-- 4. Ecosystem Summary Reporting +-------------------------------------------------------------------------------- + +-- | Formats a tabular ASCII overview of ecosystem synchronization outcomes. +-- +-- Renders a multi-column report displaying the structural alignment across all +-- discovered repositories in the target ecosystem directory. +-- +-- === Table Architecture & Columns +-- +-- The generated matrix contains eight informative columns: +-- +-- 1. __Repository (20 chars):__ The folder basename of the discovered checkout. +-- 2. __Mode (10 chars):__ @DRY-RUN@ preview simulation vs @APPLIED@ live mutation. +-- 3. __Created (7 chars):__ Number of previously missing files synthesized. +-- 4. __Updated (7 chars):__ Number of drifted files restored to canonical form. +-- 5. __Chmod (7 chars):__ Number of scripts whose executable bits were corrected. +-- 6. __Unchanged (9 chars):__ Number of assets already in clean compliance. +-- 7. __Errors (6 chars):__ Count of I/O failures or Dhall decoding exceptions. +-- 8. __Disposition (11 chars):__ +-- * @RESONANT@: Repository is in full compliance with zero errors. +-- * @DRIFTED@: Discrepancies exist (only possible under DryRun mode). +-- * @FAILED@: One or more I/O or evaluation exceptions occurred. +-- +-- === Summary Footer +-- +-- Emits aggregate counters indicating the total number of evaluated repositories, +-- how many achieved full resonance, and how many encountered errors. +formatEcosystemSummary :: SyncMode -> [(FilePath, Either Text SyncResult)] -> Text +formatEcosystemSummary mode results = + let sep = "+----------------------+------------+---------+---------+---------+-----------+--------+-------------+" + hdr = "| Repository | Mode | Created | Updated | Chmod | Unchanged | Errors | Disposition |" + rows = map formatRow results + totalRepos = length results + successfulRepos = length (filter (\(_, r) -> case r of Right res -> resultSuccess res; Left _ -> False) results) + footer = "Total Repositories: " <> T.show totalRepos + <> " | Resonant: " <> T.show successfulRepos + <> " | Failed: " <> T.show (totalRepos - successfulRepos) + in T.unlines ([sep, hdr, sep] ++ rows ++ [sep, footer]) + where + -- | Formats an individual repository's synchronization outcome into a padded table row. + -- Handles both failed evaluations (schema errors, missing paths) and successful runs. + formatRow (path, outcome) = + let repoSlug = T.pack (takeFileName path) + -- Helper to right-pad text values to fixed column width + pad n t = if T.length t >= n then T.take n t else t <> T.replicate (n - T.length t) " " + modeStr = case mode of DryRun -> "DRY-RUN"; ApplySync -> "APPLIED" + in case outcome of + -- Branch A: Unhandled failure during Dhall evaluation or repository access + Left _err -> + "| " <> pad 20 repoSlug + <> " | " <> pad 10 modeStr + <> " | " <> pad 7 "-" + <> " | " <> pad 7 "-" + <> " | " <> pad 7 "-" + <> " | " <> pad 9 "-" + <> " | " <> pad 6 "1" + <> " | " <> pad 11 "FAILED" <> " |" + -- Branch B: Structured synchronization outcome with per-category counters + Right res -> + let cStr = T.show (length (resultCreated res)) + uStr = T.show (length (resultUpdated res)) + mStr = T.show (length (resultChmodded res)) + kStr = T.show (length (resultUnchanged res)) + eStr = T.show (length (resultErrors res)) + disp = if resultSuccess res then "RESONANT" else "DRIFTED" + in "| " <> pad 20 repoSlug + <> " | " <> pad 10 modeStr + <> " | " <> pad 7 cStr + <> " | " <> pad 7 uStr + <> " | " <> pad 7 mStr + <> " | " <> pad 9 kStr + <> " | " <> pad 6 eStr + <> " | " <> pad 11 disp <> " |" + +-------------------------------------------------------------------------------- +-- 5. Multi-Remote Replication Topology Synchronization +-------------------------------------------------------------------------------- + +-- | Synchronizes or audits the Git remote replication topology for a repository checkout. +-- +-- Evaluates the target checkout against Note [Multi-Remote Replication Topology and Provider Compliance] +-- [ref:note-remote-topology], identifying missing canonical remotes (@rad@, @github@, +-- @gitcode@, @framagit@, @disroot@), URL drift, and prohibited hosting providers +-- (such as SourceHut or plaintext HTTP). +-- +-- === Phased Remote Reconciliation Sequence +-- +-- 1. __Checkout Validation:__ +-- Verifies that the target checkout directory exists prior to initiating Git queries. +-- 2. __Porcelain Topology Audit:__ +-- Invokes 'syncRemoteTopologyQuick' to inspect @git remote -v@ metadata and compare +-- active mirrors against canonical expectations. +-- 3. __Diagnostic Report Emission:__ +-- Outputs the formatted tabular report ('formatRemoteReport') highlighting missing, +-- drifted, and prohibited endpoints. +-- 4. __Plan Display & Execution:__ +-- When actions are planned, outputs the action table ('formatRemoteSyncPlan'). +-- Under 'ApplySync' mode, applies the Git commands and prints confirmation logs. +-- 5. __Exit Disposition:__ +-- Yields 'ExitSuccess' if all actions succeeded or preview completed cleanly. +runRemoteSync :: SyncMode -> FilePath -> IO ExitCode +runRemoteSync mode targetDir = do + exists <- doesDirectoryExist targetDir + if not exists + then do + TIO.hPutStrLn stderr ("Target directory does not exist: " <> T.pack targetDir) + pure (ExitFailure 1) + else do + (report, execRes) <- syncRemoteTopologyQuick mode targetDir + TIO.putStrLn (formatRemoteReport report) + let plan = computeRemoteSyncPlan report + unless (null (planRemoteActions plan)) $ + TIO.putStrLn (formatRemoteSyncPlan plan) + case execRes of + Left err -> do + TIO.hPutStrLn stderr ("Remote synchronization failed: " <> err) + pure (ExitFailure 1) + Right logs -> do + when (mode == ApplySync) $ + mapM_ TIO.putStrLn logs + pure ExitSuccess + +-- | Discovers and synchronizes remote topology across all repositories in a parent folder. +-- +-- Evaluates each discovered checkout under 'runRemoteSync', outputting individual +-- audit tables and terminating with 'ExitSuccess' only if all checkouts succeed. +-- +-- === Multi-Repository Traversal Semantics +-- +-- 1. Locates candidate repositories via 'discoverEcosystemRepositories'. +-- 2. Iterates deterministically through discovered folders in alphabetical order. +-- 3. Audits and repairs the 5-forge replication topology within each checkout. +-- 4. Yields 'ExitFailure 1' if any discovered repository encounters Git configuration errors. +runEcosystemRemoteSync :: SyncMode -> FilePath -> IO ExitCode +runEcosystemRemoteSync mode parentDir = do + exists <- doesDirectoryExist parentDir + if not exists + then do + TIO.hPutStrLn stderr ("Ecosystem directory does not exist: " <> T.pack parentDir) + pure (ExitFailure 1) + else do + repos <- discoverEcosystemRepositories parentDir + if null repos + then do + TIO.putStrLn ("No repositories discovered under: " <> T.pack parentDir) + pure ExitSuccess + else do + TIO.putStrLn ("Auditing remote topology across " <> T.show (length repos) <> " repositories under " <> T.pack parentDir <> ":\n") + codes <- forM repos $ \repo -> do + TIO.putStrLn ("--- " <> T.pack (takeFileName repo) <> " (" <> T.pack repo <> ") ---") + code <- runRemoteSync mode repo + TIO.putStrLn "" + pure code + pure if all (== ExitSuccess) codes then ExitSuccess else ExitFailure 1 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,582 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Module: Main +-- Description: Comprehensive specification and verification suite for gachi-cli +-- +-- Validates: +-- 1. CLI option and flag parsing across subcommands and modes. +-- 2. Pure resolution of project specifications from Dhall files and CLI options. +-- 3. Headless workspace instantiation and filesystem materialization. +-- 4. Hermetic Git repository initialization and trailer governance (.githooks / .gitmessage). +-- 5. Execution modes ('FailOnExisting', 'SkipExisting', 'OverwriteExisting', '--dry-run'). +module Main (main) where + +import Control.Exception (SomeException, bracket, catch) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import Data.Time.Clock.POSIX (getPOSIXTime) +import Options.Applicative + ( ParserResult(..) + , defaultPrefs + , execParserPure + ) +import System.Directory + ( createDirectoryIfMissing + , doesDirectoryExist + , doesFileExist + , executable + , getPermissions + , getTemporaryDirectory + , removeDirectoryRecursive + ) +import System.Exit (ExitCode(..)) +import System.FilePath ((), takeFileName) +import System.Process (readProcessWithExitCode) +import Test.Hspec + +import Gachi.CLI +import Gachi.Schema.Dhall (exampleProjectDhall) +import Gachi.Schema.Project + ( authorEmail + , authorName + , projectAuthor + , projectName + ) +import Gachi.Scaffold (ScaffoldMode(..)) + +-- | Helper executing an action within an isolated temporary directory. +withTempDir :: String -> (FilePath -> IO a) -> IO a +withTempDir prefix action = do + base <- getTemporaryDirectory + t <- getPOSIXTime + let dirPath = base (prefix ++ "-" ++ show (round (t * 1000) :: Integer)) + bracket + (createDirectoryIfMissing True dirPath >> pure dirPath) + (\p -> catch (removeDirectoryRecursive p) (\(_ :: SomeException) -> pure ())) + action + +main :: IO () +main = hspec $ do + describe "Gachi.CLI.Options (Option Parsing)" $ do + it "parses default 'init' with project name positional" $ do + let res = execParserPure defaultPrefs (commandParser "0.1.0.0") ["init", "my-project"] + case res of + Success (CmdInit opts) -> do + initProjectName opts `shouldBe` Just "my-project" + initConfigFile opts `shouldBe` Nothing + initMode opts `shouldBe` FailOnExisting + initNoGit opts `shouldBe` False + initDryRun opts `shouldBe` False + _ -> expectationFailure "Expected Success (CmdInit opts)" + + it "parses 'init' with Dhall config file and target directory" $ do + let res = execParserPure defaultPrefs (commandParser "0.1.0.0") + ["init", "-c", "custom.dhall", "-d", "/tmp/target", "-m", "overwrite", "--no-git"] + case res of + Success (CmdInit opts) -> do + initConfigFile opts `shouldBe` Just "custom.dhall" + initTargetDir opts `shouldBe` Just "/tmp/target" + initMode opts `shouldBe` OverwriteExisting + initNoGit opts `shouldBe` True + _ -> expectationFailure "Expected Success (CmdInit opts)" + + it "parses 'init' with satellite package list and description" $ do + let res = execParserPure defaultPrefs (commandParser "0.1.0.0") + ["init", "multi-pkg", "--packages", "pkg-core,pkg-api,pkg-cli", "--desc", "My API"] + case res of + Success (CmdInit opts) -> do + initProjectName opts `shouldBe` Just "multi-pkg" + initPackages opts `shouldBe` ["pkg-core", "pkg-api", "pkg-cli"] + initDescription opts `shouldBe` Just "My API" + _ -> expectationFailure "Expected Success (CmdInit opts)" + + it "correctly parses mode strings" $ do + parseMode "fail" `shouldBe` Right FailOnExisting + parseMode "SKIP" `shouldBe` Right SkipExisting + parseMode "Overwrite" `shouldBe` Right OverwriteExisting + parseMode "invalid" `shouldSatisfy` (\case Left _ -> True; _ -> False) + + it "parses version command" $ do + let res = execParserPure defaultPrefs (commandParser "0.1.0.0") ["version"] + case res of + Success CmdVersion -> pure () + _ -> expectationFailure "Expected Success CmdVersion" + + it "parses 'sync' subcommand with target, dry-run, and all flags" $ do + let res = execParserPure defaultPrefs (commandParser "0.1.0.0") + ["sync", "-t", "/path/to/repo", "--dry-run", "-a"] + case res of + Success (CmdSync opts) -> do + syncTargetDir opts `shouldBe` Just "/path/to/repo" + syncDryRun opts `shouldBe` True + syncAll opts `shouldBe` True + syncRemotes opts `shouldBe` False + _ -> expectationFailure "Expected Success (CmdSync opts)" + + it "parses 'sync' subcommand with --remotes / -r flag" $ do + let res = execParserPure defaultPrefs (commandParser "0.1.0.0") + ["sync", "-t", "/path/to/repo", "-r"] + case res of + Success (CmdSync opts) -> do + syncTargetDir opts `shouldBe` Just "/path/to/repo" + syncRemotes opts `shouldBe` True + _ -> expectationFailure "Expected Success (CmdSync opts)" + + it "parses 'doctor' subcommand with target, sheaf, and all flags" $ do + let res1 = execParserPure defaultPrefs (commandParser "0.1.0.0") ["doctor"] + case res1 of + Success (CmdDoctor opts) -> do + doctorTargetDir opts `shouldBe` Nothing + doctorSheaf opts `shouldBe` False + doctorAll opts `shouldBe` False + _ -> expectationFailure "Expected Success (CmdDoctor opts) for default doctor" + + let res2 = execParserPure defaultPrefs (commandParser "0.1.0.0") ["doctor", "-t", "/path/to/repo", "-s", "-a"] + case res2 of + Success (CmdDoctor opts) -> do + doctorTargetDir opts `shouldBe` Just "/path/to/repo" + doctorSheaf opts `shouldBe` True + doctorAll opts `shouldBe` True + _ -> expectationFailure "Expected Success (CmdDoctor opts) with flags" + + it "parses 'retrofit' subcommand with target, dry-run, and markdown flags" $ do + let res1 = execParserPure defaultPrefs (commandParser "0.1.0.0") ["retrofit"] + case res1 of + Success (CmdRetrofit opts) -> do + retrofitTargetDir opts `shouldBe` Nothing + retrofitDryRun opts `shouldBe` False + retrofitMarkdown opts `shouldBe` False + _ -> expectationFailure "Expected Success (CmdRetrofit opts) for default retrofit" + + let res2 = execParserPure defaultPrefs (commandParser "0.1.0.0") + ["retrofit", "-t", "/path/to/legacy", "--dry-run", "-m"] + case res2 of + Success (CmdRetrofit opts) -> do + retrofitTargetDir opts `shouldBe` Just "/path/to/legacy" + retrofitDryRun opts `shouldBe` True + retrofitMarkdown opts `shouldBe` True + _ -> expectationFailure "Expected Success (CmdRetrofit opts) with flags" + + describe "Gachi.CLI.Init (Project Resolution)" $ do + it "resolves default project when no config is provided" $ do + let opts = InitOptions + { initProjectName = Just "test-slug" + , initConfigFile = Nothing + , initTargetDir = Nothing + , initMode = FailOnExisting + , initAuthorName = Just "Alice Smith" + , initAuthorEmail = Just "alice@example.com" + , initDescription = Just "Test project" + , initPackages = ["test-slug-core"] + , initNoGit = True + , initDryRun = False + , initInteractive = False + } + res <- resolveProject opts + case res of + Right (proj, targetDir) -> do + projectName proj `shouldBe` "test-slug" + authorName (projectAuthor proj) `shouldBe` "Alice Smith" + authorEmail (projectAuthor proj) `shouldBe` "alice@example.com" + targetDir `shouldBe` "test-slug" + Left err -> expectationFailure (T.unpack err) + + it "resolves project from Dhall configuration file" $ do + withTempDir "gachi-dhall-resolve" $ \tmpDir -> do + let dhallPath = tmpDir "project.dhall" + TIO.writeFile dhallPath exampleProjectDhall + let opts = InitOptions + { initProjectName = Nothing + , initConfigFile = Just dhallPath + , initTargetDir = Just (tmpDir "target") + , initMode = FailOnExisting + , initAuthorName = Nothing + , initAuthorEmail = Nothing + , initDescription = Nothing + , initPackages = [] + , initNoGit = True + , initDryRun = False + , initInteractive = False + } + res <- resolveProject opts + case res of + Right (proj, targetDir) -> do + projectName proj `shouldBe` "gongju" + targetDir `shouldBe` (tmpDir "target") + Left err -> expectationFailure (T.unpack err) + + describe "Gachi.CLI.Init (Filesystem Materialization & Git Setup)" $ do + it "performs dry-run without writing any files to target directory" $ do + withTempDir "gachi-dry-run" $ \tmpDir -> do + let targetDir = tmpDir "uncreated-dir" + opts = InitOptions + { initProjectName = Just "dry-project" + , initConfigFile = Nothing + , initTargetDir = Just targetDir + , initMode = FailOnExisting + , initAuthorName = Nothing + , initAuthorEmail = Nothing + , initDescription = Nothing + , initPackages = [] + , initNoGit = True + , initDryRun = True + , initInteractive = False + } + exitCode <- runInit opts + exitCode `shouldBe` ExitSuccess + exists <- doesDirectoryExist targetDir + exists `shouldBe` False + + it "initializes full standardized workspace with Git governance" $ do + withTempDir "gachi-init-full" $ \tmpDir -> do + let targetDir = tmpDir "demo-project" + opts = InitOptions + { initProjectName = Just "demo-project" + , initConfigFile = Nothing + , initTargetDir = Just targetDir + , initMode = FailOnExisting + , initAuthorName = Just "Nadia Yvette Chambers" + , initAuthorEmail = Just "nadia.yvette.chambers@ik.me" + , initDescription = Just "Full demonstration workspace" + , initPackages = ["demo-project-core"] + , initNoGit = False + , initDryRun = False + , initInteractive = False + } + exitCode <- runInit opts + exitCode `shouldBe` ExitSuccess + + -- Verify files created + readmeExists <- doesFileExist (targetDir "README.md") + readmeExists `shouldBe` True + + verifyScriptExists <- doesFileExist (targetDir "bin/demo-project-verify") + verifyScriptExists `shouldBe` True + + cabalExists <- doesFileExist (targetDir "cabal.project") + cabalExists `shouldBe` True + + -- Verify Git repository and governance configuration + gitDirExists <- doesDirectoryExist (targetDir ".git") + gitDirExists `shouldBe` True + + (c1, hooksOut, _) <- readProcessWithExitCode "git" ["-C", targetDir, "config", "--get", "core.hooksPath"] "" + c1 `shouldBe` ExitSuccess + T.strip (T.pack hooksOut) `shouldBe` ".githooks" + + (c2, tmplOut, _) <- readProcessWithExitCode "git" ["-C", targetDir, "config", "--get", "commit.template"] "" + c2 `shouldBe` ExitSuccess + T.strip (T.pack tmplOut) `shouldBe` ".gitmessage" + + it "respects FailOnExisting mode on pre-existing files" $ do + withTempDir "gachi-fail-mode" $ \tmpDir -> do + let targetDir = tmpDir "existing-proj" + opts = InitOptions + { initProjectName = Just "existing-proj" + , initConfigFile = Nothing + , initTargetDir = Just targetDir + , initMode = FailOnExisting + , initAuthorName = Nothing + , initAuthorEmail = Nothing + , initDescription = Nothing + , initPackages = [] + , initNoGit = True + , initDryRun = False + , initInteractive = False + } + exit1 <- runInit opts + exit1 `shouldBe` ExitSuccess + -- Second run with FailOnExisting should fail gracefully + exit2 <- runInit opts + exit2 `shouldBe` ExitFailure 1 + + describe "Gachi.CLI.Sync (Harmonic Synchronization Command)" $ do + it "executes dry-run synchronization without modifying files" $ do + withTempDir "gachi-cli-sync-dry" $ \tmpDir -> do + let targetDir = tmpDir "sync-proj" + initOpts = InitOptions + { initProjectName = Just "sync-proj" + , initConfigFile = Nothing + , initTargetDir = Just targetDir + , initMode = FailOnExisting + , initAuthorName = Nothing + , initAuthorEmail = Nothing + , initDescription = Nothing + , initPackages = [] + , initNoGit = True + , initDryRun = False + , initInteractive = False + } + initCode <- runInit initOpts + initCode `shouldBe` ExitSuccess + + let syncOpts = SyncOptions + { syncTargetDir = Just targetDir + , syncDryRun = True + , syncAll = False + , syncRemotes = False + } + syncCode <- runSync syncOpts + syncCode `shouldBe` ExitSuccess + + it "synchronizes and repairs configuration in an initialized workspace" $ do + withTempDir "gachi-cli-sync-apply" $ \tmpDir -> do + let targetDir = tmpDir "repair-proj" + initOpts = InitOptions + { initProjectName = Just "repair-proj" + , initConfigFile = Nothing + , initTargetDir = Just targetDir + , initMode = FailOnExisting + , initAuthorName = Nothing + , initAuthorEmail = Nothing + , initDescription = Nothing + , initPackages = [] + , initNoGit = True + , initDryRun = False + , initInteractive = False + } + initCode <- runInit initOpts + initCode `shouldBe` ExitSuccess + + -- Mutate .hlint.yaml to cause drift + let hlintPath = targetDir ".hlint.yaml" + TIO.writeFile hlintPath "# Drifted HLint configuration\n" + + -- Apply synchronization to repair drift + let syncOpts = SyncOptions + { syncTargetDir = Just targetDir + , syncDryRun = False + , syncAll = False + , syncRemotes = False + } + syncCode1 <- runSync syncOpts + syncCode1 `shouldBe` ExitSuccess + + -- Verify file content was repaired + repairedContent <- TIO.readFile hlintPath + repairedContent `shouldSatisfy` (\t -> "Ecosystem HLint Configuration" `T.isInfixOf` t) + + -- Re-run sync to verify CLI idempotency + syncCode2 <- runSync syncOpts + syncCode2 `shouldBe` ExitSuccess + + it "executes ecosystem-wide synchronization with --all" $ do + withTempDir "gachi-cli-sync-all" $ \tmpDir -> do + let repoA = tmpDir "repo-one" + repoB = tmpDir "repo-two" + makeOpts dir = InitOptions + { initProjectName = Just (T.pack (takeFileName dir)) + , initConfigFile = Nothing + , initTargetDir = Just dir + , initMode = FailOnExisting + , initAuthorName = Nothing + , initAuthorEmail = Nothing + , initDescription = Nothing + , initPackages = [] + , initNoGit = True + , initDryRun = False + , initInteractive = False + } + _ <- runInit (makeOpts repoA) + _ <- runInit (makeOpts repoB) + + let allOpts = SyncOptions + { syncTargetDir = Just tmpDir + , syncDryRun = True + , syncAll = True + , syncRemotes = False + } + allCode <- runSync allOpts + allCode `shouldBe` ExitSuccess + + it "executes remote topology audit and synchronization with --remotes" $ do + withTempDir "gachi-cli-sync-remotes" $ \tmpDir -> do + let targetDir = tmpDir "remote-proj" + initOpts = InitOptions + { initProjectName = Just "remote-proj" + , initConfigFile = Nothing + , initTargetDir = Just targetDir + , initMode = FailOnExisting + , initAuthorName = Nothing + , initAuthorEmail = Nothing + , initDescription = Nothing + , initPackages = [] + , initNoGit = False + , initDryRun = False + , initInteractive = False + } + initCode <- runInit initOpts + initCode `shouldBe` ExitSuccess + + -- Audit & sync remotes via CLI + let syncOpts = SyncOptions + { syncTargetDir = Just targetDir + , syncDryRun = False + , syncAll = False + , syncRemotes = True + } + syncCode <- runSync syncOpts + syncCode `shouldBe` ExitSuccess + + -- Verify git remote output contains canonical remotes + (cGit, remotesOut, _) <- readProcessWithExitCode "git" ["-C", targetDir, "remote"] "" + cGit `shouldBe` ExitSuccess + let rList = words remotesOut + rList `shouldContain` ["github"] + rList `shouldContain` ["framagit"] + rList `shouldContain` ["disroot"] + + describe "Gachi.CLI.Doctor (Diagnostics & Sheaf Auditing)" $ do + it "audits ambient toolchain binaries successfully" $ do + toolchainOk <- checkToolchainHealth + toolchainOk `shouldBe` True + + it "runs sheaf coherence audit via doctor --sheaf" $ do + let docOpts = DoctorOptions + { doctorTargetDir = Nothing + , doctorSheaf = True + , doctorAll = False + } + exitCode <- runDoctor docOpts + exitCode `shouldBe` ExitSuccess + + it "runs general doctor on an initialized workspace successfully" $ do + withTempDir "gachi-cli-doctor" $ \tmpDir -> do + let targetDir = tmpDir "doctor-proj" + initOpts = InitOptions + { initProjectName = Just "doctor-proj" + , initConfigFile = Nothing + , initTargetDir = Just targetDir + , initMode = FailOnExisting + , initAuthorName = Just "Doctor Tester" + , initAuthorEmail = Just "doctor@example.com" + , initDescription = Just "Test workspace for doctor" + , initPackages = [] + , initNoGit = False + , initDryRun = False + , initInteractive = False + } + initCode <- runInit initOpts + initCode `shouldBe` ExitSuccess + + let docOpts = DoctorOptions + { doctorTargetDir = Just targetDir + , doctorSheaf = False + , doctorAll = False + } + + -- Pre-sync doctor detects missing CI workflow obstruction + preSyncExit <- runDoctor docOpts + preSyncExit `shouldBe` ExitFailure 1 + + -- Sync repository to install standardized CI workflows + let syncOpts = SyncOptions + { syncTargetDir = Just targetDir + , syncDryRun = False + , syncAll = False + , syncRemotes = False + } + syncCode <- runSync syncOpts + syncCode `shouldBe` ExitSuccess + + -- Post-sync doctor confirms harmonic equilibrium (10/10 contracts coherent) + postSyncExit <- runDoctor docOpts + postSyncExit `shouldBe` ExitSuccess + + describe "Gachi.CLI.Retrofit (Diagnostic Inspection Execution)" $ do + it "fails gracefully with ExitFailure 1 when target directory does not exist" $ do + let opts = RetrofitOptions + { retrofitTargetDir = Just "/nonexistent/directory/path/xyz" + , retrofitDryRun = True + , retrofitMarkdown = False + } + exitCode <- runRetrofit opts + exitCode `shouldBe` ExitFailure 1 + + it "runs diagnostic inspection on an initialized workspace successfully" $ withTempDir "gachi-cli-retrofit" $ \baseDir -> do + let targetDir = baseDir "retrofit-proj" + initOpts = InitOptions + { initProjectName = Just "retrofit-proj" + , initConfigFile = Nothing + , initTargetDir = Just targetDir + , initMode = FailOnExisting + , initAuthorName = Just "Nadia Yvette Chambers" + , initAuthorEmail = Just "nadia.yvette.chambers@ik.me" + , initDescription = Just "Retrofit Target Testing" + , initPackages = ["core"] + , initNoGit = False + , initDryRun = False + , initInteractive = False + } + initCode <- runInit initOpts + initCode `shouldBe` ExitSuccess + + let retroOpts = RetrofitOptions + { retrofitTargetDir = Just targetDir + , retrofitDryRun = True + , retrofitMarkdown = False + } + retroCode <- runRetrofit retroOpts + retroCode `shouldBe` ExitSuccess + + let mdOpts = RetrofitOptions + { retrofitTargetDir = Just targetDir + , retrofitDryRun = False + , retrofitMarkdown = True + } + mdCode <- runRetrofit mdOpts + mdCode `shouldBe` ExitSuccess + + it "applies non-destructive skeleton overlay to an uninitialized legacy checkout" $ withTempDir "gachi-cli-retrofit-live" $ \baseDir -> do + let targetDir = baseDir "legacy-app" + createDirectoryIfMissing True (targetDir "src") + let origCode = "module Lib (greet) where\ngreet :: String -> String\ngreet name = \"Hello, \" ++ name\n" + TIO.writeFile (targetDir "src" "Lib.hs") origCode + TIO.writeFile (targetDir "legacy-app.cabal") "cabal-version: 3.0\nname: legacy-app\nversion: 0.1.0.0\n" + + let retroOpts = RetrofitOptions + { retrofitTargetDir = Just targetDir + , retrofitDryRun = False + , retrofitMarkdown = False + } + retroCode <- runRetrofit retroOpts + retroCode `shouldBe` ExitSuccess + + -- Invariant 1: Verification runner materialized with executable permissions + let verifyScript = targetDir "bin" "legacy-app-verify" + doesFileExist verifyScript `shouldReturn` True + p <- getPermissions verifyScript + executable p `shouldBe` True + + -- Invariant 2: Standard documentation hierarchy and agent advisories installed + doesFileExist (targetDir "docs" "INDEX.md") `shouldReturn` True + doesFileExist (targetDir "AGENTS.md") `shouldReturn` True + doesFileExist (targetDir ".githooks" "commit-msg") `shouldReturn` True + + -- Invariant 3: Git repository initialized + doesDirectoryExist (targetDir ".git") `shouldReturn` True + + -- Invariant 4: Domain source files preserved completely untouched + codeAfter <- TIO.readFile (targetDir "src" "Lib.hs") + codeAfter `shouldBe` origCode + + it "evaluates progressive quality gates during retrofit execution" $ withTempDir "gachi-cli-retrofit-gates" $ \baseDir -> do + let targetDir = baseDir "quality-app" + createDirectoryIfMissing True (targetDir "src") + TIO.writeFile (targetDir "src" "Main.hs") "module Main where\nmain = pure ()\n" + TIO.writeFile (targetDir "quality-app.cabal") "cabal-version: 3.0\nname: quality-app\nversion: 0.1.0.0\n" + + let retroOpts = RetrofitOptions + { retrofitTargetDir = Just targetDir + , retrofitDryRun = False + , retrofitMarkdown = False + } + retroCode <- runRetrofit retroOpts + retroCode `shouldBe` ExitSuccess + + -- Verify that overlay was applied and quality gates evaluated cleanly + doesFileExist (targetDir "bin" "quality-app-verify") `shouldReturn` True + doesFileExist (targetDir "PLAN.md") `shouldReturn` True + doesFileExist (targetDir "tagref.yml") `shouldReturn` True