(in-package #:lispsearch)

;;;; SQLite + FTS5 layer. One connection per command run. The base `system`
;;;; table is the source of truth; `system_fts` is an external-content FTS5 index
;;;; kept in sync by triggers (see lispsearch-plan.md §5).

(defparameter +schema-version+ "1")

;;; --- connection -------------------------------------------------------------

(defun connect (&optional (path *db-path*))
  "Open (creating if needed) the SQLite database at PATH and return the handle.
PATH may be the special string \":memory:\" for a transient in-memory database."
  (let ((p (if (pathnamep path) (namestring path) (string path))))
    (unless (string= p ":memory:")
      (ensure-directories-exist p))
    (sqlite:connect p)))

(defmacro with-db ((db &optional (path '*db-path*)) &body body)
  "Run BODY with DB bound to a fresh connection, migrated and then closed."
  `(let ((,db (connect ,path)))
     (unwind-protect
          (progn (migrate ,db) ,@body)
       (sqlite:disconnect ,db))))

;;; --- schema / migration -----------------------------------------------------

(defparameter +schema-statements+
  (list
   "PRAGMA journal_mode = WAL;"
   "PRAGMA foreign_keys = ON;"
   "CREATE TABLE IF NOT EXISTS system (
      id            INTEGER PRIMARY KEY,
      registry_name TEXT NOT NULL UNIQUE,
      system_name   TEXT NOT NULL,
      description   TEXT,
      author        TEXT,
      license       TEXT,
      homepage      TEXT,
      latest        TEXT,
      deps          TEXT,
      readme        TEXT,
      etag          TEXT,
      fetched_at    TEXT,
      enriched      INTEGER NOT NULL DEFAULT 0
    );"
   "CREATE VIRTUAL TABLE IF NOT EXISTS system_fts USING fts5(
      system_name, description, readme, deps,
      content='system', content_rowid='id',
      tokenize='porter unicode61'
    );"
   "CREATE TRIGGER IF NOT EXISTS system_ai AFTER INSERT ON system BEGIN
      INSERT INTO system_fts(rowid, system_name, description, readme, deps)
      VALUES (new.id, new.system_name, new.description, new.readme, new.deps);
    END;"
   "CREATE TRIGGER IF NOT EXISTS system_ad AFTER DELETE ON system BEGIN
      INSERT INTO system_fts(system_fts, rowid, system_name, description, readme, deps)
      VALUES ('delete', old.id, old.system_name, old.description, old.readme, old.deps);
    END;"
   "CREATE TRIGGER IF NOT EXISTS system_au AFTER UPDATE ON system BEGIN
      INSERT INTO system_fts(system_fts, rowid, system_name, description, readme, deps)
      VALUES ('delete', old.id, old.system_name, old.description, old.readme, old.deps);
      INSERT INTO system_fts(rowid, system_name, description, readme, deps)
      VALUES (new.id, new.system_name, new.description, new.readme, new.deps);
    END;"
   "CREATE TABLE IF NOT EXISTS meta (key TEXT PRIMARY KEY, value TEXT);"))

(defun migrate (db)
  "Idempotently create the schema, triggers, and FTS index; record schema version."
  (dolist (stmt +schema-statements+)
    (sqlite:execute-non-query db stmt))
  (meta-set db "schema_version" +schema-version+)
  db)

;;; --- meta -------------------------------------------------------------------

(defun meta-set (db key value)
  (sqlite:execute-non-query db
    "INSERT INTO meta(key, value) VALUES(?, ?)
     ON CONFLICT(key) DO UPDATE SET value = excluded.value"
    key value))

(defun meta-get (db key)
  (sqlite:execute-single db "SELECT value FROM meta WHERE key = ?" key))

;;; --- writes -----------------------------------------------------------------

(defun upsert-name (db registry system)
  "Tier-1 insert: record the catalog name with enriched=0. No-op if present."
  (sqlite:execute-non-query db
    "INSERT INTO system (registry_name, system_name) VALUES (?, ?)
     ON CONFLICT(registry_name) DO NOTHING"
    registry system))

(defun upsert-system (db plist)
  "Full upsert of an enriched record keyed on registry_name. PLIST keys:
:registry-name :system-name :description :author :license :homepage
:latest :deps :readme :etag :fetched-at."
  (flet ((g (k) (getf plist k)))
    (sqlite:execute-non-query db
      "INSERT INTO system
         (registry_name, system_name, description, author, license, homepage,
          latest, deps, readme, etag, fetched_at, enriched)
       VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, 1)
       ON CONFLICT(registry_name) DO UPDATE SET
         system_name = excluded.system_name,
         description = excluded.description,
         author      = excluded.author,
         license     = excluded.license,
         homepage    = excluded.homepage,
         latest      = excluded.latest,
         deps        = excluded.deps,
         readme      = excluded.readme,
         etag        = excluded.etag,
         fetched_at  = excluded.fetched_at,
         enriched    = 1"
      (g :registry-name) (g :system-name) (g :description) (g :author)
      (g :license) (g :homepage) (g :latest) (g :deps) (g :readme)
      (g :etag) (or (g :fetched-at) (iso-now)))))

(defun mark-enriched (db id &key (enriched 1) (fetched-at (iso-now)))
  "Flag row ID as enriched (or not) and stamp fetched_at."
  (sqlite:execute-non-query db
    "UPDATE system SET enriched = ?, fetched_at = ? WHERE id = ?"
    enriched fetched-at id))

;;; --- search -----------------------------------------------------------------

(defun fts-escape-term (term)
  "Turn one user token into a safe FTS5 prefix token: a double-quoted phrase
followed by * so that e.g. \"html\" also matches \"html5\". A trailing * the user
typed is folded into the same prefix form. Embedded quotes are doubled."
  (let* ((had-star (and (plusp (length term))
                        (char= #\* (char term (1- (length term))))))
         (core (if had-star (subseq term 0 (1- (length term))) term))
         (quoted (str:replace-all "\"" "\"\"" core)))
    (format nil "\"~A\"*" quoted)))

(defun build-fts-query (query)
  "Build a safe FTS5 MATCH expression from raw user input: each whitespace-
separated term becomes a prefix term, all implicitly AND-ed. Prefix matching is
the default so partial words and version-suffixed tokens (html -> html5) hit."
  (str:join " " (mapcar #'fts-escape-term (str:words query))))

(defun search-fts (db query &key (limit 20))
  "Full-text search, BM25-ranked (best first). Returns a list of rows:
(system_name latest description deps rank)."
  (let ((match (build-fts-query query)))
    (when (plusp (length match))
      (sqlite:execute-to-list db
        "SELECT s.system_name, s.latest, s.description, s.deps,
                bm25(system_fts) AS rank
         FROM system_fts JOIN system s ON s.id = system_fts.rowid
         WHERE system_fts MATCH ?
         ORDER BY rank
         LIMIT ?"
        match limit))))

(defun search-name (db pattern &key (limit 20))
  "Fast name search via GLOB. Returns (system_name latest description deps) rows."
  (sqlite:execute-to-list db
    "SELECT system_name, latest, description, deps
     FROM system
     WHERE system_name GLOB ?
     ORDER BY system_name
     LIMIT ?"
    pattern limit))

(defun deps-rows (db name)
  "Direct dependencies of NAME as search-style rows
(dep_name latest description deps); latest/description/deps are filled from the
catalog when the dependency is itself indexed, else NIL. Empty when NAME is
unknown or has no recorded deps. Uses SQLite's json_each over the stored deps
JSON array."
  (sqlite:execute-to-list db
    "SELECT j.value, s.latest, s.description, s.deps
     FROM system parent
     JOIN json_each(parent.deps) j
     LEFT JOIN system s ON s.system_name = j.value
     WHERE parent.system_name = ? OR parent.registry_name = ?
     ORDER BY j.value"
    name name))

(defun rdeps-rows (db name &key (limit 200))
  "Reverse dependencies: systems whose deps array includes NAME, as search-style
rows (system_name latest description deps). Only enriched rows carry deps."
  (sqlite:execute-to-list db
    "SELECT DISTINCT s.system_name, s.latest, s.description, s.deps
     FROM system s
     JOIN json_each(s.deps) j ON j.value = ?
     WHERE s.deps IS NOT NULL
     ORDER BY s.system_name
     LIMIT ?"
    name limit))

(defun get-system (db name)
  "Look up one system by system_name or registry_name. Returns a plist or NIL."
  (let ((row (first
              (sqlite:execute-to-list db
                "SELECT registry_name, system_name, description, author, license,
                        homepage, latest, deps, readme, etag, fetched_at, enriched
                 FROM system
                 WHERE system_name = ? OR registry_name = ?
                 LIMIT 1"
                name name))))
    (when row
      (destructuring-bind (registry-name system-name description author license
                           homepage latest deps readme etag fetched-at enriched)
          row
        (list :registry-name registry-name :system-name system-name
              :description description :author author :license license
              :homepage homepage :latest latest :deps deps :readme readme
              :etag etag :fetched-at fetched-at :enriched enriched)))))

(defun stats (db)
  "Totals and enrichment progress. Returns a plist."
  (list :total       (sqlite:execute-single db "SELECT COUNT(*) FROM system")
        :enriched     (sqlite:execute-single db "SELECT COUNT(*) FROM system WHERE enriched = 1")
        :last-refresh (meta-get db "last_refresh")
        :catalog-sha  (meta-get db "catalog_sha")
        :schema-version (meta-get db "schema_version")))
