packages feed

valiant-cli (empty) → 0.1.0.0

raw patch · 32 files changed

+3656/−0 lines, 32 filesdep +Globdep +aesondep +aeson-pretty

Dependencies added: Glob, aeson, aeson-pretty, ansi-terminal, base, bytestring, containers, cryptohash-sha256, directory, dotenv, filepath, hspec, optparse-applicative, pg-wire, temporary, text, time, valiant-cli, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,74 @@+# Changelog++All notable changes to the valiant project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),+and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).++## [0.1.0.0] - 2026-04-25++Initial release. The project ships four primary packages plus eight adapter+libraries.++### Packages++- **pg-wire** 0.1.0.0: pure-Haskell PostgreSQL v3 wire-protocol driver. No+  libpq, no C dependencies. Includes a connection pool with idle reaping,+  health checks, jittered max-life, queue mode (LIFO/FIFO), recycling+  modes, lifecycle hooks, and `nothunks`-checked invariants.+- **valiant** 0.1.0.0: runtime library. Binary codecs for all common+  PostgreSQL types (numerics, text, time, UUID, JSON/JSONB, hstore, inet,+  macaddr, point, ranges, arrays, composites, enums), a `Statement` type,+  query execution, server-side cursor streaming, pipelined execution,+  COPY in/out, large objects, LISTEN/NOTIFY, advisory locks, transactions,+  and re-exports from `pg-wire`.+- **valiant-cli** 0.1.0.0: `valiant` CLI with `prepare`, `check`,+  `types`, `generate`, and `watch` commands.+- **valiant-plugin** 0.1.0.0: GHC source plugin that validates SQL files+  against the `.valiant/` cache at compile time.++### Adapters++Eight first-party adapters for popular effect systems and streaming+libraries: `valiant-bluefin`, `valiant-conduit`, `valiant-effectful`,+`valiant-fused-effects`, `valiant-mtl`, `valiant-pipes`,+`valiant-streaming`, `valiant-streamly`.++### Highlights++- **Compile-time SQL safety.** Raw `.sql` files are validated against a+  live PostgreSQL database via `valiant prepare` and a `.valiant/` cache.+  The GHC source plugin checks parameter and result types at compile+  time. No Template Haskell.+- **Performance.** Roughly 5x faster than hasql on multi-row reads and+  10x faster on pipelined batch writes in our comparative benchmarks+  (`bench-compare`). Competitive with asyncpg (Python) on throughput.+- **Wire protocol features.** Extended query protocol with binary+  format, statement caching, prepared statements, server-side cursors,+  pipelining, COPY in/out (including CSV), large objects,+  LISTEN/NOTIFY, query cancellation, cleartext, MD5, and SCRAM-SHA-256+  authentication.+- **Strict by default.** `StrictData`, `-funbox-strict-fields`, and+  `-fspecialise-aggressively` across all libraries. `-fno-full-laziness`+  on streaming-sensitive modules. `nothunks` invariants on the pool.+- **Tested.** 267 unit tests in `pg-wire`, 282 in `valiant`, 101+  integration tests against a real Postgres, plus property tests with+  hedgehog and a state-machine test for the connection pool.++### Added (post-tag)++- `refine` and `refineWith` combinators in `Valiant.Binary.Decode` for+  validating decoded values against extra invariants without writing a+  full `PgDecode` instance.+- `fetchAllUnboxed`: an unboxed-vector variant of `fetchAllVec` for+  fixed-size primitive result columns. Eliminates per-element pointer+  indirection for `Int32`/`Int64`/`Double`/`Bool` and tuples of those.++### Documentation++- Tutorial, performance notes, asyncpg comparison, async architecture,+  and gap analysis under `docs/`.+- Per-package READMEs for `pg-wire`, `valiant`, `valiant-cli`,+  `valiant-plugin`, and each adapter.++[0.1.0.0]: https://github.com/joshburgess/valiant/releases/tag/v0.1.0.0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2026 Josh Burgess++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from this+   software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,410 @@+# valiant++**Compile-time checked SQL for Haskell.**++Inspired by Rust's [sqlx](https://github.com/launchbadge/sqlx), built from scratch for Haskell. No Template Haskell. No `libpq`. No C dependencies. Raw `.sql` files validated against a live Postgres database at prepare time, with a GHC source plugin that enforces type safety at compile time. The fastest Haskell PostgreSQL library: 5x faster than hasql on multi-row reads, 10x faster on pipelined batch writes, competitive with asyncpg (Python) on throughput.++## How it works++```+  .sql files ──> valiant prepare ──> .valiant/ cache ──> GHC plugin ──> type-safe Haskell+                    (live DB)        (committed)      (compile time)+```++1. Write SQL in standalone `.sql` files with full editor support+2. Run `valiant prepare` to validate queries against your database and cache type metadata+3. The GHC source plugin reads the cache at compile time and verifies your Haskell types match+4. At runtime, a custom Postgres wire protocol driver executes queries with binary format encoding++## Quick start++```haskell+-- sql/users/find_by_id.sql:+--   SELECT id, name, email FROM users WHERE id = $1++{-# OPTIONS_GHC -fplugin=Valiant.Plugin+                -fplugin-opt=Valiant.Plugin:sql-dir=sql #-}++module MyApp.Queries.Users where++import Valiant++findById :: Statement Int32 (Maybe (Int32, Text, Maybe Text))+findById = queryFile "users/find_by_id.sql"+```++The plugin verifies at compile time that:+- The `.sql` file exists+- `Int32` matches the `$1` parameter (Postgres `int4`)+- `(Int32, Text, Maybe Text)` matches the result columns+- `email` is correctly wrapped in `Maybe` (it's nullable)++If anything is wrong, you get a clear compile error:++```+src/MyApp/Queries/Users.hs:12:1: error: [VALIANT-003]++    -- Result type mismatch+    |+    |  Comparing column by column:+    |+    |    Column    Postgres type    Your type       Expected+    |    id        int4             Int32           Int32       ok+    |    name      text             Text            Text        ok+    |    email     text (nullable)  Text            Maybe Text  MISMATCH+    |+    -- Fix: wrap the field in Maybe:  Maybe Text+```++## Runtime usage++```haskell+import Valiant+import MyApp.Queries.Users qualified as Q++main :: IO ()+main = do+  pool <- newPool defaultPoolConfig+    { poolConnString = "postgres://user:pass@localhost:5432/mydb"+    , poolSize = 10+    }++  -- Fetch one row+  mUser <- withResource pool $ \conn ->+    fetchOne conn Q.findById 42++  -- Fetch all rows+  users <- withResource pool $ \conn ->+    fetchAll conn Q.listAll ()++  -- Execute a command+  n <- withResource pool $ \conn ->+    execute conn Q.insert ("Alice", Just "alice@example.com")++  -- Batch insert (pipelined, eliminates per-row round-trips)+  withResource pool $ \conn ->+    executeBatch conn Q.insert+      [ ("Alice", Just "alice@example.com")+      , ("Bob", Just "bob@example.com")+      , ("Carol", Nothing)+      ]++  -- Transactions+  withTransaction pool $ \tx -> do+    execute (txConn tx) Q.insert ("Dave", Just "dave@example.com")+    execute (txConn tx) Q.insert ("Eve", Nothing)++  -- Constant-memory streaming (no cursor/transaction needed)+  total <- withResource pool $ \conn ->+    executeWithFold conn Q.listAll () (RowFold 0 (\n _ -> n + 1))+```++## CLI tool++```bash+# Validate all .sql files against your database+$ valiant prepare+  [1/10] sql/users/find_by_id.sql ............ ok+  [2/10] sql/users/find_by_email.sql ......... ok+  ...+  Wrote 10 cache files to .valiant/++# Check cache freshness (for CI, no database needed)+$ valiant check++# Print inferred Haskell types+$ valiant types+  sql/users/find_by_id.sql+    Params: Int32+    Result: (Int32, Text, Maybe Text)++# Auto-generate Haskell binding modules+$ valiant generate --module-prefix MyApp.Queries --output-dir src/MyApp/Queries/+  Generated src/MyApp/Queries/Users.hs (7 queries)+  Generated src/MyApp/Queries/Posts.hs (3 queries)++# Watch for changes and re-prepare+$ valiant watch+```++## Performance++valiant is the fastest Haskell PostgreSQL library. It implements its own wire+protocol in pure Haskell with binary format encoding, direct byte writes,+pipelined execution, async sender/receiver split, and zero unnecessary copies.++Benchmarks against [hasql](https://hackage.haskell.org/package/hasql)+(libpq FFI, binary) and [postgresql-simple](https://hackage.haskell.org/package/postgresql-simple)+(libpq FFI, text). Single connection, native Postgres 16.++**Reads** (Linux benchmark host, Postgres 16, Unix socket):++| Rows | valiant | hasql | pg-simple | vs hasql | vs pg-simple |+|------|-------|-------|-----------|----------|--------------|+| 1 (by PK) | 138 μs | 89 μs | 179 μs | 1.6x slower | **23% faster** |+| 1,000 | **895 μs** | 4.76 ms | 3.57 ms | **5.3x faster** | **4.0x faster** |+| 5,000 | **4.66 ms** | 25.5 ms | 20.0 ms | **5.5x faster** | **4.3x faster** |+| 10,000 | **11.0 ms** | 54.4 ms | 38.3 ms | **5.0x faster** | **3.5x faster** |++valiant is 1.6x slower on single-row lookups (the async sender/receiver+split has per-query coordination overhead that dominates when there's+nothing to pipeline) but **5x faster** once row decoding dominates.++**Writes (pipelined):**++| Rows | valiant (pipelined) | valiant (seq) | hasql | pg-simple |+|------|--------------------|------------|-------|-----------|+| 100 | **956 μs** | 15.2 ms | 9.46 ms | 15.9 ms |++Pipelined batch inserts are **9.9x faster** than hasql and **16.6x faster**+than postgresql-simple.++**vs asyncpg (Python)** (CI-verified on the same GitHub Actions runner, Postgres 16, Unix socket):++| Benchmark | asyncpg | valiant |+|-----------|---------|-------|+| SELECT 1+1 throughput (10 conns) | 30,279/s | **31,056/s** |+| fetch 1000 rows throughput | 2,819/s | **3,091/s** |+| batch insert 1000 (pipelined) | N/A | **173.8/s** |++See [docs/benchmark-results/asyncpg-comparison.md](docs/benchmark-results/asyncpg-comparison.md)+for the full head-to-head comparison.++**Why it's fast:**++- **Binary format decoding** -- direct from network buffer, no FFI boundary+- **Direct byte writes** -- `unsafeCreate` + `pokeByteOff`, 5-6x faster than Builder for fixed-size types (30ns per Int32)+- **Pipelined execution** -- `executeBatch` sends N Bind+Execute pairs with 1 Sync, 40-100x faster than sequential+- **Sender/receiver split** -- dedicated writer+reader threads per connection, automatic pipelining for concurrent workloads+- **Fused Builder encoding** -- all protocol messages in a batch fused into one Builder, one allocation, one `send()`+- **Direct-to-Vector parsing** -- DataRow parsed directly into mutable Vector, no intermediate list+- **Pre-computed message sizes** -- single-pass protocol encoding, no double-copy+- **Message coalescing + TCP_NODELAY** -- single syscall per message sequence+- **Fused row decoding** -- decode as rows arrive, no intermediate list+- **Pure Haskell** -- no `libpq`, no C toolchain, no system dependencies++| | libpq (FFI) | valiant (pure Haskell) |+|---|---|---|+| Single-row latency | **89 μs** (hasql) | 138 μs (1.6x slower) |+| Multi-row throughput (10K) | 54.4 ms (hasql) | **11.0 ms (5.0x faster)** |+| Batch writes (100 inserts) | 9.46 ms (hasql) | **956 μs (9.9x faster)** |+| vs asyncpg (Python) | N/A | **Faster on row throughput** |+| Build requirements | Needs `libpq-dev` | No system dependencies |++See [docs/PERFORMANCE.md](docs/PERFORMANCE.md) for the full deep-dive:+codec benchmarks, pool benchmarks, architecture comparison, optimization+techniques, and the complete optimization journey. Archived numbers with+CSV data (Apple Silicon / macOS / Docker Postgres) are in+[docs/benchmark-results/](docs/benchmark-results/README.md); the+[`bench-compare`](bench-compare/README.md) suite reproduces the read,+insert, and asyncpg comparisons locally or via the+[Benchmarks workflow](.github/workflows/benchmarks.yml).++## Project structure++valiant is a multi-package Cabal project:++| Package | Description |+|---------|-------------|+| `pg-wire` | Pure Haskell PostgreSQL v3 wire protocol driver, connection pool, auth, TLS |+| `valiant` | Runtime library: binary codecs, query execution, transactions, streaming, COPY |+| `valiant-cli` | CLI tool (`valiant prepare`, `check`, `types`, `generate`, `watch`) |+| `valiant-plugin` | GHC source plugin for compile-time query validation |+| `valiant-conduit` | Conduit streaming adapter |+| `valiant-pipes` | Pipes streaming adapter |+| `valiant-streaming` | `streaming` library adapter |+| `valiant-streamly` | Streamly streaming adapter |+| `valiant-bluefin` | Bluefin effect system adapter |+| `valiant-effectful` | Effectful effect system adapter |+| `valiant-fused-effects` | Fused-effects effect system adapter |+| `valiant-mtl` | MTL monad transformer adapter |+| `valiant-example` | Example REST API using valiant + scotty |+| [`bench-compare`](bench-compare/README.md) | Comparative benchmarks against hasql, postgresql-simple, persistent, and asyncpg |++```+valiant/+├── wire/                      # pg-wire: wire protocol, connection, pool, auth, TLS+│   ├── src/PgWire/            # Protocol messages, builders, parsers, async I/O+│   └── test/                  # Wire protocol unit tests+├── runtime/                   # valiant: runtime library+│   ├── src/Valiant/           # Binary codecs, execute, batch, pipeline, fold, copy, streaming+│   ├── bench/                 # Codec + concurrent benchmarks (criterion)+│   ├── integration/           # Integration tests (require Postgres)+│   └── test/                  # Codec unit tests+├── src/                       # valiant-cli source+│   └── Valiant/CLI/           # Commands, cache, type map, discovery, nullability+├── plugin/                    # GHC source plugin+│   └── src/Valiant/Plugin/    # AST traversal, verification, error messages+├── adapters/                  # Streaming and effect system adapters (8 packages)+│   ├── valiant-conduit/       # Conduit adapter+│   ├── valiant-pipes/         # Pipes adapter+│   ├── valiant-streaming/     # streaming library adapter+│   ├── valiant-streamly/      # Streamly adapter+│   ├── valiant-bluefin/       # Bluefin effect system adapter+│   ├── valiant-effectful/     # Effectful effect system adapter+│   ├── valiant-fused-effects/ # Fused-effects adapter+│   └── valiant-mtl/           # MTL monad transformer adapter+├── example/                   # Example REST API (scotty)+├── bench-compare/             # Comparative benchmarks vs hasql, pg-simple+├── scripts/                   # pg-setup.sh, pg-teardown.sh+├── docs/                      # TUTORIAL.md, PERFORMANCE.md, ASYNC_ARCHITECTURE.md+└── .valiant/                  # Cached query metadata (committed to VCS)+```++## Features++### SQL authoring+- One SQL statement per `.sql` file with full editor support+- Optional metadata comments: `-- valiant:name`, `-- valiant:result`, `-- valiant:single`+- Directory structure maps to Haskell module structure++### Compile-time validation+- 6 structured error codes (`VALIANT-001`..`006`) with column-by-column diagnostics+- Nullability inference from `pg_attribute`+- Did-you-mean suggestions for mistyped file paths (Levenshtein distance)+- Type inference (no signature required) or typed hole discovery+- `addDependentFile` tracking: GHC recompiles when `.sql` files change++### Type mapping++| Postgres | Haskell | Postgres | Haskell |+|----------|---------|----------|---------|+| `bool` | `Bool` | `float4` | `Float` |+| `int2` | `Int16` | `float8` | `Double` |+| `int4` | `Int32` | `numeric` | `Scientific` |+| `int8` | `Int64` | `uuid` | `UUID` |+| `text` | `Text` | `json`/`jsonb` | `Value` |+| `bytea` | `ByteString` | `date` | `Day` |+| `varchar` | `Text` | `time` | `TimeOfDay` |+| `timestamp` | `LocalTime` | `timestamptz` | `UTCTime` |+| `interval` | `PgInterval` | `inet`/`cidr` | `PgInet` |+| `int4[]`, etc. | `Vector Int32`, etc. | | |++Nullable columns are wrapped in `Maybe`. Custom types are auto-discovered+from `pg_type` at prepare time: enums map to `Text`, domains unwrap to+their base type, ranges map to `PgRange BaseType`. Manual overrides via+`valiant-types.json`.++### Runtime+- Custom PostgreSQL v3 wire protocol implementation (no FFI, no `libpq`)+- Async sender/receiver split: dedicated writer+reader threads per connection+  with automatic pipelining for concurrent workloads (7.2x scaling at 32 threads)+- Binary format encoding/decoding for all supported types+- Extended query protocol (Parse/Bind/Execute/Sync) with prepared statement caching+- Cross-connection shared statement cache at the pool level+- Pipelined batch execution (`executeBatch`) for high-throughput writes+- Pipeline Applicative for combining independent queries into one round-trip+- Fused Builder encoding and direct-to-Vector DataRow parsing+- Constant-memory streaming via `RowFold` (no cursor/transaction needed)+- Server-side cursors for large result sets within transactions+- Connection pooling with idle reaping, max lifetime, health checking, and+  pool-level type cache+- SCRAM-SHA-256 (with channel binding), MD5, and cleartext authentication+- TLS 1.2/1.3 via the `tls` library, client certificates, CA validation+- Multi-host failover with `target_session_attrs` and `load_balance_hosts`+- Transactions with configurable isolation levels and savepoints+- LISTEN/NOTIFY for async notifications (callback-based, no polling)+- COPY IN/OUT for bulk data transfer (text, CSV, and binary formats)+- Query cancellation with `cancelQuery` and `withQueryTimeout`+- Composite, range, array, interval, and Scientific binary codecs+- `PgEnum` type class for Haskell sum types mapping to PG enums+- Protocol tracing via `setTraceHandler` callback+- Logging hooks for query timing and connection events++## Workflow++### Development++```bash+# 1. Write a query+echo "SELECT id, name FROM users WHERE active = true" > sql/users/list_active.sql++# 2. Validate against your dev database+export DATABASE_URL="postgres://localhost:5432/mydb"+valiant prepare++# 3. Write (or generate) the Haskell binding+# 4. Build (the plugin checks everything at compile time)+cabal build+```++### CI++```yaml+steps:+  - name: Verify query cache+    run: valiant check          # no database needed++  - name: Build+    run: cabal build+    env:+      VALIANT_OFFLINE: "true"   # plugin reads from .valiant/ only+```++### Running benchmarks++```bash+# Start Postgres via docker-compose (tuned for benchmarks)+docker compose up -d --wait+export DATABASE_URL="postgres://valiant_test:valiant_test@localhost:5433/valiant_test"++# Codec benchmarks (pure, no database needed)+cabal bench valiant-bench --benchmark-options='--match prefix codec'++# Query benchmarks+cabal bench valiant-bench --benchmark-options='--match prefix query'++# Concurrent benchmarks (the async split showcase)+cabal bench valiant-bench --benchmark-options='+RTS -N -RTS --match prefix concurrent'++# Comparative benchmarks vs hasql and postgresql-simple+# (requires system libpq: `brew install libpq` on macOS, then add its bin to PATH)+cabal run --project-file=cabal.project.bench bench-compare++# Teardown+docker compose down+```++## Building from source++Requires GHC 9.10.3 and Cabal 3.0+. v0.1 ships against a single GHC+version; multi-GHC support (9.6, 9.8, and newer) is planned for 0.1.x+once the plugin's GHC AST shims are in place.++```bash+git clone https://github.com/joshburgess/valiant.git+cd valiant+cabal build all+cabal test pg-wire-test valiant-test valiant-cli-test valiant-plugin-test+```++All packages compile with `-Werror`.++## Design decisions++**Why not Template Haskell?** TH has stage restrictions, cross-compilation issues, and makes it hard to produce good error messages. A GHC source plugin runs after typechecking, has access to the full AST, and can emit rich diagnostics with source locations and custom formatting.++**Why a separate prepare step?** Connecting to Postgres from inside the compiler (as Rust's sqlx does) causes well-known compilation speed issues and complicates CI. A separate CLI step + JSON cache keeps compilation fast and enables fully offline builds.++**Why a custom wire protocol driver?** Full control over binary format encoding, connection management, and protocol features (pipelining, async I/O, COPY, LISTEN/NOTIFY, cursors) without depending on `libpq` or any existing Haskell database library. No system C dependencies means simpler builds and cross-compilation. And as the benchmarks show, pure Haskell binary decoding is faster than FFI-based alternatives on multi-row reads.++**Why sender/receiver split?** The same architecture behind asyncpg's 3x advantage over psycopg2. Dedicated writer+reader threads per connection allow multiple green threads to pipeline queries automatically on a single connection, achieving 7.2x throughput scaling at 32 threads.++## Comparison with Rust's sqlx++| Aspect | Rust sqlx | valiant |+|--------|-----------|-------|+| SQL authoring | String literals or `.sql` files | `.sql` files (primary) |+| Compile-time mechanism | Proc macro | GHC source plugin |+| DB at compile time | From proc macro | Separate `valiant prepare` step |+| Offline mode | `.sqlx/` JSON cache | `.valiant/` JSON cache |+| Code generation | No | `valiant generate` (optional) |+| Runtime driver | Custom async Rust driver | Custom async Haskell driver |+| Concurrent I/O | Tokio async/await | Sender/receiver green threads |+| Error messages | Generic Rust type errors | Column-by-column diagnostics with fixes |+| Pipelining | Via driver internals | Explicit `executeBatch` + automatic via async split |+| Custom types | Trait impls | Auto-discovery from `pg_type` + `PgEnum` type class |++## License++BSD-3-Clause
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Valiant.CLI.App (run)++main :: IO ()+main = run
+ src/Valiant/CLI/App.hs view
@@ -0,0 +1,145 @@+module Valiant.CLI.App+  ( run+  ) where++import Valiant.CLI.Command.Check (runCheck)+import Valiant.CLI.Command.Generate (GenerateOpts (..), runGenerate)+import Valiant.CLI.Command.Prepare (runPrepare)+import Valiant.CLI.Command.Types (runTypes)+import Valiant.CLI.Command.Watch (runWatch)+import Valiant.CLI.Config (AppEnv (..), resolveEnv)+import Options.Applicative+import System.Exit (ExitCode, exitWith)++-- | Entry point for the @valiant@ CLI.+run :: IO ()+run = do+  opts <- execParser parserInfo+  env <- resolveEnv (optSqlDir opts) (optCacheDir opts) (optDatabaseUrl opts) (optVerbose opts)+  code <- dispatch env (optCommand opts)+  exitWith code++-- CLI option types --------------------------------------------------------++data Opts = Opts+  { optSqlDir :: FilePath+  , optCacheDir :: FilePath+  , optDatabaseUrl :: Maybe String+  , optVerbose :: Bool+  , optCommand :: Command+  }++data PrepareOpts = PrepareOpts+  { prepInlineDirs :: [FilePath]+  -- ^ Directories to scan for inline @query "..."@ calls in @.hs@ files.+  }++data Command+  = CmdPrepare PrepareOpts+  | CmdCheck+  | CmdTypes (Maybe FilePath)+  | CmdGenerate GenerateOpts+  | CmdWatch++-- Dispatch ----------------------------------------------------------------++dispatch :: AppEnv -> Command -> IO ExitCode+dispatch env = \case+  CmdPrepare opts -> runPrepare env (prepInlineDirs opts)+  CmdCheck -> runCheck env+  CmdTypes mFile -> runTypes env mFile+  CmdGenerate opts -> runGenerate env opts+  CmdWatch -> runWatch env++-- Parsers -----------------------------------------------------------------++parserInfo :: ParserInfo Opts+parserInfo =+  info+    (optsParser <**> helper)+    ( fullDesc+        <> header "valiant — compile-time checked SQL for Haskell"+        <> progDesc "Validate .sql files against a live Postgres database and cache type metadata."+    )++optsParser :: Parser Opts+optsParser =+  Opts+    <$> strOption+      ( long "sql-dir"+          <> metavar "DIR"+          <> value "sql"+          <> showDefault+          <> help "Directory containing .sql files"+      )+    <*> strOption+      ( long "cache-dir"+          <> metavar "DIR"+          <> value ".valiant"+          <> showDefault+          <> help "Directory for cached query metadata"+      )+    <*> optional+      ( strOption+          ( long "database-url"+              <> metavar "URL"+              <> help "PostgreSQL connection URL (overrides DATABASE_URL env var)"+          )+      )+    <*> switch+      ( long "verbose"+          <> short 'v'+          <> help "Enable verbose output"+      )+    <*> commandParser++commandParser :: Parser Command+commandParser =+  subparser+    ( command "prepare"+        ( info+            ( CmdPrepare . PrepareOpts+                <$> many+                  ( strOption+                      ( long "inline"+                          <> metavar "DIR"+                          <> help "Scan .hs files in DIR for inline query \"...\" calls"+                      )+                  )+            )+            (progDesc "Prepare all .sql files (and inline queries) against the database")+        )+        <> command "check" (info (pure CmdCheck) (progDesc "Check that all cache files are current"))+        <> command+          "types"+          ( info+              ( CmdTypes+                  <$> optional (argument str (metavar "FILE" <> help "Show types for a specific .sql file"))+              )+              (progDesc "Print inferred Haskell types for queries")+          )+        <> command+          "generate"+          ( info+              ( CmdGenerate+                  <$> ( GenerateOpts+                          <$> strOption+                            ( long "module-prefix"+                                <> metavar "PREFIX"+                                <> value "Queries"+                                <> showDefault+                                <> help "Module name prefix for generated modules"+                            )+                          <*> strOption+                            ( long "output-dir"+                                <> metavar "DIR"+                                <> value "src"+                                <> showDefault+                                <> help "Output directory for generated Haskell files"+                            )+                      )+              )+              (progDesc "Generate Haskell binding modules from .sql files")+          )+        <> command "watch" (info (pure CmdWatch) (progDesc "Watch .sql files for changes and re-prepare"))+    )
+ src/Valiant/CLI/Cache.hs view
@@ -0,0 +1,246 @@+module Valiant.CLI.Cache+  ( CacheEntry (..)+  , CacheParam (..)+  , CacheColumn (..)+  , StatementType (..)+  , writeCacheEntry+  , readCacheEntry+  , findCacheFile+  , cacheFileName+  , statementTypeFromSql+  , ensureCacheDir+  ) where++import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), eitherDecodeStrict, object, withObject, withText, (.:), (.:?), (.=))+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import Data.List (find, isSuffixOf)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime)+import Data.Word (Word32)+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, listDirectory, renameFile)+import System.FilePath ((</>))++-- | The full cache entry written to a @.valiant/*.json@ file.+data CacheEntry = CacheEntry+  { ceVersion :: Text+  , ceFile :: FilePath+  , ceSqlHash :: Text+  , ceSql :: Text+  , ceDbUrlHash :: Text+  , cePreparedAt :: UTCTime+  , ceStatementType :: StatementType+  , ceParams :: [CacheParam]+  , ceColumns :: [CacheColumn]+  }+  deriving stock (Show, Eq)++data StatementType = Select | Insert | Update | Delete | Other+  deriving stock (Show, Eq)++data CacheParam = CacheParam+  { cpIndex :: Int+  , cpName :: Maybe Text+  -- ^ Named parameter name from @:name@ syntax. 'Nothing' for positional @$N@.+  , cpPgOid :: Word32+  , cpPgTypeName :: Text+  , cpHaskellType :: Text+  , cpHaskellModule :: Text+  , cpPgTypeCategory :: Maybe Text+  -- ^ @\"enum\"@, @\"domain\"@, @\"range\"@, etc. 'Nothing' for built-in types.+  , cpPgEnumLabels :: Maybe [Text]+  -- ^ Enum labels from @pg_enum@, if this is an enum type.+  }+  deriving stock (Show, Eq)++data CacheColumn = CacheColumn+  { ccName :: Text+  , ccPgOid :: Word32+  , ccPgTypeName :: Text+  , ccNullable :: Bool+  , ccHaskellType :: Text+  , ccHaskellModule :: Text+  , ccSourceTableOid :: Maybe Word32+  , ccSourceColumnNum :: Maybe Int+  , ccPgTypeCategory :: Maybe Text+  -- ^ @\"enum\"@, @\"domain\"@, @\"range\"@, etc. 'Nothing' for built-in types.+  , ccPgEnumLabels :: Maybe [Text]+  -- ^ Enum labels from @pg_enum@, if this is an enum type.+  }+  deriving stock (Show, Eq)++-- JSON instances ----------------------------------------------------------++instance ToJSON CacheEntry where+  toJSON CacheEntry {..} =+    object+      [ "valiant_version" .= ceVersion+      , "file" .= ceFile+      , "sql_hash" .= ceSqlHash+      , "sql" .= ceSql+      , "database_url_hash" .= ceDbUrlHash+      , "prepared_at" .= cePreparedAt+      , "statement_type" .= ceStatementType+      , "parameters" .= ceParams+      , "columns" .= ceColumns+      ]++instance FromJSON CacheEntry where+  parseJSON = withObject "CacheEntry" $ \o ->+    CacheEntry+      <$> o .: "valiant_version"+      <*> o .: "file"+      <*> o .: "sql_hash"+      <*> o .: "sql"+      <*> o .: "database_url_hash"+      <*> o .: "prepared_at"+      <*> o .: "statement_type"+      <*> o .: "parameters"+      <*> o .: "columns"++instance ToJSON StatementType where+  toJSON = \case+    Select -> String "select"+    Insert -> String "insert"+    Update -> String "update"+    Delete -> String "delete"+    Other -> String "other"++instance FromJSON StatementType where+  parseJSON = withText "StatementType" $ \case+    "select" -> pure Select+    "insert" -> pure Insert+    "update" -> pure Update+    "delete" -> pure Delete+    _ -> pure Other++instance ToJSON CacheParam where+  toJSON CacheParam {..} =+    object+      [ "index" .= cpIndex+      , "name" .= cpName+      , "pg_oid" .= cpPgOid+      , "pg_type_name" .= cpPgTypeName+      , "haskell_type" .= cpHaskellType+      , "haskell_module" .= cpHaskellModule+      , "pg_type_category" .= cpPgTypeCategory+      , "pg_enum_labels" .= cpPgEnumLabels+      ]++instance FromJSON CacheParam where+  parseJSON = withObject "CacheParam" $ \o ->+    CacheParam+      <$> o .: "index"+      <*> o .:? "name"+      <*> o .: "pg_oid"+      <*> o .: "pg_type_name"+      <*> o .: "haskell_type"+      <*> o .: "haskell_module"+      <*> o .:? "pg_type_category"+      <*> o .:? "pg_enum_labels"++instance ToJSON CacheColumn where+  toJSON CacheColumn {..} =+    object+      [ "name" .= ccName+      , "pg_oid" .= ccPgOid+      , "pg_type_name" .= ccPgTypeName+      , "nullable" .= ccNullable+      , "haskell_type" .= ccHaskellType+      , "haskell_module" .= ccHaskellModule+      , "source_table_oid" .= ccSourceTableOid+      , "source_column_number" .= ccSourceColumnNum+      , "pg_type_category" .= ccPgTypeCategory+      , "pg_enum_labels" .= ccPgEnumLabels+      ]++instance FromJSON CacheColumn where+  parseJSON = withObject "CacheColumn" $ \o ->+    CacheColumn+      <$> o .: "name"+      <*> o .: "pg_oid"+      <*> o .: "pg_type_name"+      <*> o .: "nullable"+      <*> o .: "haskell_type"+      <*> o .: "haskell_module"+      <*> o .:? "source_table_oid"+      <*> o .:? "source_column_number"+      <*> o .:? "pg_type_category"+      <*> o .:? "pg_enum_labels"++-- File operations ---------------------------------------------------------++-- | Ensure the cache directory exists.+ensureCacheDir :: FilePath -> IO ()+ensureCacheDir = createDirectoryIfMissing True++-- | Write a 'CacheEntry' to disk as pretty-printed JSON.+-- Uses write-to-temp-then-rename for atomicity: a crash mid-write+-- cannot leave a corrupted cache file.+writeCacheEntry :: FilePath -> CacheEntry -> IO ()+writeCacheEntry cacheDir entry = do+  ensureCacheDir cacheDir+  let fileName = cacheFileName (ceFile entry) (T.take 12 (ceSqlHash entry))+      path = cacheDir </> fileName+      tmpPath = path <> ".tmp"+  LBS.writeFile tmpPath (encodePretty entry)+  renameFile tmpPath path++-- | Read a 'CacheEntry' from a JSON file.+readCacheEntry :: FilePath -> IO (Either String CacheEntry)+readCacheEntry path = do+  -- Strict read: closes the handle before decoding, avoiding the+  -- lazy-I/O handle leak when callers ignore the result on error.+  bytes <- BS.readFile path+  pure (eitherDecodeStrict bytes)++-- | Find a cache file matching the given SQL file path and content hash.+findCacheFile :: FilePath -> FilePath -> Text -> IO (Maybe CacheEntry)+findCacheFile cacheDir sqlRelPath sqlHash = do+  exists <- doesDirectoryExist cacheDir+  if not exists+    then pure Nothing+    else do+      files <- listDirectory cacheDir+      let hashShort = T.take 12 sqlHash+          expected = cacheFileName sqlRelPath hashShort+      case find (== expected) files of+        Nothing -> pure Nothing+        Just f -> do+          result <- readCacheEntry (cacheDir </> f)+          pure $ case result of+            Left _ -> Nothing+            Right entry+              | ceSqlHash entry == sqlHash -> Just entry+              | otherwise -> Nothing++-- | Generate a cache file name from an SQL relative path and truncated hash.+--+-- >>> cacheFileName "users/find_by_id.sql" "a1b2c3d4e5f6"+-- "users-find_by_id-a1b2c3d4e5f6.json"+cacheFileName :: FilePath -> Text -> FilePath+cacheFileName sqlRelPath hashShort =+  T.unpack (slug <> "-" <> hashShort) <> ".json"+  where+    slug =+      T.replace "/" "-" . T.replace "\\" "-" . T.pack $+        dropSqlExt sqlRelPath++    dropSqlExt "<inline>" = "inline"+    dropSqlExt p+      | ".sql" `isSuffixOf` p = take (length p - 4) p+      | otherwise = p++-- | Infer the statement type from the SQL text.+statementTypeFromSql :: Text -> StatementType+statementTypeFromSql sql =+  case T.words (T.toCaseFold (T.stripStart sql)) of+    (w : _)+      | w == "select" -> Select+      | w == "insert" -> Insert+      | w == "update" -> Update+      | w == "delete" -> Delete+      | w == "with" -> Select -- CTEs are usually selects+    _ -> Other
+ src/Valiant/CLI/Command/Check.hs view
@@ -0,0 +1,49 @@+module Valiant.CLI.Command.Check+  ( runCheck+  ) where++import Data.Text qualified as T+import Valiant.CLI.Cache (findCacheFile)+import Valiant.CLI.Config (AppEnv (..))+import Valiant.CLI.Discover (SqlFile (..), discoverSqlFiles)+import Valiant.CLI.Error (ValiantCliError (..), dieWithError)+import Valiant.CLI.Output+import System.Exit (ExitCode (..))++runCheck :: AppEnv -> IO ExitCode+runCheck env = do+  printHeader $ "Checking queries in " <> T.pack (appSqlDir env) <> " ..."++  files <- discoverSqlFiles (appSqlDir env)+  case files of+    [] -> dieWithError (ErrNoSqlFiles (appSqlDir env))+    _ -> pure ()++  let total = length files+  printLn $ "  Checking " <> T.pack (show total) <> " queries..."+  printLn ""++  results <- mapM (checkFile env total) (zip [1 ..] files)+  let okCount = length (filter id results)+  printSummary okCount total++  if okCount == total+    then do+      printLn "  All cache files are current."+      pure ExitSuccess+    else do+      printLn ""+      printLn "  Run `valiant prepare` to update stale or missing cache files."+      pure (ExitFailure 1)++checkFile :: AppEnv -> Int -> (Int, SqlFile) -> IO Bool+checkFile env total (idx, sqlFile) = do+  printProgress idx total (sqlRelPath sqlFile)+  mEntry <- findCacheFile (appCacheDir env) (sqlRelPath sqlFile) (sqlHash sqlFile)+  case mEntry of+    Just _ -> do+      printOk+      pure True+    Nothing -> do+      printStale+      pure False
+ src/Valiant/CLI/Command/Generate.hs view
@@ -0,0 +1,258 @@+module Valiant.CLI.Command.Generate+  ( runGenerate+  , GenerateOpts (..)+  ) where++import Data.Char (toUpper)+import Data.List (intercalate, nub, sort)+import Data.List qualified as List+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Valiant.CLI.Cache (CacheColumn (..), CacheEntry (..), CacheParam (..), StatementType (..), findCacheFile)+import Valiant.CLI.Config (AppEnv (..))+import Valiant.CLI.Discover (SqlFile (..), discoverSqlFiles)+import Valiant.CLI.Error (ValiantCliError (..), dieWithError)+import Valiant.CLI.Output+import Valiant.CLI.SqlMetadata (SqlMetadata (..), parseSqlMetadata)+import System.Directory (createDirectoryIfMissing, renameFile)+import System.Exit (ExitCode (..))+import System.FilePath (takeBaseName, takeDirectory, (</>))++data GenerateOpts = GenerateOpts+  { genModulePrefix :: String+  , genOutputDir :: FilePath+  }+  deriving stock (Show)++runGenerate :: AppEnv -> GenerateOpts -> IO ExitCode+runGenerate env opts = do+  files <- discoverSqlFiles (appSqlDir env)+  case files of+    [] -> dieWithError (ErrNoSqlFiles (appSqlDir env))+    _ -> pure ()++  -- Group SQL files by their parent directory → one module per directory+  let grouped = groupByDirectory files+  results <- mapM (generateModule env opts) (Map.toAscList grouped)+  let okCount = length (filter id results)+      total = length results+  if okCount == total+    then pure ExitSuccess+    else pure (ExitFailure 1)++-- | Group SQL files by their first directory component.+-- @users/find_by_id.sql@ → key @"users"@, @posts/insert.sql@ → key @"posts"@+-- Files at the root go under key @""@.+groupByDirectory :: [SqlFile] -> Map String [SqlFile]+groupByDirectory = List.foldl' go Map.empty+  where+    go acc sf =+      let dir = takeDirectory (sqlRelPath sf)+          key = if dir == "." then "" else dir+       in Map.insertWith (++) key [sf] acc++-- | Generate a single Haskell module for a group of SQL files.+generateModule :: AppEnv -> GenerateOpts -> (String, [SqlFile]) -> IO Bool+generateModule env opts (dirKey, files) = do+  -- Load cache entries for all files+  entries <- mapM (loadEntry env) files+  let pairs = [(sf, e) | (sf, Just e) <- zip files entries]+  if null pairs+    then do+      printLn $ "  Skipping " <> T.pack dirKey <> " (no cache entries)"+      pure False+    else do+      let moduleName = buildModuleName (genModulePrefix opts) dirKey+          modulePath = genOutputDir opts </> moduleNameToPath moduleName+          content = renderModule env moduleName pairs+      createDirectoryIfMissing True (takeDirectory modulePath)+      let tmpPath = modulePath <> ".tmp"+      writeFile tmpPath content+      renameFile tmpPath modulePath+      printLn $+        "  Generated "+          <> T.pack modulePath+          <> " ("+          <> T.pack (show (length pairs))+          <> " queries)"+      pure True++loadEntry :: AppEnv -> SqlFile -> IO (Maybe CacheEntry)+loadEntry env sf = findCacheFile (appCacheDir env) (sqlRelPath sf) (sqlHash sf)++-- Module name construction ------------------------------------------------++buildModuleName :: String -> String -> String+buildModuleName prefix dirKey+  | null dirKey = prefix+  | otherwise = prefix <> "." <> toPascalCase dirKey++toPascalCase :: String -> String+toPascalCase = concatMap capitalize . splitOn '/'+  where+    capitalize [] = []+    capitalize (c : cs) = toUpper c : cs++    splitOn _ [] = []+    splitOn sep s =+      let (w, rest) = break (== sep) s+       in w : case rest of+            [] -> []+            (_ : rs) -> splitOn sep rs++moduleNameToPath :: String -> FilePath+moduleNameToPath = (<> ".hs") . map (\c -> if c == '.' then '/' else c)++-- Rendering ---------------------------------------------------------------++renderModule :: AppEnv -> String -> [(SqlFile, CacheEntry)] -> String+renderModule env moduleName pairs =+  unlines $+    [ "-- AUTO-GENERATED by valiant generate. Edit as needed."+    , "-- Re-run: valiant generate --module-prefix " <> takeWhile (/= '.') moduleName <> " --output-dir ..."+    , "{-# OPTIONS_GHC -fplugin=Valiant.Plugin"+    , "                -fplugin-opt=Valiant.Plugin:sql-dir=" <> appSqlDir env+    , "                -fplugin-opt=Valiant.Plugin:cache-dir=" <> appCacheDir env <> " #-}"+    , "module " <> moduleName <> " where"+    , ""+    , "import Valiant"+    ]+      <> renderImports pairs+      <> [""]+      <> concatMap renderBinding pairs++renderImports :: [(SqlFile, CacheEntry)] -> [String]+renderImports pairs =+  let -- Group by module and collect types+      grouped = Map.toAscList $ List.foldl' groupImport Map.empty (concatMap collectImports pairs)+   in map renderImportLine grouped++collectImports :: (SqlFile, CacheEntry) -> [(String, String)]+collectImports (_, entry) =+  [(T.unpack (cpHaskellModule p), baseType (T.unpack (cpHaskellType p))) | p <- ceParams entry]+    <> [(T.unpack (ccHaskellModule c), baseType (T.unpack (ccHaskellType c))) | c <- ceColumns entry]++-- Strip "Maybe " prefix to get the base type for import+baseType :: String -> String+baseType ('M' : 'a' : 'y' : 'b' : 'e' : ' ' : rest) = rest+baseType t = t++groupImport :: Map String [String] -> (String, String) -> Map String [String]+groupImport acc (modName, typeName)+  | modName == "Prelude" = acc+  | otherwise = Map.insertWith (\new old -> nub (old ++ new)) modName [typeName] acc++renderImportLine :: (String, [String]) -> String+renderImportLine (modName, types) =+  "import " <> modName <> " (" <> intercalate ", " (sort (nub types)) <> ")"++renderBinding :: (SqlFile, CacheEntry) -> [String]+renderBinding (sf, entry) =+  let meta = parseSqlMetadata (TE.decodeUtf8 (sqlContent sf))+      bindName = case smName meta of+        Just name -> T.unpack name+        Nothing -> sqlFileToBindingName (sqlRelPath sf)+      paramType = formatParamType (ceParams entry)+      resultType = case smResult meta of+        Just typeName ->+          let wrap = resultWrapper (sqlRelPath sf) (smSingle meta) (ceStatementType entry) (ceColumns entry)+           in wrap (T.unpack typeName)+        Nothing -> formatResultType (sqlRelPath sf) (smSingle meta) (ceStatementType entry) (ceColumns entry)+      queryFn = case smResult meta of+        Just typeName -> "queryFileAs @" <> T.unpack typeName+        Nothing -> "queryFile"+      sqlComment = T.unpack (T.takeWhile (/= '\n') (ceSql entry))+   in [ ""+      , "-- " <> sqlRelPath sf+      , "-- " <> sqlComment+      , bindName <> " :: Statement " <> paramType <> " " <> resultType+      , bindName <> " = " <> queryFn <> " " <> show (sqlRelPath sf)+      ]++-- | Convert @users/find_by_id.sql@ → @findById@+sqlFileToBindingName :: FilePath -> String+sqlFileToBindingName path = snakeToCamel (takeBaseName path)++snakeToCamel :: String -> String+snakeToCamel [] = []+snakeToCamel s =+  let (word, rest) = break (== '_') s+   in word <> case rest of+        [] -> []+        (_ : rs) -> capitalize rs+  where+    capitalize [] = []+    capitalize (c : cs) =+      let (w, rest') = break (== '_') (c : cs)+       in case w of+            (x : xs) -> (toUpper x : xs) <> case rest' of+              [] -> []+              (_ : rs) -> capitalize rs+            [] -> case rest' of+              [] -> []+              (_ : rs) -> capitalize rs++formatParamType :: [CacheParam] -> String+formatParamType [] = "()"+formatParamType [p] = parensIfNeeded (T.unpack (cpHaskellType p))+formatParamType ps = "(" <> intercalate ", " (map (T.unpack . cpHaskellType) ps) <> ")"++formatResultType :: FilePath -> Bool -> StatementType -> [CacheColumn] -> String+formatResultType sqlPath single stmtType cols = case cols of+  [] -> "()"+  _ ->+    let inner = case cols of+          [c] -> parensIfNeeded (T.unpack (ccHaskellType c))+          cs -> "(" <> intercalate ", " (map (T.unpack . ccHaskellType) cs) <> ")"+     in if single+          then inner+          else inferReturnWrapper sqlPath stmtType cols inner++-- | Determine the wrapper for a named result type based on SQL conventions and metadata.+resultWrapper :: FilePath -> Bool -> StatementType -> [CacheColumn] -> String -> String+resultWrapper sqlPath single stmtType cols typeName+  | single = typeName+  | otherwise = inferReturnWrapper sqlPath stmtType cols typeName++-- | Infer the return type wrapper from the SQL file name prefix.+-- The naming convention follows the roadmap:+--+--   * @find_*@ → @Maybe r@ (zero or one row)+--   * @get_*@  → @r@ (exactly one row, no wrapper)+--   * @list_*@ → @[r]@ (multiple rows)+--   * @count_*@ → scalar type directly (no tuple, no wrapper)+--   * @exists_*@ → @Bool@+--   * @insert*@/@update_*@/@delete_*@/@upsert_*@ → @()@ when no columns+--   * default  → no wrapper (raw type)+inferReturnWrapper :: FilePath -> StatementType -> [CacheColumn] -> String -> String+inferReturnWrapper sqlPath _stmtType cols inner+  | "find_" `isPrefixOfBase` base = "(Maybe " <> inner <> ")"+  | "list_" `isPrefixOfBase` base = "[" <> inner <> "]"+  | "count_" `isPrefixOfBase` base = case cols of+      [c] -> parensIfNeeded (T.unpack (ccHaskellType c))+      _ -> inner+  | "exists_" `isPrefixOfBase` base = "Bool"+  | "get_" `isPrefixOfBase` base = inner+  | isCommandPrefix base, null cols = "()"+  | isCommandPrefix base = inner+  | otherwise = inner+  where+    base = takeBaseName sqlPath++    isPrefixOfBase :: String -> String -> Bool+    isPrefixOfBase prefix str = take (length prefix) str == prefix++    isCommandPrefix :: String -> Bool+    isCommandPrefix b =+      "insert" `isPrefixOfBase` b+        || "update_" `isPrefixOfBase` b+        || "delete_" `isPrefixOfBase` b+        || "upsert_" `isPrefixOfBase` b++-- | Wrap in parens if the type contains spaces (e.g. "Maybe Text" → "(Maybe Text)")+parensIfNeeded :: String -> String+parensIfNeeded s+  | ' ' `elem` s = "(" <> s <> ")"+  | otherwise = s
+ src/Valiant/CLI/Command/Prepare.hs view
@@ -0,0 +1,251 @@+module Valiant.CLI.Command.Prepare+  ( runPrepare+  ) where++import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Time.Clock (UTCTime, getCurrentTime)+import Data.Word (Word32)+import PgWire.Connection (Connection)+import PgWire.Protocol.Oid (Oid (..))+import Valiant.CLI.Cache+import Valiant.CLI.Config (AppEnv (..))+import Valiant.CLI.Describe (ColumnMeta (..), DescribeError (..), ParamMeta (..), QueryMeta (..), describeQuery, withPgConnection)+import Valiant.CLI.Discover (SqlFile (..), discoverSqlFiles, discoverInlineSql)+import System.FilePath.Glob qualified as Glob+import Valiant.CLI.Error (ValiantCliError (..), dieWithError)+import Valiant.CLI.Hash (sha256Hex)+import Valiant.CLI.Nullability (resolveNullability)+import Valiant.CLI.Output+import Valiant.CLI.CustomTypes (CustomTypeMap, customTypesFile, loadCustomTypes)+import Valiant.CLI.NamedParams (NamedParamMapping, preprocessNamedParams)+import Valiant.CLI.TypeMap (HaskellType (..), ResolvedType (..), oidToHaskellTypeWith, oidToTypeNameWith, resolveType, resolveUnknownOid)+import System.Exit (ExitCode (..))++runPrepare :: AppEnv -> [FilePath] -> IO ExitCode+runPrepare env inlineDirs = do+  dbUrl <- case appDatabaseUrl env of+    Nothing -> dieWithError ErrNoDatabaseUrl+    Just url -> pure url++  printHeader $ "Using database " <> maskPassword (TE.decodeUtf8 dbUrl)+  printHeader $ "Scanning " <> T.pack (appSqlDir env) <> " for .sql files..."++  sqlFiles <- discoverSqlFiles (appSqlDir env)++  -- Discover inline SQL from Haskell source if --inline dirs provided+  inlineFiles <- case inlineDirs of+    [] -> pure []+    dirs -> do+      hsPaths <- concat <$> mapM discoverHsFiles dirs+      inlines <- discoverInlineSql hsPaths+      case inlines of+        [] -> pure []+        _ -> do+          printLn $ "  Found " <> T.pack (show (length inlines)) <> " inline queries in .hs files"+          pure inlines++  let files = sqlFiles <> inlineFiles+  case files of+    [] -> dieWithError (ErrNoSqlFiles (appSqlDir env))+    _ -> printLn $ "  Found " <> T.pack (show (length files)) <> " queries total"++  printLn ""++  customs <- loadCustomTypes customTypesFile+  let total = length files++  withPgConnection dbUrl $ \conn -> do+    results <- mapM (processFile env customs conn total) (zip [1 ..] files)+    let okCount = length (filter id results)+    printSummary okCount total+    printLn $ "  Wrote " <> T.pack (show okCount) <> " cache files to " <> T.pack (appCacheDir env) <> "/"+    pure $+      if okCount == total+        then ExitSuccess+        else ExitFailure 1++-- | Discover all .hs files in a directory tree.+discoverHsFiles :: FilePath -> IO [FilePath]+discoverHsFiles dir = do+  let pat = Glob.compile "**/*.hs"+  matched <- Glob.globDir [pat] dir+  pure (concat matched)++processFile :: AppEnv -> CustomTypeMap -> Connection -> Int -> (Int, SqlFile) -> IO Bool+processFile env customs conn total (idx, sqlFile) = do+  printProgress idx total (sqlRelPath sqlFile)++  -- Check if cache is already current+  existing <- findCacheFile (appCacheDir env) (sqlRelPath sqlFile) (sqlHash sqlFile)+  case existing of+    Just _ -> do+      printOk+      pure True+    Nothing -> do+      -- Preprocess :name → $N before sending to Postgres+      let (rewrittenSql, nameMapping) = preprocessNamedParams (sqlContent sqlFile)+          prepFile = sqlFile {sqlContent = rewrittenSql}+      result <- describeQuery conn prepFile+      case result of+        Left err -> do+          printFailed (deMessage err)+          pure False+        Right meta -> do+          nullabilities <- resolveNullability conn (qmColumns meta)+          now <- getCurrentTime+          buildResult <- buildCacheEntry env customs conn sqlFile meta nullabilities nameMapping now+          case buildResult of+            Left errMsg -> do+              printFailed errMsg+              pure False+            Right entry -> do+              writeCacheEntry (appCacheDir env) entry+              printOk+              pure True++buildCacheEntry+  :: AppEnv+  -> CustomTypeMap+  -> Connection+  -> SqlFile+  -> QueryMeta+  -> [Bool]+  -> NamedParamMapping+  -> UTCTime+  -> IO (Either Text CacheEntry)+buildCacheEntry env customs conn sqlFile meta nullabilities nameMapping now = do+  let nameMap = Map.fromList [(idx, name) | (name, idx) <- nameMapping]+  eParams <- resolveParams customs conn nameMap (qmParams meta)+  case eParams of+    Left err -> pure (Left err)+    Right params -> do+      eColumns <- resolveColumns customs conn (zip (qmColumns meta) nullabilities)+      case eColumns of+        Left err -> pure (Left err)+        Right columns -> do+          let sqlText = TE.decodeUtf8 (sqlContent sqlFile)+          pure . Right $+            CacheEntry+              { ceVersion = "0.1.0"+              , ceFile = sqlRelPath sqlFile+              , ceSqlHash = sqlHash sqlFile+              , ceSql = sqlText+              , ceDbUrlHash = maybe "" sha256Hex (appDatabaseUrl env)+              , cePreparedAt = now+              , ceStatementType = statementTypeFromSql sqlText+              , ceParams = params+              , ceColumns = columns+              }++resolveParams :: CustomTypeMap -> Connection -> Map.Map Int Text -> [ParamMeta] -> IO (Either Text [CacheParam])+resolveParams customs conn nameMap = go []+  where+    go !acc [] = pure (Right (reverse acc))+    go !acc (pm : pms) = do+      result <- resolveParam customs conn nameMap pm+      case result of+        Left err -> pure (Left err)+        Right cp -> go (cp : acc) pms++resolveParam :: CustomTypeMap -> Connection -> Map.Map Int Text -> ParamMeta -> IO (Either Text CacheParam)+resolveParam customs conn nameMap ParamMeta {..} =+  let Oid oid = pmOid+      paramName = Map.lookup pmIndex nameMap+      paramLabel = case paramName of+        Just n -> ":" <> n+        Nothing -> "$" <> T.pack (show pmIndex)+   in case oidToHaskellTypeWith customs pmOid of+        Just ht ->+          pure . Right $+            CacheParam+              { cpIndex = pmIndex+              , cpName = paramName+              , cpPgOid = fromIntegral oid+              , cpPgTypeName = fromMaybe "unknown" (oidToTypeNameWith mempty pmOid)+              , cpHaskellType = htType ht+              , cpHaskellModule = htModule ht+              , cpPgTypeCategory = Nothing+              , cpPgEnumLabels = Nothing+              }+        Nothing -> do+          -- Auto-discover via pg_type+          resolved <- resolveUnknownOid conn customs pmOid+          case resolved of+            Left err ->+              pure . Left $ err <> " for parameter " <> paramLabel+            Right rt ->+              pure . Right $+                CacheParam+                  { cpIndex = pmIndex+                  , cpName = paramName+                  , cpPgOid = fromIntegral oid+                  , cpPgTypeName = rtPgTypeName rt+                  , cpHaskellType = htType (rtHaskellType rt)+                  , cpHaskellModule = htModule (rtHaskellType rt)+                  , cpPgTypeCategory = rtCategory rt+                  , cpPgEnumLabels = rtEnumLabels rt+                  }++resolveColumns :: CustomTypeMap -> Connection -> [(ColumnMeta, Bool)] -> IO (Either Text [CacheColumn])+resolveColumns customs conn = go []+  where+    go !acc [] = pure (Right (reverse acc))+    go !acc ((cm, nullable) : rest) = do+      result <- resolveColumn customs conn cm nullable+      case result of+        Left err -> pure (Left err)+        Right cc -> go (cc : acc) rest++resolveColumn :: CustomTypeMap -> Connection -> ColumnMeta -> Bool -> IO (Either Text CacheColumn)+resolveColumn customs conn ColumnMeta {..} nullable =+  let Oid oid = cmOid+      Oid tOid = cmTableOid+      tOidW32 = fromIntegral tOid :: Word32+      mkColumn ht cat labels =+        CacheColumn+          { ccName = cmName+          , ccPgOid = fromIntegral oid+          , ccPgTypeName = fromMaybe "unknown" (oidToTypeNameWith mempty cmOid)+          , ccNullable = nullable+          , ccHaskellType = htType (resolveType nullable ht)+          , ccHaskellModule = htModule ht+          , ccSourceTableOid = if tOidW32 == 0 then Nothing else Just tOidW32+          , ccSourceColumnNum = if cmColumnNumber == 0 then Nothing else Just cmColumnNumber+          , ccPgTypeCategory = cat+          , ccPgEnumLabels = labels+          }+   in case oidToHaskellTypeWith customs cmOid of+        Just baseHt ->+          pure . Right $ mkColumn baseHt Nothing Nothing+        Nothing -> do+          resolved <- resolveUnknownOid conn customs cmOid+          case resolved of+            Left err ->+              pure . Left $ err <> " for column \"" <> cmName <> "\""+            Right rt ->+              pure . Right $+                (mkColumn (rtHaskellType rt) (rtCategory rt) (rtEnumLabels rt))+                  { ccPgTypeName = rtPgTypeName rt+                  }++-- | Mask the password in a connection URL for display.+maskPassword :: Text -> Text+maskPassword url =+  case T.breakOn "://" url of+    (scheme, rest)+      | T.null rest -> url+      | otherwise ->+          let afterScheme = T.drop 3 rest+           in case T.breakOn "@" afterScheme of+                (_, hostPart)+                  | T.null hostPart -> url+                  | otherwise ->+                      case T.breakOn ":" afterScheme of+                        (user, passAndHost)+                          | T.null passAndHost -> url+                          | otherwise ->+                              scheme <> "://" <> user <> ":***" <> T.dropWhile (/= '@') passAndHost
+ src/Valiant/CLI/Command/Types.hs view
@@ -0,0 +1,55 @@+module Valiant.CLI.Command.Types+  ( runTypes+  ) where++import Data.Text (Text)+import Data.Text qualified as T+import Valiant.CLI.Cache (CacheColumn (..), CacheEntry (..), CacheParam (..), findCacheFile)+import Valiant.CLI.Config (AppEnv (..))+import Valiant.CLI.Discover (SqlFile (..), discoverSqlFiles)+import Valiant.CLI.Error (ValiantCliError (..), dieWithError)+import Valiant.CLI.Output+import System.Exit (ExitCode (..))++runTypes :: AppEnv -> Maybe FilePath -> IO ExitCode+runTypes env mFilter = do+  allFiles <- discoverSqlFiles (appSqlDir env)+  let files = case mFilter of+        Nothing -> allFiles+        Just f -> filter (\sf -> f == sqlRelPath sf) allFiles++  case files of+    [] -> dieWithError (ErrNoSqlFiles (appSqlDir env))+    _ -> pure ()++  results <- mapM (showTypes env) files+  pure $+    if and results+      then ExitSuccess+      else ExitFailure 1++showTypes :: AppEnv -> SqlFile -> IO Bool+showTypes env sqlFile = do+  mEntry <- findCacheFile (appCacheDir env) (sqlRelPath sqlFile) (sqlHash sqlFile)+  case mEntry of+    Nothing -> do+      printLn $ "  " <> T.pack (sqlRelPath sqlFile)+      printLn "    (no cache — run `valiant prepare`)"+      printLn ""+      pure False+    Just entry -> do+      printLn $ "  " <> T.pack (ceFile entry)+      printLn $ "    Params: " <> formatParamType (ceParams entry)+      printLn $ "    Result: " <> formatResultType (ceColumns entry)+      printLn ""+      pure True++formatParamType :: [CacheParam] -> Text+formatParamType [] = "()"+formatParamType [p] = cpHaskellType p+formatParamType ps = "(" <> T.intercalate ", " (map cpHaskellType ps) <> ")"++formatResultType :: [CacheColumn] -> Text+formatResultType [] = "()"+formatResultType [c] = ccHaskellType c+formatResultType cs = "(" <> T.intercalate ", " (map ccHaskellType cs) <> ")"
+ src/Valiant/CLI/Command/Watch.hs view
@@ -0,0 +1,90 @@+module Valiant.CLI.Command.Watch+  ( runWatch+  ) where++import Control.Concurrent (threadDelay)+import Control.Monad (forever, unless)+import Data.IORef+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Valiant.CLI.Command.Prepare (runPrepare)+import Valiant.CLI.Config (AppEnv (..))+import Valiant.CLI.Discover (SqlFile (..), discoverSqlFiles)+import Valiant.CLI.Error (ValiantCliError (..), dieWithError)+import Valiant.CLI.Output+import System.Directory (doesDirectoryExist)+import System.Exit (ExitCode (..))++-- | Run prepare in a loop, watching for SQL file changes.+-- Polls every 2 seconds (fsnotify can be added later for efficiency).+-- Automatically re-prepares when changes are detected.+runWatch :: AppEnv -> IO ExitCode+runWatch env = do+  _ <- case appDatabaseUrl env of+    Nothing -> dieWithError ErrNoDatabaseUrl+    Just _ -> pure ()++  exists <- doesDirectoryExist (appSqlDir env)+  unless exists $ dieWithError (ErrSqlDirNotFound (appSqlDir env))++  printHeader $ "Watching " <> T.pack (appSqlDir env) <> " for changes..."+  printLn ""++  -- Initial prepare+  printLn "  Running initial prepare..."+  _ <- runPrepare env []+  printLn ""++  -- Track known file hashes+  files <- discoverSqlFiles (appSqlDir env)+  hashRef <- newIORef (Map.fromList [(sqlRelPath sf, sqlHash sf) | sf <- files])++  -- Poll loop+  _ <- forever $ do+    threadDelay 2000000 -- 2 seconds+    scanAndPrepare env hashRef++  -- unreachable, but needed for type+  pure ExitSuccess++-- | Scan all SQL files, detect changes, report, and re-prepare if needed.+scanAndPrepare :: AppEnv -> IORef (Map FilePath Text) -> IO ()+scanAndPrepare env hashRef = do+  files <- discoverSqlFiles (appSqlDir env)+  oldHashes <- readIORef hashRef++  let newHashes = Map.fromList [(sqlRelPath sf, sqlHash sf) | sf <- files]+      changes = detectChanges oldHashes newHashes++  unless (null changes) $ do+    mapM_ reportChange changes+    printLn "  Re-preparing..."+    exitCode <- runPrepare env []+    case exitCode of+      ExitSuccess -> printLn ""+      ExitFailure _ -> printLn "  (Some queries failed. Fix the SQL and save again.)\n"++  -- Update stored hashes+  writeIORef hashRef newHashes++data FileChange+  = FileAdded FilePath+  | FileModified FilePath+  | FileDeleted FilePath++detectChanges :: Map FilePath Text -> Map FilePath Text -> [FileChange]+detectChanges old new =+  let added = [FileAdded k | k <- Map.keys new, not (Map.member k old)]+      modified = [FileModified k | (k, v) <- Map.toList new, Map.member k old, Map.lookup k old /= Just v]+      deleted = [FileDeleted k | k <- Map.keys old, not (Map.member k new)]+   in added ++ modified ++ deleted++reportChange :: FileChange -> IO ()+reportChange (FileAdded path) =+  printLn $ "  [+] " <> T.pack path <> " (new file)"+reportChange (FileModified path) =+  printLn $ "  [~] " <> T.pack path <> " (modified)"+reportChange (FileDeleted path) =+  printLn $ "  [-] " <> T.pack path <> " (deleted)"
+ src/Valiant/CLI/Config.hs view
@@ -0,0 +1,44 @@+module Valiant.CLI.Config+  ( AppEnv (..)+  , resolveEnv+  ) where++import Configuration.Dotenv (defaultConfig, loadFile)+import Control.Exception (SomeException, try)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as BS8+import System.Environment (lookupEnv)++-- | Resolved application environment for all commands.+data AppEnv = AppEnv+  { appSqlDir :: FilePath+  , appCacheDir :: FilePath+  , appDatabaseUrl :: Maybe ByteString+  , appVerbose :: Bool+  }+  deriving stock (Show)++-- | Load @.env@, then resolve the final 'AppEnv' from CLI options + environment.+resolveEnv+  :: FilePath+  -- ^ SQL directory (from CLI flag)+  -> FilePath+  -- ^ Cache directory (from CLI flag)+  -> Maybe String+  -- ^ Explicit DATABASE_URL (from CLI flag, overrides env)+  -> Bool+  -- ^ Verbose+  -> IO AppEnv+resolveEnv sqlDir cacheDir mDbUrl verbose = do+  -- Best-effort .env loading; ignore errors (file may not exist).+  _ <- try @SomeException $ loadFile defaultConfig+  dbUrl <- case mDbUrl of+    Just url -> pure (Just (BS8.pack url))+    Nothing -> fmap BS8.pack <$> lookupEnv "DATABASE_URL"+  pure+    AppEnv+      { appSqlDir = sqlDir+      , appCacheDir = cacheDir+      , appDatabaseUrl = dbUrl+      , appVerbose = verbose+      }
+ src/Valiant/CLI/CustomTypes.hs view
@@ -0,0 +1,63 @@+module Valiant.CLI.CustomTypes+  ( CustomTypeMap+  , loadCustomTypes+  , customTypesFile+  ) where++import Data.Aeson (FromJSON (..), eitherDecode, withObject, (.:))+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Word (Word32)+import PgWire.Protocol.Oid (Oid (..))+import Valiant.CLI.TypeMap (HaskellType (..))+import System.Directory (doesFileExist)++-- | User-defined OID → Haskell type mappings.+type CustomTypeMap = Map Oid HaskellType++-- | Default file name for custom type mappings.+customTypesFile :: FilePath+customTypesFile = "valiant-types.json"++-- | Load custom type mappings from a JSON file if it exists.+-- Returns an empty map if the file is absent.+--+-- Expected format:+--+-- > [+-- >   { "oid": 600, "pg_type_name": "point", "haskell_type": "MyPoint", "haskell_module": "MyApp.Types" },+-- >   { "oid": 16389, "pg_type_name": "mood", "haskell_type": "Text", "haskell_module": "Data.Text" }+-- > ]+loadCustomTypes :: FilePath -> IO CustomTypeMap+loadCustomTypes path = do+  exists <- doesFileExist path+  if not exists+    then pure Map.empty+    else do+      bytes <- LBS.readFile path+      case eitherDecode bytes of+        Left _ -> pure Map.empty+        Right entries -> pure (toMap entries)++toMap :: [CustomTypeEntry] -> CustomTypeMap+toMap = Map.fromList . map toPair+  where+    toPair CustomTypeEntry {..} =+      (Oid cteOid, HaskellType cteHaskellType cteHaskellModule)++data CustomTypeEntry = CustomTypeEntry+  { cteOid :: Word32+  , ctePgTypeName :: Text+  , cteHaskellType :: Text+  , cteHaskellModule :: Text+  }++instance FromJSON CustomTypeEntry where+  parseJSON = withObject "CustomTypeEntry" $ \o ->+    CustomTypeEntry+      <$> o .: "oid"+      <*> o .: "pg_type_name"+      <*> o .: "haskell_type"+      <*> o .: "haskell_module"
+ src/Valiant/CLI/Describe.hs view
@@ -0,0 +1,244 @@+module Valiant.CLI.Describe+  ( QueryMeta (..)+  , ParamMeta (..)+  , ColumnMeta (..)+  , DescribeError (..)+  , PgTypeInfo (..)+  , PgTypeCategory (..)+  , describeQuery+  , queryTypeInfo+  , queryEnumLabels+  , queryRangeSubtype+  , withPgConnection+  ) where++import Control.Exception (bracket, try)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as BS8+import Data.IORef (IORef, writeIORef)+import Data.Text (Text)+import Data.Text.Encoding qualified as TE+import Data.Vector qualified as V+import Data.Vector (Vector)+import Data.Word (Word32)+import PgWire.Async (submitExclusive)+import PgWire.Connection (Connection, close, connAsync, connectString, simpleQuery)+import PgWire.Error (PgWireError)+import PgWire.Protocol.Backend (BackendMsg (..), FieldInfo (..), PgError (..), TxStatus)+import PgWire.Protocol.Frontend (DescribeTarget (..), FrontendMsg (..))+import PgWire.Protocol.Oid (Oid (..))+import PgWire.Wire (WireConn, recvBackendMsg, sendFrontendMsg)+import Valiant.CLI.Discover (SqlFile (..))++-- | Raw metadata returned by Postgres for a described query.+data QueryMeta = QueryMeta+  { qmParams :: [ParamMeta]+  , qmColumns :: [ColumnMeta]+  }+  deriving stock (Show)++-- | Metadata for a single query parameter.+data ParamMeta = ParamMeta+  { pmIndex :: Int+  , pmOid :: Oid+  }+  deriving stock (Show)++-- | Metadata for a single result column.+data ColumnMeta = ColumnMeta+  { cmName :: Text+  , cmOid :: Oid+  , cmTableOid :: Oid+  , cmColumnNumber :: Int+  }+  deriving stock (Show)++-- | An error that occurred while describing a query.+data DescribeError = DescribeError+  { deMessage :: Text+  , deDetail :: Maybe Text+  , deHint :: Maybe Text+  }+  deriving stock (Show)++-- | Connect to Postgres, run an action, and close the connection.+withPgConnection :: ByteString -> (Connection -> IO a) -> IO a+withPgConnection connStr action = do+  result <- try @PgWireError (bracket (connectString connStr) close action)+  case result of+    Right a -> pure a+    Left err -> error $ "valiant: connection failed: " <> show err++-- | Prepare and describe a SQL query, returning structured metadata.+describeQuery :: Connection -> SqlFile -> IO (Either DescribeError QueryMeta)+describeQuery conn sqlFile = do+  let stmtName = BS8.pack ("valiant_" <> sqlRelPath sqlFile)+      sql = sqlContent sqlFile+  result <- parseAndDescribe conn stmtName sql+  pure $ case result of+    Left err -> Left (pgErrorToDescribeError err)+    Right (paramOids, fields) -> Right (buildMeta paramOids fields)++-- | Send Parse + Describe + Sync in one round trip and collect the response.+-- Returns the parameter OIDs and column field info, or the server's error.+parseAndDescribe+  :: Connection+  -> ByteString+  -- ^ statement name+  -> ByteString+  -- ^ SQL text+  -> IO (Either PgError (Vector Word32, Vector FieldInfo))+parseAndDescribe conn stmtName sql =+  submitExclusive (connAsync conn) $ \wc txRef -> do+    sendFrontendMsg wc (Parse stmtName sql V.empty)+    sendFrontendMsg wc (Describe DescribeStatement stmtName)+    sendFrontendMsg wc Sync+    collectDescribeResponse wc txRef++-- | Collect the response to a Parse + Describe + Sync sequence.+-- Expected message order on success:+-- ParseComplete, ParameterDescription, (RowDescription | NoData), ReadyForQuery.+-- On error: ErrorResponse, ReadyForQuery.+collectDescribeResponse+  :: WireConn+  -> IORef TxStatus+  -> IO (Either PgError (Vector Word32, Vector FieldInfo))+collectDescribeResponse wc txRef = loop Nothing V.empty V.empty+  where+    loop !mErr !paramOids !fields = do+      msg <- recvBackendMsg wc+      case msg of+        ParseComplete -> loop mErr paramOids fields+        ParameterDescription oids -> loop mErr oids fields+        RowDescription fs -> loop mErr paramOids fs+        NoData -> loop mErr paramOids V.empty+        ErrorResponse err -> loop (Just err) paramOids fields+        ReadyForQuery status -> do+          writeIORef txRef status+          pure $ case mErr of+            Just err -> Left err+            Nothing -> Right (paramOids, fields)+        _ -> loop mErr paramOids fields++buildMeta :: Vector Word32 -> Vector FieldInfo -> QueryMeta+buildMeta paramOids fields =+  QueryMeta+    { qmParams =+        [ ParamMeta {pmIndex = i + 1, pmOid = Oid oid}+        | (i, oid) <- zip [0 ..] (V.toList paramOids)+        ]+    , qmColumns = map fieldToColumnMeta (V.toList fields)+    }++fieldToColumnMeta :: FieldInfo -> ColumnMeta+fieldToColumnMeta fi =+  ColumnMeta+    { cmName = TE.decodeUtf8 (fiName fi)+    , cmOid = Oid (fiTypeOid fi)+    , cmTableOid = Oid (fiTableOid fi)+    , cmColumnNumber = fromIntegral (fiColumnNum fi)+    }++pgErrorToDescribeError :: PgError -> DescribeError+pgErrorToDescribeError err =+  DescribeError+    { deMessage = TE.decodeUtf8 (pgMessage err)+    , deDetail = TE.decodeUtf8 <$> pgDetail err+    , deHint = TE.decodeUtf8 <$> pgHint err+    }++-- Type discovery -------------------------------------------------------------++-- | Category of a PG type discovered from @pg_type@.+data PgTypeCategory+  = PgEnum+  | PgComposite+  | PgDomain+  | PgRange+  | PgBase+  | PgPseudo+  deriving stock (Show, Eq)++-- | Metadata about a PG type, queried from @pg_type@.+data PgTypeInfo = PgTypeInfo+  { ptiName :: Text+  , ptiCategory :: PgTypeCategory+  , ptiArrayOid :: Word32+  -- ^ OID of the array form of this type (0 if none).+  , ptiBaseOid :: Word32+  -- ^ For domains: the underlying type OID. 0 otherwise.+  , ptiElemOid :: Word32+  -- ^ For array types: the element type OID. 0 otherwise.+  }+  deriving stock (Show)++-- | Query @pg_type@ for information about an unknown OID.+queryTypeInfo :: Connection -> Oid -> IO (Maybe PgTypeInfo)+queryTypeInfo conn (Oid rawOid) = do+  let sql =+        "SELECT typname, typtype, typarray, typbasetype, typelem FROM pg_type WHERE oid = "+          <> BS8.pack (show rawOid)+  result <- try @PgWireError (simpleQuery conn sql)+  pure $ case result of+    Left _ -> Nothing+    Right (rows, _) -> case rows of+      (row : _) -> Just (parsePgTypeRow row)+      [] -> Nothing++parsePgTypeRow :: [Maybe ByteString] -> PgTypeInfo+parsePgTypeRow row =+  let (mName, mTyptype, mTyparray, mTypbase, mTypelem) = case row of+        (a : b : c : d : e : _) -> (a, b, c, d, e)+        _ -> (Nothing, Nothing, Nothing, Nothing, Nothing)+   in PgTypeInfo+        { ptiName = maybe "" TE.decodeUtf8 mName+        , ptiCategory = parseTyptype mTyptype+        , ptiArrayOid = parseOidField mTyparray+        , ptiBaseOid = parseOidField mTypbase+        , ptiElemOid = parseOidField mTypelem+        }++parseTyptype :: Maybe ByteString -> PgTypeCategory+parseTyptype (Just "e") = PgEnum+parseTyptype (Just "c") = PgComposite+parseTyptype (Just "d") = PgDomain+parseTyptype (Just "r") = PgRange+parseTyptype (Just "p") = PgPseudo+parseTyptype _ = PgBase++parseOidField :: Maybe ByteString -> Word32+parseOidField Nothing = 0+parseOidField (Just bs) =+  case BS8.readInt bs of+    Just (n, _) -> fromIntegral n+    Nothing -> 0++-- | Query @pg_enum@ for the labels of an enum type.+queryEnumLabels :: Connection -> Oid -> IO [Text]+queryEnumLabels conn (Oid rawOid) = do+  let sql =+        "SELECT enumlabel FROM pg_enum WHERE enumtypid = "+          <> BS8.pack (show rawOid)+          <> " ORDER BY enumsortorder"+  result <- try @PgWireError (simpleQuery conn sql)+  pure $ case result of+    Left _ -> []+    Right (rows, _) -> map labelOf rows+  where+    labelOf (Just v : _) = TE.decodeUtf8 v+    labelOf _ = ""++-- | Query @pg_range@ for the subtype OID of a range type.+queryRangeSubtype :: Connection -> Oid -> IO (Maybe Oid)+queryRangeSubtype conn (Oid rawOid) = do+  let sql =+        "SELECT rngsubtype FROM pg_range WHERE rngtypid = "+          <> BS8.pack (show rawOid)+  result <- try @PgWireError (simpleQuery conn sql)+  pure $ case result of+    Left _ -> Nothing+    Right (rows, _) -> case rows of+      ((Just v : _) : _) -> case BS8.readInt v of+        Just (n, _) -> Just (Oid (fromIntegral n))+        Nothing -> Nothing+      _ -> Nothing
+ src/Valiant/CLI/Discover.hs view
@@ -0,0 +1,107 @@+module Valiant.CLI.Discover+  ( SqlFile (..)+  , discoverSqlFiles+  , discoverInlineSql+  ) where++import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as BS8+import Data.List (nub, sort)+import Data.Text (Text)+import Valiant.CLI.Hash (sha256Hex, sha256HexTruncated)+import System.Directory (doesDirectoryExist, makeAbsolute)+import System.FilePath (makeRelative)+import System.FilePath.Glob qualified as Glob++-- | A discovered SQL file with its content and hash.+data SqlFile = SqlFile+  { sqlRelPath :: FilePath+  -- ^ Relative path from the SQL root, e.g. @"users/find_by_id.sql"@.+  , sqlAbsPath :: FilePath+  -- ^ Absolute path on disk.+  , sqlContent :: BS.ByteString+  -- ^ Raw file contents.+  , sqlHash :: Text+  -- ^ Full SHA-256 hex digest of the content.+  , sqlHashShort :: Text+  -- ^ Truncated (12-char) SHA-256 hex digest.+  }+  deriving stock (Show)++-- | Recursively discover all @.sql@ files under the given directory.+-- Returns files sorted by relative path.+discoverSqlFiles :: FilePath -> IO [SqlFile]+discoverSqlFiles sqlDir = do+  absDir <- makeAbsolute sqlDir+  exists <- doesDirectoryExist absDir+  if not exists+    then pure []+    else do+      let pat = Glob.compile "**/*.sql"+      matched <- Glob.globDir [pat] absDir+      let paths = sort (concat matched)+      mapM (mkSqlFile absDir) paths++-- | Scan Haskell source files for @query "..."@ calls and extract the+-- SQL text as synthetic 'SqlFile' entries. Deduplicates by SQL content.+discoverInlineSql :: [FilePath] -> IO [SqlFile]+discoverInlineSql hsPaths = do+  allSqls <- concat <$> mapM extractFromHsFile hsPaths+  -- Deduplicate by content (same SQL text from different files = one cache entry)+  let unique = nub allSqls+  pure (sort unique)++extractFromHsFile :: FilePath -> IO [SqlFile]+extractFromHsFile hsPath = do+  content <- BS.readFile hsPath+  let ls = BS8.lines content+      sqls = concatMap extractQueryCalls ls+  pure [mkInlineSqlFile sql | sql <- sqls]++-- | Simple extraction of query "..." string literals from a line.+-- Looks for: query "..." (handles basic cases, not full Haskell parsing).+extractQueryCalls :: BS.ByteString -> [BS.ByteString]+extractQueryCalls line =+  case BS8.breakSubstring "query \"" line of+    (_, rest)+      | BS.null rest -> []+      | otherwise ->+          let afterQuery = BS.drop 7 rest  -- skip 'query "'+           in case BS8.elemIndex '"' afterQuery of+                Nothing -> []+                Just endIdx ->+                  let sqlText = BS.take endIdx afterQuery+                   in sqlText : extractQueryCalls (BS.drop (endIdx + 1) afterQuery)++mkInlineSqlFile :: BS.ByteString -> SqlFile+mkInlineSqlFile sqlBs =+  let hash = sha256Hex sqlBs+      hashShort = sha256HexTruncated 12 sqlBs+   in SqlFile+        { sqlRelPath = "<inline>"+        , sqlAbsPath = "<inline>"+        , sqlContent = sqlBs+        , sqlHash = hash+        , sqlHashShort = hashShort+        }++instance Eq SqlFile where+  a == b = sqlContent a == sqlContent b++instance Ord SqlFile where+  compare a b = compare (sqlContent a) (sqlContent b)++mkSqlFile :: FilePath -> FilePath -> IO SqlFile+mkSqlFile baseDir absPath = do+  content <- BS.readFile absPath+  let relPath = makeRelative baseDir absPath+      hash = sha256Hex content+      hashShort = sha256HexTruncated 12 content+  pure+    SqlFile+      { sqlRelPath = relPath+      , sqlAbsPath = absPath+      , sqlContent = content+      , sqlHash = hash+      , sqlHashShort = hashShort+      }
+ src/Valiant/CLI/Error.hs view
@@ -0,0 +1,87 @@+module Valiant.CLI.Error+  ( ValiantCliError (..)+  , PgErrorDetail (..)+  , dieWithError+  , renderError+  ) where++import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import PgWire.Protocol.Oid (Oid (..))+import System.Exit (exitFailure)+import System.IO (stderr)++-- | Structured error from Postgres.+data PgErrorDetail = PgErrorDetail+  { pgMessage :: Text+  , pgDetail :: Maybe Text+  , pgHint :: Maybe Text+  , pgPosition :: Maybe Int+  }+  deriving stock (Show)++-- | All CLI failure modes.+data ValiantCliError+  = ErrNoDatabaseUrl+  | ErrConnectionFailed Text+  | ErrSqlDirNotFound FilePath+  | ErrNoSqlFiles FilePath+  | ErrDescribeFailed FilePath PgErrorDetail+  | ErrUnknownOid FilePath Text Oid+  | ErrCacheReadFailed FilePath String+  | ErrStaleCacheFile FilePath Text Text+  | ErrMissingCacheFile FilePath+  deriving stock (Show)++-- | Render an error to human-readable text.+renderError :: ValiantCliError -> Text+renderError = \case+  ErrNoDatabaseUrl ->+    T.unlines+      [ "valiant: DATABASE_URL is not set."+      , ""+      , "  Set it in your environment or in a .env file:"+      , "    DATABASE_URL=postgres://user:pass@localhost:5432/mydb"+      ]+  ErrConnectionFailed msg ->+    "valiant: Failed to connect to database: " <> msg+  ErrSqlDirNotFound dir ->+    "valiant: SQL directory not found: " <> T.pack dir+  ErrNoSqlFiles dir ->+    "valiant: No .sql files found in " <> T.pack dir+  ErrDescribeFailed path detail ->+    T.unlines $+      [ "valiant: " <> T.pack path <> ": FAILED"+      , "  ERROR: " <> pgMessage detail+      ]+        <> maybe [] (\d -> ["  DETAIL: " <> d]) (pgDetail detail)+        <> maybe [] (\h -> ["  HINT: " <> h]) (pgHint detail)+  ErrUnknownOid path col (Oid oid) ->+    T.unlines+      [ "valiant: " <> T.pack path <> ": unknown Postgres type"+      , "  Column \"" <> col <> "\" has OID " <> T.pack (show oid)+      , "  which valiant doesn't know how to map to a Haskell type."+      , ""+      , "  Cast the column in SQL or register a custom type mapping."+      ]+  ErrCacheReadFailed path msg ->+    "valiant: Failed to read cache file " <> T.pack path <> ": " <> T.pack msg+  ErrStaleCacheFile path cached current ->+    T.unlines+      [ "valiant: " <> T.pack path <> ": STALE"+      , "  SQL content has changed since last prepare."+      , "  Cache hash:   " <> cached+      , "  Current hash: " <> current+      ]+  ErrMissingCacheFile path ->+    T.unlines+      [ "valiant: " <> T.pack path <> ": MISSING"+      , "  No cached metadata found. Run `valiant prepare`."+      ]++-- | Print an error to stderr and exit with failure.+dieWithError :: ValiantCliError -> IO a+dieWithError err = do+  TIO.hPutStrLn stderr (renderError err)+  exitFailure
+ src/Valiant/CLI/Hash.hs view
@@ -0,0 +1,25 @@+module Valiant.CLI.Hash+  ( sha256Hex+  , sha256HexTruncated+  ) where++import Crypto.Hash.SHA256 qualified as SHA256+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Text (Text)+import Data.Text qualified as T+import Data.Word (Word8)+import Numeric (showHex)++-- | Full SHA-256 hex digest of a 'ByteString'.+sha256Hex :: ByteString -> Text+sha256Hex = T.pack . concatMap toHex . BS.unpack . SHA256.hash++-- | SHA-256 hex digest truncated to @n@ characters.+sha256HexTruncated :: Int -> ByteString -> Text+sha256HexTruncated n = T.take n . sha256Hex++toHex :: Word8 -> String+toHex w+  | w < 16 = '0' : showHex w ""+  | otherwise = showHex w ""
+ src/Valiant/CLI/NamedParams.hs view
@@ -0,0 +1,140 @@+-- | Preprocessing for named parameters in SQL files.+--+-- Converts @:name@ syntax to positional @$N@ parameters:+--+-- @+-- SELECT id, name FROM users WHERE org_id = :orgId AND role = :role+-- @+--+-- becomes:+--+-- @+-- SELECT id, name FROM users WHERE org_id = $1 AND role = $2+-- @+--+-- The name-to-position mapping is returned for storage in the cache.+-- A name that appears multiple times maps to the same @$N@.+--+-- Rules:+--+-- * @::@ (Postgres type cast) is not treated as a named parameter+-- * String literals (@\'...\'@), quoted identifiers (@\"...\"@),+--   line comments (@-- ...@), and block comments (@\/\* ... \*\/@)+--   are skipped+-- * A named parameter is @:@ followed by @[a-zA-Z_][a-zA-Z0-9_]*@+module Valiant.CLI.NamedParams+  ( NamedParamMapping+  , preprocessNamedParams+  ) where++import Data.ByteString (ByteString)+import Data.Char (isAlpha, isAlphaNum)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE++-- | Mapping from parameter name to its positional index (1-based).+type NamedParamMapping = [(Text, Int)]++-- | Preprocess a SQL bytestring, replacing @:name@ with @$N@.+-- Returns the rewritten SQL and the name-to-position mapping.+-- If the SQL contains no named parameters, returns the original+-- SQL unchanged with an empty mapping.+preprocessNamedParams :: ByteString -> (ByteString, NamedParamMapping)+preprocessNamedParams sqlBs =+  let sql = TE.decodeUtf8 sqlBs+      (rewritten, mapping) = rewrite sql+   in if Map.null mapping+        then (sqlBs, [])+        else (TE.encodeUtf8 rewritten, Map.toAscList mapping)++-- | Rewrite SQL text, replacing :name tokens with $N.+rewrite :: Text -> (Text, Map Text Int)+rewrite = go mempty Map.empty 1+  where+    go !acc !seen !nextIdx txt+      | T.null txt = (acc, seen)+      | otherwise = case T.uncons txt of+          Nothing -> (acc, seen)+          Just (c, rest)+            -- String literal: skip to closing quote+            | c == '\'' ->+                let (lit, after) = spanStringLit rest+                 in go (acc <> T.singleton c <> lit) seen nextIdx after+            -- Quoted identifier: skip to closing double-quote+            | c == '"' ->+                let (qid, after) = spanQuotedId rest+                 in go (acc <> T.singleton c <> qid) seen nextIdx after+            -- Line comment: skip to end of line+            | c == '-', Just ('-', _) <- T.uncons rest ->+                let (comment, after) = T.break (== '\n') rest+                 in go (acc <> T.singleton c <> comment) seen nextIdx after+            -- Block comment: skip to */+            | c == '/', Just ('*', rest2) <- T.uncons rest ->+                let (comment, after) = spanBlockComment rest2+                 in go (acc <> "/*" <> comment) seen nextIdx after+            -- Postgres cast (::) — not a named param+            | c == ':', Just (':', _) <- T.uncons rest ->+                go (acc <> "::") seen nextIdx (T.drop 1 rest)+            -- Named parameter+            | c == ':', Just (h, _) <- T.uncons rest, isParamStart h ->+                let (name, after) = T.span isParamChar rest+                 in case Map.lookup name seen of+                      Just idx ->+                        go (acc <> "$" <> T.pack (show idx)) seen nextIdx after+                      Nothing ->+                        go (acc <> "$" <> T.pack (show nextIdx)) (Map.insert name nextIdx seen) (nextIdx + 1) after+            -- Anything else: pass through+            | otherwise ->+                go (acc <> T.singleton c) seen nextIdx rest++    isParamStart c = isAlpha c || c == '_'+    isParamChar c = isAlphaNum c || c == '_'++-- | Consume a single-quoted string literal (handling '' escapes).+spanStringLit :: Text -> (Text, Text)+spanStringLit = go mempty+  where+    go !acc txt+      | T.null txt = (acc, txt)+      | otherwise = case T.uncons txt of+          Just ('\'', rest)+            | Just ('\'', rest2) <- T.uncons rest ->+                go (acc <> "''") rest2+            | otherwise ->+                (acc <> "'", rest)+          Just (c, rest) ->+              go (acc <> T.singleton c) rest+          Nothing -> (acc, txt)++-- | Consume a double-quoted identifier (handling "" escapes).+spanQuotedId :: Text -> (Text, Text)+spanQuotedId = go mempty+  where+    go !acc txt+      | T.null txt = (acc, txt)+      | otherwise = case T.uncons txt of+          Just ('"', rest)+            | Just ('"', rest2) <- T.uncons rest ->+                go (acc <> "\"\"") rest2+            | otherwise ->+                (acc <> "\"", rest)+          Just (c, rest) ->+              go (acc <> T.singleton c) rest+          Nothing -> (acc, txt)++-- | Consume a block comment up to and including the closing @*/@.+spanBlockComment :: Text -> (Text, Text)+spanBlockComment = go mempty+  where+    go !acc txt+      | T.null txt = (acc, txt)+      | otherwise = case T.uncons txt of+          Just ('*', rest)+            | Just ('/', rest2) <- T.uncons rest ->+                (acc <> "*/", rest2)+          Just (c, rest) ->+              go (acc <> T.singleton c) rest+          Nothing -> (acc, txt)
+ src/Valiant/CLI/Nullability.hs view
@@ -0,0 +1,36 @@+module Valiant.CLI.Nullability+  ( resolveNullability+  ) where++import Control.Exception (try)+import Data.ByteString.Char8 qualified as BS8+import PgWire.Connection (Connection, simpleQuery)+import PgWire.Error (PgWireError)+import PgWire.Protocol.Oid (Oid (..))+import Valiant.CLI.Describe (ColumnMeta (..))++-- | For each column, determine whether it is nullable by querying+-- @pg_attribute@. Columns without a source table (computed columns)+-- are assumed nullable.+resolveNullability :: Connection -> [ColumnMeta] -> IO [Bool]+resolveNullability conn = mapM (isNullable conn)++-- | Returns @True@ if the column is nullable.+isNullable :: Connection -> ColumnMeta -> IO Bool+isNullable conn col+  | cmTableOid col == Oid 0 = pure True -- computed / expression column+  | cmColumnNumber col == 0 = pure True -- no source column info+  | otherwise = do+      let Oid tableOid = cmTableOid col+          sql =+            "SELECT NOT attnotnull FROM pg_attribute WHERE attrelid = "+              <> BS8.pack (show tableOid)+              <> " AND attnum = "+              <> BS8.pack (show (cmColumnNumber col))+      result <- try @PgWireError (simpleQuery conn sql)+      pure $ case result of+        Left _ -> True -- assume nullable on error+        Right (rows, _) -> case rows of+          ((Just "t" : _) : _) -> True+          ((Just "f" : _) : _) -> False+          _ -> True -- no info or unexpected value: default to nullable
+ src/Valiant/CLI/Output.hs view
@@ -0,0 +1,93 @@+module Valiant.CLI.Output+  ( printHeader+  , printProgress+  , printOk+  , printFailed+  , printStale+  , printMissing+  , printSummary+  , printLn+  ) where++import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import System.Console.ANSI+  ( Color (..)+  , ColorIntensity (..)+  , ConsoleLayer (..)+  , SGR (..)+  , hSupportsANSIColor+  , setSGRCode+  )+import System.IO (stdout)++-- | Print a section header.+printHeader :: Text -> IO ()+printHeader hdr = TIO.putStrLn $ "valiant: " <> hdr++-- | Print progress line without trailing newline.+--+-- @printProgress 3 10 "sql/users/find_by_id.sql"@ produces:+--+-- >  [3/10] sql/users/find_by_id.sql ...+printProgress :: Int -> Int -> FilePath -> IO ()+printProgress n total path = do+  let pad = length (show total)+      idx = leftPad pad (show n)+  putStr $ "  [" <> idx <> "/" <> show total <> "] " <> path <> " ... "++-- | Print green "ok" with newline.+printOk :: IO ()+printOk = withColor Green $ TIO.putStrLn "ok"++-- | Print red "FAILED" with detail on the next line.+printFailed :: Text -> IO ()+printFailed detail = do+  withColor Red $ TIO.putStrLn "FAILED"+  TIO.putStrLn $ "    " <> detail++-- | Print yellow "STALE" with newline.+printStale :: IO ()+printStale = withColor Yellow $ TIO.putStrLn "STALE"++-- | Print yellow "MISSING" with newline.+printMissing :: IO ()+printMissing = withColor Yellow $ TIO.putStrLn "MISSING"++-- | Print a summary line.+printSummary :: Int -> Int -> IO ()+printSummary ok total+  | ok == total = do+      printLn ""+      withColor Green . TIO.putStrLn $+        "  All " <> T.pack (show total) <> " queries valid."+  | otherwise = do+      printLn ""+      withColor Red . TIO.putStrLn $+        "  "+          <> T.pack (show ok)+          <> " of "+          <> T.pack (show total)+          <> " queries valid. "+          <> T.pack (show (total - ok))+          <> " failed."++-- | Print a line of text.+printLn :: Text -> IO ()+printLn = TIO.putStrLn++-- Helpers -----------------------------------------------------------------++leftPad :: Int -> String -> String+leftPad n s = replicate (n - length s) ' ' <> s++withColor :: Color -> IO () -> IO ()+withColor color action = do+  supportsColor <- hSupportsANSIColor stdout+  if supportsColor+    then do+      putStr (setSGRCode [SetColor Foreground Vivid color])+      action+      putStr (setSGRCode [Reset])+    else action
+ src/Valiant/CLI/SqlMetadata.hs view
@@ -0,0 +1,62 @@+module Valiant.CLI.SqlMetadata+  ( SqlMetadata (..)+  , parseSqlMetadata+  , defaultMetadata+  ) where++import Data.List qualified as List+import Data.Text (Text)+import Data.Text qualified as T++-- | Optional metadata parsed from @-- valiant:@ comments in SQL files.+data SqlMetadata = SqlMetadata+  { smName :: Maybe Text+  -- ^ Override the generated binding name (@-- valiant:name getUserById@).+  , smResult :: Maybe Text+  -- ^ Use a named result type (@-- valiant:result User@).+  , smSingle :: Bool+  -- ^ Expect exactly one row (@-- valiant:single@). If set, the generated+  -- binding returns @r@ instead of @Maybe r@ or @[r]@.+  }+  deriving stock (Show, Eq)++defaultMetadata :: SqlMetadata+defaultMetadata =+  SqlMetadata+    { smName = Nothing+    , smResult = Nothing+    , smSingle = False+    }++-- | Parse @-- valiant:@ directives from SQL file content.+-- Only lines starting with @-- valiant:@ (with optional leading whitespace)+-- are recognised. The directives must appear before the first SQL keyword.+parseSqlMetadata :: Text -> SqlMetadata+parseSqlMetadata = List.foldl' applyDirective defaultMetadata . extractDirectives++extractDirectives :: Text -> [(Text, Text)]+extractDirectives sql =+  [ parseDirective line+  | line <- T.lines sql+  , isDirective line+  ]++isDirective :: Text -> Bool+isDirective line =+  let stripped = T.stripStart line+   in T.isPrefixOf "-- valiant:" stripped++parseDirective :: Text -> (Text, Text)+parseDirective line =+  let stripped = T.stripStart line+      -- Remove "-- valiant:" prefix+      afterPrefix = T.drop 11 stripped -- length "-- valiant:" == 11+      (key, rest) = T.break (== ' ') (T.strip afterPrefix)+   in (T.toLower key, T.strip rest)++applyDirective :: SqlMetadata -> (Text, Text) -> SqlMetadata+applyDirective meta (key, value) = case key of+  "name" | not (T.null value) -> meta {smName = Just value}+  "result" | not (T.null value) -> meta {smResult = Just value}+  "single" -> meta {smSingle = True}+  _ -> meta
+ src/Valiant/CLI/TypeMap.hs view
@@ -0,0 +1,276 @@+module Valiant.CLI.TypeMap+  ( HaskellType (..)+  , ResolvedType (..)+  , oidToHaskellType+  , oidToTypeName+  , resolveType+  , oidToHaskellTypeWith+  , oidToTypeNameWith+  , resolveUnknownOid+  , isArrayOid+  , arrayElementOid+  ) where++import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import PgWire.Connection (Connection)+import PgWire.Protocol.Oid (Oid (..))+import Valiant.CLI.Describe (PgTypeCategory (..), PgTypeInfo (..), queryEnumLabels, queryRangeSubtype, queryTypeInfo)++-- | A Haskell type with its originating module.+data HaskellType = HaskellType+  { htType :: Text+  , htModule :: Text+  }+  deriving stock (Show, Eq)++-- | Wrap a type in @Maybe@ if nullable.+resolveType :: Bool -> HaskellType -> HaskellType+resolveType nullable ht+  | nullable = ht {htType = "Maybe " <> htType ht}+  | otherwise = ht++-- | Look up the Haskell type for a Postgres OID (built-in types only).+oidToHaskellType :: Oid -> Maybe HaskellType+oidToHaskellType oid = Map.lookup oid oidMap++-- | Look up the Haskell type for a Postgres OID, falling back to a custom map.+oidToHaskellTypeWith :: Map Oid HaskellType -> Oid -> Maybe HaskellType+oidToHaskellTypeWith customs oid =+  -- Custom types take priority over built-in mappings+  case Map.lookup oid customs of+    Just ht -> Just ht+    Nothing -> case Map.lookup oid oidMap of+      Just ht -> Just ht+      Nothing -> arrayHaskellType oid customs++-- | Look up the Postgres type name for an OID.+oidToTypeName :: Oid -> Maybe Text+oidToTypeName oid = Map.lookup oid oidNameMap++-- | Look up the Postgres type name for an OID, falling back to a custom map.+oidToTypeNameWith :: Map Oid Text -> Oid -> Maybe Text+oidToTypeNameWith customs oid =+  Map.lookup oid oidNameMap <> Map.lookup oid customs++-- Array support -------------------------------------------------------------++-- | Check whether an OID is a known array type.+isArrayOid :: Oid -> Bool+isArrayOid oid = Map.member oid arrayOidToElement++-- | For an array OID, return the element OID.+arrayElementOid :: Oid -> Maybe Oid+arrayElementOid oid = Map.lookup oid arrayOidToElement++-- | Derive the Haskell type for an array OID: @Vector <elementType>@.+arrayHaskellType :: Oid -> Map Oid HaskellType -> Maybe HaskellType+arrayHaskellType oid customs = do+  elemOid <- arrayElementOid oid+  elemHt <- case Map.lookup elemOid oidMap of+    Just ht -> Just ht+    Nothing -> Map.lookup elemOid customs+  pure+    HaskellType+      { htType = "Vector " <> htType elemHt+      , htModule = "Data.Vector"+      }++-- Automatic type discovery ------------------------------------------------++-- | Result of resolving an unknown OID via @pg_type@ introspection.+data ResolvedType = ResolvedType+  { rtHaskellType :: HaskellType+  , rtPgTypeName :: Text+  , rtCategory :: Maybe Text+  -- ^ @\"enum\"@, @\"domain\"@, @\"range\"@ — stored in the cache JSON.+  , rtEnumLabels :: Maybe [Text]+  -- ^ Enum labels, if this is an enum type.+  }+  deriving stock (Show)++-- | Attempt to resolve an unknown OID by querying @pg_type@.+-- Handles enums (→ 'Text'), domains (→ unwrap to base type),+-- ranges (→ @PgRange BaseType@), and composites (→ error).+resolveUnknownOid+  :: Connection+  -> Map Oid HaskellType+  -- ^ Custom type overrides+  -> Oid+  -> IO (Either Text ResolvedType)+resolveUnknownOid conn customs oid = do+  mInfo <- queryTypeInfo conn oid+  case mInfo of+    Nothing ->+      let Oid raw = oid+       in pure . Left $ "Unknown OID " <> T.pack (show raw) <> " (not found in pg_type)"+    Just info -> case ptiCategory info of+      PgEnum -> do+        labels <- queryEnumLabels conn oid+        pure . Right $+          ResolvedType+            { rtHaskellType = HaskellType "Text" "Data.Text"+            , rtPgTypeName = ptiName info+            , rtCategory = Just "enum"+            , rtEnumLabels = Just labels+            }+      PgDomain -> do+        -- Follow typbasetype to the underlying type+        let baseOid = Oid (ptiBaseOid info)+        case oidToHaskellTypeWith customs baseOid of+          Just ht ->+            pure . Right $+              ResolvedType+                { rtHaskellType = ht+                , rtPgTypeName = ptiName info+                , rtCategory = Just "domain"+                , rtEnumLabels = Nothing+                }+          Nothing -> do+            -- Recursively resolve the base type (domain over domain, etc.)+            nested <- resolveUnknownOid conn customs baseOid+            case nested of+              Left err -> pure . Left $ "Domain " <> ptiName info <> " -> " <> err+              Right rt ->+                pure . Right $+                  rt+                    { rtPgTypeName = ptiName info+                    , rtCategory = Just "domain"+                    }+      PgRange -> do+        mSubOid <- queryRangeSubtype conn oid+        case mSubOid of+          Nothing ->+            pure . Left $ "Range type " <> ptiName info <> ": could not determine subtype"+          Just subOid -> do+            mSubHt <- case oidToHaskellTypeWith customs subOid of+              Just ht -> pure (Right ht)+              Nothing -> do+                nested <- resolveUnknownOid conn customs subOid+                pure (rtHaskellType <$> nested)+            case mSubHt of+              Left err -> pure . Left $ "Range type " <> ptiName info <> " subtype: " <> err+              Right subHt ->+                pure . Right $+                  ResolvedType+                    { rtHaskellType =+                        HaskellType ("PgRange " <> htType subHt) "Valiant"+                    , rtPgTypeName = ptiName info+                    , rtCategory = Just "range"+                    , rtEnumLabels = Nothing+                    }+      PgComposite ->+        pure . Left $+          "Composite type "+            <> ptiName info+            <> " (OID "+            <> T.pack (show (let Oid raw = oid in raw))+            <> ") cannot be auto-mapped. Register it in valiant-types.json or cast in SQL."+      _ ->+        pure . Left $+          "Unknown type "+            <> ptiName info+            <> " (OID "+            <> T.pack (show (let Oid raw = oid in raw))+            <> "). Register it in valiant-types.json or cast in SQL."++-- Internal mapping tables ------------------------------------------------++oidMap :: Map Oid HaskellType+oidMap =+  Map.fromList+    [ (Oid 16, HaskellType "Bool" "Prelude")+    , (Oid 17, HaskellType "ByteString" "Data.ByteString")+    , (Oid 20, HaskellType "Int64" "Data.Int")+    , (Oid 21, HaskellType "Int16" "Data.Int")+    , (Oid 23, HaskellType "Int32" "Data.Int")+    , (Oid 25, HaskellType "Text" "Data.Text")+    , (Oid 114, HaskellType "Value" "Data.Aeson")+    , (Oid 700, HaskellType "Float" "Prelude")+    , (Oid 701, HaskellType "Double" "Prelude")+    , (Oid 1043, HaskellType "Text" "Data.Text")+    , (Oid 1082, HaskellType "Day" "Data.Time")+    , (Oid 1083, HaskellType "TimeOfDay" "Data.Time")+    , (Oid 1266, HaskellType "(TimeOfDay, TimeZone)" "Data.Time")+    , (Oid 1114, HaskellType "LocalTime" "Data.Time")+    , (Oid 1184, HaskellType "UTCTime" "Data.Time")+    , (Oid 1186, HaskellType "PgInterval" "Valiant")+    , (Oid 1700, HaskellType "Scientific" "Data.Scientific")+    , (Oid 869, HaskellType "PgInet" "Valiant")+    , (Oid 650, HaskellType "PgInet" "Valiant")+    , (Oid 829, HaskellType "PgMacAddr" "Valiant")+    , (Oid 774, HaskellType "PgMacAddr" "Valiant")+    , (Oid 600, HaskellType "PgPoint" "Valiant")+    , (Oid 2950, HaskellType "UUID" "Data.UUID")+    , (Oid 3802, HaskellType "Value" "Data.Aeson")+    ]++oidNameMap :: Map Oid Text+oidNameMap =+  Map.fromList+    [ (Oid 16, "bool")+    , (Oid 17, "bytea")+    , (Oid 20, "int8")+    , (Oid 21, "int2")+    , (Oid 23, "int4")+    , (Oid 25, "text")+    , (Oid 114, "json")+    , (Oid 700, "float4")+    , (Oid 701, "float8")+    , (Oid 1043, "varchar")+    , (Oid 1082, "date")+    , (Oid 1083, "time")+    , (Oid 1266, "timetz")+    , (Oid 1114, "timestamp")+    , (Oid 1184, "timestamptz")+    , (Oid 1186, "interval")+    , (Oid 1700, "numeric")+    , (Oid 869, "inet")+    , (Oid 650, "cidr")+    , (Oid 829, "macaddr")+    , (Oid 774, "macaddr8")+    , (Oid 600, "point")+    , (Oid 2950, "uuid")+    , (Oid 3802, "jsonb")+    -- Array types+    , (Oid 1000, "_bool")+    , (Oid 1001, "_bytea")+    , (Oid 1005, "_int2")+    , (Oid 1007, "_int4")+    , (Oid 1009, "_text")+    , (Oid 1015, "_varchar")+    , (Oid 1016, "_int8")+    , (Oid 1021, "_float4")+    , (Oid 1022, "_float8")+    , (Oid 1115, "_timestamp")+    , (Oid 1182, "_date")+    , (Oid 1183, "_time")+    , (Oid 1185, "_timestamptz")+    , (Oid 2951, "_uuid")+    , (Oid 199, "_json")+    , (Oid 3807, "_jsonb")+    ]++-- | Mapping from array OIDs to their element OIDs.+arrayOidToElement :: Map Oid Oid+arrayOidToElement =+  Map.fromList+    [ (Oid 1000, Oid 16) -- bool[]+    , (Oid 1001, Oid 17) -- bytea[]+    , (Oid 1005, Oid 21) -- int2[]+    , (Oid 1007, Oid 23) -- int4[]+    , (Oid 1009, Oid 25) -- text[]+    , (Oid 1015, Oid 1043) -- varchar[]+    , (Oid 1016, Oid 20) -- int8[]+    , (Oid 1021, Oid 700) -- float4[]+    , (Oid 1022, Oid 701) -- float8[]+    , (Oid 1115, Oid 1114) -- timestamp[]+    , (Oid 1182, Oid 1082) -- date[]+    , (Oid 1183, Oid 1083) -- time[]+    , (Oid 1185, Oid 1184) -- timestamptz[]+    , (Oid 2951, Oid 2950) -- uuid[]+    , (Oid 199, Oid 114) -- json[]+    , (Oid 3807, Oid 3802) -- jsonb[]+    ]
+ test/Main.hs view
@@ -0,0 +1,22 @@+module Main where++import Valiant.CLI.CacheSpec qualified as CacheSpec+import Valiant.CLI.CustomTypesSpec qualified as CustomTypesSpec+import Valiant.CLI.DiscoverSpec qualified as DiscoverSpec+import Valiant.CLI.ErrorSpec qualified as ErrorSpec+import Valiant.CLI.HashSpec qualified as HashSpec+import Valiant.CLI.NamedParamsSpec qualified as NamedParamsSpec+import Valiant.CLI.SqlMetadataSpec qualified as SqlMetadataSpec+import Valiant.CLI.TypeMapSpec qualified as TypeMapSpec+import Test.Hspec++main :: IO ()+main = hspec $ do+  describe "Valiant.CLI.Hash" HashSpec.spec+  describe "Valiant.CLI.TypeMap" TypeMapSpec.spec+  describe "Valiant.CLI.Cache" CacheSpec.spec+  describe "Valiant.CLI.Discover" DiscoverSpec.spec+  describe "Valiant.CLI.Error" ErrorSpec.spec+  describe "Valiant.CLI.SqlMetadata" SqlMetadataSpec.spec+  describe "Valiant.CLI.NamedParams" NamedParamsSpec.spec+  describe "Valiant.CLI.CustomTypes" CustomTypesSpec.spec
+ test/Valiant/CLI/CacheSpec.hs view
@@ -0,0 +1,102 @@+module Valiant.CLI.CacheSpec (spec) where++import Data.Aeson (eitherDecode, encode)+import Data.Time.Clock (UTCTime, getCurrentTime)+import Valiant.CLI.Cache+import Test.Hspec++spec :: Spec+spec = do+  describe "StatementType JSON round-trip" $ do+    it "round-trips Select" $ do+      eitherDecode (encode Select) `shouldBe` Right Select++    it "round-trips Insert" $ do+      eitherDecode (encode Insert) `shouldBe` Right Insert++  describe "CacheEntry JSON round-trip" $ do+    it "round-trips a full cache entry" $ do+      now <- getCurrentTime+      let entry = sampleEntry now+      eitherDecode (encode entry) `shouldBe` Right entry++  describe "cacheFileName" $ do+    it "produces the expected format" $ do+      cacheFileName "users/find_by_id.sql" "a1b2c3d4e5f6"+        `shouldBe` "users-find_by_id-a1b2c3d4e5f6.json"++    it "handles nested paths" $ do+      let name = cacheFileName "admin/reports/monthly.sql" "abcdef012345"+      name `shouldBe` "admin-reports-monthly-abcdef012345.json"++  describe "statementTypeFromSql" $ do+    it "detects SELECT" $ do+      statementTypeFromSql "SELECT id FROM users" `shouldBe` Select++    it "detects INSERT" $ do+      statementTypeFromSql "INSERT INTO users (name) VALUES ($1)" `shouldBe` Insert++    it "detects UPDATE" $ do+      statementTypeFromSql "UPDATE users SET name = $1" `shouldBe` Update++    it "detects DELETE" $ do+      statementTypeFromSql "DELETE FROM users WHERE id = $1" `shouldBe` Delete++    it "detects CTE as Select" $ do+      statementTypeFromSql "WITH cte AS (SELECT 1) SELECT * FROM cte" `shouldBe` Select++    it "is case-insensitive" $ do+      statementTypeFromSql "select id from users" `shouldBe` Select++    it "handles leading whitespace" $ do+      statementTypeFromSql "  \n  SELECT id FROM users" `shouldBe` Select++sampleEntry :: UTCTime -> CacheEntry+sampleEntry now =+  CacheEntry+    { ceVersion = "0.1.0"+    , ceFile = "users/find_by_id.sql"+    , ceSqlHash = "abcdef0123456789"+    , ceSql = "SELECT id, name FROM users WHERE id = $1"+    , ceDbUrlHash = "fedcba9876543210"+    , cePreparedAt = now+    , ceStatementType = Select+    , ceParams =+        [ CacheParam+            { cpIndex = 1+            , cpName = Nothing+            , cpPgOid = 23+            , cpPgTypeName = "int4"+            , cpHaskellType = "Int32"+            , cpHaskellModule = "Data.Int"+            , cpPgTypeCategory = Nothing+            , cpPgEnumLabels = Nothing+            }+        ]+    , ceColumns =+        [ CacheColumn+            { ccName = "id"+            , ccPgOid = 23+            , ccPgTypeName = "int4"+            , ccNullable = False+            , ccHaskellType = "Int32"+            , ccHaskellModule = "Data.Int"+            , ccSourceTableOid = Just 16385+            , ccSourceColumnNum = Just 1+            , ccPgTypeCategory = Nothing+            , ccPgEnumLabels = Nothing+            }+        , CacheColumn+            { ccName = "name"+            , ccPgOid = 25+            , ccPgTypeName = "text"+            , ccNullable = False+            , ccHaskellType = "Text"+            , ccHaskellModule = "Data.Text"+            , ccSourceTableOid = Just 16385+            , ccSourceColumnNum = Just 2+            , ccPgTypeCategory = Nothing+            , ccPgEnumLabels = Nothing+            }+        ]+    }
+ test/Valiant/CLI/CustomTypesSpec.hs view
@@ -0,0 +1,62 @@+module Valiant.CLI.CustomTypesSpec (spec) where++import Data.Aeson (encode, object, (.=))+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict qualified as Map+import PgWire.Protocol.Oid (Oid (..))+import Valiant.CLI.CustomTypes (loadCustomTypes)+import Valiant.CLI.TypeMap (HaskellType (..))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec++spec :: Spec+spec = do+  describe "loadCustomTypes" $ do+    it "returns empty map when file does not exist" $ do+      customs <- loadCustomTypes "/nonexistent/valiant-types.json"+      customs `shouldBe` Map.empty++    it "loads custom type mappings from JSON file" $ do+      withSystemTempDirectory "valiant-test" $ \dir -> do+        let path = dir <> "/valiant-types.json"+            content =+              encode+                [ object+                    [ "oid" .= (600 :: Int)+                    , "pg_type_name" .= ("point" :: String)+                    , "haskell_type" .= ("MyPoint" :: String)+                    , "haskell_module" .= ("MyApp.Types" :: String)+                    ]+                ]+        LBS.writeFile path content+        customs <- loadCustomTypes path+        Map.lookup (Oid 600) customs `shouldBe` Just (HaskellType "MyPoint" "MyApp.Types")++    it "returns empty map on invalid JSON" $ do+      withSystemTempDirectory "valiant-test" $ \dir -> do+        let path = dir <> "/valiant-types.json"+        writeFile path "not valid json"+        customs <- loadCustomTypes path+        customs `shouldBe` Map.empty++    it "loads multiple entries" $ do+      withSystemTempDirectory "valiant-test" $ \dir -> do+        let path = dir <> "/valiant-types.json"+            content =+              encode+                [ object+                    [ "oid" .= (600 :: Int)+                    , "pg_type_name" .= ("point" :: String)+                    , "haskell_type" .= ("MyPoint" :: String)+                    , "haskell_module" .= ("MyApp.Types" :: String)+                    ]+                , object+                    [ "oid" .= (601 :: Int)+                    , "pg_type_name" .= ("lseg" :: String)+                    , "haskell_type" .= ("MySegment" :: String)+                    , "haskell_module" .= ("MyApp.Types" :: String)+                    ]+                ]+        LBS.writeFile path content+        customs <- loadCustomTypes path+        Map.size customs `shouldBe` 2
+ test/Valiant/CLI/DiscoverSpec.hs view
@@ -0,0 +1,124 @@+module Valiant.CLI.DiscoverSpec (spec) where++import Data.ByteString.Char8 qualified as BS8+import Data.List (sort)+import Valiant.CLI.Discover+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec++spec :: Spec+spec = do+  describe "discoverSqlFiles" $ do+    it "finds .sql files recursively" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "users")+        BS8.writeFile (tmpDir </> "users" </> "find.sql") "SELECT 1"+        BS8.writeFile (tmpDir </> "list.sql") "SELECT 2"+        files <- discoverSqlFiles tmpDir+        sort (map sqlRelPath files) `shouldBe` ["list.sql", "users/find.sql"]++    it "returns empty for non-existent directory" $ do+      files <- discoverSqlFiles "/tmp/valiant-nonexistent-dir-12345"+      map sqlRelPath files `shouldBe` []++    it "ignores non-.sql files" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        BS8.writeFile (tmpDir </> "query.sql") "SELECT 1"+        BS8.writeFile (tmpDir </> "notes.txt") "not sql"+        BS8.writeFile (tmpDir </> "readme.md") "not sql"+        files <- discoverSqlFiles tmpDir+        map sqlRelPath files `shouldBe` ["query.sql"]++    it "reads file content correctly" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        let content = "SELECT id FROM users WHERE id = $1"+        BS8.writeFile (tmpDir </> "test.sql") content+        files <- discoverSqlFiles tmpDir+        case files of+          [f] -> sqlContent f `shouldBe` content+          _ -> expectationFailure "expected exactly one file"++  describe "discoverInlineSql" $ do+    it "extracts query calls from Haskell source" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        let hsFile = tmpDir </> "Queries.hs"+        writeFile hsFile $ unlines+          [ "module Queries where"+          , "import Valiant"+          , "findById = query \"SELECT id, name FROM users WHERE id = $1\""+          , "listAll = query \"SELECT id, name FROM users\""+          ]+        files <- discoverInlineSql [hsFile]+        length files `shouldBe` 2++    it "extracts SQL content correctly" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        let hsFile = tmpDir </> "Q.hs"+        writeFile hsFile "q = query \"SELECT 1\""+        files <- discoverInlineSql [hsFile]+        case files of+          [f] -> sqlContent f `shouldBe` "SELECT 1"+          _ -> expectationFailure $ "expected 1 file, got " <> show (length files)++    it "sets path to <inline>" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        let hsFile = tmpDir </> "Q.hs"+        writeFile hsFile "q = query \"SELECT 1\""+        files <- discoverInlineSql [hsFile]+        case files of+          [f] -> sqlRelPath f `shouldBe` "<inline>"+          _ -> expectationFailure "expected 1 file"++    it "deduplicates identical SQL across files" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        let f1 = tmpDir </> "A.hs"+            f2 = tmpDir </> "B.hs"+        writeFile f1 "a = query \"SELECT 1\""+        writeFile f2 "b = query \"SELECT 1\""+        files <- discoverInlineSql [f1, f2]+        length files `shouldBe` 1++    it "handles multiple queries on separate lines" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        let hsFile = tmpDir </> "Q.hs"+        writeFile hsFile $ unlines+          [ "a = query \"SELECT 1\""+          , "b = query \"SELECT 2\""+          , "c = query \"SELECT 3\""+          ]+        files <- discoverInlineSql [hsFile]+        length files `shouldBe` 3++    it "ignores queryFile calls" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        let hsFile = tmpDir </> "Q.hs"+        writeFile hsFile "q = queryFile \"users/find.sql\""+        files <- discoverInlineSql [hsFile]+        length files `shouldBe` 0++    it "ignores lines without query calls" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        let hsFile = tmpDir </> "Q.hs"+        writeFile hsFile $ unlines+          [ "module Q where"+          , "import Valiant"+          , "-- this is a comment with query in it"+          , "x = 42"+          ]+        files <- discoverInlineSql [hsFile]+        length files `shouldBe` 0++    it "returns empty for no .hs files" $ do+      files <- discoverInlineSql []+      length files `shouldBe` 0++    it "extracts SQL with named params" $ do+      withSystemTempDirectory "valiant-test" $ \tmpDir -> do+        let hsFile = tmpDir </> "Q.hs"+        writeFile hsFile "q = query \"SELECT id FROM users WHERE name = :name AND active = :active\""+        files <- discoverInlineSql [hsFile]+        case files of+          [f] -> sqlContent f `shouldBe` "SELECT id FROM users WHERE name = :name AND active = :active"+          _ -> expectationFailure $ "expected 1 file, got " <> show (length files)
+ test/Valiant/CLI/ErrorSpec.hs view
@@ -0,0 +1,69 @@+module Valiant.CLI.ErrorSpec (spec) where++import Data.Text qualified as T+import PgWire.Protocol.Oid (Oid (..))+import Valiant.CLI.Error+import Test.Hspec++spec :: Spec+spec = do+  describe "renderError" $ do+    it "produces non-empty text for ErrNoDatabaseUrl" $+      renderError ErrNoDatabaseUrl `shouldNotBe` ""++    it "produces non-empty text for ErrConnectionFailed" $+      renderError (ErrConnectionFailed "timeout") `shouldNotBe` ""++    it "produces non-empty text for ErrSqlDirNotFound" $+      renderError (ErrSqlDirNotFound "sql/") `shouldNotBe` ""++    it "produces non-empty text for ErrNoSqlFiles" $+      renderError (ErrNoSqlFiles "sql/") `shouldNotBe` ""++    it "produces non-empty text for ErrDescribeFailed" $+      renderError (ErrDescribeFailed "test.sql" pgErr) `shouldNotBe` ""++    it "produces non-empty text for ErrUnknownOid" $+      renderError (ErrUnknownOid "test.sql" "col" (Oid 600)) `shouldNotBe` ""++    it "produces non-empty text for ErrCacheReadFailed" $+      renderError (ErrCacheReadFailed "cache.json" "parse error") `shouldNotBe` ""++    it "produces non-empty text for ErrStaleCacheFile" $+      renderError (ErrStaleCacheFile "test.sql" "aaa" "bbb") `shouldNotBe` ""++    it "produces non-empty text for ErrMissingCacheFile" $+      renderError (ErrMissingCacheFile "test.sql") `shouldNotBe` ""++    it "ErrNoDatabaseUrl mentions DATABASE_URL" $+      renderError ErrNoDatabaseUrl `shouldSatisfy` T.isInfixOf "DATABASE_URL"++    it "ErrSqlDirNotFound includes the directory path" $+      renderError (ErrSqlDirNotFound "my/sql/dir")+        `shouldSatisfy` T.isInfixOf "my/sql/dir"++    it "ErrNoSqlFiles includes the directory path" $+      renderError (ErrNoSqlFiles "some/dir")+        `shouldSatisfy` T.isInfixOf "some/dir"++    it "ErrStaleCacheFile includes both hashes" $ do+      let rendered = renderError (ErrStaleCacheFile "q.sql" "abc123" "def456")+      rendered `shouldSatisfy` T.isInfixOf "abc123"+      rendered `shouldSatisfy` T.isInfixOf "def456"++    it "ErrMissingCacheFile mentions valiant prepare" $+      renderError (ErrMissingCacheFile "q.sql")+        `shouldSatisfy` T.isInfixOf "valiant prepare"++    it "ErrDescribeFailed includes the PG error message" $+      renderError (ErrDescribeFailed "q.sql" pgErr)+        `shouldSatisfy` T.isInfixOf "column \"emal\" does not exist"++pgErr :: PgErrorDetail+pgErr =+  PgErrorDetail+    { pgMessage = "column \"emal\" does not exist"+    , pgDetail = Nothing+    , pgHint = Just "Perhaps you meant \"email\"."+    , pgPosition = Nothing+    }
+ test/Valiant/CLI/HashSpec.hs view
@@ -0,0 +1,30 @@+module Valiant.CLI.HashSpec (spec) where++import Data.Text qualified as T+import Valiant.CLI.Hash+import Test.Hspec++spec :: Spec+spec = do+  it "produces a 64-character hex string" $ do+    let h = sha256Hex "hello"+    T.length h `shouldBe` 64++  it "is deterministic" $ do+    sha256Hex "test" `shouldBe` sha256Hex "test"++  it "differs for different inputs" $ do+    sha256Hex "a" `shouldNotBe` sha256Hex "b"++  it "truncates to the requested length" $ do+    let h = sha256HexTruncated 12 "hello"+    T.length h `shouldBe` 12++  it "truncated hash is a prefix of the full hash" $ do+    let full = sha256Hex "hello"+        short = sha256HexTruncated 12 "hello"+    T.take 12 full `shouldBe` short++  -- Known SHA-256 of empty string+  it "hashes empty string correctly" $ do+    sha256Hex "" `shouldBe` "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
+ test/Valiant/CLI/NamedParamsSpec.hs view
@@ -0,0 +1,162 @@+module Valiant.CLI.NamedParamsSpec (spec) where++import Data.ByteString.Char8 qualified as BS8+import Valiant.CLI.NamedParams+import Test.Hspec++spec :: Spec+spec = do+  describe "preprocessNamedParams" $ do+    -- Basic functionality+    it "replaces a single :name with $1" $ do+      let (sql, mapping) = preprocessNamedParams "SELECT * FROM users WHERE id = :userId"+      sql `shouldBe` "SELECT * FROM users WHERE id = $1"+      mapping `shouldBe` [("userId", 1)]++    it "replaces multiple distinct :names" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT * FROM users WHERE org_id = :orgId AND role = :role AND active = :active"+      sql `shouldBe` "SELECT * FROM users WHERE org_id = $1 AND role = $2 AND active = $3"+      mapping `shouldBe` [("active", 3), ("orgId", 1), ("role", 2)]++    it "reuses the same $N for repeated :name" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT * FROM t WHERE a = :x OR b = :x"+      sql `shouldBe` "SELECT * FROM t WHERE a = $1 OR b = $1"+      mapping `shouldBe` [("x", 1)]++    it "handles mixed repeated and distinct names" $ do+      let (sql, _mapping) = preprocessNamedParams+            "SELECT * FROM t WHERE a = :x AND b = :y AND c = :x"+      sql `shouldBe` "SELECT * FROM t WHERE a = $1 AND b = $2 AND c = $1"++    -- No-op cases+    it "returns original SQL unchanged when no named params" $ do+      let input = "SELECT * FROM users WHERE id = $1"+      let (sql, mapping) = preprocessNamedParams input+      sql `shouldBe` input+      mapping `shouldBe` []++    it "returns empty mapping for parameterless queries" $ do+      let (sql, mapping) = preprocessNamedParams "SELECT 1"+      sql `shouldBe` "SELECT 1"+      mapping `shouldBe` []++    -- Postgres cast (::) handling+    it "does not treat :: as a named parameter" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT :val::text FROM t WHERE id = :id"+      sql `shouldBe` "SELECT $1::text FROM t WHERE id = $2"+      mapping `shouldBe` [("id", 2), ("val", 1)]++    it "handles multiple casts" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT :a::int4, :b::text"+      sql `shouldBe` "SELECT $1::int4, $2::text"+      mapping `shouldBe` [("a", 1), ("b", 2)]++    it "handles cast without named param" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT $1::text"+      sql `shouldBe` "SELECT $1::text"+      mapping `shouldBe` []++    -- String literal handling+    it "does not substitute inside string literals" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT * FROM t WHERE name = :name AND note = ':not_a_param'"+      sql `shouldBe` "SELECT * FROM t WHERE name = $1 AND note = ':not_a_param'"+      mapping `shouldBe` [("name", 1)]++    it "handles escaped single quotes in strings" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT * FROM t WHERE name = 'it''s :not_a_param' AND id = :id"+      sql `shouldBe` "SELECT * FROM t WHERE name = 'it''s :not_a_param' AND id = $1"+      mapping `shouldBe` [("id", 1)]++    -- Quoted identifier handling+    it "does not substitute inside quoted identifiers" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT \":notParam\" FROM t WHERE id = :id"+      sql `shouldBe` "SELECT \":notParam\" FROM t WHERE id = $1"+      mapping `shouldBe` [("id", 1)]++    -- Comment handling+    it "does not substitute inside line comments" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT * FROM t -- WHERE :name = 'foo'\nWHERE id = :id"+      sql `shouldBe` "SELECT * FROM t -- WHERE :name = 'foo'\nWHERE id = $1"+      mapping `shouldBe` [("id", 1)]++    it "does not substitute inside block comments" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT * /* :notParam */ FROM t WHERE id = :id"+      sql `shouldBe` "SELECT * /* :notParam */ FROM t WHERE id = $1"+      mapping `shouldBe` [("id", 1)]++    -- Naming conventions+    it "supports underscored parameter names" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT * FROM t WHERE org_id = :org_id"+      sql `shouldBe` "SELECT * FROM t WHERE org_id = $1"+      mapping `shouldBe` [("org_id", 1)]++    it "supports names starting with underscore" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT * FROM t WHERE id = :_internal"+      sql `shouldBe` "SELECT * FROM t WHERE id = $1"+      mapping `shouldBe` [("_internal", 1)]++    it "supports names with digits" $ do+      let (sql, mapping) = preprocessNamedParams+            "SELECT * FROM t WHERE id = :param1 AND val = :param2"+      sql `shouldBe` "SELECT * FROM t WHERE id = $1 AND val = $2"+      mapping `shouldBe` [("param1", 1), ("param2", 2)]++    -- Edge cases+    it "handles :name at end of input" $ do+      let (sql, mapping) = preprocessNamedParams "SELECT * FROM t WHERE id = :id"+      sql `shouldBe` "SELECT * FROM t WHERE id = $1"+      mapping `shouldBe` [("id", 1)]++    it "handles :name at start of input" $ do+      let (sql, mapping) = preprocessNamedParams ":val"+      sql `shouldBe` "$1"+      mapping `shouldBe` [("val", 1)]++    it "handles adjacent :names" $ do+      let (sql, _) = preprocessNamedParams "VALUES (:a,:b,:c)"+      sql `shouldBe` "VALUES ($1,$2,$3)"++    it "does not treat bare colon as param" $ do+      let (sql, mapping) = preprocessNamedParams "SELECT * FROM t WHERE time > '12:30:00'"+      sql `shouldBe` "SELECT * FROM t WHERE time > '12:30:00'"+      mapping `shouldBe` []++    it "does not treat colon followed by digit as param" $ do+      let (sql, mapping) = preprocessNamedParams "SELECT * FROM t WHERE x = :1bad"+      -- :1 is not a valid param name (starts with digit)+      sql `shouldBe` "SELECT * FROM t WHERE x = :1bad"+      mapping `shouldBe` []++    -- Realistic queries+    it "handles a realistic INSERT" $ do+      let (sql, mapping) = preprocessNamedParams+            "INSERT INTO users (name, email, org_id) VALUES (:name, :email, :orgId)"+      sql `shouldBe` "INSERT INTO users (name, email, org_id) VALUES ($1, $2, $3)"+      length mapping `shouldBe` 3++    it "handles a realistic UPDATE" $ do+      let (sql, mapping) = preprocessNamedParams+            "UPDATE users SET name = :name, email = :email WHERE id = :userId"+      sql `shouldBe` "UPDATE users SET name = $1, email = $2 WHERE id = $3"+      length mapping `shouldBe` 3++    it "handles a CTE with named params" $ do+      let (sql, _) = preprocessNamedParams+            "WITH active AS (SELECT * FROM users WHERE active = :active)\n\+            \SELECT * FROM active WHERE org_id = :orgId"+      BS8.isInfixOf "$1" sql `shouldBe` True+      BS8.isInfixOf "$2" sql `shouldBe` True+      BS8.isInfixOf ":active" sql `shouldBe` False+      BS8.isInfixOf ":orgId" sql `shouldBe` False
+ test/Valiant/CLI/SqlMetadataSpec.hs view
@@ -0,0 +1,59 @@+module Valiant.CLI.SqlMetadataSpec (spec) where++import Valiant.CLI.SqlMetadata+import Test.Hspec++spec :: Spec+spec = do+  describe "parseSqlMetadata" $ do+    it "parses empty SQL as default metadata" $ do+      let meta = parseSqlMetadata "SELECT 1"+      smName meta `shouldBe` Nothing+      smResult meta `shouldBe` Nothing+      smSingle meta `shouldBe` False++    it "parses -- valiant:name directive" $ do+      let sql = "-- valiant:name getUserById\nSELECT id, name FROM users WHERE id = $1"+          meta = parseSqlMetadata sql+      smName meta `shouldBe` Just "getUserById"++    it "parses -- valiant:result directive" $ do+      let sql = "-- valiant:result User\nSELECT id, name FROM users WHERE id = $1"+          meta = parseSqlMetadata sql+      smResult meta `shouldBe` Just "User"++    it "parses -- valiant:single directive" $ do+      let sql = "-- valiant:single\nSELECT id, name FROM users WHERE id = $1"+          meta = parseSqlMetadata sql+      smSingle meta `shouldBe` True++    it "parses multiple directives" $ do+      let sql =+            "-- valiant:name getUserById\n\+            \-- valiant:result User\n\+            \-- valiant:single\n\+            \SELECT id, name FROM users WHERE id = $1"+          meta = parseSqlMetadata sql+      smName meta `shouldBe` Just "getUserById"+      smResult meta `shouldBe` Just "User"+      smSingle meta `shouldBe` True++    it "ignores regular SQL comments" $ do+      let sql = "-- This is a regular comment\nSELECT 1"+          meta = parseSqlMetadata sql+      smName meta `shouldBe` Nothing++    it "handles leading whitespace on directive lines" $ do+      let sql = "  -- valiant:name myQuery\nSELECT 1"+          meta = parseSqlMetadata sql+      smName meta `shouldBe` Just "myQuery"++    it "ignores directives with empty values for name and result" $ do+      let sql = "-- valiant:name\nSELECT 1"+          meta = parseSqlMetadata sql+      smName meta `shouldBe` Nothing++    it "ignores unknown directive keys" $ do+      let sql = "-- valiant:foobar baz\nSELECT 1"+          meta = parseSqlMetadata sql+      meta `shouldBe` defaultMetadata
+ test/Valiant/CLI/TypeMapSpec.hs view
@@ -0,0 +1,104 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+module Valiant.CLI.TypeMapSpec (spec) where++import Data.Map.Strict qualified as Map+import PgWire.Protocol.Oid (Oid (..))+import Valiant.CLI.TypeMap+import Test.Hspec++spec :: Spec+spec = do+  describe "oidToHaskellType" $ do+    it "maps int4 (OID 23) to Int32" $ do+      let Just ht = oidToHaskellType (Oid 23)+      htType ht `shouldBe` "Int32"+      htModule ht `shouldBe` "Data.Int"++    it "maps text (OID 25) to Text" $ do+      let Just ht = oidToHaskellType (Oid 25)+      htType ht `shouldBe` "Text"++    it "maps bool (OID 16) to Bool" $ do+      let Just ht = oidToHaskellType (Oid 16)+      htType ht `shouldBe` "Bool"++    it "maps timestamptz (OID 1184) to UTCTime" $ do+      let Just ht = oidToHaskellType (Oid 1184)+      htType ht `shouldBe` "UTCTime"++    it "returns Nothing for unknown OIDs" $ do+      oidToHaskellType (Oid 99999) `shouldBe` Nothing++  describe "oidToTypeName" $ do+    it "maps OID 23 to int4" $ do+      oidToTypeName (Oid 23) `shouldBe` Just "int4"++    it "maps OID 25 to text" $ do+      oidToTypeName (Oid 25) `shouldBe` Just "text"++  describe "resolveType" $ do+    it "wraps in Maybe when nullable" $ do+      let ht = HaskellType "Text" "Data.Text"+      htType (resolveType True ht) `shouldBe` "Maybe Text"++    it "leaves unchanged when not nullable" $ do+      let ht = HaskellType "Int32" "Data.Int"+      htType (resolveType False ht) `shouldBe` "Int32"++  describe "isArrayOid" $ do+    it "recognises int4[] (OID 1007)" $ do+      isArrayOid (Oid 1007) `shouldBe` True++    it "recognises text[] (OID 1009)" $ do+      isArrayOid (Oid 1009) `shouldBe` True++    it "rejects non-array OID 23" $ do+      isArrayOid (Oid 23) `shouldBe` False++    it "rejects unknown OID" $ do+      isArrayOid (Oid 99999) `shouldBe` False++  describe "arrayElementOid" $ do+    it "maps int4[] to int4" $ do+      arrayElementOid (Oid 1007) `shouldBe` Just (Oid 23)++    it "maps text[] to text" $ do+      arrayElementOid (Oid 1009) `shouldBe` Just (Oid 25)++    it "maps timestamptz[] to timestamptz" $ do+      arrayElementOid (Oid 1185) `shouldBe` Just (Oid 1184)++    it "returns Nothing for non-array OID" $ do+      arrayElementOid (Oid 23) `shouldBe` Nothing++  describe "oidToHaskellTypeWith (array support)" $ do+    it "maps int4[] to Vector Int32" $ do+      let Just ht = oidToHaskellTypeWith Map.empty (Oid 1007)+      htType ht `shouldBe` "Vector Int32"+      htModule ht `shouldBe` "Data.Vector"++    it "maps text[] to Vector Text" $ do+      let Just ht = oidToHaskellTypeWith Map.empty (Oid 1009)+      htType ht `shouldBe` "Vector Text"++    it "maps bool[] to Vector Bool" $ do+      let Just ht = oidToHaskellTypeWith Map.empty (Oid 1000)+      htType ht `shouldBe` "Vector Bool"++    it "uses custom types for unknown OIDs" $ do+      let customs = Map.singleton (Oid 600) (HaskellType "MyPoint" "MyApp.Types")+          Just ht = oidToHaskellTypeWith customs (Oid 600)+      htType ht `shouldBe` "MyPoint"+      htModule ht `shouldBe` "MyApp.Types"++    it "custom types override built-in types" $ do+      let customs = Map.singleton (Oid 23) (HaskellType "CustomInt" "Custom")+          Just ht = oidToHaskellTypeWith customs (Oid 23)+      htType ht `shouldBe` "CustomInt"++  describe "oidToTypeName (array names)" $ do+    it "maps int4[] OID to _int4" $ do+      oidToTypeName (Oid 1007) `shouldBe` Just "_int4"++    it "maps text[] OID to _text" $ do+      oidToTypeName (Oid 1009) `shouldBe` Just "_text"
+ valiant-cli.cabal view
@@ -0,0 +1,134 @@+cabal-version:   3.0+name:            valiant-cli+version:         0.1.0.0+synopsis:        Compile-time checked SQL for Haskell: CLI tool+description:+  The @valiant@ CLI tool connects to a live PostgreSQL database,+  validates @.sql@ files via @PREPARE@ / @DESCRIBE@, and caches+  type metadata for the GHC source plugin to consume at compile time.+license:         BSD-3-Clause+license-file:    LICENSE+author:          Josh Burgess+maintainer:      joshburgess.webdev@gmail.com+category:        Database+homepage:        https://github.com/joshburgess/valiant+bug-reports:     https://github.com/joshburgess/valiant/issues+build-type:      Simple+extra-doc-files:+    CHANGELOG.md+    README.md+tested-with:     GHC ==9.10.3++source-repository head+  type:     git+  location: https://github.com/joshburgess/valiant++flag werror+  description: Enable -Werror for development builds.+  default:     False+  manual:      True++common warnings+  ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors -funbox-strict-fields -fspecialise-aggressively+  if flag(werror)+    ghc-options: -Werror++-- The valiant-cli package ships an executable (`valiant`). The CLI's+-- implementation modules live in a private sublibrary so they don't+-- pollute the Hackage public API surface; the executable and the test+-- suite both depend on it directly.+library cli-internal+  import:           warnings+  visibility:       private+  hs-source-dirs:   src+  default-language: GHC2021+  default-extensions:+    DeriveAnyClass+    DerivingStrategies+    LambdaCase+    OverloadedStrings+    RecordWildCards+    StrictData++  exposed-modules:+    Valiant.CLI.App+    Valiant.CLI.Cache+    Valiant.CLI.Command.Check+    Valiant.CLI.Command.Generate+    Valiant.CLI.Command.Prepare+    Valiant.CLI.Command.Types+    Valiant.CLI.Command.Watch+    Valiant.CLI.Config+    Valiant.CLI.CustomTypes+    Valiant.CLI.Describe+    Valiant.CLI.Discover+    Valiant.CLI.Error+    Valiant.CLI.Hash+    Valiant.CLI.NamedParams+    Valiant.CLI.Nullability+    Valiant.CLI.Output+    Valiant.CLI.SqlMetadata+    Valiant.CLI.TypeMap++  build-depends:+    , aeson                 >=2.1     && <2.3+    , aeson-pretty          >=0.8     && <0.9+    , ansi-terminal         >=1.0     && <1.2+    , base                  >=4.17    && <5+    , bytestring            >=0.11    && <0.13+    , containers            >=0.6     && <0.8+    , cryptohash-sha256     >=0.11    && <0.12+    , directory             >=1.3     && <1.4+    , dotenv                >=0.11    && <0.13+    , filepath              >=1.4     && <1.6+    , Glob                  >=0.10    && <0.11+    , optparse-applicative  >=0.18    && <0.19+    , pg-wire               ==0.1.*+    , text                  >=2.0     && <2.2+    , time                  >=1.12    && <1.15+    , vector                >=0.13    && <0.14++executable valiant+  import:           warnings+  hs-source-dirs:   app+  main-is:          Main.hs+  default-language: GHC2021+  build-depends:+    , base       >=4.17 && <5+    , valiant-cli:cli-internal+  ghc-options:      -threaded -rtsopts++test-suite valiant-cli-test+  import:           warnings+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Main.hs+  default-language: GHC2021+  default-extensions:+    OverloadedStrings++  ghc-options: -rtsopts "-with-rtsopts=-K8K"++  other-modules:+    Valiant.CLI.CacheSpec+    Valiant.CLI.CustomTypesSpec+    Valiant.CLI.DiscoverSpec+    Valiant.CLI.ErrorSpec+    Valiant.CLI.HashSpec+    Valiant.CLI.NamedParamsSpec+    Valiant.CLI.SqlMetadataSpec+    Valiant.CLI.TypeMapSpec++  build-depends:+    , aeson+    , base             >=4.17 && <5+    , bytestring+    , containers+    , directory+    , filepath+    , hspec            >=2.11 && <2.13+    , pg-wire+    , temporary        >=1.3  && <1.4+    , text+    , time+    , valiant-cli:cli-internal