#!/usr/bin/env bb
;; ============================================================================
;; beagle-store-ingest-code — THE FLIP, stage 1: Beagle source tree -> canonical CODE log.
;; ============================================================================
;; Demotes Beagle text from source-of-truth to a generated view: ingest each
;; module's AST into a per-repo native Store transaction log, re-keying file-local integer
;; node labels only where the predicate declares a structural reference.
;;
;; The log carries ONLY the AST (kind/v or qualified-symbol qualifier/name,
;; fN/child/segN/commentN/tail + a per-module
;; @<mod>#root file "<path>" bookkeeping fact). refers_to + render markers are
;; DERIVED — they are materialized in-memory over the warm store at resolution
;; time (resolve-preds), never persisted. (See DESIGN.md §2.)
;;
;; USAGE:
;;   bin/beagle-store-ingest-code <src-dir-or-file> [<src-dir-or-file> ...]
;;     --space-id <id>         stable identity of this code corpus (required)
;;     [--out <code.log>]      default: $PWD/.store/code.log
;;     [--module <name>]       restrict to ONE module by name substring (the flip
;;                             experiment ingests ONLY schema; this is how)
;;     [--root <dir>]          source root module names are derived from (default:
;;                             the common ancestor dir of the ingested files)
;;
;; The default ingests every .bclj it finds (staged adoption uses this); the flip
;; experiment passes `--module schema` so ONLY schema.bclj is folded.
;;
;; Beagle CLI discovery (first match wins):
;;   BEAGLE_STORE_BEAGLE   explicit executable path or command name
;;   BEAGLE_HOME   toolchain root containing bin/beagle
;;   PATH          executable named beagle
;; ============================================================================
(require '[clojure.string :as str]
         '[clojure.java.io :as io]
         '[clojure.edn :as edn]
         '[babashka.classpath :as cp]
         '[babashka.fs :as fs]
         '[babashka.process :as proc])

(def ^:private store-root
  (.getCanonicalPath (.getParentFile (.getParentFile (io/file *file*)))))
(cp/add-classpath
 (str store-root java.io.File/pathSeparator (io/file store-root "out")))
(require '[database :as database]
         '[store.types :as t]
         '[resolve-core :as rc])

(defn- die [& xs] (binding [*out* *err*] (apply println xs)) (System/exit 1))
(defn- log! [& xs] (binding [*out* *err*] (apply println xs)))

(defn- nonblank-env [name]
  (let [value (System/getenv name)]
    (when-not (str/blank? value) value)))

(def ^:private beagle-home (nonblank-env "BEAGLE_HOME"))
(def ^:private beagle-command
  (or (nonblank-env "BEAGLE_STORE_BEAGLE")
      (when beagle-home (str beagle-home "/bin/beagle"))
      "beagle"))
(def ^:private beagle-bin (some-> (fs/which beagle-command) str))

;; --- args --------------------------------------------------------------------
(defn- parse-args [args]
  (loop [a args, opts {:srcs [] :out nil :module nil :append false :root nil
                       :space-id nil}]
    (cond
      (empty? a) opts
      (= "--out" (first a))    (recur (drop 2 a) (assoc opts :out (second a)))
      (= "--module" (first a)) (recur (drop 2 a) (assoc opts :module (second a)))
      (= "--append" (first a)) (recur (rest a) (assoc opts :append true))
      (= "--root" (first a))   (recur (drop 2 a) (assoc opts :root (second a)))
      (= "--space-id" (first a))
      (recur (drop 2 a) (assoc opts :space-id (second a)))
      (str/starts-with? (first a) "--")
      (die "unknown option" (first a))
      :else                    (recur (rest a) (update opts :srcs conj (first a))))))

;; Live Beagle source extensions; the parsed AST is target-independent.
(def ^:private beagle-ext-re #"\.b(clj|js|nix|gl)$")
(defn- beagle-file? [p] (boolean (re-find beagle-ext-re p)))

(defn- beagle-files [path]
  (let [f (io/file path)]
    (cond
      (and (.isFile f) (beagle-file? path)) [path]
      (.isDirectory f) (->> (.listFiles f)
                            (map #(.getPath ^java.io.File %))
                            (filter beagle-file?)
                            sort vec)
      :else [])))

;; module name from a Beagle path: the path RELATIVE to the ingest root (--root,
;; default: common ancestor dir of all ingested files), DOT-joined, .b* stripped.
;; This is the @<module># prefix the resolver groups by (name->module) — its regex
;; (@([^#]+)#) admits any separator, but downstream builds flat filenames from the
;; key (store_mcp's edited-<mod>.bclj / <src>/<mod>.bclj views), so dots, not slashes.
;; One dir of files keeps bare basenames; a TREE qualifies its module name, so duplicate
;; basenames across dirs never collide into one module.
(defn- path-segs [p] (vec (remove str/blank? (str/split p #"/"))))
(defn- common-prefix [a b]
  (loop [i 0]
    (if (and (< i (count a)) (< i (count b)) (= (nth a i) (nth b i)))
      (recur (inc i))
      (subvec a 0 i))))
(defn- infer-root-segs [paths]
  (reduce common-prefix (map #(vec (butlast (path-segs %))) paths)))
(defn- module-of [root-segs path]
  (let [segs (path-segs path)
        n    (count root-segs)
        rel  (if (and (<= n (count segs)) (= root-segs (subvec segs 0 n)))
               (subvec segs n)
               segs)                                   ; not under root: full path qualifies
        rel  (if (seq rel) rel [(peek segs)])]
    (str/replace (str/join "." rel) beagle-ext-re "")))

;; --- emit-edn one module, parse to [s p o] triples ---------------------------
;; emit-edn prints `@file <path>` then one `[s "pred" o]` per line. o is an INTEGER
;; (a structural link to node `o`) or a STRING (a literal value). We re-key every id.
(defn- emit-edn-triples [path]
  (let [r (proc/sh {:out :string :err :string}
                   beagle-bin "facts-roundtrip" "--emit-edn" path)]
    (when (not (zero? (:exit r)))
      (throw
       (ex-info (str "emit-edn FAILED for " path "\n" (:err r))
                {:type :beagle-emit-failed :path path :exit (:exit r)})))
    (->> (str/split-lines (:out r))
         (keep (fn [line]
                 (when (str/starts-with? line "[")
                   (edn/read-string line))))
         vec)))

;; --- the flip's re-key: file-local int n -> "@<mod>#n" -----------------------
(defn- nodename [module n] (str "@" module "#" n))

;; One module's emit-edn becomes recursive-Term propositions. Subject int s is
;; "@mod#s"; an integer object is re-keyed only on a structural predicate.
;; Scalar integers (line/col/pos/span and numeric v) remain literal Terms.
;; PLUS one bookkeeping fact @<mod>#root file "<path>" so render-from-log knows the
;; source path (the @file wrapper analogue; "root" never collides with an int id).
(def ^:private node-reference-predicate-re
  #"^(?:child|tail|seg[0-9]+|comment[0-9]+)$")

(defn- node-reference-predicate? [predicate]
  (and (string? predicate)
       (or (rc/ord-pos? predicate)
           (boolean (re-matches node-reference-predicate-re predicate)))))

(defn- structural-reader-triples [triples]
  (let [symbol-nodes
        (into #{}
              (keep (fn [[subject predicate object]]
                      (when (and (= predicate "kind") (= object "symbol"))
                        subject)))
              triples)]
    (into []
          (mapcat
           (fn [[subject predicate object :as triple]]
             (if (and (= predicate "v")
                      (contains? symbol-nodes subject)
                      (string? object))
               (let [reference (symbol object)
                     qualifier (namespace reference)]
                 (if qualifier
                   [[subject "qualifier" qualifier]
                    [subject "name" (name reference)]]
                   [triple]))
               [triple])))
          triples)))

(defn- module->propositions [root-segs path]
  (let [module (module-of root-segs path)
        triples (structural-reader-triples (emit-edn-triples path))
        node-propositions
        (mapv (fn [[s p o]]
                (t/triple (nodename module s)
                          p
                          (if (and (integer? o) (node-reference-predicate? p))
                            (nodename module o)
                            o)))
              triples)]
    (into [(t/triple (str "@" module "#root") "file" path)]
          node-propositions)))

(defn- recorded-now []
  (let [now (java.time.Instant/now)]
    (t/instant (.getEpochSecond now) (.getNano now))))

(defn- replace-atomically! [source target]
  (java.nio.file.Files/move
   (.toPath (io/file source))
   (.toPath (io/file target))
   (into-array java.nio.file.CopyOption
               [java.nio.file.StandardCopyOption/ATOMIC_MOVE
                java.nio.file.StandardCopyOption/REPLACE_EXISTING])))

;; --- main --------------------------------------------------------------------
(let [{:keys [srcs out module append root space-id]}
      (parse-args *command-line-args*)
      out-path (or out (str (System/getProperty "user.dir") "/.store/code.log"))]
  (when (empty? srcs)
    (die "usage: bin/beagle-store-ingest-code <src> [<src>...] --space-id <id> [--out <log>] [--module <name>] [--root <dir>]"))
  (when append
    (die "--append was removed: rebuild the complete sibling Store transaction log instead"))
  (when (str/blank? space-id)
    (die "--space-id is required and must be nonempty"))
  (when-not beagle-bin
    (die "missing executable Beagle CLI" (pr-str beagle-command)
         "(set BEAGLE_STORE_BEAGLE / BEAGLE_HOME or add beagle to PATH)"))
  (let [files (->> srcs (mapcat beagle-files) distinct sort
                   (filter (fn [p] (or (nil? module) (str/includes? p module)))))]
    (when (empty? files) (die "no Beagle modules matched" (pr-str srcs) (when module (str "(module filter: " module ")"))))
    (if module
      (log! "beagle-store-ingest-code: folding" (count files) "module(s) ->" out-path
            (str "(module filter: " module ")"))
      (log! "beagle-store-ingest-code: folding" (count files) "module(s) ->" out-path))
    (let [root-segs (if root (path-segs root) (infer-root-segs files))
          target (.getCanonicalFile (io/file out-path))
          _ (.mkdirs (.getParentFile target))
          sibling (io/file (.getParentFile target)
                           (str "." (.getName target) ".ingest-"
                                (java.util.UUID/randomUUID) ".storelog"))
          proposition-count (atom 0)]
      (try
        (database/create-triple-log! (.getPath sibling) space-id)
        (let [db (database/open-database! (.getPath sibling) space-id)
              total (count files)]
          ;; Report each module as it lands: a minutes-long fold with no output
          ;; is indistinguishable from a hang to any caller with a timeout.
          (doseq [[index path] (map-indexed vector files)]
            (let [propositions (module->propositions root-segs path)]
              (database/commit!
               db {:actor "beagle-store-ingest-code"
                   :recorded-at (recorded-now)
                   :operations
                   (mapv (fn [proposition]
                           {:action :assert :proposition proposition})
                         propositions)})
              (swap! proposition-count + (count propositions))
              (log! (str "  [" (inc index) "/" total "]")
                    (module-of root-segs path) "<-" path
                    (str "(" (count propositions) " propositions)")))))
        (replace-atomically! sibling target)
        (log! "beagle-store-ingest-code: wrote" @proposition-count "AST propositions in"
              (count files) "module transaction(s); ids re-keyed @<mod>#<n>")
        (log! "DONE — the Beagle source is now downstream of" (.getPath target))
        (finally
          (java.nio.file.Files/deleteIfExists (.toPath sibling)))))))
