Green source tour

(ns green.advice
  "Emacs-style advice for step functions: the full set of nadvice
  combinators, LIFO stacking (most recently added outermost) with an
  optional :depth override, removal by explicit id.
  Registries are plain maps of step-name -> vector of
  {:id :how :fn :seq :depth}, so all operations are pure — advice is
  workflow-scoped, not global. A workflow embedded via
  green.workflow/step inherits its ancestors' advice at run time by
  merging registries (see `merge-entries`); the values stay pure.
  The :seq field is a caller-assigned monotonic add-order number; it lets
  a step-scoped registry and a separate all-steps registry be merged and
  sorted into one strict add-order stack (see green.workflow/run-step).
  :depth (-100..100, default 0) overrides add order the way Emacs hook
  depths do: lower pushes the advice outward, higher pushes it inward;
  at equal depth the most recently added is outermost.")

(def hows
  "The supported combinators, matching Emacs nadvice. With FUNCTION the
  advice, OLDFUN the prior chain, and r the opts map:

    :around        (FUNCTION OLDFUN r)
    :before        (FUNCTION r) then (OLDFUN r)
    :after         (OLDFUN r) then (FUNCTION r), returns OLDFUN's value
    :override      (FUNCTION r), OLDFUN never runs
    :before-while  (and (FUNCTION r) (OLDFUN r))
    :before-until  (or  (FUNCTION r) (OLDFUN r))
    :after-while   (let [ret (OLDFUN r)] (if (green-true? ret) (FUNCTION r) ret))
    :after-until   (let [ret (OLDFUN r)] (if (green-true? ret) ret (FUNCTION r)))
    :filter-args   (OLDFUN (FUNCTION r))
    :filter-return (FUNCTION (OLDFUN r))

  Typical use cases for each `how`:
    :around        dry-run, retry, timing/tracing, locks; call OLDFUN
                   zero, one, or many times
    :override      stubs, tests, or environment-specific replacements
    :before        setup/prerequisites such as backend files, dirs, locks,
                   or validation
    :after         audit, metrics, notifications, or cleanup without
                   changing OLDFUN's result
    :before-while  precondition gates: continue only while guards pass
    :before-until  fast paths/no-ops: cached or already-converged result
                   skips OLDFUN
    :after-while   success-only follow-ups such as verification,
                   registration, or notifications
    :after-until   failure recovery/fallback: rollback, repair, or supply
                   an alternate result
    :filter-args   normalize/scope inputs: defaults, derived paths,
                   sub-maps, redaction
    :filter-return normalize/enrich outputs: derived data, temp-key
                   cleanup, redaction, result-shape adaptation

  For after-while/after-until, a Green step result is true only when its
  :green/exit is 0 (missing means 0); a positive :green/exit is false.
  Non-map returns keep ordinary Clojure truthiness for compose-level use."
  #{:around :before :after :override
    :before-while :before-until :after-while :after-until
    :filter-args :filter-return})

(defn- entry [how id f order props]
  (when-not (contains? hows how)
    (throw (ex-info (str "unsupported advice combinator: " how)
                    {:how how :id id :supported hows})))
  (when-not (<= -100 (:depth props 0) 100)
    (throw (ex-info "advice :depth must be in -100..100"
                    {:depth (:depth props) :id id})))
  {:id id :how how :fn f :seq order :depth (:depth props 0)})

(defn- remove-entry-ids [entries ids]
  (filterv #(not (contains? ids (:id %))) (or entries [])))

(defn- remove-entry-id [entries id]
  (remove-entry-ids entries #{id}))

(defn add
  "Register advice `f` on `step` with combinator `how` under `id`, tagged
  with add-order `seq`. `props` may carry :depth. Re-adding an existing id
  replaces it and moves it to the top of the stack for its depth (given a
  fresh, larger `seq`)."
  [registry step how id f order props]
  (update registry step
          (fnil (fn [entries]
                  (conj (remove-entry-id entries id)
                        (entry how id f order props)))
                [])))

(defn remove-id
  "Remove the advice registered under `id` on `step`."
  [registry step id]
  (update registry step remove-entry-id id))

(defn add-global
  "Like `add`, but for a flat (not step-keyed) vector of entries — used for
  advice that applies to every step."
  [entries how id f order props]
  (conj (remove-entry-id entries id) (entry how id f order props)))

(defn remove-global-id
  "Remove the global advice registered under `id`."
  [entries id]
  (remove-entry-id entries id))

(defn merge-entries
  "Stack `outer` entries (inherited from an enclosing workflow) outside
  `inner` ones: outer seqs are rebased by `offset` so they sort above
  every inner seq, and an outer entry replaces an inner one with the same
  :id. :depth still overrides placement at compose time."
  [inner outer offset]
  (let [outer (mapv #(update % :seq + offset) outer)
        replaced-ids (set (map :id outer))]
    (into (remove-entry-ids inner replaced-ids) outer)))

(defn merge-registry
  "Merge an outer step-keyed registry over an inner one, step by step,
  with `merge-entries`."
  [inner outer offset]
  (reduce-kv (fn [reg step entries]
               (update reg step merge-entries entries offset))
             (or inner {}) outer))

(defn- green-true?
  "Truth predicate for Green step returns: success is true, failure is false.
  Compose can also be used directly with non-map values, where ordinary
  Clojure truthiness is preserved."
  [ret]
  (if (map? ret)
    (zero? (or (:green/exit ret) 0))
    (boolean ret)))

(defn- wrap [how advice-fn base]
  (case how
    :around        (fn [opts] (advice-fn base opts))
    :override      (fn [opts] (advice-fn opts))
    :before        (fn [opts] (advice-fn opts) (base opts))
    :after         (fn [opts] (let [ret (base opts)] (advice-fn opts) ret))
    :before-while  (fn [opts] (and (advice-fn opts) (base opts)))
    :before-until  (fn [opts] (or (advice-fn opts) (base opts)))
    :after-while   (fn [opts]
                     (let [ret (base opts)]
                       (if (green-true? ret) (advice-fn opts) ret)))
    :after-until   (fn [opts]
                     (let [ret (base opts)]
                       (if (green-true? ret) ret (advice-fn opts))))
    :filter-args   (fn [opts] (base (advice-fn opts)))
    :filter-return (fn [opts] (advice-fn (base opts)))))

(defn ordered
  "Entries sorted innermost-first — the order `compose` wraps them:
  higher :depth is more inward; at equal depth the most recently added
  (largest :seq) is outermost."
  [entries]
  (sort-by (juxt #(- (:depth % 0)) :seq) entries))

(defn compose
  "Wrap `base` with `entries`, ordered like Emacs nadvice: lower :depth is
  more outward; at equal depth the most recently added (largest :seq) is
  outermost. The reduce builds inside-out over `ordered` (innermost-first)
  entries."
  [base entries]
  (reduce (fn [g {:keys [how] advice-fn :fn}]
            (wrap how advice-fn g))
          base
          (ordered entries)))

(ns green.cli
  "Configuration helpers kept at the existing green.cli import path.
  Parse YAML or EDN desired state and explicitly overlay COLORS_PAR_* values.
  Applications own argument parsing, validation, reporting and process exits."
  (:require
   [clojure.edn :as edn]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [yamlstar.parser :as yaml-parser]
   [yamlstar.composer :as yaml-composer]
   [yamlstar.resolver :as yaml-resolver]
   [yamlstar.constructor :as yaml-constructor]))

(def ^:private par-prefix
  "The parameter namespace every colour shares, so one variable serves green,
  red and blue without naming any of them."
  "COLORS_PAR_")

(defn par-name
  "The `COLORS_PAR_*` environment variable that supplies flat key `k`:
  uppercased, hyphens as underscores. :do-token -> COLORS_PAR_DO_TOKEN."
  [k]
  (str par-prefix (-> (name k) str/upper-case (str/replace "-" "_"))))

(defn- par-key
  [env-name]
  (-> env-name
      (subs (count par-prefix))
      str/lower-case
      (str/replace "_" "-")
      keyword))

(defn- coerce
  "Environment variables are strings; match the type of the value already in
  opts so a boolean key stays a boolean. Without this, COLORS_PAR_X=false would
  overlay the truthy string \"false\"."
  [old value]
  (cond
    (boolean? old) (case (str/lower-case value)
                     "true" true
                     "false" false
                     value)
    (integer? old) (or (parse-long value) value)
    :else value))

(defn read-pars
  "Overlay `COLORS_PAR_*` environment variables onto flat keys in `opts`.

  `COLORS_PAR_DO_TOKEN=xxx` becomes `{:do-token \"xxx\"}`. This is how secrets
  reach a workflow without being written to the desired-state file. Overrides
  are coerced to the type of the value they replace, and applying them twice
  changes nothing."
  ([opts] (read-pars opts (System/getenv)))
  ([opts env]
   (reduce-kv (fn [result k v]
                (let [k (str k)]
                  (if (and (str/starts-with? k par-prefix)
                           (< (count par-prefix) (count k)))
                    (let [key (par-key k)]
                      (assoc result key (coerce (get result key) v)))
                    result)))
              opts
              env)))

(defn- keywordize
  "YAML gives string keys; desired state is addressed by keyword throughout,
  the way the EDN reader already delivered it. Applied to every map in the
  tree, so nested collections read the same as flat ones."
  [x]
  (cond
    (map? x) (reduce-kv (fn [m k v]
                          (assoc m (cond-> k (string? k) keyword) (keywordize v)))
                        {}
                        x)
    (sequential? x) (mapv keywordize x)
    :else x))

(defn- core-scalar-node
  "Fill yamlstar 0.1.17 scalar gaps before resolution. Quoted strings and
  explicit tags retain the parser's original nodes."
  [node]
  (if (and (map? node) (= :scalar (:kind node))
           (nil? (:style node)) (nil? (:tag node)))
    (let [value (:value node)]
      (cond
        (re-matches #"0(?:o[0-7]+|x[0-9a-fA-F]+)" value)
        (assoc node :value (str (java.math.BigInteger.
                                 (subs value 2) (if (= \o (second value)) 8 16))))
        ;; The upstream constructor only accepts signed lowercase infinity.
        (re-matches #"[-+]?\.(?:inf|Inf|INF)" value)
        (assoc node :value (str/lower-case value))
        :else node))
    node))

(defn read-state
  "Parse desired-state `text` written in `file`'s language: YAML for .yml and
  .yaml, EDN otherwise. YAML is read by yamlstar, whose 1.2 core schema leaves
  `no`, `yes` and `on` as the strings they look like."
  [file text]
  (if (re-find #"(?i)\.ya?ml$" (str file))
    (->> text
         yaml-parser/parse
         yaml-composer/compose
         (walk/postwalk core-scalar-node)
         yaml-resolver/resolve
         yaml-constructor/construct
         keywordize)
    (edn/read-string text)))

(ns green.workflow
  "The workflow engine: a graph of steps threaded by an opts map.

  - wire-fn: (step run-opts) -> [fn & next-steps] — the static
    happy-path graph for this run. It may depend on stable run-level inputs
    such as :app/event. Multiple successors run in parallel.
  - next-fn (optional): (next-fn step default-next opts) -> seq of
    [next-step opts] pairs — dynamic routing, error branching, fan-out.
  - Steps report outcome via :green/exit (0 ok, >0 error), :green/err,
    :green/trace. Thrown exceptions are caught and converted.
  - Branches converging on the same step join: the join step runs once
    with the fork-point opts plus :green/branches (vector of branch results).
  - A branch failing inside a fork lets the in-flight siblings finish their
    current step, then the fork collapses: the join is skipped and the worst
    exit propagates, with all branch results under :green/branches.
  - advice-add attaches advice to one step; advice-add-all attaches advice
    to every step. Both stack in strict add order (most recently added,
    from either, is outermost), unless a :depth prop overrides placement
    (lower = more outward), as in Emacs.
  - Advice is inherited across `step` embeds: a run stamps its effective
    advice into opts and a nested run merges it over the child's own —
    step names match flat at any depth, ancestor advice is outermost, and
    an ancestor entry replaces a same-id child entry. advice-plan shows
    the composed stack for a step."
  (:require
   [green.advice :as advice])
  (:import
   [java.io PrintWriter StringWriter]))

(defn workflow
  "Construct a workflow. :start is required; :end is an optional slice
  boundary (it runs, then the workflow stops); :wire-fn is required and
  is called as (wire-fn step run-opts); :next-fn is optional."
  [{:keys [start end wire-fn next-fn]}]
  (when-not (keyword? start)
    (throw (ex-info "workflow :start must be a keyword" {:start start})))
  (when-not (fn? wire-fn)
    (throw (ex-info "workflow :wire-fn must be a function" {:wire-fn wire-fn})))
  {::start start ::end end ::wire-fn wire-fn ::next-fn next-fn
   ::advice {} ::advice-all [] ::advice-seq 0})

(defn- next-seq [wf]
  (::advice-seq wf 0))

(defn advice-add
  "Return a workflow with advice `f` added on `step` (combinator `how`,
  explicit `id`). Pure — the original workflow is untouched. Composes with
  any all-steps advice (see `advice-add-all`) in strict add order: whichever
  was added more recently is outermost. `props` may carry :depth
  (-100..100, default 0), which overrides add order: lower depth pushes the
  advice outward, higher pushes it inward, as with Emacs hook depths."
  ([wf step how id f] (advice-add wf step how id f nil))
  ([wf step how id f props]
   (let [s (next-seq wf)]
     (-> wf
         (update ::advice advice/add step how id f s props)
         (assoc ::advice-seq (inc s))))))

(defn advice-remove
  "Return a workflow with the advice registered under `id` on `step` removed."
  [wf step id]
  (update wf ::advice advice/remove-id step id))

(defn advice-add-all
  "Return a workflow with advice `f` added on every step (combinator `how`,
  explicit `id`). Pure — the original workflow is untouched. Composes with
  any per-step advice in strict add order: whichever was added more
  recently is outermost, regardless of whether it came from `advice-add`
  or `advice-add-all`. `props` may carry :depth, as in `advice-add`."
  ([wf how id f] (advice-add-all wf how id f nil))
  ([wf how id f props]
   (let [s (next-seq wf)]
     (-> wf
         (update ::advice-all advice/add-global how id f s props)
         (assoc ::advice-seq (inc s))))))

(defn advice-remove-all
  "Return a workflow with the all-steps advice registered under `id` removed."
  [wf id]
  (update wf ::advice-all advice/remove-global-id id))

;; --- advice inheritance across embeds -------------------------------------
;; A run stamps its effective registries into every step's opts under
;; ::inherited; `step` forwards the stamp into the nested run, whose
;; `inherit` merges it over the child's own advice. Inheritance is
;; transitive because each run stamps its already-merged registries.

(defn- inherit
  "Merge an `inherited` registry payload {:advice :advice-all} from an
  enclosing run over `wf`'s own advice: inherited entries stack outside
  the child's own, and an inherited entry replaces a same-id child entry
  (per step, or in the all-steps list). Step names are flat — whatever an
  ancestor advised under a name applies to this workflow's step of that
  name."
  [wf inherited]
  (if-let [{:keys [advice advice-all]} inherited]
    (let [n (next-seq wf)]
      (-> wf
          (update ::advice advice/merge-registry advice n)
          (update ::advice-all advice/merge-entries advice-all n)))
    wf))

(defn advice-plan
  "Debugging: the advice stack that would wrap `step` at run time,
  outermost first. `wfs` is a single workflow or a chain
  [outermost ... innermost] — the workflows a run traverses to reach
  `step` through `green.workflow/step` embeds (e.g. [parent-wf cluster-wf]
  for an embedded :zk/node). Returns
  [{:id :how :depth :seq :scope :level} ...] where :scope is :step or
  :all and :level indexes the chain element that registered the advice
  (0 = outermost). A child entry replaced by a same-id ancestor entry
  does not appear."
  [wfs step]
  (let [chain (if (map? wfs) [wfs] (vec wfs))
        tag (fn [wf level]
              (-> wf
                  (update ::advice
                          (fn [m]
                            (into {} (map (fn [[k es]]
                                            [k (mapv #(assoc % :scope :step :level level) es)]))
                                  m)))
                  (update ::advice-all
                          (fn [es] (mapv #(assoc % :scope :all :level level) es)))))
        eff (reduce (fn [inherited [level wf]]
                      (let [wf (inherit (tag wf level) inherited)]
                        {:advice (::advice wf) :advice-all (::advice-all wf)}))
                    nil
                    (map-indexed vector chain))
        entries (concat (:advice-all eff) (get (:advice eff) step))]
    (->> (advice/ordered entries)
         reverse
         (mapv #(select-keys % [:id :how :depth :seq :scope :level])))))

;; --- static graph (for join scheduling) ---------------------------------

(defn- static-successors [wire-fn step run-opts]
  ;; Deliberately lenient: this graph exists only for join detection, so a
  ;; name the wire-fn can't resolve (nil or a throw) just contributes no
  ;; static edges — next-fn may own routing for it. Real wiring bugs still
  ;; surface when the step runs: run-step calls the same wire-fn and converts
  ;; the failure to :green/exit. Throwing here would escape run uncaught,
  ;; bypassing the Unix-style outcome contract.
  (try (rest (wire-fn step run-opts)) (catch Exception _ nil)))

(defn- static-graph [wire-fn start run-opts]
  (loop [g {} frontier [start]]
    (if-let [s (first frontier)]
      (if (contains? g s)
        (recur g (subvec frontier 1))
        (let [succ (vec (static-successors wire-fn s run-opts))]
          (recur (assoc g s succ) (into (subvec frontier 1) succ))))
      g)))

(defn- reaches?
  "Can a branch currently at `from` (about to run it) later arrive at `to`,
  following static wire-fn edges?"
  [g from to]
  (loop [seen #{} frontier (vec (get g from))]
    (if (empty? frontier)
      false
      (let [s (peek frontier) frontier (pop frontier)]
        (cond
          (= s to) true
          (seen s) (recur seen frontier)
          :else (recur (conj seen s) (into frontier (get g s))))))))

;; --- running one step ----------------------------------------------------

(defn- stack-trace [^Throwable t]
  (let [sw (StringWriter.)]
    (.printStackTrace t (PrintWriter. sw true))
    (str sw)))

(defn failed?
  "Whether `opts` carries a failing outcome. Steps report failure through
  :green/exit rather than by throwing, so this is the predicate a step composed
  of several sub-steps uses to decide whether to keep going."
  [opts]
  (pos? (:green/exit opts 0)))

(defn- step-failure [opts ^Throwable t]
  (assoc opts
         :green/exit (or (:green/exit (ex-data t)) 1)
         :green/err (or (ex-message t) (str (class t)))
         :green/trace (stack-trace t)))

(defn- scheduler-failure [opts ^Throwable t]
  (assoc opts
         :green/exit 1
         :green/err (or (ex-message t) (str (class t)))
         :green/trace (stack-trace t)))

(defn- with-default-exit [opts]
  (cond-> opts
    (nil? (:green/exit opts)) (assoc :green/exit 0)))

(defn- inherited-payload [wf]
  {:advice (::advice wf)
   :advice-all (::advice-all wf)})

(defn- stamp-inherited [wf opts]
  (assoc opts ::inherited (inherited-payload wf)))

(defn- step-advice [wf step]
  (concat (::advice-all wf) (get-in wf [::advice step])))

(defn- run-step [wf step run-opts opts]
  (try
    (let [decl ((::wire-fn wf) step run-opts)
          f (first decl)]
      (when-not (fn? f)
        (throw (ex-info (str "no function wired for step " step) {:step step})))
      (let [ret ((advice/compose f (step-advice wf step))
                 (assoc (stamp-inherited wf opts) :green/step step))]
        (when-not (map? ret)
          (throw (ex-info (str "step " step " returned a non-map: " (pr-str ret))
                          {:step step})))
        (with-default-exit (dissoc ret ::inherited))))
    (catch Throwable t
      (step-failure opts t))))

(defn- next-pairs
  "Successor [step opts] pairs for `step` after it produced `opts`.
  The end step is a hard boundary; without next-fn an error halts."
  [wf step run-opts opts]
  (if (= step (::end wf))
    []
    (let [dn (seq (rest ((::wire-fn wf) step run-opts)))]
      (if-let [nf (::next-fn wf)]
        (vec (nf step dn opts))
        (if (failed? opts)
          []
          (mapv (fn [s] [s opts]) dn))))))

;; --- the scheduler --------------------------------------------------------

;; Live entries: {:step k :opts m :parent id :forks [frame…]} where a fork
;; frame is {:id fork-id :opts fork-point-opts}. :parent identifies the
;; run-unit that produced the entry, so same-step entries from one fan-out
;; run individually while entries converging from different origins join.
;; Finished branches are {:opts m :forks [frame…]}; the frames let a failure
;; collapse its enclosing fork.

(defn- children [uid opts pairs forks]
  (cond
    (empty? pairs)
    {:terminals [{:opts opts :forks forks}]}

    (= 1 (count pairs))
    (let [[s o] (first pairs)]
      {:new-entries [{:step s :opts o :parent uid :forks forks}]})

    :else
    (let [frame {:id uid :opts opts}]
      {:new-entries (mapv (fn [[s o]]
                            {:step s :opts o :parent uid :forks (conj forks frame)})
                          pairs)})))

(defn- terminal-result [opts forks]
  {:terminals [{:opts opts :forks forks}]})

(defn- branch-worst-exit [branch-opts]
  (apply max (map #(:green/exit % 0) branch-opts)))

(defn- join-forks [entries]
  (let [first-forks (:forks (first entries))]
    (->> first-forks
         (map-indexed vector)
         (take-while (fn [[i frame]]
                       (every? #(= (:id frame) (get-in % [:forks i :id])) entries)))
         (mapv second))))

(defn- failed-join-result [fork-opts forks branch-opts worst]
  (let [bad (first (filter #(= worst (:green/exit % 0)) branch-opts))]
    (terminal-result (assoc fork-opts
                            :green/exit worst
                            :green/err (:green/err bad)
                            :green/trace (:green/trace bad)
                            :green/branches branch-opts)
                     forks)))

(defn- run-single-unit [wf uid step run-opts {:keys [opts forks]}]
  (let [opts' (run-step wf step run-opts opts)]
    (children uid opts' (next-pairs wf step run-opts opts') forks)))

(defn- run-join-unit [wf uid step run-opts entries]
  (let [branch-opts (mapv :opts entries)
        forks (join-forks entries)
        fork-opts (if (seq forks) (:opts (peek forks)) (first branch-opts))
        forks' (if (seq forks) (pop forks) forks)
        worst (branch-worst-exit branch-opts)]
    (if (pos? worst)
      (failed-join-result fork-opts forks' branch-opts worst)
      (let [opts' (run-step wf step run-opts (assoc fork-opts :green/branches branch-opts))]
        (children uid opts' (next-pairs wf step run-opts opts') forks')))))

(defn- unit-base-opts [entry entries]
  (if entry
    (:opts entry)
    (let [forks (join-forks entries)
          base (or (:opts (peek forks)) (:opts (first entries)) {})]
      (assoc base :green/branches (mapv :opts entries)))))

(defn- unit-forks [entry entries]
  (if entry
    (:forks entry)
    (let [forks (join-forks entries)]
      (if (seq forks) (pop forks) forks))))

(defn- failed-unit-result [entry entries ^Throwable t]
  (terminal-result (scheduler-failure (unit-base-opts entry entries) t)
                   (unit-forks entry entries)))

(defn- run-unit [wf run-opts {:keys [kind step entry entries]}]
  (let [uid (gensym "green-unit")]
    (try
      (case kind
        :single (run-single-unit wf uid step run-opts entry)
        :join (run-join-unit wf uid step run-opts entries))
      (catch Throwable t
        (failed-unit-result entry entries t)))))

(defn- failed-fork-branch? [branch]
  (and (failed? (:opts branch)) (seq (:forks branch))))

(defn- in-fork? [fork-id entry]
  (boolean (some #(= fork-id (:id %)) (:forks entry))))

(defn- fork-members [fork-id live finished]
  (into (filterv (partial in-fork? fork-id) finished)
        (filterv (partial in-fork? fork-id) live)))

(defn- outside-fork [fork-id entries]
  (filterv (complement (partial in-fork? fork-id)) entries))

(defn- collapsed-fork-entry [fork-opts bad branch-opts worst]
  (let [worst-opts (first (filter #(= worst (:green/exit % 0)) branch-opts))]
    {:opts (assoc fork-opts
                  :green/exit worst
                  :green/err (:green/err worst-opts)
                  :green/trace (:green/trace worst-opts)
                  :green/branches branch-opts)
     :forks (pop (:forks bad))}))

(defn- collapse-fork [live finished bad]
  (let [{fork-id :id fork-opts :opts} (peek (:forks bad))
        branch-opts (mapv :opts (fork-members fork-id live finished))
        worst (branch-worst-exit branch-opts)]
    [(outside-fork fork-id live)
     (conj (outside-fork fork-id finished)
           (collapsed-fork-entry fork-opts bad branch-opts worst))]))

(defn- collapse-doomed
  "While a finished branch failed inside a fork, collapse that fork: absorb
  its live entries (their current opts are their branch results — siblings
  finished their step, nothing new starts) and its finished branches, skip
  the join, and emit a terminal carrying the worst exit and :green/branches.
  Cascades outward through nested forks."
  [live finished]
  (loop [live live finished finished]
    (if-let [bad (first (filter failed-fork-branch? finished))]
      (let [[live' finished'] (collapse-fork live finished bad)]
        (recur live' finished'))
      [live finished])))

(defn- finalize [finished]
  (let [terminals (mapv #(dissoc (:opts %) ::inherited) finished)]
    (cond
      (empty? terminals) {:green/exit 0}
      (= 1 (count terminals)) (first terminals)
      :else (or (first (filter failed? terminals))
                (last terminals)))))

(defn- blocked-step? [g live step]
  (some #(and (not= (:step %) step) (reaches? g (:step %) step))
        live))

(defn- ready-steps [g live by-step]
  (or (seq (remove #(blocked-step? g live %) (keys by-step)))
      (keys by-step)))

(defn- waiting-steps [by-step ready]
  (remove (set ready) (keys by-step)))

(defn- entries-for-steps [by-step steps]
  (mapcat #(get by-step %) steps))

(defn- same-origin? [entries]
  (or (= 1 (count entries))
      (apply = (map :parent entries))))

(defn- single-units [step entries]
  (map (fn [entry] {:kind :single :step step :entry entry}) entries))

(defn- step-units [step entries]
  (if (same-origin? entries)
    (single-units step entries)
    [{:kind :join :step step :entries entries}]))

(defn- ready-units [by-step ready]
  (mapcat (fn [step] (step-units step (get by-step step))) ready))

(defn- run-units [wf run-opts units]
  (let [tasks (mapv (fn [unit] (future (run-unit wf run-opts unit))) units)
        failures (atom [])
        results (mapv (fn [task]
                        (loop []
                          (let [result (try {:value @task}
                                            (catch InterruptedException e
                                              (swap! failures conj e)
                                              {:retry true})
                                            (catch Throwable e
                                              (swap! failures conj e)
                                              {}))]
                            (if (:retry result) (recur) (:value result)))))
                      tasks)]
    (when-let [error (first @failures)] (throw error))
    results))

(defn- scheduler-step [wf run-opts g live finished]
  (let [by-step (group-by :step live)
        ready (ready-steps g live by-step)
        waiting (waiting-steps by-step ready)
        units (ready-units by-step ready)
        results (run-units wf run-opts units)]
    (collapse-doomed
     (-> []
         (into (entries-for-steps by-step waiting))
         (into (mapcat :new-entries results)))
     (into finished (mapcat :terminals results)))))

(declare run)

(defn step
  "Turn a workflow into a step function (opts -> opts), so workflows compose
  into higher-level workflows: wire the result like any other step, advise
  it, fan it out. The sub-workflow's :green/exit propagates naturally, and
  application keys like :app/event and :app/dry-run flow in with opts.

  The enclosing run's advice is inherited: the nested run merges it over
  the sub-workflow's own (see the ns docstring). The engine re-stamps the
  inherited registry after :in-fn runs, so :in-fn may build sub-opts from
  scratch without severing inheritance.

  Options:
    :in-fn  (fn [opts] sub-opts)        — shape the opts entering the
                                          sub-workflow
    :out-fn (fn [opts sub-result] opts) — merge the sub-result back into the
                                          parent's opts (default: the
                                          sub-result itself is the step's
                                          result)"
  ([wf] (step wf {}))
  ([wf {:keys [in-fn out-fn]}]
   (fn [opts]
     (let [inherited (::inherited opts)
           sub-opts (cond-> ((or in-fn identity) opts)
                      inherited (assoc ::inherited inherited))
           result (run wf sub-opts)]
       (if out-fn (out-fn opts result) result)))))

(defn run
  "Run the workflow from its start step with `opts` as the initial state.
  The same initial opts are passed to `wire-fn` as `run-opts` for the
  whole run, so the static graph stays stable. Returns the final opts map;
  its :green/exit is the workflow's exit code. When `opts` carries an
  inherited advice registry (stamped by an enclosing run through `step`),
  it is merged over the workflow's own advice before anything runs."
  [wf opts]
  (let [run-opts opts
        wf (inherit wf (::inherited opts))
        g (static-graph (::wire-fn wf) (::start wf) run-opts)]
    (loop [live [{:step (::start wf) :opts opts :parent ::root :forks []}]
           finished []]
      (if (empty? live)
        (finalize finished)
        (let [[live' finished'] (scheduler-step wf run-opts g live finished)]
          (recur live' finished'))))))

(ns green.advice-test
  (:require [clojure.test :refer [deftest is testing]]
            [green.advice :as advice]
            [green.workflow :as wf]))

(defn- log [o x] (update o :log (fnil conj []) x))

(defn- single-step-wf []
  (wf/workflow {:start :t/step
                :wire-fn (fn [_ _] [(fn [o] (log o :base))])}))

(deftest filter-return-and-lifo-stacking
  (let [base (single-step-wf)
        advised (-> base
                    (wf/advice-add :t/step :filter-return ::a #(log % :a))
                    (wf/advice-add :t/step :filter-return ::b #(log % :b)))]
    (testing "most recently added advice is outermost"
      (is (= [:base :a :b] (:log (wf/run advised {})))))
    (testing "the original workflow is untouched (workflow-scoped advice)"
      (is (= [:base] (:log (wf/run base {})))))))

(deftest advice-remove-by-id
  (let [advised (-> (single-step-wf)
                    (wf/advice-add :t/step :filter-return ::a #(log % :a))
                    (wf/advice-add :t/step :filter-return ::b #(log % :b))
                    (wf/advice-remove :t/step ::a))]
    (is (= [:base :b] (:log (wf/run advised {}))))))

(deftest re-adding-same-id-replaces-and-moves-to-top
  (let [advised (-> (single-step-wf)
                    (wf/advice-add :t/step :filter-return ::a #(log % :a1))
                    (wf/advice-add :t/step :filter-return ::b #(log % :b))
                    (wf/advice-add :t/step :filter-return ::a #(log % :a2)))]
    (is (= [:base :b :a2] (:log (wf/run advised {}))))))

(deftest override-replaces-base
  (let [advised (-> (single-step-wf)
                    (wf/advice-add :t/step :override ::o #(log % :override)))]
    (is (= [:override] (:log (wf/run advised {}))))))

(deftest around-controls-the-call
  (let [advised (-> (single-step-wf)
                    (wf/advice-add :t/step :around ::ar
                                   (fn [f o] (log (f (log o :in)) :out))))]
    (is (= [:in :base :out] (:log (wf/run advised {}))))))

(deftest filter-args-transforms-input
  (let [advised (-> (single-step-wf)
                    (wf/advice-add :t/step :filter-args ::fa #(assoc % :x 1)))]
    (is (= 1 (:x (wf/run advised {}))))))

(deftest before-and-after-run-for-side-effects
  (let [seen (atom [])
        advised (-> (single-step-wf)
                    (wf/advice-add :t/step :before ::b
                                   (fn [o] (swap! seen conj [:before (:log o)]) o))
                    (wf/advice-add :t/step :after ::a
                                   (fn [o] (swap! seen conj [:after (:log o)]) o)))
        res (wf/run advised {})]
    (testing "before and after both see the step's input opts (Emacs: both
              get r); their returns are ignored and OLDFUN's value flows out"
      (is (= [:base] (:log res)))
      (is (= [[:before nil] [:after nil]] @seen)))))

(deftest before-runs-newest-to-oldest-after-runs-oldest-to-newest
  (let [seen (atom [])
        note (fn [k] (fn [o] (swap! seen conj k) o))
        advised (-> (single-step-wf)
                    (wf/advice-add :t/step :before ::b1 (note :b1))
                    (wf/advice-add :t/step :before ::b2 (note :b2))
                    (wf/advice-add :t/step :after ::a1 (note :a1))
                    (wf/advice-add :t/step :after ::a2 (note :a2)))]
    (wf/run advised {})
    (is (= [:b2 :b1 :a1 :a2] @seen))))

(deftest throwing-advice-fails-the-step-through-the-contract
  (let [advised (-> (single-step-wf)
                    (wf/advice-add :t/step :before ::boom
                                   (fn [_] (throw (ex-info "advice boom" {})))))
        res (wf/run advised {})]
    (is (= 1 (:green/exit res)))
    (is (= "advice boom" (:green/err res)))
    (is (string? (:green/trace res)))))

(defn- two-step-wf []
  (wf/workflow {:start :t/a
               :wire-fn (fn [s _]
                          (case s
                            :t/a [(fn [o] (log o :a)) :t/b]
                            :t/b [(fn [o] (log o :b))]))}))

(deftest advice-add-all-applies-to-every-step
  (let [advised (-> (two-step-wf)
                    (wf/advice-add-all :filter-return ::tag #(log % :all)))]
    (is (= [:a :all :b :all] (:log (wf/run advised {}))))))

(deftest advice-add-all-interleaves-in-strict-add-order-with-per-step
  (let [advised (-> (two-step-wf)
                    (wf/advice-add-all :filter-return ::g1 #(log % :g1))
                    (wf/advice-add :t/a :filter-return ::pa #(log % :pa))
                    (wf/advice-add-all :filter-return ::g2 #(log % :g2)))
        res (wf/run advised {})]
    (testing ":t/a ran with both global entries plus its own, in add order"
      (is (= [:a :g1 :pa :g2] (subvec (:log res) 0 4))))
    (testing ":t/b, with no per-step advice, only saw the globals in add order"
      (is (= [:b :g1 :g2] (subvec (:log res) 4))))))

(deftest advice-remove-all-removes-the-global-entry
  (let [advised (-> (two-step-wf)
                    (wf/advice-add-all :filter-return ::g #(log % :g))
                    (wf/advice-remove-all ::g))]
    (is (= [:a :b] (:log (wf/run advised {}))))))

;; --- the while/until combinators -----------------------------------------

(defn- entry [how f seq]
  {:id (gensym "adv") :how how :fn f :seq seq :depth 0})

(deftest before-while-gates-the-inward-call
  (let [seen (atom [])
        base (fn [o] (swap! seen conj :base) (log o :base))]
    (testing "truthy advice lets the chain run; base sees the original opts"
      (reset! seen [])
      (let [f (advice/compose base [(entry :before-while
                                           (fn [_] (swap! seen conj :w) true) 0)])]
        (is (= [:base] (:log (f {}))))
        (is (= [:w :base] @seen))))
    (testing "nil advice short-circuits: nothing inward runs, result is nil"
      (reset! seen [])
      (let [f (advice/compose base [(entry :before-while
                                           (fn [_] (swap! seen conj :w) nil) 0)])]
        (is (nil? (f {})))
        (is (= [:w] @seen))))))

(deftest before-while-stack-runs-newest-to-oldest-and-stops-on-nil
  (let [seen (atom [])
        base (fn [o] (swap! seen conj :base) o)
        f (advice/compose base
                          [(entry :before-while (fn [_] (swap! seen conj :old) true) 0)
                           (entry :before-while (fn [_] (swap! seen conj :new) nil) 1)])]
    (is (nil? (f {})))
    (is (= [:new] @seen) "the newest gate is outermost and stops the chain")))

(deftest before-until-short-circuits-on-non-nil
  (testing "a non-nil advice return is the result; base never runs"
    (let [advised (-> (single-step-wf)
                      (wf/advice-add :t/step :before-until ::bu #(log % :bu)))]
      (is (= [:bu] (:log (wf/run advised {}))))))
  (testing "a nil advice return falls through to the chain"
    (let [advised (-> (single-step-wf)
                      (wf/advice-add :t/step :before-until ::bu (fn [_] nil)))]
      (is (= [:base] (:log (wf/run advised {})))))))

(deftest after-while-runs-oldest-to-newest-and-stops-on-nil
  (let [seen (atom [])
        base (fn [o] (swap! seen conj :base) o)
        f (advice/compose base
                          [(entry :after-while (fn [_] (swap! seen conj :old) nil) 0)
                           (entry :after-while (fn [_] (swap! seen conj :new) true) 1)])]
    (is (nil? (f {})))
    (is (= [:base :old] @seen)
        "base first, then oldest advice; its nil skips the newer one")))

(deftest after-while-and-after-until-use-green-exit-as-truth
  (testing ":after-while does not run after a failing step result"
    (let [seen (atom [])
          f (advice/compose (fn [o]
                              (swap! seen conj :base)
                              (assoc (log o :base) :green/exit 7))
                            [(entry :after-while
                                    (fn [o]
                                      (swap! seen conj :after)
                                      (assoc (log o :after) :green/exit 0))
                                    0)])
          ret (f {})]
      (is (= 7 (:green/exit ret)))
      (is (= [:base] (:log ret)))
      (is (= [:base] @seen))))
  (testing ":after-until falls through to advice after a failing step result"
    (let [seen (atom [])
          f (advice/compose (fn [o]
                              (swap! seen conj :base)
                              (assoc (log o :base) :green/exit 7))
                            [(entry :after-until
                                    (fn [o]
                                      (swap! seen conj :recover)
                                      (assoc (log o :recover) :green/exit 0))
                                    0)])
          ret (f {})]
      (is (= 0 (:green/exit ret)))
      (is (= [:recover] (:log ret)))
      (is (= [:base :recover] @seen)))))

(deftest after-until-supplies-a-result-when-the-chain-returns-nil
  (testing "compose level: advice only fires when the inward call is nil"
    (let [f (advice/compose (fn [_] nil)
                            [(entry :after-until (fn [o] (log o :fallback)) 0)])]
      (is (= [:fallback] (:log (f {})))))
    (let [f (advice/compose (fn [o] (log o :base))
                            [(entry :after-until (fn [o] (log o :fallback)) 0)])]
      (is (= [:base] (:log (f {}))) "a non-nil chain result short-circuits")))
  (testing "in a workflow: a before-while gate nils the step out and an
            outer after-until turns that into a real result"
    (let [advised (-> (single-step-wf)
                      (wf/advice-add :t/step :before-while ::gate (fn [_] nil))
                      (wf/advice-add :t/step :after-until ::fallback #(log % :fallback)))
          res (wf/run advised {})]
      (is (= [:fallback] (:log res)))
      (is (= 0 (:green/exit res))))))

(deftest after-until-stack-runs-oldest-to-newest
  (let [seen (atom [])
        f (advice/compose (fn [_] (swap! seen conj :base) nil)
                          [(entry :after-until (fn [_] (swap! seen conj :old) nil) 0)
                           (entry :after-until (fn [_] (swap! seen conj :new) :hit) 1)])]
    (is (= :hit (f {})))
    (is (= [:base :old :new] @seen))))

;; --- depth ----------------------------------------------------------------

(deftest depth-overrides-add-order
  (let [advised (-> (single-step-wf)
                    (wf/advice-add :t/step :filter-return ::outer #(log % :outer) {:depth -50})
                    (wf/advice-add :t/step :filter-return ::mid #(log % :mid))
                    (wf/advice-add :t/step :filter-return ::inner #(log % :inner) {:depth 50}))]
    (testing "lower depth is more outward, higher more inward, whatever the add order"
      (is (= [:base :inner :mid :outer] (:log (wf/run advised {})))))))

(deftest equal-depth-falls-back-to-newest-outermost
  (let [advised (-> (single-step-wf)
                    (wf/advice-add :t/step :filter-return ::a #(log % :a) {:depth -50})
                    (wf/advice-add :t/step :filter-return ::b #(log % :b) {:depth -50}))]
    (is (= [:base :a :b] (:log (wf/run advised {}))))))

(deftest depth-applies-across-per-step-and-all-steps-advice
  (let [advised (-> (two-step-wf)
                    (wf/advice-add-all :filter-return ::g #(log % :g))
                    (wf/advice-add :t/a :filter-return ::p #(log % :p) {:depth 100}))
        res (wf/run advised {})]
    (testing "depth 100 pushes the later-added per-step advice inside the global one"
      (is (= [:a :p :g] (subvec (:log res) 0 3))))
    (is (= [:b :g] (subvec (:log res) 3)))))

(deftest invalid-how-and-out-of-range-depth-are-rejected-at-add-time
  (is (thrown-with-msg? clojure.lang.ExceptionInfo #"unsupported advice combinator"
                        (wf/advice-add (single-step-wf) :t/step :befor ::typo identity)))
  (is (thrown-with-msg? clojure.lang.ExceptionInfo #":depth must be in -100..100"
                        (wf/advice-add (single-step-wf) :t/step :before ::deep identity
                                       {:depth 101}))))

;; --- cross-workflow inheritance (advice through wf/step) -------------------

(defn- embed
  "A parent workflow that runs :p/a, then `sub` as an embedded step, then :p/z."
  [sub]
  (wf/workflow {:start :p/a
                :wire-fn (fn [s _]
                           (case s
                             :p/a [(fn [o] (log o :p-a)) :p/sub]
                             :p/sub [(wf/step sub) :p/z]
                             :p/z [(fn [o] (log o :p-z))]))}))

(deftest parent-advice-reaches-an-embedded-step
  (let [sub (single-step-wf)
        parent (-> (embed sub)
                   (wf/advice-add :t/step :filter-return ::p #(log % :p)))]
    (is (= [:p-a :base :p :p-z] (:log (wf/run parent {}))))
    (testing "the child value is untouched — standalone runs stay bare"
      (is (= [:base] (:log (wf/run sub {})))))))

(deftest parent-override-redefines-an-embedded-step
  (let [parent (-> (embed (single-step-wf))
                   (wf/advice-add :t/step :override ::o #(log % :redefined)))]
    (is (= [:p-a :redefined :p-z] (:log (wf/run parent {}))))))

(deftest inherited-advice-is-outermost
  (let [sub (-> (single-step-wf)
                (wf/advice-add :t/step :filter-return ::c #(log % :child)))
        parent (-> (embed sub)
                   (wf/advice-add :t/step :filter-return ::p #(log % :parent)))]
    (is (= [:p-a :base :child :parent :p-z] (:log (wf/run parent {}))))))

(deftest same-id-parent-advice-replaces-the-childs
  (let [sub (-> (single-step-wf)
                (wf/advice-add :t/step :filter-return ::x #(log % :child-x)))
        parent (-> (embed sub)
                   (wf/advice-add :t/step :filter-return ::x #(log % :parent-x)))]
    (is (= [:p-a :base :parent-x :p-z] (:log (wf/run parent {}))))))

(deftest depth-overrides-inheritance-order
  (let [sub (-> (single-step-wf)
                (wf/advice-add :t/step :filter-return ::c #(log % :child) {:depth -50}))
        parent (-> (embed sub)
                   (wf/advice-add :t/step :filter-return ::p #(log % :parent)))]
    (testing "the child's depth -50 stays outside the parent's depth-0 advice"
      (is (= [:p-a :base :parent :child :p-z] (:log (wf/run parent {})))))))

(deftest advice-add-all-propagates-into-embeds
  (let [parent (-> (embed (single-step-wf))
                   (wf/advice-add-all :filter-return ::g #(log % :g)))]
    (testing "every inner step is wrapped, and so is the embed step itself"
      (is (= [:p-a :g :base :g :g :p-z :g] (:log (wf/run parent {})))))))

(deftest inheritance-survives-a-scoping-in-fn
  (let [parent (-> (wf/workflow {:start :p/sub
                                 :wire-fn (fn [_ _]
                                            [(wf/step (single-step-wf)
                                                      {:in-fn (fn [o] {:n (:n o)})})])})
                   (wf/advice-add :t/step :filter-return ::p #(log % :p)))]
    (testing ":in-fn built sub-opts from scratch; the engine re-stamped the registry"
      (is (= [:base :p] (:log (wf/run parent {:n 1})))))))

(deftest inheritance-is-transitive-through-nested-embeds
  (let [inner (single-step-wf)
        mid (wf/workflow {:start :m/sub :wire-fn (fn [_ _] [(wf/step inner)])})
        top (-> (wf/workflow {:start :top/sub :wire-fn (fn [_ _] [(wf/step mid)])})
                (wf/advice-add :t/step :filter-return ::p #(log % :top)))]
    (is (= [:base :top] (:log (wf/run top {}))))))

(deftest the-inherited-registry-does-not-leak-into-results
  (let [parent (-> (embed (single-step-wf))
                   (wf/advice-add :t/step :filter-return ::p identity))
        res (wf/run parent {})]
    (is (not (contains? res :green.workflow/inherited)))))

(deftest advice-plan-shows-the-cross-workflow-stack
  (let [sub (-> (single-step-wf)
                (wf/advice-add :t/step :before ::backend identity)
                (wf/advice-add :t/step :filter-return ::inner identity {:depth 50}))
        parent (-> (embed sub)
                   (wf/advice-add :t/step :before ::backend identity)
                   (wf/advice-add-all :around ::audit (fn [f o] (f o))))]
    (testing "outermost first, with provenance; the parent's ::backend replaced the child's"
      (is (= [[::audit :all 0] [::backend :step 0] [::inner :step 1]]
             (mapv (juxt :id :scope :level) (wf/advice-plan [parent sub] :t/step)))))
    (testing "a single workflow works too"
      (is (= [[::backend :step 0] [::inner :step 0]]
             (mapv (juxt :id :scope :level) (wf/advice-plan sub :t/step)))))))

(deftest advice-add-all-workflow-is-untouched-by-later-adds
  (let [base (two-step-wf)
        g1 (wf/advice-add-all base :filter-return ::g1 #(log % :g1))
        g2 (wf/advice-add-all g1 :filter-return ::g2 #(log % :g2))]
    (is (= [:a :g1 :b :g1] (:log (wf/run g1 {}))) "g1 is untouched by adding g2")
    (is (= [:a :g1 :g2 :b :g1 :g2] (:log (wf/run g2 {}))))))

(ns green.cli-test
  (:require [clojure.test :refer [deftest is testing]]
            [green.cli :as cli]))

(deftest colors-par-variables-overlay-desired-state
  (testing "the file supplies structure, the environment supplies secrets"
    (is (= {:do-token "tok" :profile "prod"}
           (cli/read-pars {:profile "prod"} {"COLORS_PAR_DO_TOKEN" "tok"
                                             "PATH" "/usr/bin"}))))

  (testing "hyphens in the key are underscores in the variable"
    (is (= "COLORS_PAR_R2_ACCESS_KEY_ID" (cli/par-name :r2-access-key-id)))
    (is (= {:r2-access-key-id "id"}
           (cli/read-pars {} {"COLORS_PAR_R2_ACCESS_KEY_ID" "id"}))))

  (testing "an override takes the type of the value it replaces"
    (is (= {:prevent-destroy false}
           (cli/read-pars {:prevent-destroy true}
                          {"COLORS_PAR_PREVENT_DESTROY" "false"})))
    (is (= {:port 25}
           (cli/read-pars {:port 587} {"COLORS_PAR_PORT" "25"})))
    (is (= {:name "x"} (cli/read-pars {:name "y"} {"COLORS_PAR_NAME" "x"}))))

  (testing "applying the overlay twice changes nothing"
    (let [env {"COLORS_PAR_PREVENT_DESTROY" "false"}
          once (cli/read-pars {:prevent-destroy true} env)]
      (is (= once (cli/read-pars once env)))))

  (testing "the bare prefix is not a key"
    (is (= {} (cli/read-pars {} {"COLORS_PAR_" "x"}))))

  (testing "no colour keeps a prefix of its own"
    (is (= {} (cli/read-pars {} {"GREEN_PAR_DO_TOKEN" "tok"
                                 "RED_PAR_DO_TOKEN" "tok"
                                 "BLUE_PAR_DO_TOKEN" "tok"
                                 "ONCE_PAR_DO_TOKEN" "tok"})))))

(deftest desired-state-is-read-by-extension
  (testing "yaml keys arrive as keywords, nesting included"
    (is (= {:profile "prod" :once {:applications [{:host "www.example.com"}]}}
           (cli/read-state "colors.yml"
                           "profile: prod\nonce:\n  applications:\n    - host: www.example.com\n"))))

  (testing "the 1.2 core schema leaves no/yes/on as the strings they look like"
    (is (= {:a "no" :b "yes" :c "on" :d true :e 12}
           (cli/read-state "colors.yaml" "a: no\nb: yes\nc: on\nd: true\ne: 012\n"))))

  (testing "edn is still read, so existing projects keep working"
    (is (= {:profile "prod" :port 587}
           (cli/read-state "green.edn" "{:profile \"prod\" :port 587}")))))

(deftest core-scalar-numbers-and-strings
  (let [state (cli/read-state "state.yml"
                (str "exponent: 1e3\nfractional-exponent: 1.0e3\nsmall-exponent: 1.25e-2\n"
                     "date: 2026-09-11\nclock: 1:30.5\noctal: 0o17\nhex: 0x1f\n"
                     "quoted: [\"1e3\", \"0o17\", \"0x1f\", \"2026-09-11\"]\n"
                     "nested: {number: &n 0o17, alias: *n}\n"
                     "tagged: !!str 0o17\nblock: |\n  0o17\n"))]
    (is (== 1000 (:exponent state) (:fractional-exponent state)))
    (is (= 0.0125 (:small-exponent state)))
    (is (= "2026-09-11" (:date state)))
    (is (= "1:30.5" (:clock state)))
    (is (= 15 (:octal state)))
    (is (= 31 (:hex state)))
    (is (= ["1e3" "0o17" "0x1f" "2026-09-11"] (:quoted state)))
    (is (= {:number 15 :alias 15} (:nested state)))
    (is (= "0o17" (:tagged state)))
    (is (= "0o17\n" (:block state)))))

(deftest core-signed-infinity
  (let [state (cli/read-state "state.yml" "positive: +.INF\nnegative: -.Inf\nnan: .NaN\nquoted: \"-.Inf\"\n")]
    (is (= Double/POSITIVE_INFINITY (:positive state)))
    (is (= Double/NEGATIVE_INFINITY (:negative state)))
    (is (Double/isNaN (:nan state)))
    (is (= "-.Inf" (:quoted state)))))

(ns green.workflow-test
  (:require [clojure.test :refer [deftest is testing]]
            [green.workflow :as wf]))

(defn- mark [k] (fn [o] (update o :seen (fnil conj []) k)))

(deftest linear-happy-path
  (let [w (wf/workflow {:start :t/a
                        :wire-fn (fn [s _]
                                   (case s
                                     :t/a [(mark :a) :t/b]
                                     :t/b [(mark :b) :t/c]
                                     :t/c [(mark :c)]))})
        res (wf/run w {})]
    (is (= [:a :b :c] (:seen res)))
    (is (= 0 (:green/exit res)))))

(deftest error-halts-without-next-fn
  (let [w (wf/workflow {:start :t/a
                        :wire-fn (fn [s _]
                                   (case s
                                     :t/a [(mark :a) :t/b]
                                     :t/b [(fn [o] (assoc o :green/exit 3)) :t/c]
                                     :t/c [(mark :c)]))})
        res (wf/run w {})]
    (is (= 3 (:green/exit res)))
    (is (= [:a] (:seen res)) ":t/c must not run")))

(deftest exception-becomes-exit-err-trace
  (let [w (wf/workflow {:start :t/a
                        :wire-fn (fn [s _]
                                   (case s
                                     :t/a [(fn [_] (throw (ex-info "boom" {})))
                                           :t/b]
                                     :t/b [(mark :b)]))})
        res (wf/run w {})]
    (is (= 1 (:green/exit res)))
    (is (= "boom" (:green/err res)))
    (is (string? (:green/trace res)))
    (is (nil? (:seen res)) ":t/b must not run")))

(deftest end-step-is-an-inclusive-slice-boundary
  (let [wire (fn [s _]
               (case s
                 :t/a [(mark :a) :t/b]
                 :t/b [(mark :b) :t/c]
                 :t/c [(mark :c)]))]
    (testing "end stops after running it"
      (is (= [:a :b]
             (:seen (wf/run (wf/workflow {:start :t/a :end :t/b :wire-fn wire}) {})))))
    (testing "start skips earlier steps"
      (is (= [:b :c]
             (:seen (wf/run (wf/workflow {:start :t/b :wire-fn wire}) {})))))))

(deftest wire-fn-can-select-an-event-specific-static-graph
  (let [w (wf/workflow
           {:start :t/start
            :wire-fn (fn [step run-opts]
                       (case [(:green/event run-opts) step]
                         [:create :t/start] [(mark :start) :t/node]
                         [:create :t/node] [(mark :node) :t/config]
                         [:create :t/config] [(mark :config)]
                         [:delete :t/start] [(mark :start) :t/config]
                         [:delete :t/config] [(mark :config) :t/node]
                         [:delete :t/node] [(mark :node)]))})]
    (is (= [:start :node :config]
           (:seen (wf/run w {:green/event :create}))))
    (is (= [:start :config :node]
           (:seen (wf/run w {:green/event :delete}))))))

(deftest wire-fn-uses-stable-run-opts-not-branch-opts
  (let [w (wf/workflow
           {:start :t/start
            :wire-fn (fn [step run-opts]
                       (case step
                         :t/start [identity :t/work]
                         :t/work [(mark :work)
                                  (if (= :branch (:route run-opts))
                                    :t/branch-done
                                    :t/run-done)]
                         :t/run-done [(mark :run-done)]
                         :t/branch-done [(mark :branch-done)]))
            :next-fn (fn [step default-next opts]
                       (if (= step :t/start)
                         [[:t/work (assoc opts :route :branch)]]
                         (mapv (fn [s] [s opts]) default-next)))})
        res (wf/run w {:route :run})]
    (is (= [:work :run-done] (:seen res)))
    (is (= :branch (:route res)) "the step still receives branch-local opts")))

(deftest next-fn-reroutes-errors
  (let [w (wf/workflow {:start :t/a
                        :wire-fn (fn [s _]
                                   (case s
                                     :t/a [(fn [o] (assoc o :green/exit 7)) :t/b]
                                     :t/b [(mark :b)]
                                     :t/cleanup [(fn [o] (-> o (assoc :green/exit 0)
                                                             ((mark :cleanup))))]))
                        :next-fn (fn [step dn opts]
                                   (cond
                                     (pos? (:green/exit opts 0)) (when-not (= step :t/cleanup)
                                                                   [[:t/cleanup opts]])
                                     :else (map (fn [s] [s opts]) dn)))})
        res (wf/run w {})]
    (is (= [:cleanup] (:seen res)))
    (is (= 0 (:green/exit res)))))

(deftest next-fn-nil-terminates
  (let [w (wf/workflow {:start :t/a
                        :wire-fn (fn [s _]
                                   (case s
                                     :t/a [(mark :a) :t/b]
                                     :t/b [(mark :b)]))
                        :next-fn (fn [_ _ _] nil)})
        res (wf/run w {})]
    (is (= [:a] (:seen res)))))

(deftest static-fork-and-join
  ;; :t/a forks to :t/b and :t/c; :t/c has a longer chain (:t/c -> :t/c2);
  ;; both arrive at :t/d, which must run once with both branches collected.
  (let [w (wf/workflow {:start :t/a
                        :wire-fn (fn [s _]
                                   (case s
                                     :t/a [(mark :a) :t/b :t/c]
                                     :t/b [(mark :b) :t/d]
                                     :t/c [(mark :c) :t/c2]
                                     :t/c2 [(mark :c2) :t/d]
                                     :t/d [(fn [o]
                                             (assoc o :joined
                                                    (mapv :seen (:green/branches o))))]))})
        res (wf/run w {})]
    (is (= 0 (:green/exit res)))
    (is (= 2 (count (:green/branches res))))
    (testing "join waited for the longer branch"
      (is (= #{[:a :b] [:a :c :c2]} (set (:joined res)))))
    (testing "join base opts come from the fork point"
      (is (= [:a] (:seen res))
          "join step's own opts derive from fork opts, not a branch"))))

(deftest dynamic-fan-out-and-join
  (let [w (wf/workflow {:start :t/fan
                        :wire-fn (fn [s _]
                                   (case s
                                     :t/fan [(mark :fan) :t/work]
                                     :t/work [(fn [o] (assoc o :done (:n o)))
                                              :t/join]
                                     :t/join [(fn [o]
                                                (assoc o :collected
                                                       (set (map :done (:green/branches o)))))]))
                        :next-fn (fn [step dn opts]
                                   (cond
                                     (pos? (:green/exit opts 0)) []
                                     (= step :t/fan) (for [n [1 2 3]]
                                                       [:t/work (assoc opts :n n)])
                                     :else (map (fn [s] [s opts]) dn)))})
        res (wf/run w {})]
    (is (= 0 (:green/exit res)))
    (is (= 3 (count (:green/branches res))))
    (is (= #{1 2 3} (:collected res)))))

(deftest branch-failure-skips-join-and-propagates-worst-exit
  (let [w (wf/workflow {:start :t/a
                        :wire-fn (fn [s _]
                                   (case s
                                     :t/a [(mark :a) :t/ok :t/bad]
                                     :t/ok [(mark :ok) :t/d]
                                     :t/bad [(fn [o] (assoc o :green/exit 5
                                                            :green/err "bad branch"))
                                             :t/d]
                                     :t/d [(mark :join-ran)]))})
        res (wf/run w {})]
    (is (= 5 (:green/exit res)))
    (is (= "bad branch" (:green/err res)))
    (is (not-any? #(= % :join-ran) (:seen res [])) "join must be skipped")
    (is (= 2 (count (:green/branches res))) "both branches finished")))

(deftest workflows-compose-as-steps
  (let [sub (wf/workflow {:start :s/a
                          :wire-fn (fn [s _]
                                     (case s
                                       :s/a [(mark :sub-a) :s/b]
                                       :s/b [(mark :sub-b)]))})
        parent (wf/workflow {:start :p/a
                             :wire-fn (fn [s _]
                                        (case s
                                          :p/a [(mark :p-a) :p/sub]
                                          :p/sub [(wf/step sub) :p/z]
                                          :p/z [(mark :p-z)]))})
        res (wf/run parent {})]
    (is (= 0 (:green/exit res)))
    (is (= [:p-a :sub-a :sub-b :p-z] (:seen res)))))

(deftest sub-workflow-failure-halts-the-parent
  (let [sub (wf/workflow {:start :s/a
                          :wire-fn (fn [_ _] [(fn [o] (assoc o :green/exit 4
                                                           :green/err "sub failed"))])})
        parent (wf/workflow {:start :p/sub
                             :wire-fn (fn [s _]
                                        (case s
                                          :p/sub [(wf/step sub) :p/z]
                                          :p/z [(mark :p-z)]))})
        res (wf/run parent {})]
    (is (= 4 (:green/exit res)))
    (is (= "sub failed" (:green/err res)))
    (is (nil? (:seen res)) ":p/z must not run")))

(deftest step-in-out-scope-the-sub-workflow
  (let [sub (wf/workflow {:start :s/a
                          :wire-fn (fn [_ _] [(fn [o] (assoc o :result (* 2 (:n o))))])})
        parent (wf/workflow {:start :p/sub
                             :wire-fn (fn [_ _]
                                        [(wf/step sub
                                                  {:in-fn (fn [o] {:green/event (:green/event o)
                                                                   :n (:parent-n o)})
                                                   :out-fn (fn [o r] (assoc o :doubled (:result r)))})])})
        res (wf/run parent {:green/event :create :parent-n 21 :keep-me :yes})]
    (is (= 42 (:doubled res)))
    (is (= :yes (:keep-me res)) ":out-fn preserved the parent opts")))

(deftest parallel-branches-actually-run-concurrently
  (let [in-flight (atom 0)
        peak (atom 0)
        slow (fn [o]
               (swap! peak max (swap! in-flight inc))
               (Thread/sleep 50)
               (swap! in-flight dec)
               o)
        w (wf/workflow {:start :t/a
                        :wire-fn (fn [s _]
                                   (case s
                                     :t/a [identity :t/x :t/y :t/z]
                                     :t/x [slow :t/d]
                                     :t/y [slow :t/d]
                                     :t/z [slow :t/d]
                                     :t/d [identity]))})
        res (wf/run w {:green/exit 0})]
    (is (= 0 (:green/exit res)))
    (is (< 1 @peak) "branches overlapped in time")))

(deftest nested-join-uses-common-ancestry
  (doseq [right-length [1 4] enclosing-fork [false true]]
    (testing (str "right length " right-length ", enclosing fork " enclosing-fork)
      (let [right-step #(keyword "t" (str "right" %))
            graph (into {:t/root (if enclosing-fork [:t/fork :t/outside] [:t/fork])
                         :t/fork [:t/left (right-step 1)] :t/left [:t/leaf1 :t/leaf2]
                         :t/leaf1 [:t/join] :t/leaf2 [:t/join]
                         :t/join (if enclosing-fork [:t/final] [])
                         :t/outside [:t/final] :t/final []}
                        (for [i (range 1 (inc right-length))]
                          [(right-step i) [(if (= i right-length) :t/join (right-step (inc i)))]]))
            joins (atom [])
            result (wf/run (wf/workflow
                            {:start :t/root
                             :wire-fn (fn [s _]
                                        (into [(fn [o]
                                                 (when (#{:t/join :t/final} s)
                                                   (swap! joins conj {:step s :base (:path o)
                                                                      :branches (:green/branches o)}))
                                                 (update o :path (fnil conj []) s))]
                                              (get graph s)))}) {})]
        (is (= 0 (:green/exit result)))
        (is (= [:t/root :t/fork] (:base (first @joins))))
        (is (= 3 (count (:branches (first @joins)))))
        (is (= (if enclosing-fork 2 1) (count @joins)))
        (when enclosing-fork
          (is (= [:t/root] (:base (second @joins))))
          (is (= 2 (count (:branches (second @joins))))))))))

(deftest failure-after-nested-join-does-not-collapse-joined-fork
  (let [graph {:t/root [:t/left :t/right] :t/left [:t/a :t/b]
               :t/a [:t/join] :t/b [:t/join] :t/right [:t/r2]
               :t/r2 [:t/r3] :t/r3 [:t/join] :t/join [:t/fail] :t/fail []}
        result (wf/run (wf/workflow
                        {:start :t/root
                         :wire-fn (fn [s _]
                                    (into [(fn [o]
                                             (if (= s :t/fail)
                                               (assoc o :green/exit 8 :green/err "after join")
                                               (assoc o :joined (or (= s :t/join) (:joined o)))))]
                                          (get graph s)))}) {})]
    (is (= 8 (:green/exit result)))
    (is (true? (:joined result)))
    (is (= 3 (count (:green/branches result))))))

(deftest failed-join-preserves-worst-diagnostics
  (doseq [exits [[3 9] [9 3] [9 9]]]
    (let [result (wf/run (wf/workflow
                          {:start :t/root
                           :wire-fn (fn [s _]
                                      (case s
                                        :t/root [identity :t/a :t/b]
                                        :t/join [(fn [_] (throw (Exception. "join must not execute")))]
                                        (let [n (if (= s :t/a) 0 1)]
                                          [(fn [o] (assoc o :green/exit (exits n)
                                                           :green/err (str "error " n)
                                                           :green/trace (str "trace " n))) :t/join])))
                           :next-fn (fn [_ ns o] (mapv (fn [n] [n o]) ns))}) {})
          winner (if (>= (exits 0) (exits 1)) 0 1)]
      (is (= (apply max exits) (:green/exit result)))
      (is (= (str "error " winner) (:green/err result)))
      (is (= (str "trace " winner) (:green/trace result)))
      (is (= 2 (count (:green/branches result)))))))

(deftest join-routing-exceptions-preserve-common-fork-context
  (let [graph {:t/root [:t/left :t/right] :t/left [:t/a :t/b]
               :t/a [:t/join] :t/b [:t/join] :t/right [:t/r2]
               :t/r2 [:t/r3] :t/r3 [:t/join] :t/join []}
        result (wf/run (wf/workflow
                        {:start :t/root
                         :wire-fn (fn [s _] (into [(fn [o] (update o :path (fnil conj []) s))]
                                                 (get graph s)))
                         :next-fn (fn [s ns o]
                                    (when (= s :t/join) (throw (Exception. "routing failed")))
                                    (mapv (fn [n] [n o]) ns))}) {})]
    (is (= 1 (:green/exit result)))
    (is (= "routing failed" (:green/err result)))
    (is (= [:t/root] (:path result)))
    (is (= 3 (count (:green/branches result))))))

#!/usr/bin/env bb
;; hello — the smallest useful green package.
;;
;;   ./green create             # uname ∥ write greeting  →  check (join)
;;   ./green create --dry-run   # uname still runs (read-only); writes are skipped
;;   ./green delete             # remove the greeting file
;;   COLORS_PAR_NAME=agent ./green create
;;
;; Steps call local CLIs and the file system directly. A real package does the
;; same with a cloud CLI or API (`gcloud`, `doctl`, `oci`, an HTTP client):
;; green owns graphs, subworkflows and advice; this application owns its CLI.

(require '[babashka.fs :as fs])

(def script-dir
  (str (fs/parent (fs/canonicalize (if (= "NO_SOURCE_PATH" *file*)
                                     (fs/path (fs/cwd) "green")
                                     *file*)))))

;; Resolve green from this checkout. GREEN_LIB_ROOT points the launcher at
;; another working tree; a standalone package pins a :git/sha instead.
((requiring-resolve 'babashka.deps/add-deps)
 {:deps {'io.github.getcolors/green
         {:local/root (or (System/getenv "GREEN_LIB_ROOT")
                          (str (fs/path script-dir "../..")))}}})

(require '[babashka.cli :as args]
         '[clojure.java.shell :as shell]
         '[clojure.string :as str]
         '[green.cli :as cli]
         '[green.workflow :as wf])

(defn greeting-path
  "The greeting file, resolved against the desired-state file's directory."
  [opts]
  (let [p (fs/path (:greeting-file opts))]
    (str (if (fs/absolute? p)
           p
           (fs/path (fs/parent (:hello/state-file opts)) p)))))

(defn greeting [opts]
  (str "hello, " (:name opts) "\n"))

(defn start-step
  "Application validation; configuration and defaults are prepared by main."
  [opts]
  (let [errors (for [k [:name :greeting-file]
                     :when (str/blank? (str (get opts k)))]
                 (str (name k) " must not be blank (" (cli/par-name k) ")"))]
    (if (seq errors)
      (assoc opts :green/exit 2 :green/err (str/join "; " errors))
      opts)))

(defn uname-step
  "Read-only local CLI call: record the kernel name."
  [opts]
  (let [{:keys [exit out err]} (shell/sh "uname" "-s")]
    (if (zero? exit)
      (assoc opts :hello/kernel (str/trim out))
      (assoc opts :green/exit exit :green/err (str "uname failed: " err)))))

(defn write-step
  "Side effect: write the greeting file."
  [opts]
  (let [path (greeting-path opts)]
    (fs/create-dirs (fs/parent path))
    (spit path (greeting opts))
    (assoc opts :hello/written path)))

(defn check-step
  "Join: merge both branches, read the file back and verify it."
  [opts]
  (let [opts (apply merge opts (:green/branches opts))
        path (greeting-path opts)
        actual (when (fs/exists? path) (slurp path))]
    (if (= (greeting opts) actual)
      (do (println (str (str/trim actual) " (" (:hello/kernel opts) ")"))
          (dissoc opts :green/branches))
      (assoc opts :green/exit 1
                  :green/err (str "unexpected content in " path ": " (pr-str actual))))))

(defn remove-step
  "Side effect: delete the greeting file. Idempotent."
  [opts]
  (fs/delete-if-exists (greeting-path opts))
  opts)

(defn verify-step [opts]
  (if (= (greeting opts) (slurp (greeting-path opts)))
    opts
    (assoc opts :green/exit 1 :green/err "Greeting verification failed")))

(def artifact-workflow
  (wf/workflow {:start :hello/write
                :wire-fn (fn [step _]
                           (case step
                             :hello/write [write-step :hello/verify]
                             :hello/verify [verify-step]))}))

(defn wire-fn
  "The artifact subworkflow runs alongside uname, then both join at check."
  [step run-opts]
  (case [(:hello/event run-opts) step]
    [:create :hello/start] [start-step :hello/uname :hello/artifact]
    [:create :hello/uname] [uname-step :hello/check]
    [:create :hello/artifact] [(wf/step artifact-workflow) :hello/check]
    [:create :hello/check] [check-step]
    [:delete :hello/start] [start-step :hello/remove]
    [:delete :hello/remove] [remove-step]))

(defn report-step
  "Application-owned advice; inherited by the artifact's internal steps."
  [inner opts]
  (let [result (inner opts)]
    (locking *out* (println "<<<" (:green/step opts)))
    result))

(defn skip-write [inner opts]
  (if (:hello/dry-run opts)
    (do (locking *out* (println "dry-run: would run" (:green/step opts))) opts)
    (inner opts)))

(def workflow
  (reduce (fn [workflow step]
            (wf/advice-add workflow step :around :hello/skip skip-write))
          (wf/advice-add-all (wf/workflow {:start :hello/start :wire-fn wire-fn})
                             :around :hello/report report-step)
          [:hello/write :hello/verify :hello/check :hello/remove]))

(defn main [argv]
  (try
    (let [{:keys [args opts]} (args/parse-args (vec argv)
                             {:spec {:file {:alias :f :default "green.yml"}
                                     :dry-run {:coerce :boolean}}
                              :restrict true})
          event (first args)]
      (if-not (and (= 1 (count args)) (#{"create" "delete"} event))
        {:green/exit 2 :green/err "Usage: green create|delete [-f FILE] [--dry-run]"}
        (let [file (str (fs/absolutize (:file opts)))
              state (cli/read-state file (slurp file))]
          (when-not (map? state)
            (throw (ex-info "Desired state must be a map" {})))
          (wf/run workflow
                  (assoc (cli/read-pars (merge {:greeting-file "work/hello.txt"} state))
                         :hello/event (keyword event) :hello/state-file file
                         :hello/dry-run (boolean (:dry-run opts)))))))
    (catch Exception error
      {:green/exit 2 :green/err (ex-message error)})))

(let [{:green/keys [exit err]} (main *command-line-args*)]
  (when err (binding [*out* *err*] (println err)))
  (System/exit (or exit 0)))

(ns hello.launcher-test
  "Drives examples/hello through its real ./green launcher in a scratch
  directory, so the example keeps working as green changes. Needs `bb` on
  PATH (as CI provides); green itself is resolved from this checkout."
  (:require
   [clojure.java.io :as io]
   [clojure.java.shell :as shell]
   [clojure.string :as str]
   [clojure.test :refer [deftest is testing]])
  (:import
   [java.nio.file Files]
   [java.nio.file.attribute FileAttribute]))

(def ^:private launcher
  (.getCanonicalPath (io/file "examples/hello/green")))

(def ^:private green-root
  (.getCanonicalPath (io/file ".")))

(defn- scratch-dir []
  (let [dir (.toFile (Files/createTempDirectory "green-hello" (make-array FileAttribute 0)))]
    (io/copy (io/file "examples/hello/green.yml") (io/file dir "green.yml"))
    dir))

(defn- env
  "The inherited environment minus any COLORS_PAR_* (so the operator's shell
  cannot change the result), plus `extra`."
  [extra]
  (merge (into {} (remove (fn [[k _]] (str/starts-with? k "COLORS_PAR_")))
               (System/getenv))
         {"GREEN_LIB_ROOT" green-root}
         extra))

(defn- green [dir extra-env & args]
  (apply shell/sh "bb" launcher
         (concat args [:dir (str dir) :env (env extra-env)])))

(deftest create-check-delete
  (let [dir (scratch-dir)
        greeting (io/file dir "work/hello.txt")]
    (testing "dry-run runs the read-only uname step and writes nothing"
      (let [{:keys [exit out]} (green dir {} "create" "--dry-run")]
        (is (= 0 exit))
        (is (str/includes? out "dry-run: would run :hello/write"))
        (is (str/includes? out "<<< :hello/uname"))
        (is (not (.exists greeting)))))
    (testing "create forks uname and an artifact subworkflow, then joins at check"
      (let [{:keys [exit out]} (green dir {} "create")]
        (is (= 0 exit))
        (is (re-find #"hello, world \(\S+\)" out))
        (is (= "hello, world\n" (slurp greeting)))
        (is (str/includes? out "<<< :hello/write"))
        (is (str/includes? out "<<< :hello/verify"))
        (is (str/includes? out "<<< :hello/artifact"))))
    (testing "COLORS_PAR_* overlays the desired state"
      (let [{:keys [exit out]} (green dir {"COLORS_PAR_NAME" "agent"} "create")]
        (is (= 0 exit))
        (is (str/includes? out "hello, agent"))
        (is (= "hello, agent\n" (slurp greeting)))))
    (testing "delete removes the file and is idempotent"
      (is (= 0 (:exit (green dir {} "delete"))))
      (is (not (.exists greeting)))
      (is (= 0 (:exit (green dir {} "delete")))))))

(deftest preflight-and-usage-errors-exit-2
  (let [dir (scratch-dir)]
    (testing "a blank parameter fails application validation"
      (let [{:keys [exit err]} (green dir {"COLORS_PAR_NAME" ""} "create")]
        (is (= 2 exit))
        (is (str/includes? err "COLORS_PAR_NAME"))
        (is (not (.exists (io/file dir "work/hello.txt"))))))
    (testing "events outside the package's set are usage errors"
      (let [{:keys [exit err]} (green dir {} "destroy")]
        (is (= 2 exit))
        (is (str/includes? err "Usage:"))))))

(deftest application-parser-selects-files-and-rejects-usage-errors
  (let [dir (scratch-dir)
        selected (io/file dir "selected.edn")]
    (spit selected "{:name \"selected\" :greeting-file \"work/selected.txt\"}")
    (is (= 0 (:exit (green dir {} "create" "-f" (str selected)))))
    (is (= "hello, selected\n" (slurp (io/file dir "work/selected.txt"))))
    (doseq [argv [["create" "--unknown"] ["create" "extra"] []]]
      (is (= 2 (:exit (apply green dir {} argv)))))
    (spit selected "[]")
    (is (= 2 (:exit (green dir {} "create" "-f" (str selected)))))))