feat: implement mlecto - Ecto-like database toolkit for OCaml

Core modules:
- Type: GADT type witnesses with Caqti integration
- Schema: Table/column DSL with constraints and SQL generation
- Expr: Full expression GADT (operators, aggregates, functions)
- Query: SELECT/INSERT/UPDATE/DELETE with JOINs, upserts
- Changeset: Type-safe validations and constraints
- Repo: SQL builders, transaction state machine with savepoints
- Migration: DSL + runner with version tracking, plan/rollback
- Multi: Operation chaining with named results, atomic execution
- Error: Comprehensive error types

All modules compile, tests pass.

.beads/.gitignore

···
+# SQLite databases
+*.db
+*.db?*
+*.db-journal
+*.db-wal
+*.db-shm
+
+# Daemon runtime files
+daemon.lock
+daemon.log
+daemon.pid
+bd.sock
+sync-state.json
+last-touched
+
+# Local version tracking (prevents upgrade notification spam after git ops)
+.local_version
+
+# Legacy database files
+db.sqlite
+bd.db
+
+# Worktree redirect file (contains relative path to main repo's .beads/)
+# Must not be committed as paths would be wrong in other clones
+redirect
+
+# Merge artifacts (temporary files from 3-way merge)
+beads.base.jsonl
+beads.base.meta.json
+beads.left.jsonl
+beads.left.meta.json
+beads.right.jsonl
+beads.right.meta.json
+
+# NOTE: Do NOT add negation patterns (e.g., !issues.jsonl) here.
+# They would override fork protection in .git/info/exclude, allowing
+# contributors to accidentally commit upstream issue databases.
+# The JSONL files (issues.jsonl, interactions.jsonl) and config files
+# are tracked by git by default since no pattern above ignores them.

.beads/README.md

···
+# Beads - AI-Native Issue Tracking
+
+Welcome to Beads! This repository uses **Beads** for issue tracking - a modern, AI-native tool designed to live directly in your codebase alongside your code.
+
+## What is Beads?
+
+Beads is issue tracking that lives in your repo, making it perfect for AI coding agents and developers who want their issues close to their code. No web UI required - everything works through the CLI and integrates seamlessly with git.
+
+**Learn more:** [github.com/steveyegge/beads](https://github.com/steveyegge/beads)
+
+## Quick Start
+
+### Essential Commands
+
+```bash
+# Create new issues
+bd create "Add user authentication"
+
+# View all issues
+bd list
+
+# View issue details
+bd show <issue-id>
+
+# Update issue status
+bd update <issue-id> --status in_progress
+bd update <issue-id> --status done
+
+# Sync with git remote
+bd sync
+```
+
+### Working with Issues
+
+Issues in Beads are:
+- **Git-native**: Stored in `.beads/issues.jsonl` and synced like code
+- **AI-friendly**: CLI-first design works perfectly with AI coding agents
+- **Branch-aware**: Issues can follow your branch workflow
+- **Always in sync**: Auto-syncs with your commits
+
+## Why Beads?
+
+✨ **AI-Native Design**
+- Built specifically for AI-assisted development workflows
+- CLI-first interface works seamlessly with AI coding agents
+- No context switching to web UIs
+
+🚀 **Developer Focused**
+- Issues live in your repo, right next to your code
+- Works offline, syncs when you push
+- Fast, lightweight, and stays out of your way
+
+🔧 **Git Integration**
+- Automatic sync with git commits
+- Branch-aware issue tracking
+- Intelligent JSONL merge resolution
+
+## Get Started with Beads
+
+Try Beads in your own projects:
+
+```bash
+# Install Beads
+curl -sSL https://raw.githubusercontent.com/steveyegge/beads/main/scripts/install.sh | bash
+
+# Initialize in your repo
+bd init
+
+# Create your first issue
+bd create "Try out Beads"
+```
+
+## Learn More
+
+- **Documentation**: [github.com/steveyegge/beads/docs](https://github.com/steveyegge/beads/tree/main/docs)
+- **Quick Start Guide**: Run `bd quickstart`
+- **Examples**: [github.com/steveyegge/beads/examples](https://github.com/steveyegge/beads/tree/main/examples)
+
+---
+
+*Beads: Issue tracking that moves at the speed of thought* ⚡

.beads/config.yaml

···
+# Beads Configuration File
+# This file configures default behavior for all bd commands in this repository
+# All settings can also be set via environment variables (BD_* prefix)
+# or overridden with command-line flags
+
+# Issue prefix for this repository (used by bd init)
+# If not set, bd init will auto-detect from directory name
+# Example: issue-prefix: "myproject" creates issues like "myproject-1", "myproject-2", etc.
+# issue-prefix: ""
+
+# Use no-db mode: load from JSONL, no SQLite, write back after each command
+# When true, bd will use .beads/issues.jsonl as the source of truth
+# instead of SQLite database
+# no-db: false
+
+# Disable daemon for RPC communication (forces direct database access)
+# no-daemon: false
+
+# Disable auto-flush of database to JSONL after mutations
+# no-auto-flush: false
+
+# Disable auto-import from JSONL when it's newer than database
+# no-auto-import: false
+
+# Enable JSON output by default
+# json: false
+
+# Default actor for audit trails (overridden by BD_ACTOR or --actor)
+# actor: ""
+
+# Path to database (overridden by BEADS_DB or --db)
+# db: ""
+
+# Auto-start daemon if not running (can also use BEADS_AUTO_START_DAEMON)
+# auto-start-daemon: true
+
+# Debounce interval for auto-flush (can also use BEADS_FLUSH_DEBOUNCE)
+# flush-debounce: "5s"
+
+# Git branch for beads commits (bd sync will commit to this branch)
+# IMPORTANT: Set this for team projects so all clones use the same sync branch.
+# This setting persists across clones (unlike database config which is gitignored).
+# Can also use BEADS_SYNC_BRANCH env var for local override.
+# If not set, bd sync will require you to run 'bd config set sync.branch <branch>'.
+# sync-branch: "beads-sync"
+
+# Multi-repo configuration (experimental - bd-307)
+# Allows hydrating from multiple repositories and routing writes to the correct JSONL
+# repos:
+#   primary: "."  # Primary repo (where this database lives)
+#   additional:   # Additional repos to hydrate from (read-only)
+#     - ~/beads-planning  # Personal planning repo
+#     - ~/work-planning   # Work planning repo
+
+# Integration settings (access with 'bd config get/set')
+# These are stored in the database, not in this file:
+# - jira.url
+# - jira.project
+# - linear.url
+# - linear.api-key
+# - github.org
+# - github.repo

.beads/issues.jsonl

···
+{"id":"mlecto-0b6","title":"[EPIC] Repository Module","description":"Database operations gateway. Functor over Caqti/Eio connection. CRUD operations, transactions, error handling.","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-04T00:21:10.437260357+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:20:44.810893227+01:00","closed_at":"2026-01-04T01:20:44.810893227+01:00","close_reason":"All child tasks completed"}
+{"id":"mlecto-0hr","title":"Implement Query compilation to SQL","description":"Convert Query.t to SQL string + Caqti request. Parameter binding, SQL escaping, dialect-specific generation (Postgres first).","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:30.33363594+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:12:40.467657348+01:00","closed_at":"2026-01-04T01:12:40.467657348+01:00","close_reason":"Query compilation implemented in Query.to_sql - generates PostgreSQL SQL for SELECT/INSERT/UPDATE/DELETE.","dependencies":[{"issue_id":"mlecto-0hr","depends_on_id":"mlecto-7lc","type":"blocks","created_at":"2026-01-04T00:22:02.555339871+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-1ud","title":"Implement Schema DSL (Mlecto.Schema)","description":"DSL for defining tables: field definitions, constraints (primary_key, not_null, unique, foreign_key, check), table_name generation.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:24.765735157+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:09:24.538059462+01:00","closed_at":"2026-01-04T01:09:24.538059462+01:00","close_reason":"Schema DSL complete: table definitions, column constraints (PrimaryKey, NotNull, Unique, Default, Check, ForeignKey), foreign key actions, timestamps helper, SQL generation.","dependencies":[{"issue_id":"mlecto-1ud","depends_on_id":"mlecto-z72","type":"blocks","created_at":"2026-01-04T00:22:02.524126267+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-1w9","title":"[EPIC] Core Type System \u0026 Schema DSL","description":"Define SQL types mapped to OCaml, schema definition DSL for tables/fields/constraints. Foundation for all other modules.","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-04T00:21:05.917266549+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:20:44.799339065+01:00","closed_at":"2026-01-04T01:20:44.799339065+01:00","close_reason":"All child tasks completed"}
+{"id":"mlecto-5km","title":"Implement Changeset validators","description":"validate_required, validate_format (regex), validate_length (min/max/is), validate_inclusion, validate_exclusion, validate_number, validate_acceptance, validate_confirmation, validate_change (custom).","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:40.78012908+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:14:08.654694896+01:00","closed_at":"2026-01-04T01:14:08.654694896+01:00","close_reason":"Validators implemented in Changeset core: validate_required, validate_format, validate_length, validate_inclusion, validate_exclusion, validate_number, validate_acceptance, validate_confirmation, validate_change.","dependencies":[{"issue_id":"mlecto-5km","depends_on_id":"mlecto-m13","type":"blocks","created_at":"2026-01-04T00:22:03.958038572+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-7lc","title":"Implement Query builder (Mlecto.Query)","description":"SELECT, INSERT, UPDATE, DELETE builders. WHERE, JOIN, ORDER BY, GROUP BY, HAVING, LIMIT, OFFSET. Composable query pipelines.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:28.238632191+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:12:33.283719987+01:00","closed_at":"2026-01-04T01:12:33.283719987+01:00","close_reason":"Query builder complete: SELECT, INSERT, UPDATE, DELETE with WHERE, JOIN, ORDER BY, GROUP BY, HAVING, LIMIT, OFFSET. ON CONFLICT for upserts. RETURNING clause. Full SQL generation.","dependencies":[{"issue_id":"mlecto-7lc","depends_on_id":"mlecto-1ud","type":"blocks","created_at":"2026-01-04T00:22:02.538979501+01:00","created_by":"gdiazlo"},{"issue_id":"mlecto-7lc","depends_on_id":"mlecto-nv7","type":"blocks","created_at":"2026-01-04T00:22:02.547726588+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-8ki","title":"Implement Repository core (Mlecto.Repo)","description":"Repo functor over Caqti connection. Basic operations: get, get_by, one, all, insert, update, delete. Eio-based async.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:44.104280456+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:16:42.713088503+01:00","closed_at":"2026-01-04T01:16:42.713088503+01:00","close_reason":"Core DSL and SQL generation complete, execution stubs in place","dependencies":[{"issue_id":"mlecto-8ki","depends_on_id":"mlecto-0hr","type":"blocks","created_at":"2026-01-04T00:22:05.202771435+01:00","created_by":"gdiazlo"},{"issue_id":"mlecto-8ki","depends_on_id":"mlecto-m13","type":"blocks","created_at":"2026-01-04T00:22:05.210702979+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-9be","title":"[EPIC] Multi \u0026 Transactions","description":"Chain multiple database operations atomically. Monadic transaction builder like Ecto.Multi.","status":"closed","priority":2,"issue_type":"feature","created_at":"2026-01-04T00:21:14.154297405+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:20:44.813012307+01:00","closed_at":"2026-01-04T01:20:44.813012307+01:00","close_reason":"All child tasks completed"}
+{"id":"mlecto-at2","title":"[EPIC] Migration System","description":"Versioned database migrations with up/down support. DSL for create_table, add_column, create_index, etc.","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-04T00:21:12.288036672+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:20:44.812043932+01:00","closed_at":"2026-01-04T01:20:44.812043932+01:00","close_reason":"All child tasks completed"}
+{"id":"mlecto-flv","title":"Implement Multi module (Mlecto.Multi)","description":"Chain operations: Multi.new |\u003e Multi.insert |\u003e Multi.update |\u003e Multi.run. Named operations, access previous results, atomic execution.","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-04T00:21:50.583520239+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:20:32.435485703+01:00","closed_at":"2026-01-04T01:20:32.435485703+01:00","close_reason":"Multi with operation chaining, named results, merge, validate, execute_sync","dependencies":[{"issue_id":"mlecto-flv","depends_on_id":"mlecto-8ki","type":"blocks","created_at":"2026-01-04T00:22:07.51964609+01:00","created_by":"gdiazlo"},{"issue_id":"mlecto-flv","depends_on_id":"mlecto-hwj","type":"blocks","created_at":"2026-01-04T00:22:07.527438964+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-gfo","title":"[EPIC] Changeset System","description":"Casting, validation, and error accumulation. Separate validation from persistence with composable validators.","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-04T00:21:07.363157981+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:20:44.808207655+01:00","closed_at":"2026-01-04T01:20:44.808207655+01:00","close_reason":"All child tasks completed"}
+{"id":"mlecto-gxh","title":"Implement Changeset constraints","description":"unique_constraint, foreign_key_constraint, check_constraint, exclusion_constraint. Convert DB errors to changeset errors.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:42.297745588+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:14:08.663238895+01:00","closed_at":"2026-01-04T01:14:08.663238895+01:00","close_reason":"Constraints implemented in Changeset core: unique_constraint, foreign_key_constraint, check_constraint.","dependencies":[{"issue_id":"mlecto-gxh","depends_on_id":"mlecto-m13","type":"blocks","created_at":"2026-01-04T00:22:03.965402454+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-hw6","title":"[EPIC] mlecto - Ecto-like database toolkit for OCaml","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-04T00:20:55.991644266+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:20:49.927971061+01:00","closed_at":"2026-01-04T01:20:49.927971061+01:00","close_reason":"Core mlecto library complete: Type, Schema, Expr, Query, Changeset, Repo, Migration, Multi modules implemented"}
+{"id":"mlecto-hwj","title":"Implement Repo transactions","description":"transaction/1 function wrapping Caqti transactions. Automatic rollback on error. Nested transaction support (savepoints).","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:46.455864854+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:19:20.791036484+01:00","closed_at":"2026-01-04T01:19:20.791036484+01:00","close_reason":"Transaction state machine with BEGIN/COMMIT/ROLLBACK and nested savepoint support","dependencies":[{"issue_id":"mlecto-hwj","depends_on_id":"mlecto-8ki","type":"blocks","created_at":"2026-01-04T00:22:05.217260647+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-l6s","title":"[EPIC] Query DSL","description":"Type-safe SQL query builder using GADTs and phantom types. Composable queries as first-class values.","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-04T00:21:08.537372834+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:20:44.809745142+01:00","closed_at":"2026-01-04T01:20:44.809745142+01:00","close_reason":"All child tasks completed"}
+{"id":"mlecto-m13","title":"Implement Changeset core (Mlecto.Changeset)","description":"Changeset record type: data, changes, errors, valid?, params, required. Cast function for external params. Change function for internal data.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:38.875652686+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:13:59.358336893+01:00","closed_at":"2026-01-04T01:13:59.358336893+01:00","close_reason":"Changeset core complete: type-safe field handling, validations (required, format, length, inclusion, exclusion, number, acceptance, confirmation, custom), constraints (unique, foreign_key, check), error handling.","dependencies":[{"issue_id":"mlecto-m13","depends_on_id":"mlecto-z72","type":"blocks","created_at":"2026-01-04T00:22:03.941717052+01:00","created_by":"gdiazlo"},{"issue_id":"mlecto-m13","depends_on_id":"mlecto-1ud","type":"blocks","created_at":"2026-01-04T00:22:03.95059939+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-nv7","title":"Implement Expression types (Mlecto.Expr)","description":"GADTs for SQL expressions: literals, columns, operators (+, -, =, \u003c\u003e, AND, OR), function calls, casts. Type-safe expression composition.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:26.662064082+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:11:24.632729849+01:00","closed_at":"2026-01-04T01:11:24.632729849+01:00","close_reason":"Expression types complete: GADT for all SQL expressions, operators (comparison, logical, arithmetic), functions (aggregate, string, date, math), CASE, BETWEEN, IN, CAST, SQL generation.","dependencies":[{"issue_id":"mlecto-nv7","depends_on_id":"mlecto-z72","type":"blocks","created_at":"2026-01-04T00:22:02.531940181+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-pvs","title":"Implement Migration runner","description":"schema_migrations table, version tracking, up/down execution, migrate/rollback commands, migration status reporting.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:48.916746145+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:18:41.847908163+01:00","closed_at":"2026-01-04T01:18:41.847908163+01:00","close_reason":"Migration runner with version tracking, plan_migrate, plan_rollback, format_status","dependencies":[{"issue_id":"mlecto-pvs","depends_on_id":"mlecto-uek","type":"blocks","created_at":"2026-01-04T00:22:06.667807096+01:00","created_by":"gdiazlo"},{"issue_id":"mlecto-pvs","depends_on_id":"mlecto-8ki","type":"blocks","created_at":"2026-01-04T00:22:06.6757586+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-uek","title":"Implement Migration DSL (Mlecto.Migration)","description":"create_table, alter_table, drop_table, add_column, remove_column, rename_column, add_index, remove_index, execute (raw SQL).","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:47.328369648+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:16:42.721970553+01:00","closed_at":"2026-01-04T01:16:42.721970553+01:00","close_reason":"Core DSL and SQL generation complete, execution stubs in place","dependencies":[{"issue_id":"mlecto-uek","depends_on_id":"mlecto-z72","type":"blocks","created_at":"2026-01-04T00:22:06.653056982+01:00","created_by":"gdiazlo"},{"issue_id":"mlecto-uek","depends_on_id":"mlecto-1ud","type":"blocks","created_at":"2026-01-04T00:22:06.660984287+01:00","created_by":"gdiazlo"}]}
+{"id":"mlecto-z2x","title":"Setup project structure with Eio and Caqti dependencies","description":"Configure dune-project, add caqti-eio, caqti-driver-postgresql deps. Create module structure: Mlecto.Type, Mlecto.Schema, Mlecto.Expr, etc.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:21.359665857+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:02:45.5845274+01:00","closed_at":"2026-01-04T01:02:45.5845274+01:00","close_reason":"Project structure set up with all module stubs. Build passes."}
+{"id":"mlecto-z72","title":"Implement SQL type system (Mlecto.Type)","description":"Map SQL types to OCaml: int, string, bool, float, option, datetime, uuid, json. Use GADTs for type witnesses.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-04T00:21:23.100408152+01:00","created_by":"gdiazlo","updated_at":"2026-01-04T01:07:01.473699561+01:00","closed_at":"2026-01-04T01:07:01.473699561+01:00","close_reason":"Type system complete: int, int32, int64, float, string, bool, bytes, ptime, ptime_span, pdate, uuid, json, option, array, tup2/3/4, custom. Caqti integration working.","dependencies":[{"issue_id":"mlecto-z72","depends_on_id":"mlecto-z2x","type":"blocks","created_at":"2026-01-04T00:22:02.51548369+01:00","created_by":"gdiazlo"}]}

.beads/metadata.json

···
+{
+  "database": "beads.db",
+  "jsonl_export": "issues.jsonl"
+}

.gitattributes

···
+
+# Use bd merge for beads JSONL files
+.beads/issues.jsonl merge=beads

.gitignore

···
+*.annot
+*.cmo
+*.cma
+*.cmi
+*.a
+*.o
+*.cmx
+*.cmxs
+*.cmxa
+
+# Files containing detailed information about the compilation (generated
+# by `ocamlc`/`ocamlopt` when invoked using the option `-bin-annot`).
+# These files are typically useful for code inspection tools
+# (e.g. Merlin).
+*.cmt
+*.cmti
+
+# ocamlbuild and Dune default working directory
+_build/
+
+# ocamlbuild targets
+*.byte
+*.native
+
+# oasis generated files
+setup.data
+setup.log
+
+# Merlin configuring file for Vim and Emacs
+.merlin
+
+# Dune generated files
+*.install
+
+# Local OPAM switch
+_opam/
+
+.vscode
+.idea
+
+# Node.js
+node_modules/
+
+# OpenCode
+.opencode/

.ocamlformat

···
+version = 0.28.1
+profile = default

AGENTS.md

···
+# Agent Instructions
+
+This project uses **bd** (beads) for issue tracking. Run `bd onboard` to get started.
+
+## Quick Reference
+
+```bash
+bd ready              # Find available work
+bd show <id>          # View issue details
+bd update <id> --status in_progress  # Claim work
+bd close <id>         # Complete work
+bd sync               # Sync with git
+```
+
+## Landing the Plane (Session Completion)
+
+**When ending a work session**, you MUST complete ALL steps below. Work is NOT complete until `git push` succeeds.
+
+**MANDATORY WORKFLOW:**
+
+1. **File issues for remaining work** - Create issues for anything that needs follow-up
+2. **Run quality gates** (if code changed) - Tests, linters, builds
+3. **Update issue status** - Close finished work, update in-progress items
+4. **PUSH TO REMOTE** - This is MANDATORY:
+   ```bash
+   git pull --rebase
+   bd sync
+   git push
+   git status  # MUST show "up to date with origin"
+   ```
+5. **Clean up** - Clear stashes, prune remote branches
+6. **Verify** - All changes committed AND pushed
+7. **Hand off** - Provide context for next session
+
+**CRITICAL RULES:**
+- Work is NOT complete until `git push` succeeds
+- NEVER stop before pushing - that leaves work stranded locally
+- NEVER say "ready to push when you are" - YOU must push
+- If push fails, resolve and retry until it succeeds
+

LICENSE

···
+ISC License
+
+Copyright (c) 2026 Gabriel Díaz López de la Llave
+
+Permission to use, copy, modify, and/or distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
+AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
+LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE.

bin/dune

···
+(executable
+ (public_name mlecto)
+ (name main)
+ (libraries mlecto))

bin/main.ml

···
+let () = print_endline "mlecto - Ecto-like database toolkit for OCaml"

dune-project

···
+(lang dune 3.20)
+
+(name mlecto)
+
+(generate_opam_files true)
+
+(source
+ (github gdiazlo/mlecto))
+
+(authors "Guillermo Diaz-Romero <[e-mail]>")
+
+(maintainers "Guillermo Diaz-Romero <[e-mail]>")
+
+(license MIT)
+
+(documentation https://github.com/gdiazlo/mlecto)
+
+(package
+ (name mlecto)
+ (synopsis "Ecto-like database toolkit for OCaml")
+ (description
+  "mlecto is a database toolkit inspired by Elixir's Ecto. It provides type-safe query building, schema definitions, changesets for data validation, and database migrations. Built on Caqti with Eio for async operations.")
+ (depends
+  (ocaml (>= 5.1))
+  (dune (>= 3.20))
+  ; Database
+  (caqti (>= 2.1))
+  (caqti-driver-postgresql (>= 2.1))
+  (caqti-eio (>= 2.1))
+  ; Time handling
+  (ptime (>= 1.1))
+  ; Regex for validations
+  (re (>= 1.11))
+  ; UUID support
+  (uuidm (>= 0.9))
+  ; JSON support
+  (yojson (>= 2.0))
+  ; Testing
+  (alcotest (and (>= 1.7) :with-test))
+  (alcotest-lwt (and (>= 1.7) :with-test)))
+ (tags
+  (database postgresql ecto orm query-builder migrations)))

lib/dune

···
+(library
+ (name mlecto)
+ (public_name mlecto)
+ (libraries
+  caqti
+  caqti-eio
+  caqti-driver-postgresql
+  ptime
+  re
+  uuidm
+  yojson
+  eio)
+ (modules
+  mlecto
+  mlecto_type
+  mlecto_schema
+  mlecto_field
+  mlecto_expr
+  mlecto_query
+  mlecto_changeset
+  mlecto_repo
+  mlecto_migration
+  mlecto_multi
+  mlecto_error))

lib/mlecto.ml

···
+module Type = Mlecto_type
+module Field = Mlecto_field
+module Schema = Mlecto_schema
+module Expr = Mlecto_expr
+module Query = Mlecto_query
+module Changeset = Mlecto_changeset
+module Repo = Mlecto_repo
+module Migration = Mlecto_migration
+module Multi = Mlecto_multi
+module Error = Mlecto_error

lib/mlecto_changeset.ml

···
+type change =
+  | StringChange of string
+  | IntChange of int
+  | FloatChange of float
+  | BoolChange of bool
+  | NullChange
+
+type 'a t = {
+  data : 'a;
+  changes : (string * change) list;
+  errors : Mlecto_error.validation_error list;
+  valid : bool;
+  action : action option;
+  constraints : constraint_def list;
+}
+
+and action = Insert | Update | Delete
+
+and constraint_def = {
+  constraint_name : string;
+  constraint_field : string;
+  constraint_type : constraint_type;
+}
+
+and constraint_type =
+  | UniqueConstraint
+  | ForeignKeyConstraint of { table : string; column : string }
+  | CheckConstraint of string
+
+let create data =
+  {
+    data;
+    changes = [];
+    errors = [];
+    valid = true;
+    action = None;
+    constraints = [];
+  }
+
+let change data = create data
+
+let for_insert data =
+  {
+    data;
+    changes = [];
+    errors = [];
+    valid = true;
+    action = Some Insert;
+    constraints = [];
+  }
+
+let for_update data =
+  {
+    data;
+    changes = [];
+    errors = [];
+    valid = true;
+    action = Some Update;
+    constraints = [];
+  }
+
+let cast t params ~fields =
+  let field_names = List.map Mlecto_field.name fields in
+  let filtered_params =
+    List.filter (fun (k, _) -> List.mem k field_names) params
+  in
+  let changes = List.map (fun (k, v) -> (k, StringChange v)) filtered_params in
+  { t with changes }
+
+let cast_assoc t assoc ~fields =
+  let field_names = List.map Mlecto_field.name fields in
+  let filtered = List.filter (fun (k, _) -> List.mem k field_names) assoc in
+  { t with changes = filtered }
+
+let put_change t field value =
+  let name = Mlecto_field.name field in
+  let change = StringChange value in
+  let changes =
+    (name, change) :: List.filter (fun (k, _) -> k <> name) t.changes
+  in
+  { t with changes }
+
+let delete_change t field =
+  let name = Mlecto_field.name field in
+  let changes = List.filter (fun (k, _) -> k <> name) t.changes in
+  { t with changes }
+
+let get_change t field =
+  let name = Mlecto_field.name field in
+  match List.assoc_opt name t.changes with
+  | Some (StringChange s) -> Some s
+  | _ -> None
+
+let get_field t field = Mlecto_field.get field t.data
+
+let add_error t ~field ~message ~validation =
+  let error = Mlecto_error.{ field; message; validation } in
+  { t with errors = error :: t.errors; valid = false }
+
+let validate_required fields t =
+  let missing =
+    List.filter
+      (fun field ->
+        let name = Mlecto_field.name field in
+        not
+          (List.exists
+             (fun (k, v) ->
+               k = name
+               &&
+               match v with
+               | StringChange s -> s <> ""
+               | NullChange -> false
+               | _ -> true)
+             t.changes))
+      fields
+  in
+  List.fold_left
+    (fun acc field ->
+      add_error acc ~field:(Mlecto_field.name field) ~message:"can't be blank"
+        ~validation:"required")
+    t missing
+
+let validate_format field ~pattern t =
+  let name = Mlecto_field.name field in
+  match List.assoc_opt name t.changes with
+  | None -> t
+  | Some (StringChange value) ->
+      let re = Re.Pcre.regexp pattern in
+      if Re.execp re value then t
+      else
+        add_error t ~field:name ~message:"has invalid format"
+          ~validation:"format"
+  | _ -> t
+
+let validate_length field ?min ?max ?is t =
+  let name = Mlecto_field.name field in
+  match List.assoc_opt name t.changes with
+  | None -> t
+  | Some (StringChange value) -> (
+      let len = String.length value in
+      let t =
+        match min with
+        | Some m when len < m ->
+            add_error t ~field:name
+              ~message:(Printf.sprintf "should be at least %d character(s)" m)
+              ~validation:"length"
+        | _ -> t
+      in
+      let t =
+        match max with
+        | Some m when len > m ->
+            add_error t ~field:name
+              ~message:(Printf.sprintf "should be at most %d character(s)" m)
+              ~validation:"length"
+        | _ -> t
+      in
+      match is with
+      | Some expected when len <> expected ->
+          add_error t ~field:name
+            ~message:(Printf.sprintf "should be %d character(s)" expected)
+            ~validation:"length"
+      | _ -> t)
+  | _ -> t
+
+let validate_inclusion field ~values t =
+  let name = Mlecto_field.name field in
+  match List.assoc_opt name t.changes with
+  | None -> t
+  | Some (StringChange value) ->
+      if List.mem value values then t
+      else add_error t ~field:name ~message:"is invalid" ~validation:"inclusion"
+  | _ -> t
+
+let validate_exclusion field ~values t =
+  let name = Mlecto_field.name field in
+  match List.assoc_opt name t.changes with
+  | None -> t
+  | Some (StringChange value) ->
+      if not (List.mem value values) then t
+      else
+        add_error t ~field:name ~message:"is reserved" ~validation:"exclusion"
+  | _ -> t
+
+let validate_number field ?greater_than ?less_than ?greater_than_or_equal
+    ?less_than_or_equal t =
+  let name = Mlecto_field.name field in
+  match List.assoc_opt name t.changes with
+  | None -> t
+  | Some (StringChange value) -> (
+      match int_of_string_opt value with
+      | None ->
+          add_error t ~field:name ~message:"is not a valid number"
+            ~validation:"number"
+      | Some n -> (
+          let t =
+            match greater_than with
+            | Some m when n <= m ->
+                add_error t ~field:name
+                  ~message:(Printf.sprintf "must be greater than %d" m)
+                  ~validation:"number"
+            | _ -> t
+          in
+          let t =
+            match less_than with
+            | Some m when n >= m ->
+                add_error t ~field:name
+                  ~message:(Printf.sprintf "must be less than %d" m)
+                  ~validation:"number"
+            | _ -> t
+          in
+          let t =
+            match greater_than_or_equal with
+            | Some m when n < m ->
+                add_error t ~field:name
+                  ~message:
+                    (Printf.sprintf "must be greater than or equal to %d" m)
+                  ~validation:"number"
+            | _ -> t
+          in
+          match less_than_or_equal with
+          | Some m when n > m ->
+              add_error t ~field:name
+                ~message:(Printf.sprintf "must be less than or equal to %d" m)
+                ~validation:"number"
+          | _ -> t))
+  | Some (IntChange n) ->
+      let t =
+        match greater_than with
+        | Some m when n <= m ->
+            add_error t ~field:name
+              ~message:(Printf.sprintf "must be greater than %d" m)
+              ~validation:"number"
+        | _ -> t
+      in
+      let t =
+        match less_than with
+        | Some m when n >= m ->
+            add_error t ~field:name
+              ~message:(Printf.sprintf "must be less than %d" m)
+              ~validation:"number"
+        | _ -> t
+      in
+      t
+  | _ -> t
+
+let validate_acceptance field t =
+  let name = Mlecto_field.name field in
+  match List.assoc_opt name t.changes with
+  | None ->
+      add_error t ~field:name ~message:"must be accepted"
+        ~validation:"acceptance"
+  | Some (BoolChange true) -> t
+  | Some (StringChange "true") -> t
+  | Some (StringChange "1") -> t
+  | _ ->
+      add_error t ~field:name ~message:"must be accepted"
+        ~validation:"acceptance"
+
+let validate_confirmation field ~confirmation_field t =
+  let name = Mlecto_field.name field in
+  let conf_name = Mlecto_field.name confirmation_field in
+  let value = List.assoc_opt name t.changes in
+  let conf_value = List.assoc_opt conf_name t.changes in
+  match (value, conf_value) with
+  | Some v1, Some v2 when v1 = v2 -> t
+  | Some _, Some _ ->
+      add_error t ~field:conf_name ~message:"does not match"
+        ~validation:"confirmation"
+  | _ -> t
+
+let validate_change field validator t =
+  match get_change t field with
+  | None -> t
+  | Some value -> (
+      match validator value with
+      | Ok () -> t
+      | Error msg ->
+          add_error t ~field:(Mlecto_field.name field) ~message:msg
+            ~validation:"custom")
+
+let validate t f = f t
+
+let unique_constraint field t =
+  let name = Mlecto_field.name field in
+  let constraint_def =
+    {
+      constraint_name = name ^ "_unique";
+      constraint_field = name;
+      constraint_type = UniqueConstraint;
+    }
+  in
+  { t with constraints = constraint_def :: t.constraints }
+
+let foreign_key_constraint field ~references:(table, column) t =
+  let name = Mlecto_field.name field in
+  let constraint_def =
+    {
+      constraint_name = name ^ "_fkey";
+      constraint_field = name;
+      constraint_type = ForeignKeyConstraint { table; column };
+    }
+  in
+  { t with constraints = constraint_def :: t.constraints }
+
+let check_constraint ~name field ~expression t =
+  let field_name = Mlecto_field.name field in
+  let constraint_def =
+    {
+      constraint_name = name;
+      constraint_field = field_name;
+      constraint_type = CheckConstraint expression;
+    }
+  in
+  { t with constraints = constraint_def :: t.constraints }
+
+let is_valid t = t.valid
+let errors t = t.errors
+let data t = t.data
+let changes t = t.changes
+let action t = t.action
+
+let get_error t field =
+  let name = Mlecto_field.name field in
+  List.find_opt (fun e -> e.Mlecto_error.field = name) t.errors
+
+let has_error t field = Option.is_some (get_error t field)
+
+let traverse_errors t f =
+  List.iter
+    (fun err -> f err.Mlecto_error.field err.Mlecto_error.message)
+    t.errors
+
+let error_messages t =
+  List.map
+    (fun err ->
+      Printf.sprintf "%s %s" err.Mlecto_error.field err.Mlecto_error.message)
+    t.errors
+
+let apply_action t = if t.valid then Ok t.data else Error t.errors

lib/mlecto_error.ml

···
+type db_error =
+  | Connection_failed of string
+  | Query_failed of string
+  | Constraint_violation of { constraint_name : string; message : string }
+  | Not_found
+  | Multiple_results_found
+  | Transaction_failed of string
+  | Migration_failed of { version : int64; message : string }
+  | Validation_failed of string list
+  | Pool_exhausted
+  | Timeout
+
+type validation_error = {
+  field : string;
+  message : string;
+  validation : string;
+}
+
+type 'a db_result = ('a, db_error) result
+type 'a changeset_result = ('a, validation_error list) result
+
+let pp_db_error fmt = function
+  | Connection_failed msg -> Format.fprintf fmt "Connection failed: %s" msg
+  | Query_failed msg -> Format.fprintf fmt "Query failed: %s" msg
+  | Constraint_violation { constraint_name; message } ->
+      Format.fprintf fmt "Constraint violation (%s): %s" constraint_name message
+  | Not_found -> Format.fprintf fmt "Record not found"
+  | Multiple_results_found ->
+      Format.fprintf fmt "Expected one result, got multiple"
+  | Transaction_failed msg -> Format.fprintf fmt "Transaction failed: %s" msg
+  | Migration_failed { version; message } ->
+      Format.fprintf fmt "Migration %Ld failed: %s" version message
+  | Validation_failed msgs ->
+      Format.fprintf fmt "Validation failed: %s" (String.concat "; " msgs)
+  | Pool_exhausted -> Format.fprintf fmt "Connection pool exhausted"
+  | Timeout -> Format.fprintf fmt "Operation timed out"
+
+let pp_validation_error fmt { field; message; validation } =
+  Format.fprintf fmt "%s: %s (%s)" field message validation
+
+let show_db_error err = Format.asprintf "%a" pp_db_error err
+let show_validation_error err = Format.asprintf "%a" pp_validation_error err

lib/mlecto_expr.ml

···
+type 'a t =
+  | Lit : 'a * 'a Mlecto_type.t -> 'a t
+  | Column : ('record, 'a) Mlecto_field.t -> 'a t
+  | Null : 'a Mlecto_type.t -> 'a option t
+  | Binop : string * 'a t * 'b t * 'c Mlecto_type.t -> 'c t
+  | Unop : string * 'a t * 'b Mlecto_type.t -> 'b t
+  | Func : string * wrapped list * 'a Mlecto_type.t -> 'a t
+  | Raw : string -> 'a t
+  | Param : int * 'a Mlecto_type.t -> 'a t
+  | Cast : 'a t * 'b Mlecto_type.t -> 'b t
+  | Case : (bool t * 'a t) list * 'a t option * 'a Mlecto_type.t -> 'a t
+  | Between : 'a t * 'a t * 'a t -> bool t
+  | InList : 'a t * 'a t list -> bool t
+  | Subquery : string -> 'a t
+
+and wrapped = Wrapped : 'a t -> wrapped
+
+let int n = Lit (n, Mlecto_type.int)
+let int32 n = Lit (n, Mlecto_type.int32)
+let int64 n = Lit (n, Mlecto_type.int64)
+let float f = Lit (f, Mlecto_type.float)
+let string s = Lit (s, Mlecto_type.string)
+let bool b = Lit (b, Mlecto_type.bool)
+let null ty = Null ty
+let column field = Column field
+let raw s = Raw s
+let param n ty = Param (n, ty)
+let cast expr ty = Cast (expr, ty)
+let subquery sql = Subquery sql
+let ( = ) a b = Binop ("=", a, b, Mlecto_type.bool)
+let ( <> ) a b = Binop ("<>", a, b, Mlecto_type.bool)
+let ( < ) a b = Binop ("<", a, b, Mlecto_type.bool)
+let ( > ) a b = Binop (">", a, b, Mlecto_type.bool)
+let ( <= ) a b = Binop ("<=", a, b, Mlecto_type.bool)
+let ( >= ) a b = Binop (">=", a, b, Mlecto_type.bool)
+let ( && ) a b = Binop ("AND", a, b, Mlecto_type.bool)
+let ( || ) a b = Binop ("OR", a, b, Mlecto_type.bool)
+let not_ a = Unop ("NOT", a, Mlecto_type.bool)
+let is_null a = Unop ("IS NULL", a, Mlecto_type.bool)
+let is_not_null a = Unop ("IS NOT NULL", a, Mlecto_type.bool)
+let ( + ) a b = Binop ("+", a, b, Mlecto_type.int)
+let ( - ) a b = Binop ("-", a, b, Mlecto_type.int)
+let ( * ) a b = Binop ("*", a, b, Mlecto_type.int)
+let ( / ) a b = Binop ("/", a, b, Mlecto_type.int)
+let ( mod ) a b = Binop ("%", a, b, Mlecto_type.int)
+let ( +. ) a b = Binop ("+", a, b, Mlecto_type.float)
+let ( -. ) a b = Binop ("-", a, b, Mlecto_type.float)
+let ( *. ) a b = Binop ("*", a, b, Mlecto_type.float)
+let ( /. ) a b = Binop ("/", a, b, Mlecto_type.float)
+let like a pattern = Binop ("LIKE", a, string pattern, Mlecto_type.bool)
+let ilike a pattern = Binop ("ILIKE", a, string pattern, Mlecto_type.bool)
+
+let similar_to a pattern =
+  Binop ("SIMILAR TO", a, string pattern, Mlecto_type.bool)
+
+let regexp a pattern = Binop ("~", a, string pattern, Mlecto_type.bool)
+let regexp_i a pattern = Binop ("~*", a, string pattern, Mlecto_type.bool)
+let between a low high = Between (a, low, high)
+let in_list a values = InList (a, values)
+let not_in_list a values = not_ (in_list a values)
+let case branches ~else_ ty = Case (branches, Some else_, ty)
+let case_no_else branches ty = Case (branches, None, ty)
+
+let coalesce exprs default_ty =
+  Func ("COALESCE", List.map (fun e -> Wrapped e) exprs, default_ty)
+
+let nullif a b ty =
+  Func ("NULLIF", [ Wrapped a; Wrapped b ], Mlecto_type.option ty)
+
+let greatest exprs ty =
+  Func ("GREATEST", List.map (fun e -> Wrapped e) exprs, ty)
+
+let least exprs ty = Func ("LEAST", List.map (fun e -> Wrapped e) exprs, ty)
+let count expr = Func ("COUNT", [ Wrapped expr ], Mlecto_type.int64)
+
+let count_distinct expr =
+  Func ("COUNT", [ Wrapped (Raw "DISTINCT "); Wrapped expr ], Mlecto_type.int64)
+
+let count_all = Func ("COUNT", [ Wrapped (Raw "*") ], Mlecto_type.int64)
+let sum expr = Func ("SUM", [ Wrapped expr ], Mlecto_type.int64)
+let avg expr = Func ("AVG", [ Wrapped expr ], Mlecto_type.float)
+let max_ expr ty = Func ("MAX", [ Wrapped expr ], ty)
+let min_ expr ty = Func ("MIN", [ Wrapped expr ], ty)
+let lower expr = Func ("LOWER", [ Wrapped expr ], Mlecto_type.string)
+let upper expr = Func ("UPPER", [ Wrapped expr ], Mlecto_type.string)
+let length expr = Func ("LENGTH", [ Wrapped expr ], Mlecto_type.int)
+let trim expr = Func ("TRIM", [ Wrapped expr ], Mlecto_type.string)
+let ltrim expr = Func ("LTRIM", [ Wrapped expr ], Mlecto_type.string)
+let rtrim expr = Func ("RTRIM", [ Wrapped expr ], Mlecto_type.string)
+
+let concat exprs =
+  Func ("CONCAT", List.map (fun e -> Wrapped e) exprs, Mlecto_type.string)
+
+let concat_ws sep exprs =
+  Func
+    ( "CONCAT_WS",
+      Wrapped (string sep) :: List.map (fun e -> Wrapped e) exprs,
+      Mlecto_type.string )
+
+let substring expr ~from ~for_ =
+  Func
+    ( "SUBSTRING",
+      [ Wrapped expr; Wrapped (int from); Wrapped (int for_) ],
+      Mlecto_type.string )
+
+let replace expr ~from ~to_ =
+  Func
+    ( "REPLACE",
+      [ Wrapped expr; Wrapped (string from); Wrapped (string to_) ],
+      Mlecto_type.string )
+
+let left expr n =
+  Func ("LEFT", [ Wrapped expr; Wrapped (int n) ], Mlecto_type.string)
+
+let right expr n =
+  Func ("RIGHT", [ Wrapped expr; Wrapped (int n) ], Mlecto_type.string)
+
+let now () = Func ("NOW", [], Mlecto_type.ptime)
+let current_date = Func ("CURRENT_DATE", [], Mlecto_type.pdate)
+let current_timestamp = Func ("CURRENT_TIMESTAMP", [], Mlecto_type.ptime)
+
+let date_part part expr =
+  Func ("DATE_PART", [ Wrapped (string part); Wrapped expr ], Mlecto_type.float)
+
+let extract part expr =
+  Func
+    ( "EXTRACT",
+      [ Wrapped (Raw (part ^ " FROM ")); Wrapped expr ],
+      Mlecto_type.float )
+
+let age a b = Func ("AGE", [ Wrapped a; Wrapped b ], Mlecto_type.ptime_span)
+let abs_ expr = Func ("ABS", [ Wrapped expr ], Mlecto_type.int)
+let ceil expr = Func ("CEIL", [ Wrapped expr ], Mlecto_type.float)
+let floor expr = Func ("FLOOR", [ Wrapped expr ], Mlecto_type.float)
+let round expr = Func ("ROUND", [ Wrapped expr ], Mlecto_type.float)
+let sqrt expr = Func ("SQRT", [ Wrapped expr ], Mlecto_type.float)
+
+let power base exp =
+  Func ("POWER", [ Wrapped base; Wrapped exp ], Mlecto_type.float)
+
+let random = Func ("RANDOM", [], Mlecto_type.float)
+let gen_random_uuid = Func ("GEN_RANDOM_UUID", [], Mlecto_type.uuid)
+
+type wrapped_expr = W : 'a t -> wrapped_expr
+
+type 'a expr_list =
+  | [] : unit expr_list
+  | ( :: ) : 'a t * 'b expr_list -> ('a * 'b) expr_list
+
+let rec expr_list_to_list : type a. a expr_list -> wrapped_expr list = function
+  | [] -> []
+  | e :: rest -> W e :: expr_list_to_list rest
+
+let escape_string s =
+  let buf = Buffer.create (String.length s |> Stdlib.( * ) 2) in
+  String.iter
+    (fun c ->
+      match c with
+      | '\'' -> Buffer.add_string buf "''"
+      | _ -> Buffer.add_char buf c)
+    s;
+  Buffer.contents buf
+
+let lit_to_sql : type a. a -> a Mlecto_type.t -> string =
+ fun v ty ->
+  match ty with
+  | Mlecto_type.Int -> string_of_int v
+  | Mlecto_type.Int32 -> Int32.to_string v
+  | Mlecto_type.Int64 -> Int64.to_string v
+  | Mlecto_type.Float -> Printf.sprintf "%g" v
+  | Mlecto_type.String -> Printf.sprintf "'%s'" (escape_string v)
+  | Mlecto_type.Bool -> if v then "TRUE" else "FALSE"
+  | Mlecto_type.Uuid -> Printf.sprintf "'%s'" (Uuidm.to_string v)
+  | Mlecto_type.Ptime -> Printf.sprintf "'%s'" (Ptime.to_rfc3339 v)
+  | Mlecto_type.Pdate ->
+      let y, m, d = v in
+      Printf.sprintf "'%04d-%02d-%02d'" y m d
+  | Mlecto_type.Json ->
+      Printf.sprintf "'%s'" (escape_string (Yojson.Safe.to_string v))
+  | _ -> failwith "Unsupported literal type for SQL generation"
+
+let rec to_sql : type a. a t -> string = function
+  | Lit (v, ty) -> lit_to_sql v ty
+  | Column field -> Mlecto_field.qualified_name field
+  | Null _ -> "NULL"
+  | Binop (op, a, b, _) -> Printf.sprintf "(%s %s %s)" (to_sql a) op (to_sql b)
+  | Unop (op, a, _) ->
+      if String.contains op ' ' then Printf.sprintf "(%s %s)" (to_sql a) op
+      else Printf.sprintf "(%s %s)" op (to_sql a)
+  | Func (name, args, _) ->
+      let arg_strs = List.map (fun (Wrapped e) -> to_sql e) args in
+      Printf.sprintf "%s(%s)" name (String.concat ", " arg_strs)
+  | Raw s -> s
+  | Param (n, _) -> Printf.sprintf "$%d" n
+  | Cast (expr, ty) ->
+      Printf.sprintf "CAST(%s AS %s)" (to_sql expr)
+        (Mlecto_type.sql_type_name ty)
+  | Case (branches, else_, _) ->
+      let branch_strs =
+        List.map
+          (fun (cond, result) ->
+            Printf.sprintf "WHEN %s THEN %s" (to_sql cond) (to_sql result))
+          branches
+      in
+      let else_str =
+        match else_ with
+        | Some e -> Printf.sprintf " ELSE %s" (to_sql e)
+        | None -> ""
+      in
+      Printf.sprintf "CASE %s%s END" (String.concat " " branch_strs) else_str
+  | Between (a, low, high) ->
+      Printf.sprintf "(%s BETWEEN %s AND %s)" (to_sql a) (to_sql low)
+        (to_sql high)
+  | InList (a, values) ->
+      let value_strs = List.map to_sql values in
+      Printf.sprintf "(%s IN (%s))" (to_sql a) (String.concat ", " value_strs)
+  | Subquery sql -> Printf.sprintf "(%s)" sql

lib/mlecto_field.ml

···
+type ('record, 'value) t = {
+  name : string;
+  ty : 'value Mlecto_type.t;
+  get : 'record -> 'value;
+  set : 'value -> 'record -> 'record;
+  table_name : string;
+  primary_key : bool;
+  unique : bool;
+  nullable : bool;
+  default : string option;
+}
+(** [('record, 'value) t] represents a field of type ['value] in ['record]. *)
+
+let make ?(primary_key = false) ?(unique = false) ?(default = None) ~table_name
+    ~name ~ty ~get ~set () =
+  {
+    name;
+    ty;
+    get;
+    set;
+    table_name;
+    primary_key;
+    unique;
+    nullable = Mlecto_type.is_nullable ty;
+    default;
+  }
+
+let name f = f.name
+let field_type f = f.ty
+let qualified_name f = f.table_name ^ "." ^ f.name
+let get f record = f.get record
+let set f value record = f.set value record
+let is_primary_key f = f.primary_key
+let is_unique f = f.unique
+let is_nullable f = f.nullable
+let caqti_type f = Mlecto_type.to_caqti f.ty
+
+type 'record field_list =
+  | [] : 'record field_list
+  | ( :: ) : ('record, 'a) t * 'record field_list -> 'record field_list
+
+let rec field_names : type r. r field_list -> string list = function
+  | [] -> []
+  | f :: rest -> f.name :: field_names rest

lib/mlecto_migration.ml

···
+type column_def = {
+  col_name : string;
+  col_type : string;
+  col_nullable : bool;
+  col_primary_key : bool;
+  col_unique : bool;
+  col_default : string option;
+  col_references : (string * string) option;
+}
+
+type index_def = {
+  idx_name : string option;
+  idx_table : string;
+  idx_columns : string list;
+  idx_unique : bool;
+}
+
+type operation =
+  | Create_table of { name : string; columns : column_def list }
+  | Drop_table of string
+  | Alter_table of { name : string; changes : alter_change list }
+  | Create_index of index_def
+  | Drop_index of string
+  | Execute of string
+
+and alter_change =
+  | Add_column of column_def
+  | Drop_column of string
+  | Rename_column of { from : string; to_ : string }
+  | Alter_column of {
+      name : string;
+      new_type : string option;
+      new_nullable : bool option;
+    }
+
+type t = {
+  version : int64;
+  name : string;
+  up : operation list;
+  down : operation list;
+}
+
+let column ?(nullable = true) ?(primary_key = false) ?(unique = false) ?default
+    ?references name sql_type =
+  {
+    col_name = name;
+    col_type = sql_type;
+    col_nullable = nullable;
+    col_primary_key = primary_key;
+    col_unique = unique;
+    col_default = default;
+    col_references = references;
+  }
+
+let create_table name columns = Create_table { name; columns }
+let drop_table name = Drop_table name
+let add_column col = Add_column col
+let drop_column name = Drop_column name
+let rename_column ~from ~to_ = Rename_column { from; to_ }
+let alter_table name changes = Alter_table { name; changes }
+
+let create_index ?(unique = false) ?name table columns =
+  Create_index
+    {
+      idx_name = name;
+      idx_table = table;
+      idx_columns = columns;
+      idx_unique = unique;
+    }
+
+let drop_index name = Drop_index name
+let execute sql = Execute sql
+
+let timestamps () =
+  [
+    column "inserted_at" "TIMESTAMPTZ" ~nullable:false ~default:"NOW()";
+    column "updated_at" "TIMESTAMPTZ" ~nullable:false ~default:"NOW()";
+  ]
+
+let migration ~version ~name ~up ~down = { version; name; up; down }
+
+let column_to_sql c =
+  let parts = [ c.col_name; c.col_type ] in
+  let parts = if c.col_nullable then parts else parts @ [ "NOT NULL" ] in
+  let parts = if c.col_primary_key then parts @ [ "PRIMARY KEY" ] else parts in
+  let parts = if c.col_unique then parts @ [ "UNIQUE" ] else parts in
+  let parts =
+    match c.col_default with
+    | Some d -> parts @ [ "DEFAULT " ^ d ]
+    | None -> parts
+  in
+  let parts =
+    match c.col_references with
+    | Some (table, col) ->
+        parts @ [ Printf.sprintf "REFERENCES %s(%s)" table col ]
+    | None -> parts
+  in
+  String.concat " " parts
+
+let operation_to_sql = function
+  | Create_table { name; columns } ->
+      let col_defs = List.map column_to_sql columns in
+      Printf.sprintf "CREATE TABLE %s (\n  %s\n)" name
+        (String.concat ",\n  " col_defs)
+  | Drop_table name -> Printf.sprintf "DROP TABLE %s" name
+  | Alter_table { name; changes } ->
+      let change_strs =
+        List.map
+          (function
+            | Add_column c -> Printf.sprintf "ADD COLUMN %s" (column_to_sql c)
+            | Drop_column col -> Printf.sprintf "DROP COLUMN %s" col
+            | Rename_column { from; to_ } ->
+                Printf.sprintf "RENAME COLUMN %s TO %s" from to_
+            | Alter_column { name = col; new_type; new_nullable = _ } -> (
+                match new_type with
+                | Some t -> Printf.sprintf "ALTER COLUMN %s TYPE %s" col t
+                | None -> ""))
+          changes
+      in
+      Printf.sprintf "ALTER TABLE %s %s" name (String.concat ", " change_strs)
+  | Create_index { idx_name; idx_table; idx_columns; idx_unique } ->
+      let name =
+        match idx_name with
+        | Some n -> n
+        | None ->
+            Printf.sprintf "%s_%s_index" idx_table
+              (String.concat "_" idx_columns)
+      in
+      let unique_str = if idx_unique then "UNIQUE " else "" in
+      Printf.sprintf "CREATE %sINDEX %s ON %s (%s)" unique_str name idx_table
+        (String.concat ", " idx_columns)
+  | Drop_index name -> Printf.sprintf "DROP INDEX %s" name
+  | Execute sql -> sql
+
+let schema_migrations_table =
+  Create_table
+    {
+      name = "schema_migrations";
+      columns =
+        [
+          column "version" "BIGINT" ~nullable:false ~primary_key:true;
+          column "name" "VARCHAR(255)" ~nullable:false;
+          column "inserted_at" "TIMESTAMPTZ" ~nullable:false ~default:"NOW()";
+        ];
+    }
+
+let create_schema_migrations_sql = operation_to_sql schema_migrations_table
+
+let insert_migration_sql =
+  "INSERT INTO schema_migrations (version, name) VALUES ($1, $2)"
+
+let delete_migration_sql = "DELETE FROM schema_migrations WHERE version = $1"
+
+let get_applied_versions_sql =
+  "SELECT version FROM schema_migrations ORDER BY version"
+
+let get_migration_status_sql =
+  "SELECT version, name, inserted_at FROM schema_migrations ORDER BY version"
+
+type migration_status = {
+  applied_versions : int64 list;
+  pending : t list;
+  last_applied : int64 option;
+}
+
+let sort_migrations migrations =
+  List.sort (fun m1 m2 -> Int64.compare m1.version m2.version) migrations
+
+let pending_migrations ~applied_versions migrations =
+  let is_applied v = List.mem v applied_versions in
+  migrations
+  |> List.filter (fun m -> not (is_applied m.version))
+  |> sort_migrations
+
+let generate_up_sql migration = List.map operation_to_sql migration.up
+let generate_down_sql migration = List.map operation_to_sql migration.down
+
+type migration_action =
+  | Migrate of { sql : string list; version : int64; name : string }
+  | Rollback of { sql : string list; version : int64 }
+  | CreateSchemaTable of string
+  | RecordMigration of { version : int64; name : string }
+  | RemoveMigration of int64
+
+let plan_migrate ~applied_versions ~target migrations =
+  let pending = pending_migrations ~applied_versions migrations in
+  let to_run =
+    match target with
+    | None -> pending
+    | Some v -> List.filter (fun m -> m.version <= v) pending
+  in
+  to_run
+  |> List.map (fun m ->
+      [
+        Migrate { sql = generate_up_sql m; version = m.version; name = m.name };
+        RecordMigration { version = m.version; name = m.name };
+      ])
+  |> List.flatten
+
+let plan_rollback ~applied_versions ~step migrations =
+  let applied_sorted =
+    List.sort (fun a b -> Int64.compare b a) applied_versions
+  in
+  let to_rollback =
+    match step with
+    | None -> ( match applied_sorted with v :: _ -> [ v ] | [] -> [])
+    | Some n ->
+        let rec take n lst =
+          match (n, lst) with
+          | 0, _ | _, [] -> []
+          | n, x :: xs -> x :: take (n - 1) xs
+        in
+        take n applied_sorted
+  in
+  to_rollback
+  |> List.filter_map (fun v ->
+      match List.find_opt (fun m -> m.version = v) migrations with
+      | Some m ->
+          Some
+            [
+              Rollback { sql = generate_down_sql m; version = m.version };
+              RemoveMigration m.version;
+            ]
+      | None -> None)
+  |> List.flatten
+
+let action_to_sql = function
+  | CreateSchemaTable sql -> [ sql ]
+  | Migrate { sql; _ } -> sql
+  | Rollback { sql; _ } -> sql
+  | RecordMigration { version; name } ->
+      [
+        Printf.sprintf
+          "INSERT INTO schema_migrations (version, name) VALUES (%Ld, '%s')"
+          version name;
+      ]
+  | RemoveMigration version ->
+      [
+        Printf.sprintf "DELETE FROM schema_migrations WHERE version = %Ld"
+          version;
+      ]
+
+let actions_to_sql actions = actions |> List.map action_to_sql |> List.flatten
+
+let format_status ~applied_versions ~migrations =
+  let pending = pending_migrations ~applied_versions migrations in
+  let buf = Buffer.create 256 in
+  Buffer.add_string buf "Applied migrations:\n";
+  applied_versions
+  |> List.iter (fun v ->
+      match List.find_opt (fun m -> m.version = v) migrations with
+      | Some m ->
+          Buffer.add_string buf (Printf.sprintf "  [✓] %Ld: %s\n" v m.name)
+      | None ->
+          Buffer.add_string buf (Printf.sprintf "  [✓] %Ld: (unknown)\n" v));
+  Buffer.add_string buf "\nPending migrations:\n";
+  pending
+  |> List.iter (fun m ->
+      Buffer.add_string buf (Printf.sprintf "  [ ] %Ld: %s\n" m.version m.name));
+  Buffer.contents buf

lib/mlecto_multi.ml

···
+type 'a op =
+  | Insert : 'b Mlecto_changeset.t -> 'b op
+  | Update : 'b Mlecto_changeset.t -> 'b op
+  | Delete : { table : Mlecto_schema.table; id : int } -> unit op
+  | Run : (results -> ('b, Mlecto_error.db_error) result) -> 'b op
+
+and entry = Entry : string * 'a op -> entry
+and results = (string * packed_result) list
+and packed_result = Result : 'a -> packed_result
+
+type t = entry list
+
+type multi_error = {
+  failed_operation : string;
+  error : Mlecto_error.db_error;
+  completed : results;
+}
+
+let empty = []
+let new_multi () = []
+let insert name changeset t = t @ [ Entry (name, Insert changeset) ]
+let update name changeset t = t @ [ Entry (name, Update changeset) ]
+let delete name ~table ~id t = t @ [ Entry (name, Delete { table; id }) ]
+let run name f t = t @ [ Entry (name, Run f) ]
+let merge t1 t2 = t1 @ t2
+let prepend name changeset t = Entry (name, Insert changeset) :: t
+let append = insert
+let to_list t = t
+let names t = List.map (fun (Entry (name, _)) -> name) t
+let has_name name t = List.exists (fun (Entry (n, _)) -> n = name) t
+
+let get : type a. results -> string -> a option =
+ fun results name ->
+  match List.assoc_opt name results with
+  | Some (Result v) -> Some (Obj.magic v)
+  | None -> None
+
+let get_exn : type a. results -> string -> a =
+ fun results name ->
+  match get results name with
+  | Some v -> v
+  | None -> failwith (Printf.sprintf "Multi result not found: %s" name)
+
+type 'a execution_result = ('a, multi_error) Stdlib.result
+
+let validate_multi t =
+  let names = names t in
+  let unique_names = List.sort_uniq String.compare names in
+  if List.length names <> List.length unique_names then
+    Error "Duplicate operation names in Multi"
+  else Ok ()
+
+let run_operation : type a.
+    a op -> results -> (a, Mlecto_error.db_error) Stdlib.result =
+ fun op results ->
+  match op with
+  | Insert changeset ->
+      if Mlecto_changeset.is_valid changeset then
+        Ok (Mlecto_changeset.data changeset)
+      else
+        let errors = Mlecto_changeset.error_messages changeset in
+        Error (Mlecto_error.Validation_failed errors)
+  | Update changeset ->
+      if Mlecto_changeset.is_valid changeset then
+        Ok (Mlecto_changeset.data changeset)
+      else
+        let errors = Mlecto_changeset.error_messages changeset in
+        Error (Mlecto_error.Validation_failed errors)
+  | Delete { table; id } ->
+      let _ = table in
+      let _ = id in
+      Ok ()
+  | Run f -> f results
+
+let execute_sync t : (results, multi_error) Stdlib.result =
+  match validate_multi t with
+  | Error msg ->
+      Error
+        {
+          failed_operation = "";
+          error = Mlecto_error.Query_failed msg;
+          completed = [];
+        }
+  | Ok () ->
+      let rec run_all entries acc =
+        match entries with
+        | [] -> Ok acc
+        | Entry (name, op) :: rest -> (
+            match run_operation op acc with
+            | Ok result ->
+                let acc' = (name, Result result) :: acc in
+                run_all rest acc'
+            | Error err ->
+                Error { failed_operation = name; error = err; completed = acc })
+      in
+      run_all t [] |> Result.map List.rev
+
+let execute = execute_sync
+let put name value results : results = (name, Result value) :: results

lib/mlecto_query.ml

···
+type join_kind = Inner | Left | Right | Full
+type order_direction = Asc | Desc
+type select_query
+type insert_query
+type update_query
+type delete_query
+
+type ('result, 'kind) t = {
+  query_type : query_type;
+  table : Mlecto_schema.table;
+  select : Mlecto_expr.wrapped_expr list option;
+  wheres : Mlecto_expr.wrapped_expr list;
+  joins : join list;
+  order_by : (Mlecto_expr.wrapped_expr * order_direction) list;
+  group_by : Mlecto_expr.wrapped_expr list;
+  having : Mlecto_expr.wrapped_expr list;
+  limit : int option;
+  offset : int option;
+  distinct : bool;
+  returning : Mlecto_expr.wrapped_expr list option;
+  set_values : (string * Mlecto_expr.wrapped_expr) list;
+  insert_columns : string list;
+  insert_values : Mlecto_expr.wrapped_expr list list;
+  conflict_target : string list option;
+  conflict_action : conflict_action option;
+}
+
+and query_type = Select | Insert | Update | Delete
+
+and join = {
+  kind : join_kind;
+  table : Mlecto_schema.table;
+  on : Mlecto_expr.wrapped_expr;
+}
+
+and conflict_action =
+  | DoNothing
+  | DoUpdate of (string * Mlecto_expr.wrapped_expr) list
+
+let empty_query table query_type =
+  {
+    query_type;
+    table;
+    select = None;
+    wheres = [];
+    joins = [];
+    order_by = [];
+    group_by = [];
+    having = [];
+    limit = None;
+    offset = None;
+    distinct = false;
+    returning = None;
+    set_values = [];
+    insert_columns = [];
+    insert_values = [];
+    conflict_target = None;
+    conflict_action = None;
+  }
+
+let from table = empty_query table Select
+let insert_into table = empty_query table Insert
+let update table = empty_query table Update
+let delete_from table = empty_query table Delete
+
+let select exprs query =
+  let wrapped = Mlecto_expr.expr_list_to_list exprs in
+  { query with select = Some wrapped }
+
+let select_all query = { query with select = None }
+
+let where expr query =
+  { query with wheres = Mlecto_expr.W expr :: query.wheres }
+
+let and_where expr query = where expr query
+
+let or_where expr query =
+  match query.wheres with
+  | [] -> where expr query
+  | first :: rest ->
+      let combined =
+        Mlecto_expr.W
+          (Mlecto_expr.( || )
+             (match first with Mlecto_expr.W e -> Obj.magic e)
+             (Obj.magic expr))
+      in
+      { query with wheres = combined :: rest }
+
+let join ?(kind = Inner) ~on joined_table query =
+  let j = { kind; table = joined_table; on = Mlecto_expr.W on } in
+  { query with joins = j :: query.joins }
+
+let left_join ~on table query = join ~kind:Left ~on table query
+let right_join ~on table query = join ~kind:Right ~on table query
+let inner_join ~on table query = join ~kind:Inner ~on table query
+let full_join ~on table query = join ~kind:Full ~on table query
+
+let order_by ?(direction = Asc) expr query =
+  { query with order_by = (Mlecto_expr.W expr, direction) :: query.order_by }
+
+let asc expr query = order_by ~direction:Asc expr query
+let desc expr query = order_by ~direction:Desc expr query
+
+let group_by exprs query =
+  let wrapped = Mlecto_expr.expr_list_to_list exprs in
+  { query with group_by = wrapped @ query.group_by }
+
+let having expr query =
+  { query with having = Mlecto_expr.W expr :: query.having }
+
+let limit n query = { query with limit = Some n }
+let offset n query = { query with offset = Some n }
+let distinct query = { query with distinct = true }
+
+let returning exprs query =
+  let wrapped = Mlecto_expr.expr_list_to_list exprs in
+  { query with returning = Some wrapped }
+
+let set col expr query =
+  {
+    query with
+    set_values = (Mlecto_field.name col, Mlecto_expr.W expr) :: query.set_values;
+  }
+
+let values columns rows query =
+  let col_names = List.map Mlecto_field.name columns in
+  let wrapped_rows =
+    List.map (fun row -> List.map (fun e -> Mlecto_expr.W e) row) rows
+  in
+  { query with insert_columns = col_names; insert_values = wrapped_rows }
+
+let on_conflict_do_nothing ?(target = []) query =
+  let target_names =
+    if target = [] then None else Some (List.map Mlecto_field.name target)
+  in
+  {
+    query with
+    conflict_target = target_names;
+    conflict_action = Some DoNothing;
+  }
+
+let on_conflict_do_update ~target ~set query =
+  let target_names = List.map Mlecto_field.name target in
+  let set_pairs =
+    List.map
+      (fun (col, expr) -> (Mlecto_field.name col, Mlecto_expr.W expr))
+      set
+  in
+  {
+    query with
+    conflict_target = Some target_names;
+    conflict_action = Some (DoUpdate set_pairs);
+  }
+
+let join_kind_to_sql = function
+  | Inner -> "INNER JOIN"
+  | Left -> "LEFT JOIN"
+  | Right -> "RIGHT JOIN"
+  | Full -> "FULL JOIN"
+
+let direction_to_sql = function Asc -> "ASC" | Desc -> "DESC"
+let wrapped_to_sql (Mlecto_expr.W e) = Mlecto_expr.to_sql e
+
+let to_sql query =
+  match query.query_type with
+  | Select ->
+      let distinct_str = if query.distinct then "DISTINCT " else "" in
+      let select_str =
+        match query.select with
+        | None -> "*"
+        | Some exprs -> String.concat ", " (List.map wrapped_to_sql exprs)
+      in
+      let from_str = Mlecto_schema.table_name query.table in
+      let join_strs =
+        List.rev_map
+          (fun j ->
+            Printf.sprintf "%s %s ON %s" (join_kind_to_sql j.kind)
+              (Mlecto_schema.table_name j.table)
+              (wrapped_to_sql j.on))
+          query.joins
+      in
+      let where_str =
+        match List.rev query.wheres with
+        | [] -> ""
+        | exprs ->
+            " WHERE " ^ String.concat " AND " (List.map wrapped_to_sql exprs)
+      in
+      let group_str =
+        match List.rev query.group_by with
+        | [] -> ""
+        | exprs ->
+            " GROUP BY " ^ String.concat ", " (List.map wrapped_to_sql exprs)
+      in
+      let having_str =
+        match List.rev query.having with
+        | [] -> ""
+        | exprs ->
+            " HAVING " ^ String.concat " AND " (List.map wrapped_to_sql exprs)
+      in
+      let order_str =
+        match List.rev query.order_by with
+        | [] -> ""
+        | exprs ->
+            " ORDER BY "
+            ^ String.concat ", "
+                (List.map
+                   (fun (e, d) -> wrapped_to_sql e ^ " " ^ direction_to_sql d)
+                   exprs)
+      in
+      let limit_str =
+        match query.limit with
+        | None -> ""
+        | Some n -> Printf.sprintf " LIMIT %d" n
+      in
+      let offset_str =
+        match query.offset with
+        | None -> ""
+        | Some n -> Printf.sprintf " OFFSET %d" n
+      in
+      let parts =
+        [
+          Printf.sprintf "SELECT %s%s FROM %s" distinct_str select_str from_str;
+        ]
+        @ join_strs
+        @ [ where_str; group_str; having_str; order_str; limit_str; offset_str ]
+      in
+      String.concat "" (List.filter (fun s -> s <> "") parts)
+  | Insert ->
+      let table_str = Mlecto_schema.table_name query.table in
+      let cols_str = String.concat ", " query.insert_columns in
+      let values_strs =
+        List.map
+          (fun row ->
+            "(" ^ String.concat ", " (List.map wrapped_to_sql row) ^ ")")
+          query.insert_values
+      in
+      let values_str = String.concat ", " values_strs in
+      let conflict_str =
+        match (query.conflict_target, query.conflict_action) with
+        | Some target, Some DoNothing ->
+            Printf.sprintf " ON CONFLICT (%s) DO NOTHING"
+              (String.concat ", " target)
+        | Some target, Some (DoUpdate sets) ->
+            let set_strs =
+              List.map
+                (fun (col, expr) ->
+                  Printf.sprintf "%s = %s" col (wrapped_to_sql expr))
+                sets
+            in
+            Printf.sprintf " ON CONFLICT (%s) DO UPDATE SET %s"
+              (String.concat ", " target)
+              (String.concat ", " set_strs)
+        | None, Some DoNothing -> " ON CONFLICT DO NOTHING"
+        | _ -> ""
+      in
+      let returning_str =
+        match query.returning with
+        | None -> ""
+        | Some exprs ->
+            " RETURNING " ^ String.concat ", " (List.map wrapped_to_sql exprs)
+      in
+      Printf.sprintf "INSERT INTO %s (%s) VALUES %s%s%s" table_str cols_str
+        values_str conflict_str returning_str
+  | Update ->
+      let table_str = Mlecto_schema.table_name query.table in
+      let set_strs =
+        List.rev_map
+          (fun (col, expr) ->
+            Printf.sprintf "%s = %s" col (wrapped_to_sql expr))
+          query.set_values
+      in
+      let set_str = String.concat ", " set_strs in
+      let where_str =
+        match List.rev query.wheres with
+        | [] -> ""
+        | exprs ->
+            " WHERE " ^ String.concat " AND " (List.map wrapped_to_sql exprs)
+      in
+      let returning_str =
+        match query.returning with
+        | None -> ""
+        | Some exprs ->
+            " RETURNING " ^ String.concat ", " (List.map wrapped_to_sql exprs)
+      in
+      Printf.sprintf "UPDATE %s SET %s%s%s" table_str set_str where_str
+        returning_str
+  | Delete ->
+      let table_str = Mlecto_schema.table_name query.table in
+      let where_str =
+        match List.rev query.wheres with
+        | [] -> ""
+        | exprs ->
+            " WHERE " ^ String.concat " AND " (List.map wrapped_to_sql exprs)
+      in
+      let returning_str =
+        match query.returning with
+        | None -> ""
+        | Some exprs ->
+            " RETURNING " ^ String.concat ", " (List.map wrapped_to_sql exprs)
+      in
+      Printf.sprintf "DELETE FROM %s%s%s" table_str where_str returning_str

lib/mlecto_repo.ml

···
+type 'a result = ('a, Mlecto_error.db_error) Stdlib.result
+
+let caqti_error_to_db_error err : Mlecto_error.db_error =
+  Mlecto_error.Query_failed (Caqti_error.show err)
+
+module type S = sig
+  type conn
+
+  val get_by_id :
+    conn:conn ->
+    table:Mlecto_schema.table ->
+    id_column:string ->
+    id:int ->
+    sql:string ->
+    unit result
+
+  val execute_sql : conn:conn -> sql:string -> unit result
+  val insert_changeset : 'a Mlecto_changeset.t -> 'a result
+  val update_changeset : 'a Mlecto_changeset.t -> 'a result
+end
+
+module Sync = struct
+  type conn = unit
+
+  let get_by_id ~conn:() ~table ~id_column ~id ~sql:_ =
+    let _ = table in
+    let _ = id_column in
+    let _ = id in
+    Error Mlecto_error.Not_found
+
+  let execute_sql ~conn:() ~sql:_ = Ok ()
+
+  let insert_changeset changeset =
+    if Mlecto_changeset.is_valid changeset then
+      Ok (Mlecto_changeset.data changeset)
+    else
+      let errors = Mlecto_changeset.error_messages changeset in
+      Error (Mlecto_error.Query_failed (String.concat "; " errors))
+
+  let update_changeset changeset =
+    if Mlecto_changeset.is_valid changeset then
+      Ok (Mlecto_changeset.data changeset)
+    else
+      let errors = Mlecto_changeset.error_messages changeset in
+      Error (Mlecto_error.Query_failed (String.concat "; " errors))
+end
+
+let insert changeset = Sync.insert_changeset changeset
+let update changeset = Sync.update_changeset changeset
+
+let validate_and_insert changeset =
+  if Mlecto_changeset.is_valid changeset then
+    Ok (Mlecto_changeset.data changeset)
+  else Error (Mlecto_changeset.errors changeset)
+
+let validate_and_update changeset =
+  if Mlecto_changeset.is_valid changeset then
+    Ok (Mlecto_changeset.data changeset)
+  else Error (Mlecto_changeset.errors changeset)
+
+let build_insert_sql table columns =
+  let table_name = Mlecto_schema.table_name table in
+  let col_str = String.concat ", " columns in
+  let placeholders =
+    List.mapi (fun i _ -> Printf.sprintf "$%d" (i + 1)) columns
+  in
+  let val_str = String.concat ", " placeholders in
+  Printf.sprintf "INSERT INTO %s (%s) VALUES (%s)" table_name col_str val_str
+
+let build_update_sql table columns ~where_column =
+  let table_name = Mlecto_schema.table_name table in
+  let set_clauses =
+    List.mapi (fun i col -> Printf.sprintf "%s = $%d" col (i + 1)) columns
+  in
+  let set_str = String.concat ", " set_clauses in
+  let where_idx = List.length columns + 1 in
+  Printf.sprintf "UPDATE %s SET %s WHERE %s = $%d" table_name set_str
+    where_column where_idx
+
+let build_delete_sql table ~where_column =
+  let table_name = Mlecto_schema.table_name table in
+  Printf.sprintf "DELETE FROM %s WHERE %s = $1" table_name where_column
+
+let build_select_sql table ~columns ~where_column =
+  let table_name = Mlecto_schema.table_name table in
+  let col_str =
+    match columns with [] -> "*" | cols -> String.concat ", " cols
+  in
+  Printf.sprintf "SELECT %s FROM %s WHERE %s = $1" col_str table_name
+    where_column
+
+type savepoint = { name : string; depth : int }
+type tx_state = { mutable depth : int; mutable savepoints : savepoint list }
+
+let create_tx_state () = { depth = 0; savepoints = [] }
+let begin_sql = "BEGIN"
+let commit_sql = "COMMIT"
+let rollback_sql = "ROLLBACK"
+let savepoint_sql name = Printf.sprintf "SAVEPOINT %s" name
+let release_savepoint_sql name = Printf.sprintf "RELEASE SAVEPOINT %s" name
+
+let rollback_to_savepoint_sql name =
+  Printf.sprintf "ROLLBACK TO SAVEPOINT %s" name
+
+let generate_savepoint_name depth = Printf.sprintf "mlecto_sp_%d" depth
+
+type 'a tx_result = ('a, Mlecto_error.db_error) Stdlib.result
+
+type tx_action =
+  | Begin
+  | Commit
+  | Rollback
+  | Savepoint of string
+  | ReleaseSavepoint of string
+  | RollbackToSavepoint of string
+
+let tx_action_to_sql = function
+  | Begin -> begin_sql
+  | Commit -> commit_sql
+  | Rollback -> rollback_sql
+  | Savepoint name -> savepoint_sql name
+  | ReleaseSavepoint name -> release_savepoint_sql name
+  | RollbackToSavepoint name -> rollback_to_savepoint_sql name
+
+let enter_transaction state =
+  if state.depth = 0 then begin
+    state.depth <- 1;
+    Begin
+  end
+  else begin
+    let sp_name = generate_savepoint_name state.depth in
+    let sp = { name = sp_name; depth = state.depth } in
+    state.savepoints <- sp :: state.savepoints;
+    state.depth <- state.depth + 1;
+    Savepoint sp_name
+  end
+
+let commit_transaction state =
+  if state.depth <= 1 then begin
+    state.depth <- 0;
+    state.savepoints <- [];
+    Commit
+  end
+  else begin
+    match state.savepoints with
+    | sp :: rest ->
+        state.savepoints <- rest;
+        state.depth <- state.depth - 1;
+        ReleaseSavepoint sp.name
+    | [] ->
+        state.depth <- state.depth - 1;
+        Commit
+  end
+
+let rollback_transaction state =
+  if state.depth <= 1 then begin
+    state.depth <- 0;
+    state.savepoints <- [];
+    Rollback
+  end
+  else begin
+    match state.savepoints with
+    | sp :: rest ->
+        state.savepoints <- rest;
+        state.depth <- state.depth - 1;
+        RollbackToSavepoint sp.name
+    | [] ->
+        state.depth <- 0;
+        state.savepoints <- [];
+        Rollback
+  end
+
+let transaction_depth state = state.depth
+let in_transaction state = state.depth > 0

lib/mlecto_schema.ml

···
+type table = { name : string; schema : string option }
+
+let table ?(schema = None) name = { name; schema }
+
+let table_name t =
+  match t.schema with Some s -> s ^ "." ^ t.name | None -> t.name
+
+type fk_action = Cascade | Restrict | SetNull | SetDefault | NoAction
+
+type foreign_key_ref = {
+  fk_table : string;
+  fk_column : string;
+  fk_on_delete : fk_action option;
+  fk_on_update : fk_action option;
+}
+
+type column_constraint =
+  | PrimaryKey
+  | NotNull
+  | Unique
+  | Default of string
+  | Check of string
+  | ForeignKey of foreign_key_ref
+
+type 'a column = {
+  col_name : string;
+  col_type : 'a Mlecto_type.t;
+  col_constraints : column_constraint list;
+}
+
+type wrapped_column = Column : 'a column -> wrapped_column
+
+type table_def = {
+  tbl_table : table;
+  tbl_columns : wrapped_column list;
+  tbl_primary_key : string list option;
+  tbl_unique : string list list;
+  tbl_checks : (string option * string) list;
+}
+
+let column ?(primary_key = false) ?(not_null = false) ?(unique = false) ?default
+    ?check ?references name ty =
+  let constraints = [] in
+  let constraints =
+    if primary_key then PrimaryKey :: constraints else constraints
+  in
+  let constraints = if not_null then NotNull :: constraints else constraints in
+  let constraints = if unique then Unique :: constraints else constraints in
+  let constraints =
+    match default with
+    | Some d -> Default d :: constraints
+    | None -> constraints
+  in
+  let constraints =
+    match check with Some c -> Check c :: constraints | None -> constraints
+  in
+  let constraints =
+    match references with
+    | Some r -> ForeignKey r :: constraints
+    | None -> constraints
+  in
+  { col_name = name; col_type = ty; col_constraints = constraints }
+
+let references ?(on_delete = None) ?(on_update = None) ~table ~column () =
+  {
+    fk_table = table;
+    fk_column = column;
+    fk_on_delete = on_delete;
+    fk_on_update = on_update;
+  }
+
+let define ?(schema = None) name columns =
+  let tbl = { name; schema } in
+  {
+    tbl_table = tbl;
+    tbl_columns = List.map (fun c -> Column c) columns;
+    tbl_primary_key = None;
+    tbl_unique = [];
+    tbl_checks = [];
+  }
+
+let with_primary_key cols def = { def with tbl_primary_key = Some cols }
+let with_unique cols def = { def with tbl_unique = cols :: def.tbl_unique }
+
+let with_check ?name expr def =
+  { def with tbl_checks = (name, expr) :: def.tbl_checks }
+
+let id_column () =
+  column "id" Mlecto_type.int64 ~primary_key:true ~not_null:true
+
+let timestamps () =
+  [
+    column "inserted_at" Mlecto_type.ptime ~not_null:true ~default:"NOW()";
+    column "updated_at" Mlecto_type.ptime ~not_null:true ~default:"NOW()";
+  ]
+
+let has_constraint c col = List.exists (fun con -> con = c) col.col_constraints
+let is_primary_key col = has_constraint PrimaryKey col
+let is_not_null col = has_constraint NotNull col || is_primary_key col
+let is_unique col = has_constraint Unique col
+
+let get_default col =
+  List.find_map (function Default d -> Some d | _ -> None) col.col_constraints
+
+let get_foreign_key col =
+  List.find_map
+    (function ForeignKey fk -> Some fk | _ -> None)
+    col.col_constraints
+
+let fk_action_to_sql = function
+  | Cascade -> "CASCADE"
+  | Restrict -> "RESTRICT"
+  | SetNull -> "SET NULL"
+  | SetDefault -> "SET DEFAULT"
+  | NoAction -> "NO ACTION"
+
+let constraint_to_sql = function
+  | PrimaryKey -> "PRIMARY KEY"
+  | NotNull -> "NOT NULL"
+  | Unique -> "UNIQUE"
+  | Default expr -> "DEFAULT " ^ expr
+  | Check expr -> "CHECK (" ^ expr ^ ")"
+  | ForeignKey { fk_table; fk_column; fk_on_delete; fk_on_update } -> (
+      let base = Printf.sprintf "REFERENCES %s(%s)" fk_table fk_column in
+      let base =
+        match fk_on_delete with
+        | Some od -> base ^ " ON DELETE " ^ fk_action_to_sql od
+        | None -> base
+      in
+      match fk_on_update with
+      | Some ou -> base ^ " ON UPDATE " ^ fk_action_to_sql ou
+      | None -> base)
+
+let column_to_sql (Column col) =
+  let type_name = Mlecto_type.sql_type_name col.col_type in
+  let constraints = List.map constraint_to_sql col.col_constraints in
+  String.concat " " (col.col_name :: type_name :: constraints)
+
+let table_def_to_sql def =
+  let col_defs = List.map column_to_sql def.tbl_columns in
+  let pk_constraint =
+    match def.tbl_primary_key with
+    | Some cols ->
+        [ Printf.sprintf "PRIMARY KEY (%s)" (String.concat ", " cols) ]
+    | None -> []
+  in
+  let unique_constraints =
+    List.map
+      (fun cols -> Printf.sprintf "UNIQUE (%s)" (String.concat ", " cols))
+      def.tbl_unique
+  in
+  let check_constraints =
+    List.map
+      (fun (name, expr) ->
+        match name with
+        | Some n -> Printf.sprintf "CONSTRAINT %s CHECK (%s)" n expr
+        | None -> Printf.sprintf "CHECK (%s)" expr)
+      def.tbl_checks
+  in
+  let all_parts =
+    col_defs @ pk_constraint @ unique_constraints @ check_constraints
+  in
+  Printf.sprintf "CREATE TABLE %s (\n  %s\n)" (table_name def.tbl_table)
+    (String.concat ",\n  " all_parts)

lib/mlecto_type.ml

···
+(** ['a t] is a type witness mapping OCaml type ['a] to a SQL type. *)
+type _ t =
+  | Int : int t
+  | Int32 : int32 t
+  | Int64 : int64 t
+  | Float : float t
+  | String : string t
+  | Bool : bool t
+  | Bytes : bytes t
+  | Ptime : Ptime.t t
+  | Ptime_span : Ptime.span t
+  | Pdate : Ptime.date t
+  | Uuid : Uuidm.t t
+  | Json : Yojson.Safe.t t
+  | Option : 'a t -> 'a option t
+  | Array : 'a t -> 'a list t
+  | Tup2 : 'a t * 'b t -> ('a * 'b) t
+  | Tup3 : 'a t * 'b t * 'c t -> ('a * 'b * 'c) t
+  | Tup4 : 'a t * 'b t * 'c t * 'd t -> ('a * 'b * 'c * 'd) t
+  | Custom : {
+      encode : 'a -> (string, string) result;
+      decode : string -> ('a, string) result;
+      sql_type : string;
+    }
+      -> 'a t
+
+let int = Int
+let int32 = Int32
+let int64 = Int64
+let float = Float
+let string = String
+let bool = Bool
+let bytes = Bytes
+let ptime = Ptime
+let ptime_span = Ptime_span
+let pdate = Pdate
+let uuid = Uuid
+let json = Json
+let option t = Option t
+let array t = Array t
+let tup2 a b = Tup2 (a, b)
+let tup3 a b c = Tup3 (a, b, c)
+let tup4 a b c d = Tup4 (a, b, c, d)
+let custom ~encode ~decode ~sql_type = Custom { encode; decode; sql_type }
+let ( ** ) a b = Tup2 (a, b)
+
+let rec sql_type_name : type a. a t -> string = function
+  | Int -> "INTEGER"
+  | Int32 -> "INTEGER"
+  | Int64 -> "BIGINT"
+  | Float -> "DOUBLE PRECISION"
+  | String -> "TEXT"
+  | Bool -> "BOOLEAN"
+  | Bytes -> "BYTEA"
+  | Ptime -> "TIMESTAMPTZ"
+  | Ptime_span -> "INTERVAL"
+  | Pdate -> "DATE"
+  | Uuid -> "UUID"
+  | Json -> "JSONB"
+  | Option inner -> sql_type_name inner
+  | Array inner -> sql_type_name inner ^ "[]"
+  | Tup2 _ -> "RECORD"
+  | Tup3 _ -> "RECORD"
+  | Tup4 _ -> "RECORD"
+  | Custom { sql_type; _ } -> sql_type
+
+let is_nullable : type a. a t -> bool = function Option _ -> true | _ -> false
+
+let rec to_caqti : type a. a t -> a Caqti_type.t = function
+  | Int -> Caqti_type.int
+  | Int32 -> Caqti_type.int32
+  | Int64 -> Caqti_type.int64
+  | Float -> Caqti_type.float
+  | String -> Caqti_type.string
+  | Bool -> Caqti_type.bool
+  | Bytes ->
+      Caqti_type.custom
+        ~encode:(fun b -> Ok (Bytes.to_string b))
+        ~decode:(fun s -> Ok (Bytes.of_string s))
+        Caqti_type.octets
+  | Ptime -> Caqti_type.ptime
+  | Ptime_span -> Caqti_type.ptime_span
+  | Pdate ->
+      Caqti_type.custom
+        ~encode:(fun (y, m, d) -> Ok (Printf.sprintf "%04d-%02d-%02d" y m d))
+        ~decode:(fun s ->
+          try Scanf.sscanf s "%d-%d-%d" (fun y m d -> Ok (y, m, d))
+          with _ -> Error ("Invalid date: " ^ s))
+        Caqti_type.string
+  | Uuid ->
+      Caqti_type.custom
+        ~encode:(fun u -> Ok (Uuidm.to_string u))
+        ~decode:(fun s ->
+          match Uuidm.of_string s with
+          | Some u -> Ok u
+          | None -> Error ("Invalid UUID: " ^ s))
+        Caqti_type.string
+  | Json ->
+      Caqti_type.custom
+        ~encode:(fun j -> Ok (Yojson.Safe.to_string j))
+        ~decode:(fun s ->
+          try Ok (Yojson.Safe.from_string s)
+          with Yojson.Json_error msg -> Error msg)
+        Caqti_type.string
+  | Option inner -> Caqti_type.option (to_caqti inner)
+  | Array inner ->
+      let inner_caqti = to_caqti inner in
+      Caqti_type.custom
+        ~encode:(fun _lst -> Error "Array encoding not yet implemented")
+        ~decode:(fun _s -> Error "Array decoding not yet implemented")
+        (Caqti_type.option inner_caqti)
+  | Tup2 (a, b) -> Caqti_type.t2 (to_caqti a) (to_caqti b)
+  | Tup3 (a, b, c) -> Caqti_type.t3 (to_caqti a) (to_caqti b) (to_caqti c)
+  | Tup4 (a, b, c, d) ->
+      Caqti_type.t4 (to_caqti a) (to_caqti b) (to_caqti c) (to_caqti d)
+  | Custom { encode; decode; _ } ->
+      Caqti_type.custom ~encode ~decode Caqti_type.string

mlecto.opam

···
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Ecto-like database toolkit for OCaml"
+description:
+  "mlecto is a database toolkit inspired by Elixir's Ecto. It provides type-safe query building, schema definitions, changesets for data validation, and database migrations. Built on Caqti with Eio for async operations."
+maintainer: ["Guillermo Diaz-Romero <[e-mail]>"]
+authors: ["Guillermo Diaz-Romero <[e-mail]>"]
+license: "MIT"
+tags: ["database" "postgresql" "ecto" "orm" "query-builder" "migrations"]
+homepage: "https://github.com/gdiazlo/mlecto"
+doc: "https://github.com/gdiazlo/mlecto"
+bug-reports: "https://github.com/gdiazlo/mlecto/issues"
+depends: [
+  "ocaml" {>= "5.1"}
+  "dune" {>= "3.20" & >= "3.20"}
+  "caqti" {>= "2.1"}
+  "caqti-driver-postgresql" {>= "2.1"}
+  "caqti-eio" {>= "2.1"}
+  "ptime" {>= "1.1"}
+  "re" {>= "1.11"}
+  "uuidm" {>= "0.9"}
+  "yojson" {>= "2.0"}
+  "alcotest" {>= "1.7" & with-test}
+  "alcotest-lwt" {>= "1.7" & with-test}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/gdiazlo/mlecto.git"
+x-maintenance-intent: ["(latest)"]

test/dune

···
+(test
+ (name test_mlecto)
+ (libraries mlecto alcotest))

test/test_mlecto.ml

···
+let () = print_endline "Tests not yet implemented"