diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml new file mode 100644 index 0000000..c0f29f1 --- /dev/null +++ b/.github/workflows/tests.yml @@ -0,0 +1,69 @@ +name: Tests + +on: + workflow_dispatch: + push: + paths: + - 'tools/cli-fp-gen/**' + - 'tests/**' + - 'src/**' + - '.github/workflows/tests.yml' + pull_request: + paths: + - 'tools/cli-fp-gen/**' + - 'tests/**' + - 'src/**' + - '.github/workflows/tests.yml' + +permissions: + contents: read + +jobs: + linux: + name: Linux / FPC + runs-on: ubuntu-latest + timeout-minutes: 10 + steps: + - uses: actions/checkout@v6 + - name: Install Free Pascal + run: | + sudo apt-get update + sudo apt-get install -y fp-compiler fp-units-fcl python3 + - name: Framework Unit Tests + run: bash tests/run_tests.sh + - name: Generator Unit Tests + run: bash tests/codegen/run_unit_tests.sh + - name: Golden Output Test + run: bash tests/codegen/run_golden_test.sh + - name: Generator Ops Test + run: bash tests/codegen/run_ops_test.sh + - name: Compile Smoke Test + run: bash tests/codegen/run_compile_smoke.sh + + windows: + name: Windows / FPC + runs-on: windows-latest + timeout-minutes: 15 + steps: + - uses: actions/checkout@v6 + - name: Install Free Pascal toolchain + shell: powershell + run: | + choco install lazarus --version=4.0.0 --yes --no-progress + $FpcRoot = 'C:\lazarus\fpc\3.2.2' + $FpcBin = Join-Path $FpcRoot 'bin\x86_64-win64' + $ConsoleRunner = Join-Path $FpcRoot 'units\x86_64-win64\fcl-fpcunit\consoletestrunner.ppu' + if (-not (Test-Path -LiteralPath $ConsoleRunner)) { + throw "Lazarus toolchain is missing FPCUnit console runner: $ConsoleRunner" + } + $FpcBin | + Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + & (Join-Path $FpcBin 'fpc.exe') -iV + & (Join-Path $FpcBin 'fpc.exe') -iTP + & (Join-Path $FpcBin 'fpc.exe') -iTO + - name: Framework Unit Tests + shell: powershell + run: powershell -ExecutionPolicy Bypass -File tests\run_tests.ps1 + - name: Codegen Test Suite + shell: powershell + run: powershell -ExecutionPolicy Bypass -File tests\codegen\run_all_tests.ps1 diff --git a/.gitignore b/.gitignore index 1094471..950553d 100644 --- a/.gitignore +++ b/.gitignore @@ -16,6 +16,8 @@ link.res *.dll *.so *.dylib +/tools/cli-fp-gen/cli_fp_gen +/build-temp/ # Backup files *.bak @@ -26,6 +28,7 @@ link.res # Lazarus specific backup/ lib/ +/packagefiles.xml *.lrs *.lrt *.lps diff --git a/CHANGELOG.md b/CHANGELOG.md index eaffdf0..62aa342 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,52 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +## [1.2.0] - 2026-07-27 + +### Added + +- Added `cli-fp-gen`, a standalone scaffold generator for creating `cli-fp` + applications from a versioned `clifp.json` project specification. +- Added `init`, `generate`, `add command`, and `remove command` workflows, + including nested commands, cascade removal, dry-run previews, and controlled + force-overwrite behavior. +- Added generated application entry points, command registries, parameter + registration for every supported parameter kind, and user-owned command + stubs. +- Added a generated-file manifest for safe stale-file cleanup when generated + paths change. +- Added full generator documentation from the main README, including project + layout, file ownership, build instructions, and local verification commands. + +### Fixed + +- `cli-fp-gen`: Schema version mismatch error message now includes a prompt to check the migration documentation, making it actionable when a future `schemaVersion` is encountered. +- `cli-fp-gen`: `init` now protects an existing `clifp.json` unless `--force` is supplied. +- `cli-fp-gen`: Command names containing path separators are rejected instead of being silently rewritten. +- `cli-fp-gen`: Commands that collapse to the same generated Pascal identifier are rejected with a targeted error. +- `cli-fp-gen`: Reserved Pascal words used as application names now produce valid program identifiers. +- `cli-fp-gen`: Manifest cleanup now uses platform-appropriate path casing and refuses similarly named sibling directories on case-sensitive filesystems. +- `cli-fp-gen`: Manifest cleanup now refuses stale-file paths that traverse Unix symbolic links or Windows reparse points, including directory junctions. +- `cli-fp-gen`: Malformed project specifications now release partially constructed commands and parameters safely. +- Boolean parameter lookups now report defaults as available values, matching the public API contract. + +### Improved + +- Duplicate command names under the same parent now produce a targeted error + naming the conflicting sibling and parent. +- `--dry-run` help text now includes example output so file operations are clear + before execution. +- `cli-fp-gen`: Command-name validation preserves invalid input so diagnostics can report the original name. +- `cli-fp-gen`: `MakeProgramFileRelPath` is documented to note that the generated `.lpr` filename uses PascalCase, which must be matched exactly in build scripts on case-sensitive filesystems (Linux/macOS). + +### Testing + +- Added a Windows PowerShell verification path for `cli-fp-gen` in `tests/codegen/run_all_tests.ps1`. +- Added focused FPCUnit coverage for generator naming, validation, malformed-spec error handling, and exception-safe ownership. +- GitHub Actions now runs the framework suite plus generator unit, golden-output, lifecycle, ownership, path-safety, and generated-app compile checks on Linux and Windows. +- Added Unix symbolic-link and Windows directory-junction regression tests for manifest cleanup. +- Code generator documentation now includes both the Bash test scripts and the PowerShell verification command. + ## [1.1.6] - 2026-02-21 ### Added @@ -246,5 +292,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - README with quick start guide - System requirements and compatibility information +[Unreleased]: https://github.com/ikelaiah/cli-fp/compare/v1.2.0...HEAD +[1.2.0]: https://github.com/ikelaiah/cli-fp/compare/v1.1.6...v1.2.0 [1.0.0]: https://github.com/ikelaiah/cli-fp/releases/tag/v1.0.0 diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 5129bec..c1b04f5 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -56,7 +56,13 @@ Enhancement suggestions are tracked as GitHub issues. When creating an enhanceme ## Testing -* Run the test suite with `runtests.pas` +* Run the framework test suite with `bash tests/run_tests.sh` on Linux/macOS + or `powershell -ExecutionPolicy Bypass -File tests\run_tests.ps1` on Windows +* Run the code-generator suite with `bash tests/codegen/run_unit_tests.sh`, + `bash tests/codegen/run_golden_test.sh`, `bash tests/codegen/run_ops_test.sh`, + and `bash tests/codegen/run_compile_smoke.sh` on Linux/macOS, or + `powershell -ExecutionPolicy Bypass -File tests\codegen\run_all_tests.ps1` + on Windows * Add test cases for new functionality * Ensure existing tests pass @@ -72,4 +78,4 @@ Enhancement suggestions are tracked as GitHub issues. When creating an enhanceme * Feel free to open an issue for discussion * Contact the maintainers directly -Thank you for your contribution! πŸš€ \ No newline at end of file +Thank you for your contribution! πŸš€ diff --git a/README.md b/README.md index 922c955..e645661 100644 --- a/README.md +++ b/README.md @@ -1,99 +1,94 @@ # Command-Line Interface Framework for Free Pascal πŸš€ [![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT) -[![Version](https://img.shields.io/badge/version-1.1.6-blue.svg)](https://github.com/ikelaiah/cli-fp/releases) +[![Version](https://img.shields.io/badge/version-1.2.0-blue.svg)](https://github.com/ikelaiah/cli-fp/releases) [![Free Pascal](https://img.shields.io/badge/Free%20Pascal-3.2.2-blue.svg)](https://www.freepascal.org/) [![Lazarus](https://img.shields.io/badge/Lazarus-4.0-orange.svg)](https://www.lazarus-ide.org/) [![GitHub stars](https://img.shields.io/github/stars/ikelaiah/cli-fp?style=social)](https://github.com/ikelaiah/cli-fp/stargazers) [![GitHub issues](https://img.shields.io/github/issues/ikelaiah/cli-fp)](https://github.com/ikelaiah/cli-fp/issues) -A robust toolkit for building command-line (terminal) applications in Free Pascal. Leverage Pascal's strong typing and compile-time checks while creating sophisticated terminal tools with features like `git`-style commands, progress bars, and coloured output for better readability. +`cli-fp` is a Free Pascal framework for building terminal applications. It +provides `git`-style commands, typed parameters, generated help, shell +completion, progress indicators, and coloured output so your application code +can focus on what each command actually does. -Combines Free Pascal's speed and reliability with professional-grade features. The object-oriented design handles the complex parts, letting you focus on your application's logic. +Free Pascal 3.2.2 or newer is recommended. You can use the project generator +for a new application, add the framework units to an existing project, or +install the included Lazarus package. -## πŸ“‘ Table of Contents +## Start Here -- [Command-Line Interface Framework for Free Pascal πŸš€](#command-line-interface-framework-for-free-pascal-) - - [πŸ“‘ Table of Contents](#-table-of-contents) - - [✨ Features](#-features) - - [πŸš€ Quick Start](#-quick-start) - - [🎯 Parameter Types and Validation](#-parameter-types-and-validation) - - [Basic Types](#basic-types) - - [Boolean and Flags](#boolean-and-flags) - - [Complex Types](#complex-types) - - [Validation Rules](#validation-rules) - - [πŸ“– Screenshots](#-screenshots) - - [πŸ“– System Requirements](#-system-requirements) - - [Tested Environments](#tested-environments) - - [Theoretical Compatibility](#theoretical-compatibility) - - [Dependencies](#dependencies) - - [Build Requirements](#build-requirements) - - [πŸ“– Documentation](#-documentation) - - [🎯 Use Cases](#-use-cases) - - [🀝 Contributing](#-contributing) - - [πŸ“ License](#-license) - - [πŸ™ Acknowledgments](#-acknowledgments) - - [οΏ½ Completion Script Testing](#-completion-script-testing) - - [🧩 How to Generate Completion Scripts](#-how-to-generate-completion-scripts) - - [🧩 Bash Completion Script (`--completion-file`)](#-bash-completion-script---completion-file) - - [🧩 PowerShell Completion Script (`--completion-file-pwsh`)](#-powershell-completion-script---completion-file-pwsh) +- **Creating a new CLI application?** Start with the + [project generator](#-project-generator). It creates the project structure, + command units, and a `clifp.json` specification for you. +- **Adding CLI features to an existing Pascal project?** Follow the + [manual quick start](#-quick-start). +- **Using Lazarus?** Compile `packages/lazarus/cli_fp.lpk`, then add it to your + project's required packages. -## ✨ Features +If this is your first Free Pascal project, install FPC first and confirm that +`fpc -iV` works in your terminal. -- 🎯 **Command & Subcommand Support**: Organize complex CLIs with hierarchical commands -- πŸ” **Smart Parameter Handling**: Automatic validation and type checking -- πŸ“Š **Progress Indicators**: Built-in spinners and progress bars with optional status captions -- 🎨 **Colored Output**: Rich console output with basic color support -- πŸ“š **Comprehensive Help System**: Auto-generated help with examples -- πŸ›‘οΈ **Type-Safe**: Interface-based design with strong typing -- πŸ”Œ **Extensible**: Easy to extend with custom commands and parameters -- **Modern Command-Line Interface** - - Subcommand support (e.g., `app repo init`, `app repo clone`) - - Short and long flags (`-h`, `--help`) - - Automatic help generation - - Colored output support - - **Shell Completion**: Generate completion scripts for Bash (`--completion-file`) and PowerShell (`--completion-file-pwsh`) with automatic value completion for boolean and enum parameters -- **Robust Error Handling** - - Clear error messages for unknown commands and subcommands - - Validation of command-line flags and parameters - - Helpful suggestions when errors occur - - Context-aware help display -- **Developer-Friendly** - - Interface-based design - - Easy command registration - - Extensible parameter system - - Built-in progress indicators -- **User-Friendly** - - Consistent help formatting - - Command suggestions - - Default values support - - Required parameter validation +## πŸ“‘ Table of Contents -## πŸš€ Quick Start +- [Start Here](#start-here) +- [✨ Features](#-features) +- [πŸš€ Quick Start](#-quick-start) +- [🧩 Project Generator](#-project-generator) +- [🎯 Parameter Types and Validation](#-parameter-types-and-validation) + - [Basic Types](#basic-types) + - [Boolean and Flags](#boolean-and-flags) + - [Complex Types](#complex-types) + - [Validation Rules](#validation-rules) +- [πŸ“– Screenshots](#-screenshots) +- [πŸ“– System Requirements](#-system-requirements) + - [Tested Environments](#tested-environments) + - [Theoretical Compatibility](#theoretical-compatibility) + - [Dependencies](#dependencies) + - [Build Requirements](#build-requirements) +- [πŸ“– Documentation](#-documentation) +- [🎯 Use Cases](#-use-cases) +- [🀝 Contributing](#-contributing) +- [πŸ“ License](#-license) +- [πŸ™ Acknowledgments](#-acknowledgments) +- [πŸ§ͺ Completion Script Testing](#-completion-script-testing) +- [🧩 How to Generate Completion Scripts](#-how-to-generate-completion-scripts) +- [🧩 Bash Completion Script (`--completion-file`)](#-bash-completion-script---completion-file) +- [🧩 PowerShell Completion Script (`--completion-file-pwsh`)](#-powershell-completion-script---completion-file-pwsh) -1. **Installation** +## ✨ Features -No complex build system needed! Just: +- **Commands and subcommands:** Build command trees such as + `app repo clone`. +- **Typed parameters:** Validate strings, numbers, paths, URLs, enums, + passwords, arrays, booleans, and date/time values. +- **Helpful terminal UX:** Generate contextual help, defaults, required-value + errors, and suggestions for unknown commands. +- **Shell completion:** Generate Bash and PowerShell completion scripts, + including boolean and enum value completion. +- **Console tools:** Use coloured output, spinners, and progress bars with + optional status captions. +- **Project generation:** Scaffold a new application and add or remove command + units with `cli-fp-gen`. +- **Pascal-friendly design:** Use strongly typed interfaces and ordinary FPC + units without a separate runtime dependency. -> **Note:** All example builds output their executables and units to the `example-bin/` folder in the repository root for easy access and cleanup. -> -> **Tip:** To build or clean all example projects at once, use the provided scripts: -> -> - On **Linux/macOS**: `./compile-all-examples.sh` and `./clean-all-examples.sh` -> - On **Windows**: `./compile-all-examples.ps1` and `./clean-all-examples.ps1` +## πŸš€ Quick Start +1. **Get the source** ```bash -# Clone the repository git clone https://github.com/ikelaiah/cli-fp.git - -# Or copy the source files to your project's directory ``` -2. **Use in Your Project** +You can also download a release archive. Keep the repository's `src/` +directory available to your project. + +2. **Add the framework to your project** -- Add the source directory to your project's search path (Project -> Project Options ... -> Compiler Options -> Paths -> Other unit files) -- Add the units to your uses clause: +Add `cli-fp/src` to FPC's unit search path with `-Fu`, or in Lazarus open +**Project β†’ Project Options β†’ Compiler Options β†’ Paths β†’ Other unit files**. +Then add the units you need: ```pascal uses @@ -105,7 +100,7 @@ uses CLI.Console; // Optional: Colored console output ``` -3. **Create Your First CLI App** +3. **Create your first CLI app** ```pascal program MyApp; @@ -157,16 +152,26 @@ begin end. ``` +Save the file as `MyApp.lpr`. If the `cli-fp` repository is next to your +project directory, compile and run it with: + +```bash +fpc -Fu../cli-fp/src MyApp.lpr +./MyApp greet --name "John" +``` + +On Windows, run the generated executable as `.\MyApp.exe`. + **Output:** ``` -$ ./myapp greet --name "John" +$ ./MyApp greet --name "John" Hello, John! -$ ./myapp greet +$ ./MyApp greet Hello, World! -$ ./myapp greet --help -Usage: myapp greet [options] +$ ./MyApp greet --help +Usage: MyApp greet [options] Say hello @@ -180,6 +185,29 @@ Options: A runtime-only Lazarus package is provided in `packages/lazarus/cli_fp.lpk`. To use it, open the `.lpk` file in Lazarus, click β€œCompile,” then click β€œAdd” to add it to your project’s required packages. +## 🧩 Project Generator + +This repository also includes `cli-fp-gen`, a scaffold generator for new `cli-fp` applications. + +Typical workflow: + +```powershell +fpc -Futools\cli-fp-gen\src .\tools\cli-fp-gen\cli_fp_gen.lpr +.\tools\cli-fp-gen\cli_fp_gen.exe init .\build-temp\myapp --name myapp +.\tools\cli-fp-gen\cli_fp_gen.exe add command status --project .\build-temp\myapp --description "Show status" +# Run this after manually editing clifp.json: +.\tools\cli-fp-gen\cli_fp_gen.exe generate --project .\build-temp\myapp +``` + +`init` creates a working `greet` command, so you can compile the generated +application immediately. The generated project references the framework units +from this repository; see the build command in +[the generator guide](docs/codegen.md#build-generated-app-example). + +Full generator documentation, project layout details, and `clifp.json` reference are in [docs/codegen.md](docs/codegen.md). + +> **Note:** The generated program file uses PascalCase (e.g. `src/Myapp.lpr`). On Linux/macOS, reference it with the exact same casing in your build scripts. Use `--dry-run` to preview all file operations before committing them. + ### Progress Indicator Captions (v1.1.6) Progress indicators now support inline status text via: @@ -258,6 +286,9 @@ Cmd.AddEnumParameter('-l', '--level', 'Log level', 'debug|info|warn|error'); // URL with protocol validation Cmd.AddUrlParameter('-u', '--url', 'Repository URL'); +// File or directory path +Cmd.AddPathParameter('-p', '--path', 'Target path'); + // Array (comma-separated) Cmd.AddArrayParameter('-t', '--tags', 'Tag list'); @@ -272,10 +303,12 @@ Each parameter type has built-in validation: - `String`: No validation - `Integer`: Must be a valid integer number - `Float`: Must be a valid floating-point number +- `Flag`: Presence sets the value; absent flags use their default - `Boolean`: Must be 'true' or 'false' (case-insensitive) - `DateTime`: Must be in format "YYYY-MM-DD HH:MM" (24-hour) - `Enum`: Must match one of the pipe-separated allowed values - `URL`: Must start with http://, https://, git://, or ssh:// +- `Path`: No path-existence validation - `Array`: No validation on individual items - `Password`: No validation, but value is masked in output @@ -322,6 +355,7 @@ Each parameter type has built-in validation: - [User Manual](docs/user-manual.md): Complete guide for using the framework, *including a cheat sheet* - [API Reference](docs/api-reference.md): Detailed API reference for the framework - [Technical Documentation](docs/technical-docs.md): Architecture and implementation details +- [Code Generator](docs/codegen.md): `cli-fp-gen` usage, generated layout, and verification notes - [Examples](examples/): Working example applications - [Changelog](CHANGELOG.md): Version history and updates diff --git a/PULL_REQUEST_v1.1.5.md b/docs/PULL_REQUEST_v1.1.5.md similarity index 100% rename from PULL_REQUEST_v1.1.5.md rename to docs/PULL_REQUEST_v1.1.5.md diff --git a/PULL_REQUEST_v1.1.6.md b/docs/PULL_REQUEST_v1.1.6.md similarity index 100% rename from PULL_REQUEST_v1.1.6.md rename to docs/PULL_REQUEST_v1.1.6.md diff --git a/docs/PULL_REQUEST_v1.2.0.md b/docs/PULL_REQUEST_v1.2.0.md new file mode 100644 index 0000000..f1f6133 --- /dev/null +++ b/docs/PULL_REQUEST_v1.2.0.md @@ -0,0 +1,92 @@ +# Pull Request: Release v1.2.0 - CLI Project Generator + +## Summary + +This release adds `cli-fp-gen`, a standalone scaffold generator that creates +compilable `cli-fp` applications from a versioned JSON project specification. +It also adds cross-platform CI for both the framework and generator, strengthens +generated-file safety, and fixes boolean default-value lookup behavior. + +## Type of change + +- [x] New feature (backward-compatible) +- [x] Bug fixes +- [x] Documentation +- [x] Test and CI improvements +- [ ] Breaking change + +## Generator functionality + +- [x] Initialize a new project with `init` +- [x] Regenerate project infrastructure from `clifp.json` +- [x] Add root and nested commands +- [x] Remove commands, with explicit cascade removal for subtrees +- [x] Generate all supported parameter registrations +- [x] Preview changes with `--dry-run` +- [x] Preserve user-owned command stubs unless `--force` is supplied +- [x] Clean stale generator-owned files through a manifest + +## Review fixes + +- Existing `clifp.json` files are protected during `init` +- Invalid command separators are rejected instead of silently rewritten +- Conflicting generated Pascal identifiers are detected before writing files +- Reserved Pascal application names produce valid program identifiers +- Program and manifest paths are guarded against project-directory escape +- Manifest path comparisons follow platform casing rules +- Manifest cleanup refuses paths that traverse Unix symbolic links or Windows + reparse points, including directory junctions +- Malformed project specifications release partially constructed commands and + parameters safely +- Boolean defaults satisfy the documented `GetParameterValue` contract +- Test compilers write to temporary directories instead of dirtying the source + tree + +## Testing + +### Framework + +- [x] 30 FPCUnit framework tests pass +- [x] Lazarus package compiles as version `1.2.0` +- [x] All six shipped example applications compile + +### Generator + +- [x] Focused naming, validation, and malformed-spec ownership tests pass +- [x] Golden output matches expected generated source +- [x] Generated application compiles and runs +- [x] `init`, `generate`, `add command`, and `remove command` operations pass +- [x] Dry-run behavior is non-mutating +- [x] User-owned command stubs are preserved +- [x] Program and manifest path guards are covered, including Unix symlink and + Windows junction escape attempts + +### CI + +- [x] Linux job configured +- [x] Windows job configured +- [x] Read-only repository permissions +- [x] Manual workflow dispatch +- [x] Job timeouts + +## Release metadata + +- [x] README version badge updated to `1.2.0` +- [x] Lazarus package version updated to `1.2.0` +- [x] `CHANGELOG.md` promoted from Unreleased to `1.2.0` +- [x] Release notes added +- [x] Generator and testing documentation updated + +## Compatibility + +This is a backward-compatible minor release. Existing framework APIs remain +supported, and the optional generator does not change how existing applications +are built. + +## Documentation + +- [Release notes](RELEASE_NOTES_v1.2.0.md) +- [Changelog](../CHANGELOG.md) +- [Generator guide](codegen.md) +- [README](../README.md) +- [Contributing](../CONTRIBUTING.md) diff --git a/RELEASE_NOTES_v1.1.5.md b/docs/RELEASE_NOTES_v1.1.5.md similarity index 100% rename from RELEASE_NOTES_v1.1.5.md rename to docs/RELEASE_NOTES_v1.1.5.md diff --git a/RELEASE_NOTES_v1.1.6.md b/docs/RELEASE_NOTES_v1.1.6.md similarity index 100% rename from RELEASE_NOTES_v1.1.6.md rename to docs/RELEASE_NOTES_v1.1.6.md diff --git a/docs/RELEASE_NOTES_v1.2.0.md b/docs/RELEASE_NOTES_v1.2.0.md new file mode 100644 index 0000000..78aa971 --- /dev/null +++ b/docs/RELEASE_NOTES_v1.2.0.md @@ -0,0 +1,122 @@ +# Release Notes - cli-fp v1.2.0 + +**Release Date:** July 27, 2026 + +## Overview + +Version `1.2.0` introduces `cli-fp-gen`, a standalone project and command +scaffold generator for `cli-fp`. It turns a versioned `clifp.json` +specification into a compilable Free Pascal application while keeping generated +infrastructure separate from user-owned command implementations. + +This is a backward-compatible minor release. Existing `cli-fp` applications do +not require migration. + +## New: `cli-fp-gen` + +The generator supports the complete initial project workflow: + +```text +cli-fp-gen init [--name ] [--version ] [--dry-run] [--force] +cli-fp-gen generate [--project ] [--dry-run] [--force] +cli-fp-gen add command [--parent ] [--description ] [--project ] [--dry-run] [--force] +cli-fp-gen remove command [--cascade] [--project ] [--dry-run] [--force] +``` + +### Generated project structure + +- A Pascal program entry point under `src/` +- A generated command registry under `src/generated/` +- User-owned command stubs under `src/commands/` +- A generated-file manifest for stale-file cleanup +- A versioned `clifp.json` project specification as the source of truth + +### Supported parameter kinds + +Generated command registration supports: + +- String, integer, float, flag, and explicit boolean parameters +- Path, enum, date/time, array, password, and URL parameters +- Required values, defaults, descriptions, short flags, and long flags + +### File ownership + +Generated entry points and registry units are refreshed by `generate`. Command +stubs are created once and preserved on subsequent runs unless `--force` is +explicitly supplied. + +## Safety and correctness + +The generator includes safeguards for: + +- Existing project specifications during `init` +- Project-relative generated program paths +- Manifest cleanup outside the project directory +- Case-sensitive path handling on Linux and other case-sensitive filesystems +- Manifest cleanup through Unix symbolic links and Windows reparse points, + including directory junctions +- Exception-safe cleanup of partially parsed commands and parameters when + `clifp.json` is malformed +- Invalid command tokens and missing parents +- Duplicate command paths and generated Pascal identifier collisions +- Reserved Pascal words used as application names +- Safe Pascal string escaping in generated source + +`--dry-run` previews file operations without modifying the project. + +## Framework fix + +Boolean parameter lookups now report a configured default as an available value, +matching the documented `GetParameterValue` contract and the behavior of other +parameter kinds. + +## Automated testing + +GitHub Actions now verifies the framework and generator on Linux and Windows. +The automated suite includes: + +- 30 framework unit tests +- Focused generator naming, validation, parsing-error, and ownership tests +- Golden-output comparisons +- Generator lifecycle and file-ownership checks +- Program and manifest path-safety checks, including Unix symlink and Windows + junction escape attempts +- Compilation and execution of a generated application +- Lazarus package compilation +- Compilation of all six shipped example applications + +Local test runners are available for Bash and PowerShell. + +## Build and use the generator + +Compile from the repository root: + +```bash +fpc -Futools/cli-fp-gen/src tools/cli-fp-gen/cli_fp_gen.lpr +``` + +Then create a project: + +```bash +tools/cli-fp-gen/cli_fp_gen init ./my-app --name my-app +``` + +On Windows, use `cli_fp_gen.exe`. + +See [codegen.md](codegen.md) for the complete specification and +workflow reference. + +## Upgrade notes + +- Existing applications remain source compatible. +- The Lazarus package version is now `1.2.0`. +- The generator is distributed as source and must be compiled before use. +- No `clifp.json` migration is required; schema version 1 is the current format. + +## License + +This project is licensed under the MIT License. See [LICENSE](../LICENSE). + +--- + +**Full Changelog:** [v1.1.6...v1.2.0](https://github.com/ikelaiah/cli-fp/compare/v1.1.6...v1.2.0) diff --git a/docs/codegen.md b/docs/codegen.md new file mode 100644 index 0000000..f3398e5 --- /dev/null +++ b/docs/codegen.md @@ -0,0 +1,206 @@ +# CLI Code Generator (Phase 1) + +`cli-fp-gen` is a standalone scaffold generator for `cli-fp` applications. + +Phase 1 focuses on CLI project generation only (no Lazarus wizard yet). + +## Location + +- Tool source: `tools/cli-fp-gen/` + +## Commands + +```text +cli-fp-gen init [--name ] [--version ] [--dry-run] [--force] +cli-fp-gen generate [--project ] [--dry-run] [--force] +cli-fp-gen add command [--parent ] [--description ] [--project ] [--dry-run] [--force] +cli-fp-gen remove command [--cascade] [--project ] [--dry-run] [--force] +``` + +## Project Spec + +Generated projects use `clifp.json` as the source of truth. + +Example: + +```json +{ + "schemaVersion": 1, + "app": { + "name": "myapp", + "version": "0.1.0", + "programFile": "src\\Myapp.lpr" + }, + "commands": [ + { + "name": "greet", + "description": "Say hello", + "parent": "", + "parameters": [ + { + "kind": "string", + "short": "-n", + "long": "--name", + "description": "Name to greet", + "required": false, + "default": "World", + "allowedValues": "" + } + ] + } + ] +} +``` + +### Parameter Kinds + +Supported `kind` values: + +- `string` +- `integer` +- `float` +- `flag` +- `boolean` +- `path` +- `enum` (requires `allowedValues`) +- `datetime` +- `array` +- `password` +- `url` + +## File Ownership + +- `clifp.json`: project source of truth; `init` refuses to replace an existing + spec unless `--force` is supplied +- `src/generated/*.pas`: generator-owned, overwritten on `generate` +- `src/generated/.clifp-manifest.json`: generator-owned manifest for cleanup +- `src/commands/*.pas`: user-owned command stubs, created once and not overwritten unless `--force` +- `src/*.lpr`: generator-owned in Phase 1 + +### Cleanup Safety + +The manifest is used only to remove stale generator-owned files. Before +deleting a manifest entry, `cli-fp-gen` verifies that its normalized path is +inside the project directory and that no child path component is a symbolic +link or Windows reparse point (including directory junctions). If either check +fails, generation stops and reports the unsafe path. + +This protection is deliberately conservative: a stale generated file reached +through a link is not deleted, even when that link points to another location +inside the project. Edit or remove the unexpected manifest entry or link, then +run `generate` again. + +`--force` allows overwrite operations that normally protect existing files, +including replacement of an existing spec during `init` and regeneration of +user-owned command stubs. It does not bypass manifest path safety checks. + +## Generated Layout + +```text +/ + clifp.json + src/ + .lpr + commands/ + _Command_*.pas + generated/ + _CommandRegistry_Generated.pas + .clifp-manifest.json +``` + +## Build Generated App (example) + +From the generated project directory, compile with the framework source path plus local generated/unit paths. + +### Linux/macOS (Bash) + +```bash +fpc -Fu../../src -Fu./src -Fu./src/generated -Fu./src/commands ./src/MyApp.lpr +``` + +### Windows (PowerShell) + +```powershell +fpc "-Fu..\..\src" "-Fu.\src" "-Fu.\src\generated" "-Fu.\src\commands" .\src\MyApp.lpr +``` + +Adjust the first `-Fu` path (`../../src` or `..\..\src`) to point at the +`cli-fp` framework `src/` directory. + +## Verification + +### Linux/macOS (Bash) + +The repository includes focused codegen checks under `tests/codegen/`: + +- `run_unit_tests.sh` +- `run_golden_test.sh` +- `run_compile_smoke.sh` +- `run_ops_test.sh` + +### Windows (PowerShell) + +Use the Windows-native verification script from the repository root: + +```powershell +powershell -ExecutionPolicy Bypass -File .\tests\codegen\run_all_tests.ps1 +``` + +This script compiles `cli-fp-gen`, runs the focused unit tests, +verifies golden output, compiles a generated app, and checks `init` / `generate` +/ `add command` / `remove command` behavior plus overwrite and path validation +guards. + +GitHub Actions runs the focused suite on Linux and Windows for pushes and pull +requests that change the generator, its fixtures, the framework source, or the +workflow. The workflow can also be started manually. + +The operations tests include manifest cleanup escape attempts through a Unix +symbolic link and a Windows directory junction. They assert that the generator +fails safely and leaves the external file untouched. + +## Maintainer Guide + +The generator is split into small units with one main responsibility: + +- `CliFpGen.App`: command-line parsing and command dispatch +- `CliFpGen.Generate`: project operations and generation workflow +- `CliFpGen.Model`: in-memory project and parameter types +- `CliFpGen.SpecIO`: `clifp.json` loading and saving +- `CliFpGen.Validate`: semantic and path validation +- `CliFpGen.Naming`: Pascal identifiers, unit names, and command paths +- `CliFpGen.Renderer`: Pascal source rendering +- `CliFpGen.Filesystem`: managed writes, deletions, and dry-run behavior +- `CliFpGen.Manifest`: generated-file tracking and safe stale-file cleanup + +`TProjectSpec` owns its commands, and each `TCommandSpec` owns its parameters. +When parsing JSON, construct an object completely before transferring it to +its owning list. If parsing raises an exception before that transfer, free the +partially constructed object in the same routine. + +### Adding a Parameter Kind + +Use this checklist when the framework gains a new parameter type: + +1. Add the enum value and both text mappings in `CliFpGen.Model`. +2. Add any kind-specific defaults or semantic rules in `CliFpGen.Validate`. +3. Render the matching framework registration call in + `CliFpGen.Renderer.RenderParameterCall`. +4. If the kind needs new JSON fields, add them symmetrically to load and save + in `CliFpGen.SpecIO`; update the project-spec example above. +5. Add the kind to `tests/codegen-fixtures/golden-basic/clifp.json` and update + the expected registry in `tests/codegen-golden/golden-basic/`. +6. Add focused validation or parsing tests when the kind has unique rules. +7. Update the supported-kind lists here and in the root README. +8. Run all Linux scripts under `tests/codegen/` and the Windows + `run_all_tests.ps1` script. The compile smoke test confirms that the + generated call still matches the current framework units in `src/`. + +## Notes + +- Commands are defined in a flat list with `parent` paths (slash-delimited, e.g. `repo/remote`). +- `app.programFile` must stay project-relative under `src/` and point to an `.lpr` file. +- `remove command` deletes command entries from `clifp.json`; use `--cascade` to remove a command subtree. +- Default command stubs automatically show help when they have subcommands at runtime. +- This avoids stale stub behavior when a command later becomes a command group. +- Parameter registrations and command descriptions are generated in the registry unit (not user stubs), so editing `clifp.json` and re-running `generate` updates metadata without overwriting user code. diff --git a/examples/ProgressDemo/ProgressDemo.lpr b/examples/ProgressDemo/ProgressDemo.lpr index be98ba6..c61261c 100644 --- a/examples/ProgressDemo/ProgressDemo.lpr +++ b/examples/ProgressDemo/ProgressDemo.lpr @@ -98,7 +98,7 @@ function TProcessCommand.Execute: Integer; begin try // Create main application with name and version - App := CreateCLIApplication('ProgressDemo', '1.1.6'); + App := CreateCLIApplication('ProgressDemo', '1.2.0'); (App as TCLIApplication).DebugMode := False; // Disable debug output for cleaner display // Create and configure process command diff --git a/packages/lazarus/cli_fp.lpk b/packages/lazarus/cli_fp.lpk index 409ee19..247bf94 100644 --- a/packages/lazarus/cli_fp.lpk +++ b/packages/lazarus/cli_fp.lpk @@ -36,7 +36,7 @@ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. "/> - + diff --git a/src/cli.application.pas b/src/cli.application.pas index 236a5aa..f441c0e 100644 --- a/src/cli.application.pas +++ b/src/cli.application.pas @@ -628,7 +628,7 @@ function TCLIApplication.GetParameterValue(const Param: ICommandParameter; else if Param.DefaultValue <> '' then begin Value := Param.DefaultValue; - Result := False; // Not present on command line + Result := True; Exit; end else diff --git a/src/cli.command.pas b/src/cli.command.pas index 60c2820..639473c 100644 --- a/src/cli.command.pas +++ b/src/cli.command.pas @@ -56,6 +56,10 @@ TBaseCommand = class(TInterfacedObject, ICommand) @param AName Command name as used in CLI @param ADescription Command description for help text } constructor Create(const AName, ADescription: string); + + { Updates the command description after construction. + Used by generated registration code so spec metadata stays authoritative. } + procedure UpdateDescription(const ADescription: string); { Cleans up command resources } destructor Destroy; override; @@ -216,6 +220,11 @@ constructor TBaseCommand.Create(const AName, ADescription: string); FParsedParams := nil; // Will be set by application end; +procedure TBaseCommand.UpdateDescription(const ADescription: string); +begin + FDescription := ADescription; +end; + { Destructor: Cleans up command resources } destructor TBaseCommand.Destroy; begin @@ -425,7 +434,7 @@ function TBaseCommand.GetParameterValue(const Flag: string; out Value: string): else if Param.DefaultValue <> '' then begin Value := Param.DefaultValue; - Result := False; + Result := True; Exit; end else diff --git a/tests/codegen-fixtures/golden-basic/clifp.json b/tests/codegen-fixtures/golden-basic/clifp.json new file mode 100644 index 0000000..69eb87e --- /dev/null +++ b/tests/codegen-fixtures/golden-basic/clifp.json @@ -0,0 +1,136 @@ +{ + "schemaVersion": 1, + "app": { + "name": "golden-demo", + "version": "1.2.3", + "programFile": "src/GoldenDemo.lpr" + }, + "commands": [ + { + "name": "greet", + "description": "Say hello", + "parent": "", + "parameters": [ + { + "kind": "string", + "short": "-n", + "long": "--name", + "description": "Name to greet", + "required": false, + "default": "World", + "allowedValues": "" + }, + { + "kind": "flag", + "short": "-v", + "long": "--verbose", + "description": "Verbose output", + "required": false, + "default": "false", + "allowedValues": "" + }, + { + "kind": "enum", + "short": "-m", + "long": "--mode", + "description": "Greeting mode", + "required": false, + "default": "normal", + "allowedValues": "normal|formal" + } + ] + }, + { + "name": "repo", + "description": "Repository tools", + "parent": "", + "parameters": [] + }, + { + "name": "clone", + "description": "Clone repo", + "parent": "repo", + "parameters": [ + { + "kind": "url", + "short": "-u", + "long": "--url", + "description": "Repository URL", + "required": true, + "default": "", + "allowedValues": "" + }, + { + "kind": "integer", + "short": "-d", + "long": "--depth", + "description": "Clone depth", + "required": false, + "default": "1", + "allowedValues": "" + } + ] + }, + { + "name": "types", + "description": "Parameter type showcase", + "parent": "", + "parameters": [ + { + "kind": "float", + "short": "-r", + "long": "--rate", + "description": "Rate", + "required": false, + "default": "1.0", + "allowedValues": "" + }, + { + "kind": "boolean", + "short": "-c", + "long": "--color", + "description": "Use color", + "required": false, + "default": "false", + "allowedValues": "" + }, + { + "kind": "path", + "short": "-p", + "long": "--path", + "description": "Target path", + "required": false, + "default": "", + "allowedValues": "" + }, + { + "kind": "datetime", + "short": "-t", + "long": "--time", + "description": "Run time", + "required": false, + "default": "", + "allowedValues": "" + }, + { + "kind": "array", + "short": "-a", + "long": "--items", + "description": "Items", + "required": false, + "default": "", + "allowedValues": "" + }, + { + "kind": "password", + "short": "-k", + "long": "--api-key", + "description": "API key", + "required": false, + "default": "", + "allowedValues": "" + } + ] + } + ] +} diff --git a/tests/codegen-golden/golden-basic/src/GoldenDemo.lpr b/tests/codegen-golden/golden-basic/src/GoldenDemo.lpr new file mode 100644 index 0000000..577b54e --- /dev/null +++ b/tests/codegen-golden/golden-basic/src/GoldenDemo.lpr @@ -0,0 +1,28 @@ +program GoldenDemo; + +{$mode objfpc}{$H+}{$J-} + +{ Code generated by cli-fp-gen. DO NOT EDIT. } +{ Put your command implementations in src/commands/*.pas. } + +uses + SysUtils, + CLI.Interfaces, + CLI.Application, + GoldenDemo_CommandRegistry_Generated; + +var + App: ICLIApplication; +begin + try + App := CreateCLIApplication('golden-demo', '1.2.3'); + RegisterGeneratedCommands(App); + ExitCode := App.Execute; + except + on E: Exception do + begin + WriteLn('Error: ' + E.Message); + ExitCode := 1; + end; + end; +end. diff --git a/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_Greet.pas b/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_Greet.pas new file mode 100644 index 0000000..3d63394 --- /dev/null +++ b/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_Greet.pas @@ -0,0 +1,37 @@ +unit GoldenDemo_Command_Greet; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + CLI.Command; + +{ User-owned stub created by cli-fp-gen. Safe to edit. } +type + TGreetCommand = class(TBaseCommand) + public + constructor Create; reintroduce; + function Execute: Integer; override; + end; + +implementation + +constructor TGreetCommand.Create; +begin + inherited Create('greet', 'Say hello'); +end; + +function TGreetCommand.Execute: Integer; +begin + if Length(SubCommands) > 0 then + begin + ShowHelp; + Exit(0); + end; + + WriteLn('TODO: Implement command "greet"'); + Result := 0; +end; + +end. diff --git a/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_Repo.pas b/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_Repo.pas new file mode 100644 index 0000000..c41eef9 --- /dev/null +++ b/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_Repo.pas @@ -0,0 +1,37 @@ +unit GoldenDemo_Command_Repo; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + CLI.Command; + +{ User-owned stub created by cli-fp-gen. Safe to edit. } +type + TRepoCommand = class(TBaseCommand) + public + constructor Create; reintroduce; + function Execute: Integer; override; + end; + +implementation + +constructor TRepoCommand.Create; +begin + inherited Create('repo', 'Repository tools'); +end; + +function TRepoCommand.Execute: Integer; +begin + if Length(SubCommands) > 0 then + begin + ShowHelp; + Exit(0); + end; + + WriteLn('TODO: Implement command "repo"'); + Result := 0; +end; + +end. diff --git a/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_RepoClone.pas b/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_RepoClone.pas new file mode 100644 index 0000000..7b3222c --- /dev/null +++ b/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_RepoClone.pas @@ -0,0 +1,37 @@ +unit GoldenDemo_Command_RepoClone; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + CLI.Command; + +{ User-owned stub created by cli-fp-gen. Safe to edit. } +type + TRepoCloneCommand = class(TBaseCommand) + public + constructor Create; reintroduce; + function Execute: Integer; override; + end; + +implementation + +constructor TRepoCloneCommand.Create; +begin + inherited Create('clone', 'Clone repo'); +end; + +function TRepoCloneCommand.Execute: Integer; +begin + if Length(SubCommands) > 0 then + begin + ShowHelp; + Exit(0); + end; + + WriteLn('TODO: Implement command "repo/clone"'); + Result := 0; +end; + +end. diff --git a/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_Types.pas b/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_Types.pas new file mode 100644 index 0000000..b0c81c5 --- /dev/null +++ b/tests/codegen-golden/golden-basic/src/commands/GoldenDemo_Command_Types.pas @@ -0,0 +1,37 @@ +unit GoldenDemo_Command_Types; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + CLI.Command; + +{ User-owned stub created by cli-fp-gen. Safe to edit. } +type + TTypesCommand = class(TBaseCommand) + public + constructor Create; reintroduce; + function Execute: Integer; override; + end; + +implementation + +constructor TTypesCommand.Create; +begin + inherited Create('types', 'Parameter type showcase'); +end; + +function TTypesCommand.Execute: Integer; +begin + if Length(SubCommands) > 0 then + begin + ShowHelp; + Exit(0); + end; + + WriteLn('TODO: Implement command "types"'); + Result := 0; +end; + +end. diff --git a/tests/codegen-golden/golden-basic/src/generated/.clifp-manifest.json b/tests/codegen-golden/golden-basic/src/generated/.clifp-manifest.json new file mode 100644 index 0000000..377a7fd --- /dev/null +++ b/tests/codegen-golden/golden-basic/src/generated/.clifp-manifest.json @@ -0,0 +1,8 @@ +{ + "schemaVersion" : 1, + "generatedFiles" : [ + "src/GoldenDemo.lpr", + "src/generated/GoldenDemo_CommandRegistry_Generated.pas", + "src/generated/.clifp-manifest.json" + ] +} diff --git a/tests/codegen-golden/golden-basic/src/generated/GoldenDemo_CommandRegistry_Generated.pas b/tests/codegen-golden/golden-basic/src/generated/GoldenDemo_CommandRegistry_Generated.pas new file mode 100644 index 0000000..5b8333f --- /dev/null +++ b/tests/codegen-golden/golden-basic/src/generated/GoldenDemo_CommandRegistry_Generated.pas @@ -0,0 +1,53 @@ +unit GoldenDemo_CommandRegistry_Generated; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + CLI.Interfaces; + +{ Code generated by cli-fp-gen. DO NOT EDIT. } +procedure RegisterGeneratedCommands(const App: ICLIApplication); + +implementation + +uses + GoldenDemo_Command_Greet, + GoldenDemo_Command_Repo, + GoldenDemo_Command_RepoClone, + GoldenDemo_Command_Types; + +procedure RegisterGeneratedCommands(const App: ICLIApplication); +var + CmdGreet: TGreetCommand; + CmdRepo: TRepoCommand; + CmdTypes: TTypesCommand; + CmdRepoClone: TRepoCloneCommand; +begin + CmdGreet := TGreetCommand.Create; + CmdGreet.UpdateDescription('Say hello'); + CmdGreet.AddStringParameter('-n', '--name', 'Name to greet', False, 'World'); + CmdGreet.AddFlag('-v', '--verbose', 'Verbose output', 'false'); + CmdGreet.AddEnumParameter('-m', '--mode', 'Greeting mode', 'normal|formal', False, 'normal'); + App.RegisterCommand(CmdGreet); + CmdRepo := TRepoCommand.Create; + CmdRepo.UpdateDescription('Repository tools'); + App.RegisterCommand(CmdRepo); + CmdTypes := TTypesCommand.Create; + CmdTypes.UpdateDescription('Parameter type showcase'); + CmdTypes.AddFloatParameter('-r', '--rate', 'Rate', False, '1.0'); + CmdTypes.AddBooleanParameter('-c', '--color', 'Use color', False, 'false'); + CmdTypes.AddPathParameter('-p', '--path', 'Target path', False, ''); + CmdTypes.AddDateTimeParameter('-t', '--time', 'Run time', False, ''); + CmdTypes.AddArrayParameter('-a', '--items', 'Items', False, ''); + CmdTypes.AddPasswordParameter('-k', '--api-key', 'API key', False); + App.RegisterCommand(CmdTypes); + CmdRepoClone := TRepoCloneCommand.Create; + CmdRepoClone.UpdateDescription('Clone repo'); + CmdRepoClone.AddUrlParameter('-u', '--url', 'Repository URL', True, ''); + CmdRepoClone.AddIntegerParameter('-d', '--depth', 'Clone depth', False, '1'); + CmdRepo.AddSubCommand(CmdRepoClone); +end; + +end. diff --git a/tests/codegen/codegen_test_runner.lpr b/tests/codegen/codegen_test_runner.lpr new file mode 100644 index 0000000..190df1a --- /dev/null +++ b/tests/codegen/codegen_test_runner.lpr @@ -0,0 +1,25 @@ +program CodegenTestRunner; + +{$mode objfpc}{$H+}{$J-} + +uses + Classes, + ConsoleTestRunner, + CodegenTestCase; + +type + TCodegenTestRunner = class(TTestRunner); + +var + Application: TCodegenTestRunner; + +begin + Application := TCodegenTestRunner.Create(nil); + try + Application.Initialize; + Application.Title := 'cli-fp-gen unit tests'; + Application.Run; + finally + Application.Free; + end; +end. diff --git a/tests/codegen/codegentestcase.pas b/tests/codegen/codegentestcase.pas new file mode 100644 index 0000000..08aedf8 --- /dev/null +++ b/tests/codegen/codegentestcase.pas @@ -0,0 +1,272 @@ +unit CodegenTestCase; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + Classes, + SysUtils, + FpcUnit, + TestRegistry, + CliFpGen.Model; + +type + TCodegenTests = class(TTestCase) + private + function NewValidSpec: TProjectSpec; + function AddCommand(const Spec: TProjectSpec; const Name: string; + const ParentPath: string = ''): TCommandSpec; + procedure AssertValidationFails(const Spec: TProjectSpec; + const ExpectedMessagePart: string); + procedure AssertSpecLoadFails(const JsonText, ExpectedMessagePart: string); + published + procedure TestCommandNameSeparatorIsRejected; + procedure TestGeneratedIdentifierCollisionIsRejected; + procedure TestNestedGeneratedIdentifierCollisionIsRejected; + procedure TestReservedWordAppNameProducesValidProgramIdentifier; + procedure TestProgramFileCannotEscapeProject; + procedure TestInvalidParameterKindReportsItsLocation; + procedure TestNonObjectParameterReportsItsLocation; + procedure TestMalformedParameterDoesNotLeakOwnedSpecs; + end; + +implementation + +uses + CliFpGen.Naming, + CliFpGen.SpecIO, + CliFpGen.Validate; + +procedure TCodegenTests.AssertSpecLoadFails(const JsonText, + ExpectedMessagePart: string); +var + SpecFile: string; + Lines: TStringList; + Spec: TProjectSpec; + RaisedExpectedError: Boolean; +begin + SpecFile := GetTempFileName(GetTempDir(False), 'cfg'); + Lines := TStringList.Create; + try + Lines.Text := JsonText; + Lines.SaveToFile(SpecFile); + finally + Lines.Free; + end; + + try + RaisedExpectedError := False; + Spec := nil; + try + Spec := LoadProjectSpec(SpecFile); + except + on E: Exception do + begin + RaisedExpectedError := True; + AssertTrue( + Format('Expected error containing "%s", got "%s"', + [ExpectedMessagePart, E.Message]), + Pos(LowerCase(ExpectedMessagePart), LowerCase(E.Message)) > 0 + ); + end; + end; + Spec.Free; + AssertTrue('Expected spec loading to fail', RaisedExpectedError); + finally + DeleteFile(SpecFile); + end; +end; + +function TCodegenTests.NewValidSpec: TProjectSpec; +begin + Result := TProjectSpec.Create; + Result.AppName := 'demo'; + Result.AppVersion := '1.0.0'; + Result.ProgramFile := 'src/Demo.lpr'; +end; + +function TCodegenTests.AddCommand(const Spec: TProjectSpec; + const Name: string; const ParentPath: string): TCommandSpec; +begin + Result := TCommandSpec.Create; + Result.Name := Name; + Result.Description := 'Test command'; + Result.ParentPath := ParentPath; + Spec.Commands.Add(Result); +end; + +procedure TCodegenTests.AssertValidationFails(const Spec: TProjectSpec; + const ExpectedMessagePart: string); +var + RaisedExpectedError: Boolean; +begin + RaisedExpectedError := False; + try + ValidateProjectSpec(Spec); + except + on E: Exception do + begin + RaisedExpectedError := True; + AssertTrue( + Format('Expected error containing "%s", got "%s"', + [ExpectedMessagePart, E.Message]), + Pos(LowerCase(ExpectedMessagePart), LowerCase(E.Message)) > 0 + ); + end; + end; + AssertTrue('Expected validation to fail', RaisedExpectedError); +end; + +procedure TCodegenTests.TestCommandNameSeparatorIsRejected; +var + Spec: TProjectSpec; +begin + Spec := NewValidSpec; + try + AddCommand(Spec, 'repo/clone'); + AssertValidationFails(Spec, 'Invalid command name'); + finally + Spec.Free; + end; +end; + +procedure TCodegenTests.TestGeneratedIdentifierCollisionIsRejected; +var + Spec: TProjectSpec; +begin + Spec := NewValidSpec; + try + AddCommand(Spec, 'foo-bar'); + AddCommand(Spec, 'foo_bar'); + AssertValidationFails(Spec, 'same Pascal identifier'); + finally + Spec.Free; + end; +end; + +procedure TCodegenTests.TestNestedGeneratedIdentifierCollisionIsRejected; +var + Spec: TProjectSpec; +begin + Spec := NewValidSpec; + try + AddCommand(Spec, 'a'); + AddCommand(Spec, 'ab'); + AddCommand(Spec, 'bc', 'a'); + AddCommand(Spec, 'c', 'ab'); + AssertValidationFails(Spec, 'same Pascal identifier'); + finally + Spec.Free; + end; +end; + +procedure TCodegenTests.TestReservedWordAppNameProducesValidProgramIdentifier; +begin + AssertEquals('AppProgram', MakeProgramIdentifier('program')); + AssertEquals('GoldenDemo', MakeProgramIdentifier('golden-demo')); +end; + +procedure TCodegenTests.TestProgramFileCannotEscapeProject; +var + Spec: TProjectSpec; +begin + Spec := NewValidSpec; + try + Spec.ProgramFile := 'src/../outside/Demo.lpr'; + AssertValidationFails(Spec, 'must not escape'); + finally + Spec.Free; + end; +end; + +procedure TCodegenTests.TestInvalidParameterKindReportsItsLocation; +begin + AssertSpecLoadFails( + '{"schemaVersion":1,"app":{"name":"demo","version":"1.0.0",' + + '"programFile":"src/Demo.lpr"},"commands":[{"name":"run",' + + '"description":"Run","parent":"","parameters":[{"kind":"string",' + + '"short":"-n","long":"--name","description":"Name","required":false},' + + '{"kind":"not-a-kind","short":"","long":"--bad",' + + '"description":"Bad","required":false}]}]}', + 'commands[0].parameters[1]' + ); +end; + +procedure TCodegenTests.TestNonObjectParameterReportsItsLocation; +begin + AssertSpecLoadFails( + '{"schemaVersion":1,"app":{"name":"demo","version":"1.0.0",' + + '"programFile":"src/Demo.lpr"},"commands":[{"name":"run",' + + '"description":"Run","parent":"","parameters":[42]}]}', + 'commands[0].parameters[0] must be an object' + ); +end; + +procedure TCodegenTests.TestMalformedParameterDoesNotLeakOwnedSpecs; +const + MalformedJson = + '{"schemaVersion":1,"app":{"name":"demo","version":"1.0.0",' + + '"programFile":"src/Demo.lpr"},"commands":[{"name":"run",' + + '"description":"Run","parent":"","parameters":[{"kind":"string",' + + '"short":"-n","long":"--name","description":"Name","required":false},' + + '{"kind":"not-a-kind","short":"","long":"--bad",' + + '"description":"Bad","required":false}]}]}'; +var + SpecFile: string; + Lines: TStringList; + Spec: TProjectSpec; + BeforeStatus, AfterStatus: TFPCHeapStatus; + i: Integer; +begin + SpecFile := GetTempFileName(GetTempDir(False), 'cfg'); + Lines := TStringList.Create; + try + Lines.Text := MalformedJson; + Lines.SaveToFile(SpecFile); + finally + Lines.Free; + end; + + try + // Warm up the JSON parser and exception path before measuring live blocks. + for i := 1 to 10 do + begin + Spec := nil; + try + Spec := LoadProjectSpec(SpecFile); + except + on E: Exception do + ; + end; + Spec.Free; + end; + + BeforeStatus := GetFPCHeapStatus; + for i := 1 to 100 do + begin + Spec := nil; + try + Spec := LoadProjectSpec(SpecFile); + except + on E: Exception do + ; + end; + Spec.Free; + end; + AfterStatus := GetFPCHeapStatus; + + AssertTrue( + Format('Malformed spec loads leaked memory: before=%d, after=%d', + [BeforeStatus.CurrHeapUsed, AfterStatus.CurrHeapUsed]), + AfterStatus.CurrHeapUsed <= BeforeStatus.CurrHeapUsed + ); + finally + DeleteFile(SpecFile); + end; +end; + +initialization + RegisterTest(TCodegenTests); + +end. diff --git a/tests/codegen/run_all_tests.ps1 b/tests/codegen/run_all_tests.ps1 new file mode 100644 index 0000000..c960a87 --- /dev/null +++ b/tests/codegen/run_all_tests.ps1 @@ -0,0 +1,226 @@ +$ErrorActionPreference = 'Stop' + +function New-TempDir { + $path = Join-Path ([System.IO.Path]::GetTempPath()) ("cli-fp-codegen-" + [System.Guid]::NewGuid().ToString("N")) + New-Item -ItemType Directory -Path $path | Out-Null + return $path +} + +function Normalize-Content([string]$Path) { + return (Get-Content -Raw $Path) -replace "`r`n", "`n" +} + +function Assert-True([bool]$Condition, [string]$Message) { + if (-not $Condition) { + throw $Message + } +} + +function Write-JsonFile([string]$Path, $Object) { + $Object | ConvertTo-Json -Depth 20 | Set-Content -Path $Path +} + +$RootDir = (Resolve-Path (Join-Path $PSScriptRoot "..\..")).Path +$GenSrc = Join-Path $RootDir "tools\cli-fp-gen\cli_fp_gen.lpr" +$FixtureDir = Join-Path $RootDir "tests\codegen-fixtures\golden-basic" +$GoldenDir = Join-Path $RootDir "tests\codegen-golden\golden-basic" +$TmpDir = New-TempDir +$GenExe = Join-Path $TmpDir "cli_fp_gen.exe" +$LinkGuardJunction = $null + +try { + $GenUnits = Join-Path $TmpDir "gen-units" + New-Item -ItemType Directory -Path $GenUnits | Out-Null + fpc ` + "-Fu$RootDir\tools\cli-fp-gen\src" ` + "-FE$TmpDir" ` + "-FU$GenUnits" ` + $GenSrc + Assert-True ($LASTEXITCODE -eq 0) "Failed to compile cli-fp-gen" + + # Focused unit tests for naming and validation + $UnitTestOutput = Join-Path $TmpDir "unit-tests" + $UnitTestUnits = Join-Path $UnitTestOutput "units" + New-Item -ItemType Directory -Force -Path $UnitTestUnits | Out-Null + fpc ` + "-Fu$RootDir\tools\cli-fp-gen\src" ` + "-Fu$PSScriptRoot" ` + "-FE$UnitTestOutput" ` + "-FU$UnitTestUnits" ` + (Join-Path $PSScriptRoot "codegen_test_runner.lpr") + Assert-True ($LASTEXITCODE -eq 0) "Failed to compile codegen unit tests" + + & (Join-Path $UnitTestOutput "codegen_test_runner.exe") --all --format=plain | Out-Null + Assert-True ($LASTEXITCODE -eq 0) "Codegen unit tests failed" + Write-Host "Unit tests passed" + + # Golden output check + $GoldenProject = Join-Path $TmpDir "golden" + New-Item -ItemType Directory -Force -Path $GoldenProject | Out-Null + Copy-Item -Force (Join-Path $FixtureDir "clifp.json") (Join-Path $GoldenProject "clifp.json") + & $GenExe generate --project $GoldenProject | Out-Null + + $GoldenFiles = @( + "src\GoldenDemo.lpr", + "src\generated\GoldenDemo_CommandRegistry_Generated.pas", + "src\generated\.clifp-manifest.json", + "src\commands\GoldenDemo_Command_Greet.pas", + "src\commands\GoldenDemo_Command_Repo.pas", + "src\commands\GoldenDemo_Command_RepoClone.pas", + "src\commands\GoldenDemo_Command_Types.pas" + ) + + foreach ($RelativePath in $GoldenFiles) { + $Expected = Normalize-Content (Join-Path $GoldenDir $RelativePath) + $Actual = Normalize-Content (Join-Path $GoldenProject $RelativePath) + Assert-True ($Expected -eq $Actual) "Golden mismatch: $RelativePath" + } + + Write-Host "Golden test passed" + + # Compile smoke check + fpc ` + "-Fu$RootDir\src" ` + "-Fu$GoldenProject\src" ` + "-Fu$GoldenProject\src\generated" ` + "-Fu$GoldenProject\src\commands" ` + (Join-Path $GoldenProject "src\GoldenDemo.lpr") + Assert-True ($LASTEXITCODE -eq 0) "Failed to compile generated golden project" + + & (Join-Path $GoldenProject "src\GoldenDemo.exe") --help | Out-Null + & (Join-Path $GoldenProject "src\GoldenDemo.exe") repo | Out-Null + + Write-Host "Compile smoke test passed" + + # Operations and path guard check + $DemoProject = Join-Path $TmpDir "demo" + & $GenExe init $DemoProject | Out-Null + + $SpecBeforeReinit = Normalize-Content (Join-Path $DemoProject "clifp.json") + $null = (& $GenExe init $DemoProject 2>&1 | Out-String) + Assert-True ($LASTEXITCODE -ne 0) "Expected init without --force to protect the existing project spec" + Assert-True ( + (Normalize-Content (Join-Path $DemoProject "clifp.json")) -eq $SpecBeforeReinit + ) "Init without --force modified the existing project spec" + + $null = (& $GenExe add command "repo/clone" --project $DemoProject 2>&1 | Out-String) + Assert-True ($LASTEXITCODE -ne 0) "Expected a command name containing a path separator to fail" + Assert-True ( + (Normalize-Content (Join-Path $DemoProject "clifp.json")) -eq $SpecBeforeReinit + ) "Invalid add command modified the project spec" + + $DryRunOutput = (& $GenExe add command repo --project $DemoProject --description "Repo tools" --dry-run) | Out-String + Assert-True ($DryRunOutput -match "Demo_Command_Repo\.pas") "Dry-run add did not preview the new command stub" + Assert-True (-not ((Get-Content -Raw (Join-Path $DemoProject "clifp.json")) -match '"name"\s*:\s*"repo"')) "Dry-run add modified clifp.json" + Assert-True (-not (Test-Path (Join-Path $DemoProject "src\commands\Demo_Command_Repo.pas"))) "Dry-run add created a command stub" + + & $GenExe add command repo --project $DemoProject --description "Repo tools" | Out-Null + & $GenExe add command clone --parent repo --project $DemoProject --description "Clone repo" | Out-Null + + $RepoStub = Join-Path $DemoProject "src\commands\Demo_Command_Repo.pas" + Add-Content -Path $RepoStub -Value "`n{ user customization }" + & $GenExe generate --project $DemoProject | Out-Null + Assert-True ( + (Get-Content -Raw $RepoStub) -match [regex]::Escape("{ user customization }") + ) "Generate overwrote a user-owned command stub" + + $null = (& $GenExe remove command repo --project $DemoProject 2>&1 | Out-String) + Assert-True ($LASTEXITCODE -ne 0) "Expected remove command without --cascade to fail" + + & $GenExe remove command repo --cascade --project $DemoProject | Out-Null + Assert-True (-not ((Get-Content -Raw (Join-Path $DemoProject "clifp.json")) -match '"name"\s*:\s*"repo"')) "repo command still present after cascade remove" + + $DemoSpec = Get-Content -Raw (Join-Path $DemoProject "clifp.json") | ConvertFrom-Json + $OldProgramPath = Join-Path $DemoProject $DemoSpec.app.programFile + Assert-True (Test-Path $OldProgramPath) "Expected original program file to exist after init" + + $DemoSpec.app.programFile = "src/DemoRenamed.lpr" + Write-JsonFile (Join-Path $DemoProject "clifp.json") $DemoSpec + & $GenExe generate --project $DemoProject | Out-Null + + Assert-True (Test-Path (Join-Path $DemoProject "src\DemoRenamed.lpr")) "Renamed program file was not generated" + Assert-True (-not (Test-Path $OldProgramPath)) "Old generated program file was not removed by manifest cleanup" + Assert-True ((Get-Content -Raw (Join-Path $DemoProject "src\generated\.clifp-manifest.json")) -match "src/DemoRenamed\.lpr") "Manifest did not track renamed program file" + + $DescriptionsProject = Join-Path $TmpDir "descriptions" + & $GenExe init $DescriptionsProject --force | Out-Null + & $GenExe add command repo --project $DescriptionsProject --description "Owner's tools" | Out-Null + + $DescriptionsSpec = Get-Content -Raw (Join-Path $DescriptionsProject "clifp.json") | ConvertFrom-Json + foreach ($Command in $DescriptionsSpec.commands) { + if ($Command.name -eq "repo") { + $Command.description = "Repo team's tools" + } + } + Write-JsonFile (Join-Path $DescriptionsProject "clifp.json") $DescriptionsSpec + & $GenExe generate --project $DescriptionsProject | Out-Null + + $ProgramPath = Join-Path $DescriptionsProject $DescriptionsSpec.app.programFile + fpc ` + "-Fu$RootDir\src" ` + "-Fu$DescriptionsProject\src" ` + "-Fu$DescriptionsProject\src\generated" ` + "-Fu$DescriptionsProject\src\commands" ` + $ProgramPath + Assert-True ($LASTEXITCODE -eq 0) "Failed to compile generated descriptions project" + + $ExePath = [System.IO.Path]::ChangeExtension($ProgramPath, ".exe") + $HelpOutput = (& $ExePath repo --help) | Out-String + Assert-True ($HelpOutput -match "Repo team's tools") "Regenerated command description did not update runtime help" + + $PathGuardProject = Join-Path $TmpDir "path-guard" + & $GenExe init $PathGuardProject --force | Out-Null + + $PathGuardSpec = Get-Content -Raw (Join-Path $PathGuardProject "clifp.json") | ConvertFrom-Json + $PathGuardSpec.app.programFile = "../outside/Escape.lpr" + Write-JsonFile (Join-Path $PathGuardProject "clifp.json") $PathGuardSpec + + $null = (& $GenExe generate --project $PathGuardProject 2>&1 | Out-String) + Assert-True ($LASTEXITCODE -ne 0) "Expected invalid programFile path to fail validation" + Assert-True (-not (Test-Path (Join-Path $TmpDir "outside\Escape.lpr"))) "Generator wrote a program file outside the project directory" + + $ManifestGuardProject = Join-Path $TmpDir "manifest-guard" + & $GenExe init $ManifestGuardProject | Out-Null + $ManifestOutsideDir = Join-Path $TmpDir "manifest-outside" + New-Item -ItemType Directory -Path $ManifestOutsideDir | Out-Null + $ManifestVictim = Join-Path $ManifestOutsideDir "victim.txt" + Set-Content -Path $ManifestVictim -Value "protected" + + $ManifestPath = Join-Path $ManifestGuardProject "src\generated\.clifp-manifest.json" + $Manifest = Get-Content -Raw $ManifestPath | ConvertFrom-Json + $Manifest.generatedFiles = @("../manifest-outside/victim.txt") + Write-JsonFile $ManifestPath $Manifest + + $null = (& $GenExe generate --project $ManifestGuardProject 2>&1 | Out-String) + Assert-True ($LASTEXITCODE -ne 0) "Expected an out-of-project manifest entry to fail cleanup" + Assert-True (Test-Path $ManifestVictim) "Manifest cleanup deleted a file outside the project directory" + + $LinkGuardProject = Join-Path $TmpDir "link-guard" + $LinkGuardOutside = Join-Path $TmpDir "link-guard-outside" + & $GenExe init $LinkGuardProject | Out-Null + New-Item -ItemType Directory -Path $LinkGuardOutside | Out-Null + $LinkGuardVictim = Join-Path $LinkGuardOutside "victim.txt" + Set-Content -Path $LinkGuardVictim -Value "protected" + $LinkGuardJunction = Join-Path $LinkGuardProject "linked" + New-Item -ItemType Junction -Path $LinkGuardJunction -Target $LinkGuardOutside | Out-Null + + $LinkGuardManifestPath = Join-Path $LinkGuardProject "src\generated\.clifp-manifest.json" + $LinkGuardManifest = Get-Content -Raw $LinkGuardManifestPath | ConvertFrom-Json + $LinkGuardManifest.generatedFiles = @("linked/victim.txt") + Write-JsonFile $LinkGuardManifestPath $LinkGuardManifest + + $LinkGuardOutput = (& $GenExe generate --project $LinkGuardProject 2>&1 | Out-String) + Assert-True ($LASTEXITCODE -ne 0) "Expected a manifest entry through a junction to fail cleanup" + Assert-True ($LinkGuardOutput -match "symbolic link or reparse point") "Generator did not report the linked manifest path" + Assert-True (Test-Path $LinkGuardVictim) "Manifest cleanup followed a junction and deleted an external file" + + Write-Host "Ops test passed" +} +finally { + if (($null -ne $LinkGuardJunction) -and (Test-Path -LiteralPath $LinkGuardJunction)) { + [System.IO.Directory]::Delete($LinkGuardJunction) + } + if (Test-Path $TmpDir) { + Remove-Item -Recurse -Force $TmpDir + } +} diff --git a/tests/codegen/run_compile_smoke.sh b/tests/codegen/run_compile_smoke.sh new file mode 100644 index 0000000..a0e37fe --- /dev/null +++ b/tests/codegen/run_compile_smoke.sh @@ -0,0 +1,33 @@ +#!/usr/bin/env bash +set -euo pipefail + +ROOT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")/../.." && pwd)" +TMP_DIR="$(mktemp -d)" +trap 'rm -rf "$TMP_DIR"' EXIT + +GEN_SRC="$ROOT_DIR/tools/cli-fp-gen/cli_fp_gen.lpr" +GEN_BIN="$TMP_DIR/cli_fp_gen" +FIXTURE_DIR="$ROOT_DIR/tests/codegen-fixtures/golden-basic" + +mkdir -p "$TMP_DIR/gen-units" +fpc \ + -Fu"$ROOT_DIR/tools/cli-fp-gen/src" \ + -FE"$TMP_DIR" \ + -FU"$TMP_DIR/gen-units" \ + "$GEN_SRC" >/dev/null + +mkdir -p "$TMP_DIR/project" +cp "$FIXTURE_DIR/clifp.json" "$TMP_DIR/project/clifp.json" +"$GEN_BIN" generate --project "$TMP_DIR/project" >/dev/null + +fpc \ + -Fu"$ROOT_DIR/src" \ + -Fu"$TMP_DIR/project/src" \ + -Fu"$TMP_DIR/project/src/generated" \ + -Fu"$TMP_DIR/project/src/commands" \ + "$TMP_DIR/project/src/GoldenDemo.lpr" >/dev/null + +"$TMP_DIR/project/src/GoldenDemo" --help >/dev/null +"$TMP_DIR/project/src/GoldenDemo" repo >/dev/null + +echo "Compile smoke test passed" diff --git a/tests/codegen/run_golden_test.sh b/tests/codegen/run_golden_test.sh new file mode 100644 index 0000000..c5cbcec --- /dev/null +++ b/tests/codegen/run_golden_test.sh @@ -0,0 +1,39 @@ +#!/usr/bin/env bash +set -euo pipefail + +ROOT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")/../.." && pwd)" +TMP_DIR="$(mktemp -d)" +trap 'rm -rf "$TMP_DIR"' EXIT + +GEN_SRC="$ROOT_DIR/tools/cli-fp-gen/cli_fp_gen.lpr" +GEN_BIN="$TMP_DIR/cli_fp_gen" +FIXTURE_DIR="$ROOT_DIR/tests/codegen-fixtures/golden-basic" +GOLDEN_DIR="$ROOT_DIR/tests/codegen-golden/golden-basic" + +mkdir -p "$TMP_DIR/gen-units" +fpc \ + -Fu"$ROOT_DIR/tools/cli-fp-gen/src" \ + -FE"$TMP_DIR" \ + -FU"$TMP_DIR/gen-units" \ + "$GEN_SRC" >/dev/null + +mkdir -p "$TMP_DIR/project" +cp "$FIXTURE_DIR/clifp.json" "$TMP_DIR/project/clifp.json" +"$GEN_BIN" generate --project "$TMP_DIR/project" >/dev/null + +compare_file() { + local rel="$1" + diff -u --strip-trailing-cr \ + "$GOLDEN_DIR/$rel" \ + "$TMP_DIR/project/$rel" +} + +compare_file "src/GoldenDemo.lpr" +compare_file "src/generated/GoldenDemo_CommandRegistry_Generated.pas" +compare_file "src/generated/.clifp-manifest.json" +compare_file "src/commands/GoldenDemo_Command_Greet.pas" +compare_file "src/commands/GoldenDemo_Command_Repo.pas" +compare_file "src/commands/GoldenDemo_Command_RepoClone.pas" +compare_file "src/commands/GoldenDemo_Command_Types.pas" + +echo "Golden test passed" diff --git a/tests/codegen/run_ops_test.sh b/tests/codegen/run_ops_test.sh new file mode 100644 index 0000000..66dfdb4 --- /dev/null +++ b/tests/codegen/run_ops_test.sh @@ -0,0 +1,248 @@ +#!/usr/bin/env bash +set -euo pipefail + +ROOT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")/../.." && pwd)" +TMP_DIR="$(mktemp -d)" +trap 'rm -rf "$TMP_DIR"' EXIT + +GEN_SRC="$ROOT_DIR/tools/cli-fp-gen/cli_fp_gen.lpr" +GEN_BIN="$TMP_DIR/cli_fp_gen" + +mkdir -p "$TMP_DIR/gen-units" +fpc \ + -Fu"$ROOT_DIR/tools/cli-fp-gen/src" \ + -FE"$TMP_DIR" \ + -FU"$TMP_DIR/gen-units" \ + "$GEN_SRC" >/dev/null + +"$GEN_BIN" init "$TMP_DIR/demo" >/dev/null + +spec_before_reinit="$(cat "$TMP_DIR/demo/clifp.json")" +if "$GEN_BIN" init "$TMP_DIR/demo" >/dev/null 2>&1; then + echo "Expected init without --force to protect the existing project spec" + exit 1 +fi +test "$(cat "$TMP_DIR/demo/clifp.json")" = "$spec_before_reinit" || { + echo "Init without --force modified the existing project spec" + exit 1 +} + +if "$GEN_BIN" add command 'repo/clone' --project "$TMP_DIR/demo" >/dev/null 2>&1; then + echo "Expected a command name containing a path separator to fail" + exit 1 +fi +test "$(cat "$TMP_DIR/demo/clifp.json")" = "$spec_before_reinit" || { + echo "Invalid add command modified the project spec" + exit 1 +} + +dry_run_output="$("$GEN_BIN" add command repo --project "$TMP_DIR/demo" --description "Repo tools" --dry-run)" +printf '%s' "$dry_run_output" | grep -q 'Demo_Command_Repo.pas' || { + echo "Dry-run add did not preview the new command stub" + exit 1 +} +if grep -q '"name" : "repo"' "$TMP_DIR/demo/clifp.json"; then + echo "Dry-run add modified clifp.json" + exit 1 +fi +test ! -f "$TMP_DIR/demo/src/commands/Demo_Command_Repo.pas" + +"$GEN_BIN" add command repo --project "$TMP_DIR/demo" --description "Repo tools" >/dev/null +"$GEN_BIN" add command clone --parent repo --project "$TMP_DIR/demo" --description "Clone repo" >/dev/null + +repo_stub="$TMP_DIR/demo/src/commands/Demo_Command_Repo.pas" +printf '\n{ user customization }\n' >>"$repo_stub" +"$GEN_BIN" generate --project "$TMP_DIR/demo" >/dev/null +grep -q '{ user customization }' "$repo_stub" || { + echo "Generate overwrote a user-owned command stub" + exit 1 +} + +if "$GEN_BIN" remove command repo --project "$TMP_DIR/demo" >/dev/null 2>&1; then + echo "Expected remove command without --cascade to fail" + exit 1 +fi + +"$GEN_BIN" remove command repo --cascade --project "$TMP_DIR/demo" >/dev/null + +grep -q '"name" : "repo"' "$TMP_DIR/demo/clifp.json" && { + echo "repo command still present after cascade remove" + exit 1 +} + +old_program="$TMP_DIR/demo/src/Demo.lpr" +test -f "$old_program" + +python3 - <<'PY' "$TMP_DIR/demo/clifp.json" +import json, sys +p = sys.argv[1] +with open(p, "r", encoding="utf-8") as f: + data = json.load(f) +data["app"]["programFile"] = "src/DemoRenamed.lpr" +with open(p, "w", encoding="utf-8") as f: + json.dump(data, f, indent=2) + f.write("\n") +PY + +"$GEN_BIN" generate --project "$TMP_DIR/demo" >/dev/null + +test -f "$TMP_DIR/demo/src/DemoRenamed.lpr" +if test -f "$old_program"; then + echo "Old generated program file was not removed by manifest cleanup" + exit 1 +fi + +grep -q 'src/DemoRenamed.lpr' "$TMP_DIR/demo/src/generated/.clifp-manifest.json" + +"$GEN_BIN" init "$TMP_DIR/descriptions" --force >/dev/null +"$GEN_BIN" add command repo --project "$TMP_DIR/descriptions" --description "Owner's tools" >/dev/null + +python3 - <<'PY' "$TMP_DIR/descriptions/clifp.json" +import json, sys +p = sys.argv[1] +with open(p, "r", encoding="utf-8") as f: + data = json.load(f) +for cmd in data["commands"]: + if cmd["name"] == "repo": + cmd["description"] = "Repo team's tools" +with open(p, "w", encoding="utf-8") as f: + json.dump(data, f, indent=2) + f.write("\n") +PY + +"$GEN_BIN" generate --project "$TMP_DIR/descriptions" >/dev/null + +description_program_rel="$(python3 - <<'PY' "$TMP_DIR/descriptions/clifp.json" +import json, sys +with open(sys.argv[1], "r", encoding="utf-8") as f: + print(json.load(f)["app"]["programFile"]) +PY +)" +description_program="$TMP_DIR/descriptions/$description_program_rel" +test -f "$description_program" || { + echo "Generated program file not found: $description_program" + exit 1 +} + +fpc \ + -Fu"$ROOT_DIR/src" \ + -Fu"$TMP_DIR/descriptions/src" \ + -Fu"$TMP_DIR/descriptions/src/generated" \ + -Fu"$TMP_DIR/descriptions/src/commands" \ + "$description_program" + +description_executable="${description_program%.lpr}" +"$description_executable" repo --help | grep -q "Repo team's tools" || { + echo "Regenerated command description did not update runtime help" + exit 1 +} + +"$GEN_BIN" init "$TMP_DIR/path-guard" --force >/dev/null + +python3 - <<'PY' "$TMP_DIR/path-guard/clifp.json" +import json, sys +p = sys.argv[1] +with open(p, "r", encoding="utf-8") as f: + data = json.load(f) +data["app"]["programFile"] = "../outside/Escape.lpr" +with open(p, "w", encoding="utf-8") as f: + json.dump(data, f, indent=2) + f.write("\n") +PY + +if "$GEN_BIN" generate --project "$TMP_DIR/path-guard" >/dev/null 2>&1; then + echo "Expected invalid programFile path to fail validation" + exit 1 +fi + +if test -f "$TMP_DIR/outside/Escape.lpr" || test -f "$TMP_DIR/path-guard/../outside/Escape.lpr"; then + echo "Generator wrote a program file outside the project directory" + exit 1 +fi + +manifest_guard_project="$TMP_DIR/manifest-guard" +"$GEN_BIN" init "$manifest_guard_project" >/dev/null +mkdir -p "$TMP_DIR/manifest-outside" +printf 'protected\n' >"$TMP_DIR/manifest-outside/victim.txt" + +python3 - <<'PY' "$manifest_guard_project/src/generated/.clifp-manifest.json" +import json, sys +p = sys.argv[1] +with open(p, "r", encoding="utf-8") as f: + data = json.load(f) +data["generatedFiles"] = ["../manifest-outside/victim.txt"] +with open(p, "w", encoding="utf-8") as f: + json.dump(data, f, indent=2) + f.write("\n") +PY + +if "$GEN_BIN" generate --project "$manifest_guard_project" >/dev/null 2>&1; then + echo "Expected an out-of-project manifest entry to fail cleanup" + exit 1 +fi +test -f "$TMP_DIR/manifest-outside/victim.txt" || { + echo "Manifest cleanup deleted a file outside the project directory" + exit 1 +} + +link_guard_project="$TMP_DIR/link-guard" +link_guard_outside="$TMP_DIR/link-guard-outside" +"$GEN_BIN" init "$link_guard_project" >/dev/null +mkdir -p "$link_guard_outside" +printf 'protected\n' >"$link_guard_outside/victim.txt" +ln -s "$link_guard_outside" "$link_guard_project/linked" + +python3 - <<'PY' "$link_guard_project/src/generated/.clifp-manifest.json" +import json, sys +p = sys.argv[1] +with open(p, "r", encoding="utf-8") as f: + data = json.load(f) +data["generatedFiles"] = ["linked/victim.txt"] +with open(p, "w", encoding="utf-8") as f: + json.dump(data, f, indent=2) + f.write("\n") +PY + +if link_guard_output="$("$GEN_BIN" generate --project "$link_guard_project" 2>&1)"; then + echo "Expected a manifest entry through a symbolic link to fail cleanup" + exit 1 +fi +printf '%s' "$link_guard_output" | grep -q 'symbolic link or reparse point' || { + echo "Generator did not report the linked manifest path" + exit 1 +} +test -f "$link_guard_outside/victim.txt" || { + echo "Manifest cleanup followed a symbolic link and deleted an external file" + exit 1 +} + +# On case-sensitive filesystems, a sibling that differs only by case is still +# outside the project and must not pass the manifest cleanup prefix check. +case_project="$TMP_DIR/CaseProject" +case_sibling="$TMP_DIR/caseproject" +"$GEN_BIN" init "$case_project" >/dev/null +mkdir -p "$case_sibling" +if [[ ! "$case_project" -ef "$case_sibling" ]]; then + printf 'protected\n' >"$case_sibling/victim.txt" + python3 - <<'PY' "$case_project/src/generated/.clifp-manifest.json" +import json, sys +p = sys.argv[1] +with open(p, "r", encoding="utf-8") as f: + data = json.load(f) +data["generatedFiles"] = ["../caseproject/victim.txt"] +with open(p, "w", encoding="utf-8") as f: + json.dump(data, f, indent=2) + f.write("\n") +PY + + if "$GEN_BIN" generate --project "$case_project" >/dev/null 2>&1; then + echo "Expected a differently-cased sibling manifest entry to fail cleanup" + exit 1 + fi + test -f "$case_sibling/victim.txt" || { + echo "Manifest cleanup deleted a file from a differently-cased sibling directory" + exit 1 + } +fi + +echo "Ops test passed" diff --git a/tests/codegen/run_unit_tests.sh b/tests/codegen/run_unit_tests.sh new file mode 100644 index 0000000..8beec6f --- /dev/null +++ b/tests/codegen/run_unit_tests.sh @@ -0,0 +1,17 @@ +#!/usr/bin/env bash +set -euo pipefail + +ROOT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")/../.." && pwd)" +TMP_DIR="$(mktemp -d)" +trap 'rm -rf "$TMP_DIR"' EXIT + +mkdir -p "$TMP_DIR/units" + +fpc \ + -Fu"$ROOT_DIR/tools/cli-fp-gen/src" \ + -Fu"$ROOT_DIR/tests/codegen" \ + -FE"$TMP_DIR" \ + -FU"$TMP_DIR/units" \ + "$ROOT_DIR/tests/codegen/codegen_test_runner.lpr" >/dev/null + +"$TMP_DIR/codegen_test_runner" --all --format=plain diff --git a/tests/run_tests.ps1 b/tests/run_tests.ps1 new file mode 100644 index 0000000..4e620f3 --- /dev/null +++ b/tests/run_tests.ps1 @@ -0,0 +1,33 @@ +$ErrorActionPreference = 'Stop' + +function Assert-LastExitCode([string]$Message) { + if ($LASTEXITCODE -ne 0) { + throw $Message + } +} + +$RootDir = (Resolve-Path (Join-Path $PSScriptRoot "..")).Path +$TmpDir = Join-Path ( + [System.IO.Path]::GetTempPath() +) ("cli-fp-tests-" + [System.Guid]::NewGuid().ToString("N")) + +try { + $UnitDir = Join-Path $TmpDir "units" + New-Item -ItemType Directory -Force -Path $UnitDir | Out-Null + + fpc ` + "-Fu$RootDir\src" ` + "-Fu$RootDir\tests" ` + "-FE$TmpDir" ` + "-FU$UnitDir" ` + (Join-Path $RootDir "tests\TestRunner.lpr") + Assert-LastExitCode "Failed to compile framework tests" + + & (Join-Path $TmpDir "TestRunner.exe") --all --format=plain + Assert-LastExitCode "Framework tests failed" +} +finally { + if (Test-Path $TmpDir) { + Remove-Item -Recurse -Force $TmpDir + } +} diff --git a/tests/run_tests.sh b/tests/run_tests.sh new file mode 100644 index 0000000..fa73a65 --- /dev/null +++ b/tests/run_tests.sh @@ -0,0 +1,17 @@ +#!/usr/bin/env bash +set -euo pipefail + +ROOT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd)" +TMP_DIR="$(mktemp -d)" +trap 'rm -rf "$TMP_DIR"' EXIT + +mkdir -p "$TMP_DIR/units" + +fpc \ + -Fu"$ROOT_DIR/src" \ + -Fu"$ROOT_DIR/tests" \ + -FE"$TMP_DIR" \ + -FU"$TMP_DIR/units" \ + "$ROOT_DIR/tests/TestRunner.lpr" >/dev/null + +"$TMP_DIR/TestRunner" --all --format=plain diff --git a/tools/cli-fp-gen/README.md b/tools/cli-fp-gen/README.md new file mode 100644 index 0000000..95c24e9 --- /dev/null +++ b/tools/cli-fp-gen/README.md @@ -0,0 +1,47 @@ +# cli-fp-gen + +A standalone scaffold generator for [cli-fp](../../README.md) applications. + +> **You must compile this tool before use.** It is a Free Pascal project and no pre-built binary is distributed. + +## Requirements + +- [Free Pascal Compiler (FPC) 3.2.2+](https://www.freepascal.org/) + +## Build + +From the repository root: + +```bash +fpc -Futools/cli-fp-gen/src tools/cli-fp-gen/cli_fp_gen.lpr +``` + +Or from this directory: + +```bash +fpc -Fusrc cli_fp_gen.lpr +``` + +The output binary (`cli_fp_gen` / `cli_fp_gen.exe`) will be placed in this directory. + +## Usage + +```text +cli-fp-gen init [--name ] [--version ] [--dry-run] [--force] +cli-fp-gen generate [--project ] [--dry-run] [--force] +cli-fp-gen add command [--parent ] [--description ] [--project ] [--dry-run] [--force] +cli-fp-gen remove command [--cascade] [--project ] [--dry-run] [--force] +``` + +## Full Documentation + +See [docs/codegen.md](../../docs/codegen.md) for the full reference, including: + +- Project spec format (`clifp.json`) +- Supported parameter kinds +- File ownership rules +- Cleanup safety rules +- Generated project layout +- How to build a generated app +- Verification / test scripts +- Generator architecture and extension checklist diff --git a/tools/cli-fp-gen/cli_fp_gen.lpi b/tools/cli-fp-gen/cli_fp_gen.lpi new file mode 100644 index 0000000..f45724c --- /dev/null +++ b/tools/cli-fp-gen/cli_fp_gen.lpi @@ -0,0 +1,130 @@ + + + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + <Item Name="Debug"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="cli_fp_gen"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="src"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <IncludeAssertionCode Value="True"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Checks> + <IOChecks Value="True"/> + <RangeChecks Value="True"/> + <OverflowChecks Value="True"/> + <StackChecks Value="True"/> + </Checks> + <VerifyObjMethodCallValidity Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + <UseHeaptrc Value="True"/> + <TrashVariables Value="True"/> + </Debugging> + </Linking> + <Other> + <CustomOptions Value="-FcUTF8"/> + </Other> + </CompilerOptions> + </Item> + <Item Name="Release"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="cli_fp_gen"/> + </Target> + <SearchPaths> + <OtherUnitFiles Value="src"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + <RunWithoutDebug Value="True"/> + <StripSymbols Value="True"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <CustomOptions Value="-FcUTF8"/> + </Other> + </CompilerOptions> + </Item> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <Units> + <Unit> + <Filename Value="cli_fp_gen.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="cli_fp_gen"/> + </Target> + <SearchPaths> + <OtherUnitFiles Value="src"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Other> + <CustomOptions Value="-FcUTF8"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/tools/cli-fp-gen/cli_fp_gen.lpr b/tools/cli-fp-gen/cli_fp_gen.lpr new file mode 100644 index 0000000..b30d1a3 --- /dev/null +++ b/tools/cli-fp-gen/cli_fp_gen.lpr @@ -0,0 +1,19 @@ +program cli_fp_gen; + +{$mode objfpc}{$H+}{$J-} + +uses + SysUtils, + CliFpGen.App; + +begin + try + RunCliFpGen; + except + on E: Exception do + begin + WriteLn('Error: ', E.Message); + ExitCode := 1; + end; + end; +end. diff --git a/tools/cli-fp-gen/src/clifpgen.app.pas b/tools/cli-fp-gen/src/clifpgen.app.pas new file mode 100644 index 0000000..2f67b7a --- /dev/null +++ b/tools/cli-fp-gen/src/clifpgen.app.pas @@ -0,0 +1,258 @@ +unit CliFpGen.App; + +{$mode objfpc}{$H+}{$J-} + +interface + +procedure RunCliFpGen; + +implementation + +uses + SysUtils, CliFpGen.Model, CliFpGen.Generate; + +function ArgOrEmpty(const Index: Integer): string; +begin + if (Index >= 1) and (Index <= ParamCount) then + Result := ParamStr(Index) + else + Result := ''; +end; + +procedure ShowHelp; +begin + WriteLn('cli-fp-gen - Free Pascal CLI project generator'); + WriteLn(''); + WriteLn('Usage:'); + WriteLn(' cli-fp-gen init <target-dir> [--name <app-name>] [--version <x.y.z>] [--dry-run] [--force]'); + WriteLn(' cli-fp-gen generate [--project <dir-or-spec-file>] [--dry-run] [--force]'); + WriteLn(' cli-fp-gen add command <name> [--parent <cmd/path>] [--description <text>] [--project <dir-or-spec-file>] [--dry-run] [--force]'); + WriteLn(' cli-fp-gen remove command <cmd/path> [--cascade] [--project <dir-or-spec-file>] [--dry-run] [--force]'); + WriteLn(''); + WriteLn('Notes:'); + WriteLn(' - Project spec is clifp.json'); + WriteLn(' - Generated files are written to src/generated'); + WriteLn(' - Command stubs are created in src/commands and not overwritten unless --force'); + WriteLn(' - --dry-run previews all file operations without writing anything, e.g.:'); + WriteLn(' [dry-run] would write: src/generated/Myapp_CommandRegistry_Generated.pas'); + WriteLn(' [dry-run] would write: src/commands/Myapp_Command_Greet.pas'); +end; + +function ResolveSpecFile(const ProjectArg: string): string; +var + Candidate: string; +begin + Candidate := Trim(ProjectArg); + if Candidate = '' then + Candidate := GetCurrentDir; + + Candidate := ExpandFileName(Candidate); + if DirectoryExists(Candidate) then + Result := IncludeTrailingPathDelimiter(Candidate) + 'clifp.json' + else + Result := Candidate; +end; + +procedure HandleInit; +var + TargetDir, AppName, AppVersion: string; + i: Integer; + Opts: TWriteOptions; + Arg: string; +begin + if ParamCount < 2 then + raise Exception.Create('init requires <target-dir>'); + + FillChar(Opts, SizeOf(Opts), 0); + TargetDir := ExpandFileName(ParamStr(2)); + AppName := ''; + AppVersion := '0.1.0'; + + i := 3; + while i <= ParamCount do + begin + Arg := ArgOrEmpty(i); + if Arg = '--name' then + begin + Inc(i); + if i > ParamCount then raise Exception.Create('--name requires a value'); + AppName := ArgOrEmpty(i); + end + else if Arg = '--version' then + begin + Inc(i); + if i > ParamCount then raise Exception.Create('--version requires a value'); + AppVersion := ArgOrEmpty(i); + end + else if Arg = '--dry-run' then + Opts.DryRun := True + else if Arg = '--force' then + Opts.Force := True + else + raise Exception.CreateFmt('Unknown option for init: %s', [Arg]); + Inc(i); + end; + + InitNewProject(TargetDir, AppName, Opts, AppVersion); +end; + +procedure HandleGenerate; +var + i: Integer; + SpecFile, ProjectArg, Arg: string; + Opts: TWriteOptions; +begin + FillChar(Opts, SizeOf(Opts), 0); + ProjectArg := ''; + i := 2; + while i <= ParamCount do + begin + Arg := ArgOrEmpty(i); + if Arg = '--project' then + begin + Inc(i); + if i > ParamCount then raise Exception.Create('--project requires a value'); + ProjectArg := ArgOrEmpty(i); + end + else if Arg = '--dry-run' then + Opts.DryRun := True + else if Arg = '--force' then + Opts.Force := True + else + raise Exception.CreateFmt('Unknown option for generate: %s', [Arg]); + Inc(i); + end; + + SpecFile := ResolveSpecFile(ProjectArg); + GenerateFromSpecFile(SpecFile, Opts); +end; + +procedure HandleAddCommand; +var + i: Integer; + CommandName, ParentPath, Description, ProjectArg, Arg: string; + Opts: TWriteOptions; +begin + if ParamCount < 3 then + raise Exception.Create('Usage: cli-fp-gen add command <name> [options]'); + + FillChar(Opts, SizeOf(Opts), 0); + CommandName := ParamStr(3); + ParentPath := ''; + Description := ''; + ProjectArg := ''; + + i := 4; + while i <= ParamCount do + begin + Arg := ArgOrEmpty(i); + if Arg = '--parent' then + begin + Inc(i); + if i > ParamCount then raise Exception.Create('--parent requires a value'); + ParentPath := ArgOrEmpty(i); + end + else if Arg = '--description' then + begin + Inc(i); + if i > ParamCount then raise Exception.Create('--description requires a value'); + Description := ArgOrEmpty(i); + while (i < ParamCount) and (Copy(ArgOrEmpty(i + 1), 1, 2) <> '--') do + begin + Inc(i); + Description := Description + ' ' + ArgOrEmpty(i); + end; + end + else if Arg = '--project' then + begin + Inc(i); + if i > ParamCount then raise Exception.Create('--project requires a value'); + ProjectArg := ArgOrEmpty(i); + end + else if Arg = '--dry-run' then + Opts.DryRun := True + else if Arg = '--force' then + Opts.Force := True + else + raise Exception.CreateFmt('Unknown option for add command: %s', [Arg]); + Inc(i); + end; + + AddCommandToProject(ResolveSpecFile(ProjectArg), CommandName, ParentPath, Description, Opts); +end; + +procedure HandleRemoveCommand; +var + i: Integer; + CommandPath, ProjectArg, Arg: string; + Cascade: Boolean; + Opts: TWriteOptions; +begin + if ParamCount < 3 then + raise Exception.Create('Usage: cli-fp-gen remove command <cmd/path> [options]'); + + FillChar(Opts, SizeOf(Opts), 0); + CommandPath := ParamStr(3); + ProjectArg := ''; + Cascade := False; + + i := 4; + while i <= ParamCount do + begin + Arg := ArgOrEmpty(i); + if Arg = '--project' then + begin + Inc(i); + if i > ParamCount then raise Exception.Create('--project requires a value'); + ProjectArg := ArgOrEmpty(i); + end + else if Arg = '--cascade' then + Cascade := True + else if Arg = '--dry-run' then + Opts.DryRun := True + else if Arg = '--force' then + Opts.Force := True + else + raise Exception.CreateFmt('Unknown option for remove command: %s', [Arg]); + Inc(i); + end; + + RemoveCommandFromProject(ResolveSpecFile(ProjectArg), CommandPath, Cascade, Opts); +end; + +procedure RunCliFpGen; +var + Cmd1, Cmd2: string; +begin + if (ParamCount = 0) or (ParamStr(1) = '--help') or (ParamStr(1) = '-h') then + begin + ShowHelp; + Exit; + end; + + Cmd1 := LowerCase(ParamStr(1)); + if Cmd1 = 'init' then + HandleInit + else if Cmd1 = 'generate' then + HandleGenerate + else if Cmd1 = 'add' then + begin + Cmd2 := LowerCase(ArgOrEmpty(2)); + if Cmd2 = 'command' then + HandleAddCommand + else + raise Exception.Create('Only "add command" is implemented in Phase 1'); + end + else if Cmd1 = 'remove' then + begin + Cmd2 := LowerCase(ArgOrEmpty(2)); + if Cmd2 = 'command' then + HandleRemoveCommand + else + raise Exception.Create('Only "remove command" is implemented'); + end + else + raise Exception.CreateFmt('Unknown command: %s', [ParamStr(1)]); +end; + +end. diff --git a/tools/cli-fp-gen/src/clifpgen.filesystem.pas b/tools/cli-fp-gen/src/clifpgen.filesystem.pas new file mode 100644 index 0000000..5a8189d --- /dev/null +++ b/tools/cli-fp-gen/src/clifpgen.filesystem.pas @@ -0,0 +1,132 @@ +unit CliFpGen.Filesystem; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + Classes, SysUtils, CliFpGen.Model; + +type + TWriteKind = (wkGenerated, wkUserStub); + +procedure EnsureDirectoryExistsSafe(const DirPath: string; const Options: TWriteOptions); +procedure WriteManagedTextFile(const FileName, Content: string; Kind: TWriteKind; const Options: TWriteOptions); +function ReadTextFileStrict(const FileName: string): string; +procedure DeleteManagedFile(const FileName: string; const Options: TWriteOptions); + +implementation + +procedure EnsureDirectoryExistsSafe(const DirPath: string; const Options: TWriteOptions); +begin + if DirPath = '' then + Exit; + + if DirectoryExists(DirPath) then + Exit; + + if Options.DryRun then + begin + WriteLn('[dry-run] mkdir ', DirPath); + Exit; + end; + + if not ForceDirectories(DirPath) then + raise Exception.CreateFmt('Failed to create directory: %s', [DirPath]); + + WriteLn('[write] mkdir ', DirPath); +end; + +function ReadTextFileStrict(const FileName: string): string; +var + Stream: TFileStream; + Bytes: TBytes; +begin + Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); + try + SetLength(Bytes, Stream.Size); + if Length(Bytes) > 0 then + begin + Stream.ReadBuffer(Bytes[0], Length(Bytes)); + SetString(Result, PChar(@Bytes[0]), Length(Bytes)); + end + else + Result := ''; + finally + Stream.Free; + end; +end; + +procedure WriteStringToFile(const FileName, Content: string); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + if Content <> '' then + Stream.WriteBuffer(Content[1], Length(Content)); + finally + Stream.Free; + end; +end; + +procedure WriteManagedTextFile(const FileName, Content: string; Kind: TWriteKind; const Options: TWriteOptions); +var + Existing: string; + FileExistsAlready: Boolean; + AllowOverwrite: Boolean; +begin + EnsureDirectoryExistsSafe(ExtractFileDir(FileName), Options); + + FileExistsAlready := FileExists(FileName); + + if FileExistsAlready then + begin + Existing := ReadTextFileStrict(FileName); + if Existing = Content then + begin + WriteLn('[skip] unchanged ', FileName); + Exit; + end; + end; + + AllowOverwrite := (Kind = wkGenerated) or Options.Force; + if FileExistsAlready and not AllowOverwrite then + begin + WriteLn('[skip] exists (user-owned) ', FileName); + Exit; + end; + + if Options.DryRun then + begin + if FileExistsAlready then + WriteLn('[dry-run] overwrite ', FileName) + else + WriteLn('[dry-run] create ', FileName); + Exit; + end; + + WriteStringToFile(FileName, Content); + if FileExistsAlready then + WriteLn('[write] overwrite ', FileName) + else + WriteLn('[write] create ', FileName); +end; + +procedure DeleteManagedFile(const FileName: string; const Options: TWriteOptions); +begin + if not FileExists(FileName) then + Exit; + + if Options.DryRun then + begin + WriteLn('[dry-run] delete ', FileName); + Exit; + end; + + if not SysUtils.DeleteFile(FileName) then + raise Exception.CreateFmt('Failed to delete file: %s', [FileName]); + WriteLn('[write] delete ', FileName); +end; + +end. diff --git a/tools/cli-fp-gen/src/clifpgen.generate.pas b/tools/cli-fp-gen/src/clifpgen.generate.pas new file mode 100644 index 0000000..48c7b78 --- /dev/null +++ b/tools/cli-fp-gen/src/clifpgen.generate.pas @@ -0,0 +1,270 @@ +unit CliFpGen.Generate; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + Classes, SysUtils, CliFpGen.Model; + +procedure GenerateFromSpecFile(const SpecFile: string; const Options: TWriteOptions); +procedure InitNewProject(const TargetDir, AppName: string; const Options: TWriteOptions; const AppVersion: string = '0.1.0'); +procedure AddCommandToProject(const SpecFile, CommandName, ParentPath, Description: string; const Options: TWriteOptions); +procedure RemoveCommandFromProject(const SpecFile, CommandPath: string; Cascade: Boolean; const Options: TWriteOptions); + +implementation + +uses + CliFpGen.Naming, + CliFpGen.SpecIO, + CliFpGen.Validate, + CliFpGen.Renderer, + CliFpGen.Filesystem, + CliFpGen.Manifest; + +function PathCombine(const BaseDir, RelPath: string): string; +begin + Result := ExpandFileName(IncludeTrailingPathDelimiter(BaseDir) + RelPath); +end; + +function FindCommandByFullPath(const Spec: TProjectSpec; const FullPath: string): TCommandSpec; +var + i: Integer; +begin + Result := nil; + for i := 0 to Spec.Commands.Count - 1 do + if SameText(CommandFullPath(Spec.Commands[i]), FullPath) then + Exit(Spec.Commands[i]); +end; + +function NormalizeRelPath(const S: string): string; +begin + Result := StringReplace(S, '\', '/', [rfReplaceAll]); +end; + +function IsDescendantPath(const BasePath, CandidatePath: string): Boolean; +begin + Result := SameText(CandidatePath, BasePath) or + (Copy(AnsiLowerCase(CandidatePath), 1, Length(BasePath) + 1) = AnsiLowerCase(BasePath) + '/'); +end; + +procedure GenerateProjectFiles(const ProjectDir: string; const Spec: TProjectSpec; const Options: TWriteOptions); +var + i: Integer; + Cmd: TCommandSpec; + ProgramPath, RegistryPath, CommandUnitPath, CommandsDir, GeneratedDir: string; + PreviousManifest, CurrentGeneratedRel: TStringList; + RegistryRelPath: string; +begin + ValidateProjectSpec(Spec); + + EnsureDirectoryExistsSafe(ProjectDir, Options); + EnsureDirectoryExistsSafe(PathCombine(ProjectDir, 'src'), Options); + CommandsDir := PathCombine(ProjectDir, 'src' + PathDelim + 'commands'); + GeneratedDir := PathCombine(ProjectDir, 'src' + PathDelim + 'generated'); + EnsureDirectoryExistsSafe(CommandsDir, Options); + EnsureDirectoryExistsSafe(GeneratedDir, Options); + + PreviousManifest := LoadGeneratedManifest(ProjectDir); + CurrentGeneratedRel := TStringList.Create; + try + CurrentGeneratedRel.CaseSensitive := False; + CurrentGeneratedRel.Duplicates := dupIgnore; + CurrentGeneratedRel.Add(NormalizeRelPath(Spec.ProgramFile)); + RegistryRelPath := 'src/generated/' + MakeRegistryUnitName(Spec.AppName) + '.pas'; + CurrentGeneratedRel.Add(NormalizeRelPath(RegistryRelPath)); + CurrentGeneratedRel.Add(NormalizeRelPath(ManifestRelPath)); + + ProgramPath := PathCombine(ProjectDir, Spec.ProgramFile); + WriteManagedTextFile(ProgramPath, RenderProgramFile(Spec), wkGenerated, Options); + + RegistryPath := PathCombine(ProjectDir, StringReplace(RegistryRelPath, '/', PathDelim, [rfReplaceAll])); + WriteManagedTextFile(RegistryPath, RenderRegistryUnit(Spec), wkGenerated, Options); + + for i := 0 to Spec.Commands.Count - 1 do + begin + Cmd := Spec.Commands[i]; + CommandUnitPath := PathCombine(ProjectDir, 'src' + PathDelim + 'commands' + PathDelim + + MakeCommandUnitName(Spec.AppName, CommandFullPath(Cmd)) + '.pas'); + WriteManagedTextFile( + CommandUnitPath, + RenderCommandUnit(Spec, Cmd), + wkUserStub, + Options + ); + end; + + CleanupStaleGeneratedFiles(ProjectDir, PreviousManifest, CurrentGeneratedRel, Options); + SaveGeneratedManifest(ProjectDir, CurrentGeneratedRel, Options); + finally + CurrentGeneratedRel.Free; + PreviousManifest.Free; + end; +end; + +procedure SaveAndGenerateProjectFiles(const Spec: TProjectSpec; const SpecFile: string; const Options: TWriteOptions); +var + ProjectDir: string; +begin + ProjectDir := ExtractFileDir(ExpandFileName(SpecFile)); + SaveProjectSpec(Spec, SpecFile, Options); + GenerateProjectFiles(ProjectDir, Spec, Options); +end; + +procedure GenerateFromSpecFile(const SpecFile: string; const Options: TWriteOptions); +var + Spec: TProjectSpec; + ProjectDir: string; +begin + Spec := LoadProjectSpec(SpecFile); + try + ProjectDir := ExtractFileDir(ExpandFileName(SpecFile)); + GenerateProjectFiles(ProjectDir, Spec, Options); + finally + Spec.Free; + end; +end; + +procedure InitNewProject(const TargetDir, AppName: string; const Options: TWriteOptions; const AppVersion: string = '0.1.0'); +var + Spec: TProjectSpec; + Cmd: TCommandSpec; + Param: TParameterSpec; + ResolvedAppName: string; + SpecFile: string; +begin + ResolvedAppName := Trim(AppName); + if ResolvedAppName = '' then + ResolvedAppName := ExtractFileName(ExcludeTrailingPathDelimiter(TargetDir)); + if ResolvedAppName = '' then + raise Exception.Create('Unable to infer app name from target directory. Use --name.'); + + Spec := TProjectSpec.Create; + try + Spec.AppName := ResolvedAppName; + Spec.AppVersion := AppVersion; + Spec.ProgramFile := MakeProgramFileRelPath(ResolvedAppName); + + Cmd := TCommandSpec.Create; + Cmd.Name := 'greet'; + Cmd.Description := 'Say hello'; + Cmd.ParentPath := ''; + Param := TParameterSpec.Create; + Param.Kind := pkString; + Param.ShortFlag := '-n'; + Param.LongFlag := '--name'; + Param.Description := 'Name to greet'; + Param.Required := False; + Param.DefaultValue := 'World'; + Cmd.Parameters.Add(Param); + Spec.Commands.Add(Cmd); + + ValidateProjectSpec(Spec); + + SpecFile := PathCombine(TargetDir, 'clifp.json'); + if FileExists(SpecFile) and not Options.Force then + raise Exception.CreateFmt( + 'Project spec already exists: %s (use --force to replace it)', + [SpecFile]); + + EnsureDirectoryExistsSafe(TargetDir, Options); + SaveProjectSpec(Spec, SpecFile, Options); + GenerateProjectFiles(TargetDir, Spec, Options); + finally + Spec.Free; + end; +end; + +procedure AddCommandToProject(const SpecFile, CommandName, ParentPath, Description: string; const Options: TWriteOptions); +var + Spec: TProjectSpec; + Cmd: TCommandSpec; + FullPath, ParentNorm, NameNorm: string; +begin + Spec := LoadProjectSpec(SpecFile); + try + NameNorm := NormalizeCommandName(CommandName); + ParentNorm := NormalizeCommandPath(ParentPath); + if NameNorm = '' then + raise Exception.Create('Command name is required'); + if not IsValidCommandToken(NameNorm) then + raise Exception.CreateFmt('Invalid command name "%s"', [CommandName]); + + FullPath := JoinCommandPath(ParentNorm, NameNorm); + if FindCommandByFullPath(Spec, FullPath) <> nil then + raise Exception.CreateFmt('Command "%s" already exists', [FullPath]); + if (ParentNorm <> '') and (FindCommandByFullPath(Spec, ParentNorm) = nil) then + raise Exception.CreateFmt('Parent command "%s" does not exist', [ParentNorm]); + + Cmd := TCommandSpec.Create; + Cmd.Name := NameNorm; + if Trim(Description) <> '' then + Cmd.Description := Description + else + Cmd.Description := 'TODO: Describe "' + NameNorm + '" command'; + Cmd.ParentPath := ParentNorm; + Spec.Commands.Add(Cmd); + + ValidateProjectSpec(Spec); + SaveAndGenerateProjectFiles(Spec, SpecFile, Options); + finally + Spec.Free; + end; +end; + +procedure RemoveCommandFromProject(const SpecFile, CommandPath: string; Cascade: Boolean; const Options: TWriteOptions); +var + Spec: TProjectSpec; + PathNorm: string; + i: Integer; + RemovedAny, HasChildren: Boolean; + CandidatePath: string; +begin + Spec := LoadProjectSpec(SpecFile); + try + PathNorm := NormalizeCommandPath(CommandPath); + if PathNorm = '' then + raise Exception.Create('Command path is required'); + if FindCommandByFullPath(Spec, PathNorm) = nil then + raise Exception.CreateFmt('Command "%s" does not exist', [PathNorm]); + + HasChildren := False; + for i := 0 to Spec.Commands.Count - 1 do + if SameText(Spec.Commands[i].ParentPath, PathNorm) then + begin + HasChildren := True; + Break; + end; + if HasChildren and (not Cascade) then + raise Exception.CreateFmt('Command "%s" has subcommands; use --cascade to remove subtree', [PathNorm]); + + RemovedAny := False; + for i := Spec.Commands.Count - 1 downto 0 do + begin + CandidatePath := CommandFullPath(Spec.Commands[i]); + if Cascade then + begin + if IsDescendantPath(PathNorm, CandidatePath) then + begin + Spec.Commands.Delete(i); + RemovedAny := True; + end; + end + else if SameText(CandidatePath, PathNorm) then + begin + Spec.Commands.Delete(i); + RemovedAny := True; + end; + end; + + if not RemovedAny then + raise Exception.CreateFmt('Command "%s" was not removed', [PathNorm]); + + ValidateProjectSpec(Spec); + SaveAndGenerateProjectFiles(Spec, SpecFile, Options); + finally + Spec.Free; + end; +end; + +end. diff --git a/tools/cli-fp-gen/src/clifpgen.manifest.pas b/tools/cli-fp-gen/src/clifpgen.manifest.pas new file mode 100644 index 0000000..0d4aaba --- /dev/null +++ b/tools/cli-fp-gen/src/clifpgen.manifest.pas @@ -0,0 +1,197 @@ +unit CliFpGen.Manifest; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + Classes, SysUtils, CliFpGen.Model; + +function ManifestRelPath: string; +function LoadGeneratedManifest(const ProjectDir: string): TStringList; +procedure SaveGeneratedManifest(const ProjectDir: string; const GeneratedRelFiles: TStrings; const Options: TWriteOptions); +procedure CleanupStaleGeneratedFiles(const ProjectDir: string; const PreviousRelFiles, CurrentRelFiles: TStrings; const Options: TWriteOptions); + +implementation + +uses + fpjson, jsonparser, CliFpGen.Filesystem + {$IFDEF MSWINDOWS}, Windows{$ENDIF}; + +function ManifestRelPath: string; +begin + Result := 'src/generated/.clifp-manifest.json'; +end; + +function NormalizeRelPath(const S: string): string; +begin + Result := StringReplace(Trim(S), '\', '/', [rfReplaceAll]); +end; + +procedure ConfigurePathList(const Paths: TStringList); +begin + {$IFDEF MSWINDOWS} + Paths.CaseSensitive := False; + {$ELSE} + Paths.CaseSensitive := True; + {$ENDIF} +end; + +function ProjectPath(const ProjectDir, RelPath: string): string; +begin + Result := ExpandFileName(IncludeTrailingPathDelimiter(ProjectDir) + + StringReplace(RelPath, '/', PathDelim, [rfReplaceAll])); +end; + +function IsWithinProjectDir(const ProjectDir, FileName: string): Boolean; +var + RootNorm, FileNorm: string; +begin + RootNorm := IncludeTrailingPathDelimiter(ExpandFileName(ProjectDir)); + FileNorm := ExpandFileName(FileName); + {$IFDEF MSWINDOWS} + Result := SameText(Copy(FileNorm, 1, Length(RootNorm)), RootNorm); + {$ELSE} + Result := Copy(FileNorm, 1, Length(RootNorm)) = RootNorm; + {$ENDIF} +end; + +function PathsEqual(const LeftPath, RightPath: string): Boolean; +begin + {$IFDEF MSWINDOWS} + Result := SameText(LeftPath, RightPath); + {$ELSE} + Result := LeftPath = RightPath; + {$ENDIF} +end; + +function IsLinkOrReparsePoint(const FileName: string): Boolean; +var + Attributes: LongInt; +begin + Attributes := FileGetAttr(FileName); + {$IFDEF MSWINDOWS} + Result := (Attributes <> -1) and + ((Attributes and FILE_ATTRIBUTE_REPARSE_POINT) <> 0); + {$ELSE} + Result := (Attributes <> -1) and ((Attributes and faSymLink) <> 0); + {$ENDIF} +end; + +function FindLinkOrReparsePoint(const ProjectDir, FileName: string; + out LinkPath: string): Boolean; +var + RootNorm: string; + CurrentPath: string; + ParentPath: string; +begin + Result := False; + LinkPath := ''; + RootNorm := ExcludeTrailingPathDelimiter(ExpandFileName(ProjectDir)); + CurrentPath := ExcludeTrailingPathDelimiter(ExpandFileName(FileName)); + + while not PathsEqual(CurrentPath, RootNorm) do + begin + if IsLinkOrReparsePoint(CurrentPath) then + begin + LinkPath := CurrentPath; + Exit(True); + end; + + ParentPath := ExcludeTrailingPathDelimiter(ExtractFileDir(CurrentPath)); + if PathsEqual(ParentPath, CurrentPath) then + Exit; + CurrentPath := ParentPath; + end; +end; + +function LoadGeneratedManifest(const ProjectDir: string): TStringList; +var + FileName: string; + Root: TJSONData; + Obj: TJSONObject; + Arr: TJSONArray; + i: Integer; +begin + Result := TStringList.Create; + ConfigurePathList(Result); + Result.Sorted := False; + Result.Duplicates := dupIgnore; + + FileName := ProjectPath(ProjectDir, ManifestRelPath); + if not FileExists(FileName) then + Exit; + + Root := GetJSON(ReadTextFileStrict(FileName)); + try + if not (Root is TJSONObject) then + Exit; + Obj := TJSONObject(Root); + if (Obj.Find('generatedFiles') = nil) or not (Obj.Arrays['generatedFiles'] is TJSONArray) then + Exit; + Arr := Obj.Arrays['generatedFiles']; + for i := 0 to Arr.Count - 1 do + Result.Add(NormalizeRelPath(Arr.Strings[i])); + finally + Root.Free; + end; +end; + +procedure SaveGeneratedManifest(const ProjectDir: string; const GeneratedRelFiles: TStrings; const Options: TWriteOptions); +var + Root: TJSONObject; + Arr: TJSONArray; + i: Integer; + ManifestFile: string; +begin + Root := TJSONObject.Create; + try + Root.Add('schemaVersion', 1); + Arr := TJSONArray.Create; + for i := 0 to GeneratedRelFiles.Count - 1 do + Arr.Add(NormalizeRelPath(GeneratedRelFiles[i])); + Root.Add('generatedFiles', Arr); + + ManifestFile := ProjectPath(ProjectDir, ManifestRelPath); + WriteManagedTextFile(ManifestFile, Root.FormatJSON([], 2) + LineEnding, wkGenerated, Options); + finally + Root.Free; + end; +end; + +procedure CleanupStaleGeneratedFiles(const ProjectDir: string; const PreviousRelFiles, CurrentRelFiles: TStrings; const Options: TWriteOptions); +var + CurrentSet: TStringList; + i: Integer; + RelPath: string; + AbsPath: string; + LinkPath: string; +begin + CurrentSet := TStringList.Create; + try + ConfigurePathList(CurrentSet); + for i := 0 to CurrentRelFiles.Count - 1 do + CurrentSet.Add(NormalizeRelPath(CurrentRelFiles[i])); + + for i := 0 to PreviousRelFiles.Count - 1 do + begin + RelPath := NormalizeRelPath(PreviousRelFiles[i]); + if SameText(RelPath, NormalizeRelPath(ManifestRelPath)) then + Continue; + if CurrentSet.IndexOf(RelPath) >= 0 then + Continue; + AbsPath := ProjectPath(ProjectDir, RelPath); + if not IsWithinProjectDir(ProjectDir, AbsPath) then + raise Exception.CreateFmt('Refusing to delete outside project dir: %s', [AbsPath]); + if FindLinkOrReparsePoint(ProjectDir, AbsPath, LinkPath) then + raise Exception.CreateFmt( + 'Refusing to delete through symbolic link or reparse point: %s', + [LinkPath]); + DeleteManagedFile(AbsPath, Options); + end; + finally + CurrentSet.Free; + end; +end; + +end. diff --git a/tools/cli-fp-gen/src/clifpgen.model.pas b/tools/cli-fp-gen/src/clifpgen.model.pas new file mode 100644 index 0000000..d69a05b --- /dev/null +++ b/tools/cli-fp-gen/src/clifpgen.model.pas @@ -0,0 +1,173 @@ +unit CliFpGen.Model; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + Classes, SysUtils, fgl; + +type + TParameterKind = ( + pkString, + pkInteger, + pkFloat, + pkFlag, + pkBoolean, + pkPath, + pkEnum, + pkDateTime, + pkArray, + pkPassword, + pkUrl + ); + + TParameterSpec = class + private + FShortFlag: string; + FLongFlag: string; + FDescription: string; + FKind: TParameterKind; + FRequired: Boolean; + FDefaultValue: string; + FAllowedValues: string; + public + constructor Create; + property ShortFlag: string read FShortFlag write FShortFlag; + property LongFlag: string read FLongFlag write FLongFlag; + property Description: string read FDescription write FDescription; + property Kind: TParameterKind read FKind write FKind; + property Required: Boolean read FRequired write FRequired; + property DefaultValue: string read FDefaultValue write FDefaultValue; + property AllowedValues: string read FAllowedValues write FAllowedValues; + end; + + TParameterSpecList = specialize TFPGObjectList<TParameterSpec>; + + TCommandSpec = class + private + FName: string; + FDescription: string; + FParentPath: string; + FParameters: TParameterSpecList; + public + constructor Create; + destructor Destroy; override; + property Name: string read FName write FName; + property Description: string read FDescription write FDescription; + property ParentPath: string read FParentPath write FParentPath; // slash-delimited, empty for root + property Parameters: TParameterSpecList read FParameters; + end; + + TCommandSpecList = specialize TFPGObjectList<TCommandSpec>; + + TProjectSpec = class + private + FSchemaVersion: Integer; + FAppName: string; + FAppVersion: string; + FProgramFile: string; + FCommands: TCommandSpecList; + public + constructor Create; + destructor Destroy; override; + property SchemaVersion: Integer read FSchemaVersion write FSchemaVersion; + property AppName: string read FAppName write FAppName; + property AppVersion: string read FAppVersion write FAppVersion; + property ProgramFile: string read FProgramFile write FProgramFile; + property Commands: TCommandSpecList read FCommands; + end; + + TWriteOptions = record + DryRun: Boolean; + Force: Boolean; + end; + +function CommandFullPath(const Command: TCommandSpec): string; +function ParameterKindToString(const Kind: TParameterKind): string; +function TryParseParameterKind(const S: string; out Kind: TParameterKind): Boolean; + +implementation + +function CommandFullPath(const Command: TCommandSpec): string; +begin + if Trim(Command.ParentPath) = '' then + Result := Command.Name + else + Result := Command.ParentPath + '/' + Command.Name; +end; + +constructor TParameterSpec.Create; +begin + inherited Create; + FKind := pkString; + FRequired := False; +end; + +constructor TCommandSpec.Create; +begin + inherited Create; + FParameters := TParameterSpecList.Create(True); +end; + +destructor TCommandSpec.Destroy; +begin + FParameters.Free; + inherited Destroy; +end; + +function ParameterKindToString(const Kind: TParameterKind): string; +begin + case Kind of + pkString: Result := 'string'; + pkInteger: Result := 'integer'; + pkFloat: Result := 'float'; + pkFlag: Result := 'flag'; + pkBoolean: Result := 'boolean'; + pkPath: Result := 'path'; + pkEnum: Result := 'enum'; + pkDateTime: Result := 'datetime'; + pkArray: Result := 'array'; + pkPassword: Result := 'password'; + pkUrl: Result := 'url'; + else + Result := 'string'; + end; +end; + +function TryParseParameterKind(const S: string; out Kind: TParameterKind): Boolean; +var + V: string; +begin + V := LowerCase(Trim(S)); + Result := True; + if V = 'string' then Kind := pkString + else if V = 'integer' then Kind := pkInteger + else if V = 'float' then Kind := pkFloat + else if V = 'flag' then Kind := pkFlag + else if V = 'boolean' then Kind := pkBoolean + else if V = 'path' then Kind := pkPath + else if V = 'enum' then Kind := pkEnum + else if (V = 'datetime') or (V = 'date-time') then Kind := pkDateTime + else if V = 'array' then Kind := pkArray + else if V = 'password' then Kind := pkPassword + else if V = 'url' then Kind := pkUrl + else + Result := False; +end; + +constructor TProjectSpec.Create; +begin + inherited Create; + FSchemaVersion := 1; + FAppVersion := '0.1.0'; + FCommands := TCommandSpecList.Create(True); +end; + +destructor TProjectSpec.Destroy; +begin + FCommands.Free; + inherited Destroy; +end; + +end. diff --git a/tools/cli-fp-gen/src/clifpgen.naming.pas b/tools/cli-fp-gen/src/clifpgen.naming.pas new file mode 100644 index 0000000..ec3f67d --- /dev/null +++ b/tools/cli-fp-gen/src/clifpgen.naming.pas @@ -0,0 +1,237 @@ +unit CliFpGen.Naming; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + Classes, SysUtils; + +function NormalizePathSlashes(const S: string): string; +function NormalizeCommandName(const S: string): string; +function NormalizeCommandPath(const S: string): string; +function JoinCommandPath(const ParentPath, Name: string): string; +function PathDepth(const CommandPath: string): Integer; +function SegmentCount(const CommandPath: string): Integer; + +function MakeProgramIdentifier(const AppName: string): string; +function MakeProgramFileRelPath(const AppName: string): string; +function MakeRegistryUnitName(const AppName: string): string; +function MakeCommandUnitName(const AppName, CommandPath: string): string; +function MakeCommandClassName(const CommandPath: string): string; +function MakeCommandVarName(const CommandPath: string): string; + +function IsValidCommandToken(const S: string): Boolean; + +implementation + +function NormalizePathSlashes(const S: string): string; +begin + Result := StringReplace(S, '\', '/', [rfReplaceAll]); + Result := StringReplace(Result, '//', '/', [rfReplaceAll]); + while Pos('//', Result) > 0 do + Result := StringReplace(Result, '//', '/', [rfReplaceAll]); +end; + +// Command names are single tokens. Keep invalid path separators intact so +// validation can report them instead of silently changing the user's input. +function NormalizeCommandName(const S: string): string; +begin + Result := Trim(S); +end; + +function NormalizeCommandPath(const S: string): string; +var + Parts, OutParts: TStringList; + i: Integer; + Item: string; +begin + Result := Trim(NormalizePathSlashes(S)); + if Result = '' then + Exit(''); + + Parts := TStringList.Create; + OutParts := TStringList.Create; + try + Parts.Delimiter := '/'; + Parts.StrictDelimiter := True; + Parts.DelimitedText := Result; + for i := 0 to Parts.Count - 1 do + begin + Item := Trim(Parts[i]); + if Item <> '' then + OutParts.Add(Item); + end; + Result := StringReplace(Trim(OutParts.Text), LineEnding, '/', [rfReplaceAll]); + if (Result <> '') and (Result[Length(Result)] = '/') then + Delete(Result, Length(Result), 1); + finally + OutParts.Free; + Parts.Free; + end; +end; + +function JoinCommandPath(const ParentPath, Name: string): string; +var + P, N: string; +begin + P := NormalizeCommandPath(ParentPath); + N := NormalizeCommandName(Name); + if P = '' then + Result := N + else + Result := P + '/' + N; +end; + +function PathDepth(const CommandPath: string): Integer; +begin + if Trim(CommandPath) = '' then + Exit(0); + Result := SegmentCount(CommandPath); +end; + +function SegmentCount(const CommandPath: string): Integer; +var + i: Integer; +begin + if Trim(CommandPath) = '' then + Exit(0); + Result := 1; + for i := 1 to Length(CommandPath) do + if CommandPath[i] = '/' then + Inc(Result); +end; + +function TokenToPascalPart(const S: string): string; +var + i: Integer; + NextUpper: Boolean; + Ch: Char; +begin + Result := ''; + NextUpper := True; + for i := 1 to Length(S) do + begin + Ch := S[i]; + if Ch in ['A'..'Z', 'a'..'z', '0'..'9'] then + begin + if NextUpper then + Result := Result + UpCase(Ch) + else + Result := Result + LowerCase(Ch); + NextUpper := False; + end + else + NextUpper := True; + end; + if Result = '' then + Result := 'X'; + if Result[1] in ['0'..'9'] then + Result := 'N' + Result; +end; + +function PathToPascal(const S: string): string; +var + P: string; + Parts: TStringList; + i: Integer; +begin + P := NormalizeCommandPath(S); + if P = '' then + Exit('Root'); + Parts := TStringList.Create; + try + Parts.Delimiter := '/'; + Parts.StrictDelimiter := True; + Parts.DelimitedText := P; + Result := ''; + for i := 0 to Parts.Count - 1 do + Result := Result + TokenToPascalPart(Parts[i]); + finally + Parts.Free; + end; +end; + +function NormalizeUnitId(const S: string): string; +var + i: Integer; + Ch: Char; +begin + Result := ''; + for i := 1 to Length(S) do + begin + Ch := S[i]; + if Ch in ['A'..'Z', 'a'..'z', '0'..'9', '_'] then + Result := Result + Ch + else + Result := Result + '_'; + end; + if Result = '' then + Result := 'GeneratedUnit'; + if Result[1] in ['0'..'9'] then + Result := 'U_' + Result; +end; + +function MakeProgramIdentifier(const AppName: string): string; +const + PascalReservedWords = + '|absolute|and|array|as|asm|begin|case|class|const|constructor|' + + 'destructor|dispinterface|div|do|downto|else|end|except|exports|' + + 'file|finalization|finally|for|function|goto|if|implementation|in|' + + 'inherited|initialization|inline|interface|is|label|library|mod|nil|' + + 'not|object|of|on|operator|or|out|packed|procedure|program|property|' + + 'raise|record|reintroduce|repeat|resourcestring|self|set|shl|shr|' + + 'string|then|threadvar|to|try|type|unit|until|uses|var|while|with|xor|'; +begin + Result := TokenToPascalPart(AppName); + if Pos('|' + LowerCase(Result) + '|', PascalReservedWords) > 0 then + Result := 'App' + Result; +end; + +// Returns a relative path such as 'src/Myapp.lpr'. The filename is +// PascalCase (first letter capitalised) per Free Pascal conventions. +// On case-sensitive filesystems (Linux/macOS) the generated .lpr file +// must be referenced by the exact same casing in build scripts. +function MakeProgramFileRelPath(const AppName: string): string; +begin + Result := 'src' + PathDelim + MakeProgramIdentifier(AppName) + '.lpr'; +end; + +function MakeRegistryUnitName(const AppName: string): string; +begin + Result := NormalizeUnitId(TokenToPascalPart(AppName) + '_CommandRegistry_Generated'); +end; + +function MakeCommandUnitName(const AppName, CommandPath: string): string; +begin + Result := NormalizeUnitId(TokenToPascalPart(AppName) + '_Command_' + PathToPascal(CommandPath)); +end; + +function MakeCommandClassName(const CommandPath: string): string; +begin + Result := 'T' + PathToPascal(CommandPath) + 'Command'; +end; + +function MakeCommandVarName(const CommandPath: string): string; +begin + Result := 'Cmd' + PathToPascal(CommandPath); +end; + +function IsValidCommandToken(const S: string): Boolean; +var + i: Integer; + Ch: Char; +begin + Result := False; + if S = '' then + Exit; + for i := 1 to Length(S) do + begin + Ch := S[i]; + if not (Ch in ['A'..'Z', 'a'..'z', '0'..'9', '-', '_']) then + Exit(False); + end; + Result := True; +end; + +end. diff --git a/tools/cli-fp-gen/src/clifpgen.renderer.pas b/tools/cli-fp-gen/src/clifpgen.renderer.pas new file mode 100644 index 0000000..682096d --- /dev/null +++ b/tools/cli-fp-gen/src/clifpgen.renderer.pas @@ -0,0 +1,308 @@ +unit CliFpGen.Renderer; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + Classes, SysUtils, CliFpGen.Model; + +function RenderProgramFile(const Spec: TProjectSpec): string; +function RenderRegistryUnit(const Spec: TProjectSpec): string; +function RenderCommandUnit(const Spec: TProjectSpec; const Cmd: TCommandSpec): string; + +implementation + +uses + CliFpGen.Naming; + +function LinesToText(const Lines: TStrings): string; +begin + Result := Lines.Text; +end; + +function PascalStringLiteral(const S: string): string; +begin + Result := '''' + StringReplace(S, '''', '''''', [rfReplaceAll]) + ''''; +end; + +function PascalBoolLiteral(const B: Boolean): string; +begin + if B then + Result := 'True' + else + Result := 'False'; +end; + +function PascalWriteLnLiteral(const S: string): string; +begin + Result := 'WriteLn(' + PascalStringLiteral(S) + ');'; +end; + +function RenderParameterCall(const VarName: string; const Param: TParameterSpec): string; +begin + case Param.Kind of + pkString: + Result := Format('%s.AddStringParameter(%s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required), + PascalStringLiteral(Param.DefaultValue)]); + pkInteger: + Result := Format('%s.AddIntegerParameter(%s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required), + PascalStringLiteral(Param.DefaultValue)]); + pkFloat: + Result := Format('%s.AddFloatParameter(%s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required), + PascalStringLiteral(Param.DefaultValue)]); + pkFlag: + Result := Format('%s.AddFlag(%s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalStringLiteral(Param.DefaultValue)]); + pkBoolean: + Result := Format('%s.AddBooleanParameter(%s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required), + PascalStringLiteral(Param.DefaultValue)]); + pkPath: + Result := Format('%s.AddPathParameter(%s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required), + PascalStringLiteral(Param.DefaultValue)]); + pkEnum: + Result := Format('%s.AddEnumParameter(%s, %s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalStringLiteral(Param.AllowedValues), + PascalBoolLiteral(Param.Required), PascalStringLiteral(Param.DefaultValue)]); + pkDateTime: + Result := Format('%s.AddDateTimeParameter(%s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required), + PascalStringLiteral(Param.DefaultValue)]); + pkArray: + Result := Format('%s.AddArrayParameter(%s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required), + PascalStringLiteral(Param.DefaultValue)]); + pkPassword: + Result := Format('%s.AddPasswordParameter(%s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required)]); + pkUrl: + Result := Format('%s.AddUrlParameter(%s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required), + PascalStringLiteral(Param.DefaultValue)]); + else + Result := Format('%s.AddStringParameter(%s, %s, %s, %s, %s);', + [VarName, PascalStringLiteral(Param.ShortFlag), PascalStringLiteral(Param.LongFlag), + PascalStringLiteral(Param.Description), PascalBoolLiteral(Param.Required), + PascalStringLiteral(Param.DefaultValue)]); + end; +end; + +function BuildSortedCommands(const Spec: TProjectSpec): TStringList; +var + i: Integer; + Path: string; +begin + Result := TStringList.Create; + Result.Sorted := True; + Result.Duplicates := dupError; + for i := 0 to Spec.Commands.Count - 1 do + begin + Path := CommandFullPath(Spec.Commands[i]); + Result.AddObject(Format('%.4d|%s', [PathDepth(Path), AnsiLowerCase(Path)]), Spec.Commands[i]); + end; +end; + +function RenderProgramFile(const Spec: TProjectSpec): string; +var + Lines: TStringList; + ProgramIdent, RegistryUnitName: string; +begin + ProgramIdent := MakeProgramIdentifier(Spec.AppName); + RegistryUnitName := MakeRegistryUnitName(Spec.AppName); + + Lines := TStringList.Create; + try + Lines.Add('program ' + ProgramIdent + ';'); + Lines.Add(''); + Lines.Add('{$mode objfpc}{$H+}{$J-}'); + Lines.Add(''); + Lines.Add('{ Code generated by cli-fp-gen. DO NOT EDIT. }'); + Lines.Add('{ Put your command implementations in src/commands/*.pas. }'); + Lines.Add(''); + Lines.Add('uses'); + Lines.Add(' SysUtils,'); + Lines.Add(' CLI.Interfaces,'); + Lines.Add(' CLI.Application,'); + Lines.Add(' ' + RegistryUnitName + ';'); + Lines.Add(''); + Lines.Add('var'); + Lines.Add(' App: ICLIApplication;'); + Lines.Add('begin'); + Lines.Add(' try'); + Lines.Add(' App := CreateCLIApplication(' + PascalStringLiteral(Spec.AppName) + ', ' + + PascalStringLiteral(Spec.AppVersion) + ');'); + Lines.Add(' RegisterGeneratedCommands(App);'); + Lines.Add(' ExitCode := App.Execute;'); + Lines.Add(' except'); + Lines.Add(' on E: Exception do'); + Lines.Add(' begin'); + Lines.Add(' WriteLn(''Error: '' + E.Message);'); + Lines.Add(' ExitCode := 1;'); + Lines.Add(' end;'); + Lines.Add(' end;'); + Lines.Add('end.'); + Result := LinesToText(Lines); + finally + Lines.Free; + end; +end; + +function RenderRegistryUnit(const Spec: TProjectSpec): string; +var + Lines, SortedCmds, UsesUnits: TStringList; + i: Integer; + j: Integer; + Cmd: TCommandSpec; + VarName, ParentVar: string; + Path: string; +begin + Lines := TStringList.Create; + SortedCmds := BuildSortedCommands(Spec); + UsesUnits := TStringList.Create; + try + UsesUnits.Sorted := True; + UsesUnits.Duplicates := dupIgnore; + + for i := 0 to Spec.Commands.Count - 1 do + UsesUnits.Add(MakeCommandUnitName(Spec.AppName, CommandFullPath(Spec.Commands[i]))); + + Lines.Add('unit ' + MakeRegistryUnitName(Spec.AppName) + ';'); + Lines.Add(''); + Lines.Add('{$mode objfpc}{$H+}{$J-}'); + Lines.Add(''); + Lines.Add('interface'); + Lines.Add(''); + Lines.Add('uses'); + Lines.Add(' CLI.Interfaces;'); + Lines.Add(''); + Lines.Add('{ Code generated by cli-fp-gen. DO NOT EDIT. }'); + Lines.Add('procedure RegisterGeneratedCommands(const App: ICLIApplication);'); + Lines.Add(''); + Lines.Add('implementation'); + Lines.Add(''); + if UsesUnits.Count > 0 then + begin + Lines.Add('uses'); + for i := 0 to UsesUnits.Count - 1 do + begin + if i < UsesUnits.Count - 1 then + Lines.Add(' ' + UsesUnits[i] + ',') + else + Lines.Add(' ' + UsesUnits[i] + ';'); + end; + Lines.Add(''); + end; + + Lines.Add('procedure RegisterGeneratedCommands(const App: ICLIApplication);'); + if SortedCmds.Count > 0 then + begin + Lines.Add('var'); + for i := 0 to SortedCmds.Count - 1 do + begin + Cmd := TCommandSpec(SortedCmds.Objects[i]); + Path := CommandFullPath(Cmd); + VarName := MakeCommandVarName(Path); + Lines.Add(' ' + VarName + ': ' + MakeCommandClassName(Path) + ';'); + end; + end; + Lines.Add('begin'); + for i := 0 to SortedCmds.Count - 1 do + begin + Cmd := TCommandSpec(SortedCmds.Objects[i]); + Path := CommandFullPath(Cmd); + VarName := MakeCommandVarName(Path); + Lines.Add(' ' + VarName + ' := ' + MakeCommandClassName(Path) + '.Create;'); + Lines.Add(' ' + VarName + '.UpdateDescription(' + PascalStringLiteral(Cmd.Description) + ');'); + for j := 0 to Cmd.Parameters.Count - 1 do + Lines.Add(' ' + RenderParameterCall(VarName, Cmd.Parameters[j])); + if Trim(Cmd.ParentPath) = '' then + Lines.Add(' App.RegisterCommand(' + VarName + ');') + else + begin + ParentVar := MakeCommandVarName(Cmd.ParentPath); + Lines.Add(' ' + ParentVar + '.AddSubCommand(' + VarName + ');'); + end; + end; + Lines.Add('end;'); + Lines.Add(''); + Lines.Add('end.'); + Result := LinesToText(Lines); + finally + UsesUnits.Free; + SortedCmds.Free; + Lines.Free; + end; +end; + +function RenderCommandUnit(const Spec: TProjectSpec; const Cmd: TCommandSpec): string; +var + Lines: TStringList; + FullPath, UnitName, ClassName: string; +begin + FullPath := CommandFullPath(Cmd); + UnitName := MakeCommandUnitName(Spec.AppName, FullPath); + ClassName := MakeCommandClassName(FullPath); + + Lines := TStringList.Create; + try + Lines.Add('unit ' + UnitName + ';'); + Lines.Add(''); + Lines.Add('{$mode objfpc}{$H+}{$J-}'); + Lines.Add(''); + Lines.Add('interface'); + Lines.Add(''); + Lines.Add('uses'); + Lines.Add(' CLI.Command;'); + Lines.Add(''); + Lines.Add('{ User-owned stub created by cli-fp-gen. Safe to edit. }'); + Lines.Add('type'); + Lines.Add(' ' + ClassName + ' = class(TBaseCommand)'); + Lines.Add(' public'); + Lines.Add(' constructor Create; reintroduce;'); + Lines.Add(' function Execute: Integer; override;'); + Lines.Add(' end;'); + Lines.Add(''); + Lines.Add('implementation'); + Lines.Add(''); + Lines.Add('constructor ' + ClassName + '.Create;'); + Lines.Add('begin'); + Lines.Add(' inherited Create(' + PascalStringLiteral(Cmd.Name) + ', ' + + PascalStringLiteral(Cmd.Description) + ');'); + Lines.Add('end;'); + Lines.Add(''); + Lines.Add('function ' + ClassName + '.Execute: Integer;'); + Lines.Add('begin'); + Lines.Add(' if Length(SubCommands) > 0 then'); + Lines.Add(' begin'); + Lines.Add(' ShowHelp;'); + Lines.Add(' Exit(0);'); + Lines.Add(' end;'); + Lines.Add(''); + Lines.Add(' ' + PascalWriteLnLiteral('TODO: Implement command "' + FullPath + '"')); + Lines.Add(' Result := 0;'); + Lines.Add('end;'); + Lines.Add(''); + Lines.Add('end.'); + Result := LinesToText(Lines); + finally + Lines.Free; + end; +end; + +end. diff --git a/tools/cli-fp-gen/src/clifpgen.specio.pas b/tools/cli-fp-gen/src/clifpgen.specio.pas new file mode 100644 index 0000000..8311264 --- /dev/null +++ b/tools/cli-fp-gen/src/clifpgen.specio.pas @@ -0,0 +1,204 @@ +unit CliFpGen.SpecIO; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + Classes, SysUtils, fpjson, jsonparser, + CliFpGen.Model; + +function LoadProjectSpec(const SpecFile: string): TProjectSpec; +procedure SaveProjectSpec(const Spec: TProjectSpec; const SpecFile: string; const Options: TWriteOptions); + +implementation + +uses + CliFpGen.Filesystem; + +function RequireObjectField(const Obj: TJSONObject; const Name: string): TJSONObject; +begin + if (Obj = nil) or (Obj.Find(Name) = nil) or not (Obj.Objects[Name] is TJSONObject) then + raise Exception.CreateFmt('Invalid spec: missing object field "%s"', [Name]); + Result := Obj.Objects[Name]; +end; + +function LoadParameterSpec(const ParamObj: TJSONObject; const CommandIndex, + ParameterIndex: Integer): TParameterSpec; +var + ParamKind: TParameterKind; +begin + Result := TParameterSpec.Create; + try + Result.ShortFlag := ParamObj.Get('short', ''); + Result.LongFlag := ParamObj.Get('long', ''); + Result.Description := ParamObj.Get('description', ''); + if not TryParseParameterKind(ParamObj.Get('kind', 'string'), ParamKind) then + raise Exception.CreateFmt( + 'Invalid parameter kind in commands[%d].parameters[%d]', + [CommandIndex, ParameterIndex]); + Result.Kind := ParamKind; + Result.Required := ParamObj.Get('required', False); + Result.DefaultValue := ParamObj.Get('default', ''); + Result.AllowedValues := ParamObj.Get('allowedValues', ''); + except + Result.Free; + Result := nil; + raise; + end; +end; + +function LoadCommandSpec(const CmdObj: TJSONObject; + const CommandIndex: Integer): TCommandSpec; +var + ParamArray: TJSONArray; + ParamObj: TJSONObject; + Param: TParameterSpec; + j: Integer; +begin + Result := TCommandSpec.Create; + try + Result.Name := CmdObj.Get('name', ''); + Result.Description := CmdObj.Get('description', ''); + Result.ParentPath := CmdObj.Get('parent', ''); + if (CmdObj.Find('parameters') <> nil) and + (CmdObj.Arrays['parameters'] is TJSONArray) then + begin + ParamArray := CmdObj.Arrays['parameters']; + for j := 0 to ParamArray.Count - 1 do + begin + if not (ParamArray.Items[j] is TJSONObject) then + raise Exception.CreateFmt( + 'Invalid spec: commands[%d].parameters[%d] must be an object', + [CommandIndex, j]); + ParamObj := TJSONObject(ParamArray.Items[j]); + Param := LoadParameterSpec(ParamObj, CommandIndex, j); + try + // Parameters is owning; clear the local only after Add succeeds. + Result.Parameters.Add(Param); + Param := nil; + finally + Param.Free; + end; + end; + end; + except + Result.Free; + Result := nil; + raise; + end; +end; + +function LoadProjectSpec(const SpecFile: string): TProjectSpec; +var + Root: TJSONData; + RootObj, AppObj: TJSONObject; + CmdArray: TJSONArray; + i: Integer; + CmdObj: TJSONObject; + Cmd: TCommandSpec; + JsonText: string; +begin + if not FileExists(SpecFile) then + raise Exception.CreateFmt('Spec file not found: %s', [SpecFile]); + + JsonText := ReadTextFileStrict(SpecFile); + Root := GetJSON(JsonText); + try + if not (Root is TJSONObject) then + raise Exception.Create('Invalid spec: root must be a JSON object'); + RootObj := TJSONObject(Root); + + Result := TProjectSpec.Create; + try + Result.SchemaVersion := RootObj.Get('schemaVersion', 1); + + AppObj := RequireObjectField(RootObj, 'app'); + Result.AppName := AppObj.Get('name', ''); + Result.AppVersion := AppObj.Get('version', '0.1.0'); + Result.ProgramFile := AppObj.Get('programFile', ''); + + if (RootObj.Find('commands') <> nil) and (RootObj.Arrays['commands'] is TJSONArray) then + begin + CmdArray := RootObj.Arrays['commands']; + for i := 0 to CmdArray.Count - 1 do + begin + if not (CmdArray.Items[i] is TJSONObject) then + raise Exception.CreateFmt('Invalid spec: commands[%d] must be an object', [i]); + CmdObj := TJSONObject(CmdArray.Items[i]); + Cmd := LoadCommandSpec(CmdObj, i); + try + // Commands is owning; clear the local only after Add succeeds. + Result.Commands.Add(Cmd); + Cmd := nil; + finally + Cmd.Free; + end; + end; + end; + except + Result.Free; + raise; + end; + finally + Root.Free; + end; +end; + +procedure SaveProjectSpec(const Spec: TProjectSpec; const SpecFile: string; const Options: TWriteOptions); +var + RootObj, AppObj, CmdObj, ParamObj: TJSONObject; + CmdArray, ParamArray: TJSONArray; + i: Integer; + j: Integer; + Cmd: TCommandSpec; + Param: TParameterSpec; +begin + RootObj := TJSONObject.Create; + try + RootObj.Add('schemaVersion', Spec.SchemaVersion); + + AppObj := TJSONObject.Create; + AppObj.Add('name', Spec.AppName); + AppObj.Add('version', Spec.AppVersion); + AppObj.Add('programFile', Spec.ProgramFile); + RootObj.Add('app', AppObj); + + CmdArray := TJSONArray.Create; + for i := 0 to Spec.Commands.Count - 1 do + begin + Cmd := Spec.Commands[i]; + CmdObj := TJSONObject.Create; + CmdObj.Add('name', Cmd.Name); + CmdObj.Add('description', Cmd.Description); + if Trim(Cmd.ParentPath) <> '' then + CmdObj.Add('parent', Cmd.ParentPath) + else + CmdObj.Add('parent', ''); + + ParamArray := TJSONArray.Create; + for j := 0 to Cmd.Parameters.Count - 1 do + begin + Param := Cmd.Parameters[j]; + ParamObj := TJSONObject.Create; + ParamObj.Add('kind', ParameterKindToString(Param.Kind)); + ParamObj.Add('short', Param.ShortFlag); + ParamObj.Add('long', Param.LongFlag); + ParamObj.Add('description', Param.Description); + ParamObj.Add('required', Param.Required); + ParamObj.Add('default', Param.DefaultValue); + ParamObj.Add('allowedValues', Param.AllowedValues); + ParamArray.Add(ParamObj); + end; + CmdObj.Add('parameters', ParamArray); + CmdArray.Add(CmdObj); + end; + RootObj.Add('commands', CmdArray); + + WriteManagedTextFile(SpecFile, RootObj.FormatJSON([], 2) + LineEnding, wkGenerated, Options); + finally + RootObj.Free; + end; +end; + +end. diff --git a/tools/cli-fp-gen/src/clifpgen.validate.pas b/tools/cli-fp-gen/src/clifpgen.validate.pas new file mode 100644 index 0000000..b63c5e7 --- /dev/null +++ b/tools/cli-fp-gen/src/clifpgen.validate.pas @@ -0,0 +1,201 @@ +unit CliFpGen.Validate; + +{$mode objfpc}{$H+}{$J-} + +interface + +uses + Classes, SysUtils, CliFpGen.Model; + +procedure ValidateProjectSpec(const Spec: TProjectSpec); + +implementation + +uses + CliFpGen.Naming; + +function StartsWith(const S, Prefix: string): Boolean; +begin + Result := Copy(S, 1, Length(Prefix)) = Prefix; +end; + +function IsAbsoluteLikePath(const S: string): Boolean; +begin + Result := (ExtractFileDrive(S) <> '') or + ((S <> '') and ((S[1] = '/') or (S[1] = '\'))); +end; + +function ContainsParentTraversal(const S: string): Boolean; +var + Parts: TStringList; + i: Integer; +begin + Result := False; + Parts := TStringList.Create; + try + Parts.Delimiter := '/'; + Parts.StrictDelimiter := True; + Parts.DelimitedText := S; + for i := 0 to Parts.Count - 1 do + if Trim(Parts[i]) = '..' then + Exit(True); + finally + Parts.Free; + end; +end; + +procedure ValidateProjectSpec(const Spec: TProjectSpec); +var + SeenPaths, SeenGeneratedNames: TStringList; + i: Integer; + j: Integer; + Cmd: TCommandSpec; + FullPath, ParentPath: string; + GeneratedName: string; + ConflictingCommand: TCommandSpec; + ConflictIndex: Integer; + Param: TParameterSpec; + SeenFlags: TStringList; + ProgramFileNorm: string; +begin + if Spec = nil then + raise Exception.Create('Spec is nil'); + + // TODO: when v2 is defined, add migration guidance to this error message + if Spec.SchemaVersion <> 1 then + raise Exception.CreateFmt( + 'Unsupported schemaVersion: %d (only v1 is supported). ' + + 'Check the cli-fp-gen documentation for migration instructions.', + [Spec.SchemaVersion]); + + if Trim(Spec.AppName) = '' then + raise Exception.Create('Spec app.name must not be empty'); + + if Trim(Spec.ProgramFile) = '' then + raise Exception.Create('Spec app.programFile must not be empty'); + + ProgramFileNorm := NormalizePathSlashes(Trim(Spec.ProgramFile)); + if IsAbsoluteLikePath(ProgramFileNorm) then + raise Exception.CreateFmt('Spec app.programFile must be project-relative: %s', [Spec.ProgramFile]); + if ContainsParentTraversal(ProgramFileNorm) then + raise Exception.CreateFmt('Spec app.programFile must not escape the project directory: %s', [Spec.ProgramFile]); + if not StartsWith(AnsiLowerCase(ProgramFileNorm), 'src/') then + raise Exception.CreateFmt('Spec app.programFile must live under src/: %s', [Spec.ProgramFile]); + if LowerCase(ExtractFileExt(ProgramFileNorm)) <> '.lpr' then + raise Exception.CreateFmt('Spec app.programFile must be an .lpr file: %s', [Spec.ProgramFile]); + + SeenPaths := TStringList.Create; + SeenGeneratedNames := TStringList.Create; + try + SeenPaths.CaseSensitive := False; + SeenGeneratedNames.CaseSensitive := False; + + for i := 0 to Spec.Commands.Count - 1 do + begin + Cmd := Spec.Commands[i]; + Cmd.Name := NormalizeCommandName(Cmd.Name); + Cmd.ParentPath := NormalizeCommandPath(Cmd.ParentPath); + + if Cmd.Description = '' then + Cmd.Description := 'TODO: Describe "' + Cmd.Name + '" command'; + + if not IsValidCommandToken(Cmd.Name) then + raise Exception.CreateFmt('Invalid command name "%s"', [Cmd.Name]); + + if Cmd.ParentPath <> '' then + begin + ParentPath := NormalizeCommandPath(Cmd.ParentPath); + if ParentPath = '' then + raise Exception.CreateFmt('Invalid parent path for command "%s"', [Cmd.Name]); + end; + + FullPath := CommandFullPath(Cmd); + if SeenPaths.IndexOf(AnsiLowerCase(FullPath)) >= 0 then + begin + if Cmd.ParentPath <> '' then + raise Exception.CreateFmt( + 'Duplicate command name "%s" under parent "%s" (full path: "%s")', + [Cmd.Name, Cmd.ParentPath, FullPath]) + else + raise Exception.CreateFmt( + 'Duplicate root command name "%s"', [Cmd.Name]); + end; + SeenPaths.Add(AnsiLowerCase(FullPath)); + + GeneratedName := MakeCommandUnitName(Spec.AppName, FullPath); + ConflictIndex := SeenGeneratedNames.IndexOf(GeneratedName); + if ConflictIndex >= 0 then + begin + ConflictingCommand := TCommandSpec(SeenGeneratedNames.Objects[ConflictIndex]); + raise Exception.CreateFmt( + 'Commands "%s" and "%s" generate the same Pascal identifier "%s"; ' + + 'rename one of the commands', + [CommandFullPath(ConflictingCommand), FullPath, GeneratedName]); + end; + SeenGeneratedNames.AddObject(GeneratedName, Cmd); + + SeenFlags := TStringList.Create; + try + SeenFlags.CaseSensitive := False; + for j := 0 to Cmd.Parameters.Count - 1 do + begin + Param := Cmd.Parameters[j]; + + if Trim(Param.LongFlag) = '' then + raise Exception.CreateFmt('Command "%s": parameter %d missing long flag', [FullPath, j]); + if not StartsWith(Param.LongFlag, '--') then + raise Exception.CreateFmt('Command "%s": invalid long flag "%s"', [FullPath, Param.LongFlag]); + if (Trim(Param.ShortFlag) <> '') and (not StartsWith(Param.ShortFlag, '-')) then + raise Exception.CreateFmt('Command "%s": invalid short flag "%s"', [FullPath, Param.ShortFlag]); + if StartsWith(Param.ShortFlag, '--') then + raise Exception.CreateFmt('Command "%s": short flag must be single-dash style ("%s")', [FullPath, Param.ShortFlag]); + + if Trim(Param.Description) = '' then + Param.Description := 'TODO: Describe ' + Param.LongFlag; + + if Param.Kind = pkFlag then + begin + Param.Required := False; + if Param.DefaultValue = '' then + Param.DefaultValue := 'false'; + end; + + if (Param.Kind = pkEnum) and (Trim(Param.AllowedValues) = '') then + raise Exception.CreateFmt('Command "%s": enum parameter "%s" requires allowedValues', + [FullPath, Param.LongFlag]); + + if SeenFlags.IndexOf(AnsiLowerCase(Param.LongFlag)) >= 0 then + raise Exception.CreateFmt('Command "%s": duplicate parameter flag "%s"', [FullPath, Param.LongFlag]); + SeenFlags.Add(AnsiLowerCase(Param.LongFlag)); + + if Trim(Param.ShortFlag) <> '' then + begin + if SeenFlags.IndexOf(AnsiLowerCase(Param.ShortFlag)) >= 0 then + raise Exception.CreateFmt('Command "%s": duplicate parameter flag "%s"', [FullPath, Param.ShortFlag]); + SeenFlags.Add(AnsiLowerCase(Param.ShortFlag)); + end; + end; + finally + SeenFlags.Free; + end; + end; + + for i := 0 to Spec.Commands.Count - 1 do + begin + Cmd := Spec.Commands[i]; + if Cmd.ParentPath <> '' then + begin + if SeenPaths.IndexOf(AnsiLowerCase(Cmd.ParentPath)) < 0 then + raise Exception.CreateFmt( + 'Command "%s" references missing parent "%s"', + [CommandFullPath(Cmd), Cmd.ParentPath] + ); + end; + end; + finally + SeenGeneratedNames.Free; + SeenPaths.Free; + end; +end; + +end.