#!/usr/bin/env racket
#lang racket/base

;; beagle-import-nix: convert hand-written .nix to beagle/nix (.bnix).
;;
;; Strategy: shell out to `nix-parse-json` (a small Rust binary in
;; tools/nix-parse-json that wraps rnix-parser) for lossless source
;; parsing. The binary emits an S-expression AST that we read with
;; Racket's `read`, then translate to beagle/nix source.
;;
;; Why rnix (vs `nix-instantiate --parse`): nix-instantiate normalizes
;; lossily — strips fractional parts from floats, collapses `"${X}"` to
;; bare `X`, resolves relative paths to absolute. Each loss had to be
;; worked around with source pre-processing markers; rnix preserves
;; source structure so the workarounds go away.

(require racket/string
         racket/list
         racket/match
         racket/port
         racket/system
         racket/format
         racket/path
         racket/file)

;; ============================================================================
;; Driver
;; ============================================================================

(define (main argv-vec)
  (define argv (vector->list argv-vec))
  (cond
    [(or (null? argv) (member "--help" argv) (member "-h" argv))
     (display-usage)
     (exit 0)]
    [(member "--version" argv)
     (displayln "beagle-import-nix 0.3.0 (rnix backend, nix/-prefixed forms)")
     (exit 0)]
    [else
     (define input-path (car argv))
     (unless (file-exists? input-path)
       (eprintf "beagle-import-nix: file not found: ~a\n" input-path)
       (exit 1))
     (define ast (parse-with-rnix input-path))
     (define ns-name (path->ns-name input-path))
     (display (emit-bnix ast ns-name))
     (newline)]))

(define (display-usage)
  (displayln "Usage: beagle-import-nix <file.nix> > file.bnix")
  (displayln "")
  (displayln "  Converts a hand-written .nix file to beagle/nix (.bnix).")
  (displayln "  Uses rnix-parser (via tools/nix-parse-json binary) for")
  (displayln "  lossless source parsing. Output is semantically equivalent.")
  (displayln "  May need manual cleanup to use beagle/nix's higher-level")
  (displayln "  macros (module, nix/with-cfg, etc.)."))

(define (path->ns-name p)
  (define name (path->string (file-name-from-path p)))
  (regexp-replace #rx"\\.nix$" name ""))

;; ============================================================================
;; Parse step: shell out to nix-parse-json, read S-expr from stdout
;; ============================================================================

(define (find-nix-parse-json)
  (define script-path (resolved-module-path-name
                       (variable-reference->resolved-module-path
                        (#%variable-reference))))
  (define script-dir (path-only script-path))
  (define candidate
    (path->string
     (build-path script-dir 'up "tools" "nix-parse-json" "target" "release" "nix-parse-json")))
  (cond
    [(file-exists? candidate) candidate]
    [(find-executable-path "nix-parse-json")
     => values]
    [else
     (error 'beagle-import-nix
            (string-append "nix-parse-json binary not found. "
                           "Build it with: cargo build --release --manifest-path "
                           "tools/nix-parse-json/Cargo.toml"))]))

(define (parse-with-rnix path)
  (define binary (find-nix-parse-json))
  (define-values (proc out in err)
    (subprocess #f #f (current-error-port) binary (path->string (path->complete-path path))))
  (close-output-port in)
  (define result (port->string out))
  (close-input-port out)
  (subprocess-wait proc)
  (unless (zero? (subprocess-status proc))
    (error 'beagle-import-nix "nix-parse-json failed for ~a" path))
  (with-handlers ([exn:fail?
                   (lambda (e)
                     (error 'beagle-import-nix
                            "failed to read AST from nix-parse-json output: ~a\noutput was: ~a"
                            (exn-message e) result))])
    (read (open-input-string result))))

;; ============================================================================
;; Emit beagle/nix source from the AST
;; ============================================================================

(define (emit-bnix ast ns-name)
  (string-append
    "#lang beagle/nix\n"
    "(ns " (sanitize-ns ns-name) ")\n"
    "\n"
    (emit-expr ast 0)))

(define (sanitize-ns s)
  (regexp-replace* #rx"[^a-zA-Z0-9._-]" s "-"))

(define (indent n) (make-string (* n 2) #\space))

(define (emit-expr ast depth)
  (match ast
    [(list 'lambda kind body)
     (emit-lambda kind body depth)]
    [(list 'let bindings body)
     (emit-let bindings body depth)]
    [(list 'with scope body)
     ;; Emit `nix/with` (the canonical name); bare `with` is still
     ;; accepted by parse.rkt but new output should use the prefix.
     (format "(nix/with ~a\n~a~a)"
             (emit-expr scope depth)
             (indent (add1 depth))
             (emit-expr body (add1 depth)))]
    [(list 'if c t e)
     (format "(if ~a ~a ~a)"
             (emit-expr c depth)
             (emit-expr t depth)
             (emit-expr e depth))]
    [(list 'apply fn arg)
     (define args (collect-apply-args ast))
     (format "(~a ~a)"
             (emit-expr (car args) depth)
             (string-join (map (λ (a) (emit-expr a depth)) (cdr args)) " "))]
    [(list 'binop op lhs rhs)
     (emit-binop op lhs rhs depth)]
    [(list 'unop "!" arg)
     (format "(not ~a)" (emit-expr arg depth))]
    [(list 'unop "-" arg)
     (format "(- ~a)" (emit-expr arg depth))]
    [(list 'has-attr target path)
     (define path-str
       (string-join
         (map (λ (s)
                (cond
                  [(string? s) s]
                  [(and (pair? s) (eq? (car s) 'str))
                   (define parts (cadr s))
                   (cond
                     [(and (= (length parts) 1) (string? (car parts)))
                      (car parts)]
                     [else
                      (error 'beagle-import-nix
                             "has-attr path: complex interpolated string not supported in ?")])]
                  [else (format "~a" s)]))
              path)
         "."))
     (format "(has ~a ~a)"
             (emit-expr target depth)
             path-str)]
    [(list 'select target path)
     (emit-select target path depth)]
    [(list 'select-or target path default)
     (define (seg-static? s)
       (cond [(string? s) #t]
             [(and (pair? s) (eq? (car s) 'str)
                   (= (length (cadr s)) 1)
                   (string? (car (cadr s))))
              #t]
             [else #f]))
     (define (seg-text s)
       (cond [(string? s) s]
             [(and (pair? s) (eq? (car s) 'str)) (car (cadr s))]
             [else (format "~a" s)]))
     (cond
       [(and (= (length path) 1)
             (not (seg-static? (car path))))
        ;; Dynamic key with default — Nix `target.${dyn} or default`.
        ;;   if (target ? "${KEY}") then target.${KEY} else default
        (define seg (car path))
        (define parts (cadr seg))
        (define key-bnix
          (cond
            [(and (= (length parts) 1)
                  (pair? (car parts))
                  (eq? (car (car parts)) 'interp))
             (emit-expr (cadr (car parts)) depth)]
            [else (emit-str-interp parts depth)]))
        (format "(if (has ~a \"${~a}\") (get ~a ~a) ~a)"
                (emit-expr target depth)
                key-bnix
                (emit-expr target depth)
                key-bnix
                (emit-expr default depth))]
       [(= (length path) 1)
        (format "(get-or ~a ~a ~a)"
                (emit-expr target depth)
                (seg-text (car path))
                (emit-expr default depth))]
       [else
        (define prefix (drop-right path 1))
        (define last-seg (last path))
        (define prefix-target `(select ,target ,prefix))
        (format "(get-or ~a ~a ~a)"
                (emit-expr prefix-target depth)
                (seg-text last-seg)
                (emit-expr default depth))])]
    [(list 'attrset bindings)
     (emit-attrset bindings depth)]
    [(list 'rec-attrset bindings)
     (define pairs
       (apply append
              (map (λ (b)
                     (match b
                       [(list 'bind path val)
                        (define key-sym
                          (cond
                            [(and (= (length path) 1) (string? (car path)))
                             (car path)]
                            [else
                             (string-join
                               (map (λ (s) (if (string? s) s (format "~v" (cadr s))))
                                    path)
                               ".")]))
                        (list key-sym (emit-expr val depth))]
                       [(list 'inherit names)
                        (apply append
                               (map (λ (n) (list (symbol->string n) (symbol->string n))) names))]
                       [(list 'inherit-from src names)
                        (apply append
                               (map (λ (n)
                                      (list (symbol->string n)
                                            (format "~a.~a" (emit-expr src depth) (symbol->string n))))
                                    names))]
                       [_ '()]))
                   bindings)))
     (format "(rec-attrs ~a)" (string-join pairs " "))]
    [(list 'list elems)
     (format "[~a]"
             (string-join (map (λ (e) (emit-expr e depth)) elems) " "))]
    [(list 'str-lit s)
     (format "~v" (escape-literal-dollars s))]
    [(list 'str-lit-ind s)
     ;; Indented ''…'' literal (no interp). Emit as ~''…'' so the bnix
     ;; source is readable: raw multi-line content, no \n escapes.
     (emit-ms-tilde (list s) depth)]
    [(list 'path p)
     (format "(p ~v)" p)]
    [(list 'str-interp parts)
     (emit-str-interp parts depth)]
    [(list 'str-interp-ind parts)
     ;; Indented ''…'' with interp. Same ~''…'' form; interp parts emit
     ;; as inline ${EXPR} markers within the body.
     (emit-ms-tilde parts depth)]
    [(list 'int n)
     (number->string n)]
    [(list 'float n)
     (number->string n)]
    [(list 'bool b)
     (if b "true" "false")]
    [(list 'null)
     "nil"]
    [(list 'id name)
     (symbol->string name)]
    [(list 'assert c body)
     ;; Nix `assert cond; body` — emit beagle/nix's `nix/assert` form
     ;; (the canonical prefix; parse.rkt also accepts bare `assert`).
     (format "(nix/assert ~a\n~a~a)"
             (emit-expr c depth)
             (indent (add1 depth))
             (emit-expr body (add1 depth)))]
    [_ (format "; unhandled: ~v" ast)]))

(define (collect-apply-args ast)
  (let loop ([e ast] [args '()])
    (match e
      [(list 'apply fn arg) (loop fn (cons arg args))]
      [_ (cons e args)])))

(define (emit-binop op lhs rhs depth)
  (case op
    [("+")
     ;; Flatten + chain, merge literal-string runs, then choose shape
     ;; based on whether the first operand is a path (Nix path semantics)
     ;; or anything else (string interp).
     (define raw-args (flatten-plus-chain `(binop ,op ,lhs ,rhs)))
     (define merged (merge-consecutive-string-lits raw-args))
     (define first-is-path?
       (and (pair? merged)
            (let ([a (car merged)])
              (and (pair? a) (eq? (car a) 'path)))))
     (cond
       [(and first-is-path? (>= (length merged) 3))
        (define path-str (emit-expr (car merged) depth))
        (define rest-str
          (string-join (map (λ (a) (emit-expr a depth)) (cdr merged)) " "))
        (format "(+ ~a (s ~a))" path-str rest-str)]
       [first-is-path?
        (format "(+ ~a)"
                (string-join (map (λ (a) (emit-expr a depth)) merged) " "))]
       [else
        (format "(s ~a)"
                (string-join (map (λ (a) (emit-expr a depth)) merged) " "))])]
    [else
     (define lhs-str (emit-expr lhs depth))
     (define rhs-str (emit-expr rhs depth))
     (case op
       [("-")  (format "(- ~a ~a)" lhs-str rhs-str)]
       [("*")  (format "(* ~a ~a)" lhs-str rhs-str)]
       [("/")  (format "(/ ~a ~a)" lhs-str rhs-str)]
       [("++") (format "(++ ~a ~a)" lhs-str rhs-str)]
       [("//") (format "(// ~a ~a)" lhs-str rhs-str)]
       [("==") (format "(== ~a ~a)" lhs-str rhs-str)]
       [("!=") (format "(!= ~a ~a)" lhs-str rhs-str)]
       [("<")  (format "(< ~a ~a)" lhs-str rhs-str)]
       [(">")  (format "(> ~a ~a)" lhs-str rhs-str)]
       [("<=") (format "(<= ~a ~a)" lhs-str rhs-str)]
       [(">=") (format "(>= ~a ~a)" lhs-str rhs-str)]
       [("&&") (format "(and ~a ~a)" lhs-str rhs-str)]
       [("||") (format "(or ~a ~a)" lhs-str rhs-str)]
       [("->") (format "(implies ~a ~a)" lhs-str rhs-str)]
       [("!")  (format "(not ~a)" lhs-str)]
       [else   (format "; unsupported op ~a\n  (~a ~a ~a)" op op lhs-str rhs-str)])]))

(define (flatten-plus-chain ast)
  ;; Special-case path operands with trailing slash: Nix REJECTS path
  ;; literals with trailing slashes in expression position. Peel the
  ;; slash into a separate string operand.
  (match ast
    [(list 'binop "+" lhs rhs)
     (append (flatten-plus-chain lhs) (flatten-plus-chain rhs))]
    [(list 'path p)
     (cond
       [(and (> (string-length p) 1)
             (char=? (string-ref p (- (string-length p) 1)) #\/))
        (list (list 'path (substring p 0 (- (string-length p) 1)))
              `(str-lit "/"))]
       [else (list ast)])]
    [_ (list ast)]))

(define (merge-consecutive-string-lits args)
  (let loop ([rest args] [acc '()] [pending #f])
    (cond
      [(null? rest)
       (reverse (if pending (cons `(str-lit ,pending) acc) acc))]
      [else
       (define a (car rest))
       (cond
         [(and (pair? a) (eq? (car a) 'str-lit) (string? (cadr a)))
          (loop (cdr rest) acc
                (if pending
                    (string-append pending (cadr a))
                    (cadr a)))]
         [else
          (define new-acc (if pending (cons `(str-lit ,pending) acc) acc))
          (loop (cdr rest) (cons a new-acc) #f)])])))

(define (emit-lambda kind body depth)
  (match kind
    [(list 'single name)
     (format "(fn [~a] ~a)" name (emit-expr body depth))]
    [(list 'formals (list args ellipsis?))
     (define arg-strs
       (map (λ (p)
              (match p
                [(list name #f) (symbol->string name)]
                [(list name default)
                 (format "(~a ~a)" name (emit-expr default depth))]))
            args))
     (define args-str
       (cond [ellipsis? (string-append (string-join arg-strs " ") " ...")]
             [else (string-join arg-strs " ")]))
     (format "(nix/fn-set (~a)\n~a~a)"
             args-str
             (indent (add1 depth))
             (emit-expr body (add1 depth)))]
    [(list 'formals-at alias (list args ellipsis?) _position)
     (define arg-strs
       (map (λ (p)
              (match p
                [(list name #f) (symbol->string name)]
                [(list name default)
                 (format "(~a ~a)" name (emit-expr default depth))]))
            args))
     (define base-args
       (cond [ellipsis? (string-append (string-join arg-strs " ") " ...")]
             [else (string-join arg-strs " ")]))
     (format "(nix/fn-set [~a :as ~a]\n~a~a)"
             base-args
             alias
             (indent (add1 depth))
             (emit-expr body (add1 depth)))]))

(define (emit-let bindings body depth)
  (format "(let [~a]\n~a~a)"
          (string-join
            (map (λ (b)
                   (match b
                     [(list 'inherit names)
                      (format "(inherit ~a)" (string-join (map symbol->string names) " "))]
                     [(list 'inherit-from src names)
                      (format "(inherit-from ~a ~a)"
                              (emit-expr src depth)
                              (string-join (map symbol->string names) " "))]
                     [(list 'bind (list path) val)
                      (define name-str
                        (cond
                          [(string? path) path]
                          [(pair? path) (cadr path)]
                          [else (format "~v" path)]))
                      (format "~a ~a" name-str (emit-expr val depth))]
                     [_ (format "; unsupported let binding: ~v" b)]))
                 bindings)
            "\n        ")
          (indent (add1 depth))
          (emit-expr body (add1 depth))))

(define (emit-select target path depth)
  (define base-str (emit-expr target depth))
  (define target-is-id?
    (and (pair? target)
         (or (eq? (car target) 'id)
             (eq? (car target) 'select))))
  (let loop ([acc-expr-str base-str] [segs path] [first-step? #t] [via-get? #f])
    (cond
      [(null? segs) acc-expr-str]
      [else
       (define seg (car segs))
       (cond
         [(and (pair? seg) (eq? (car seg) 'str) (pair? (cadr seg))
               (= (length (cadr seg)) 1) (pair? (caadr seg))
               (eq? (car (caadr seg)) 'interp))
          ;; Single-interp string key. Inner is now AST (not raw text).
          (define key-expr (emit-expr (cadr (caadr seg)) depth))
          (loop (format "(get ~a ~a)" acc-expr-str key-expr)
                (cdr segs) #f #t)]
         [via-get?
          (define name-str
            (cond [(string? seg) seg]
                  [(and (pair? seg) (eq? (car seg) 'str)) (cadr seg)]
                  [else (format "~v" seg)]))
          (loop (format "(get ~a :~a)" acc-expr-str name-str)
                (cdr segs) #f #t)]
         [else
          (define-values (static-run rest)
            (let inner ([s (cons seg (cdr segs))] [out '()])
              (cond
                [(null? s) (values (reverse out) '())]
                [(static-seg? (car s))
                 (inner (cdr s) (cons (car s) out))]
                [else (values (reverse out) s)])))
          (cond
            [(null? static-run)
             ;; Non-static, non-interp segment (e.g. quoted-string with
             ;; non-ident chars like `"/" or `"helix/config.toml"`).
             ;; Emit via builtins.getAttr — semantically `target."key"`.
             (define key-str
               (cond [(string? seg) seg]
                     [(and (pair? seg) (eq? (car seg) 'str)
                           (pair? (cadr seg))
                           (= (length (cadr seg)) 1)
                           (string? (car (cadr seg))))
                      (car (cadr seg))]
                     [else (format "~a" seg)]))
             (loop (format "(builtins.getAttr ~v ~a)" key-str acc-expr-str)
                   (cdr segs) #f #f)]
            [else
             (define dotted
               (string-join (map static-seg-bare-text static-run) "."))
             (define new-acc
               (cond
                 [(and first-step? (not target-is-id?))
                  (define first-seg (car static-run))
                  (define rest-segs (cdr static-run))
                  (define first-str (static-seg-bare-text first-seg))
                  (define base-call (format "(get ~a :~a)" acc-expr-str first-str))
                  (cond
                    [(null? rest-segs) base-call]
                    [else
                     (format "~a.~a" base-call
                             (string-join (map static-seg-bare-text rest-segs) "."))])]
                 [else (format "~a.~a" acc-expr-str dotted)]))
             (loop new-acc rest #f via-get?)])])])))

(define (ident-str? s)
  (and (string? s)
       (regexp-match-exact? #rx"[a-zA-Z_][a-zA-Z0-9_-]*" s)))

(define (static-seg? seg)
  ;; Static = a segment that can appear in a `target.a.b.c` dotted form
  ;; on the value side. Bare-name strings are OK; (str (literal))
  ;; segments are OK only when the literal content is a valid Nix
  ;; identifier (alphanumeric + _ + -). Quoted-string segments with
  ;; non-ident chars need different emit handling.
  (or (ident-str? seg)
      (and (pair? seg) (eq? (car seg) 'str)
           (pair? (cadr seg))
           (= (length (cadr seg)) 1)
           (ident-str? (car (cadr seg))))))

(define (static-seg-bare-text seg)
  ;; Extract bare-ident text from a static segment (caller has verified
  ;; static-seg?). Used when emitting in dotted form; the segment is
  ;; guaranteed to be ident-valid so we emit unquoted.
  (cond [(string? seg) seg]
        [(and (pair? seg) (eq? (car seg) 'str))
         (car (cadr seg))]
        [else (format "~a" seg)]))

(define (emit-attrset bindings depth)
  (cond
    [(null? bindings) "{}"]
    [else
     (define normalized (map denormalize-binding bindings))
     (string-append
       "{"
       (string-join
         (map (λ (b) (emit-binding b (add1 depth))) normalized)
         (string-append "\n" (indent (add1 depth))))
       "}")]))

(define (safe-ident-segment? seg)
  ;; A path segment that can appear bare in a `:a.b.c` dotted-keyword form
  ;; in beagle/nix. Must be a string whose content is a Nix identifier
  ;; using only chars Racket's reader accepts as part of a symbol.
  ;; Apostrophes (`'`) confuse Racket's reader; treat as unsafe.
  (and (string? seg)
       (regexp-match-exact? #rx"[a-zA-Z_][a-zA-Z0-9_-]*" seg)))

(define (split-at-problem-seg path)
  ;; Returns (values safe-prefix rest). safe-prefix is the longest
  ;; leading run of safe-ident-segment?; rest starts at the first
  ;; unsafe segment (or '() if all are safe).
  (let loop ([acc '()] [rem path])
    (cond
      [(null? rem) (values (reverse acc) '())]
      [(safe-ident-segment? (car rem)) (loop (cons (car rem) acc) (cdr rem))]
      [else (values (reverse acc) rem)])))

(define (value-has-inherit? val)
  ;; True if val is an attrset whose bindings include any inherit /
  ;; inherit-from form. beagle/nix's emit miscompiles
  ;;   :a.b.c {(inherit x y)}
  ;; into `a.b.c.${inherit x y;} = false;` (it treats the inherit as a
  ;; dynamic key). Nesting the binding avoids the bug.
  (and (pair? val)
       (eq? (car val) 'attrset)
       (ormap (λ (binding)
                (and (pair? binding)
                     (or (eq? (car binding) 'inherit)
                         (eq? (car binding) 'inherit-from))))
              (cadr val))))

(define (denormalize-binding b)
  ;; Multi-segment paths with non-identifier segments (quoted strings,
  ;; interp ${...}) confuse beagle/nix's `:a.b.c` dotted-keyword reader.
  ;; Desugar into nested attrsets:
  ;;   xdg.configFile."helix/config.toml".onChange = X
  ;; becomes
  ;;   xdg.configFile = { "helix/config.toml" = { onChange = X; }; };
  (match b
    [(list 'bind path val)
     (cond
       [(or (null? path) (null? (cdr path))) b]
       [(value-has-inherit? val)
        ;; Always nest when value contains an inherit form, regardless of
        ;; segment safety — works around the beagle dotted-key + inherit
        ;; emit bug.
        (define head (list (car path)))
        (define tail (cdr path))
        (cond
          [(null? tail) `(bind ,head ,val)]
          [else
           `(bind ,head (attrset (,(denormalize-binding `(bind ,tail ,val)))))])]
       [else
        (define-values (safe-run rest) (split-at-problem-seg path))
        (cond
          [(null? rest) b]  ; all safe — keep dotted form
          [(null? safe-run)
           ;; Problem segment at head. Emit single-segment key, nest rest.
           (define head (list (car path)))
           (define tail (cdr path))
           (cond
             [(null? tail) `(bind ,head ,val)]
             [else
              `(bind ,head (attrset (,(denormalize-binding `(bind ,tail ,val)))))])]
          [else
           ;; Safe prefix, then problem segment(s). Nest at the boundary.
           `(bind ,safe-run (attrset (,(denormalize-binding `(bind ,rest ,val)))))])])]
    [_ b]))

(define (emit-binding b depth)
  (match b
    [(list 'bind path val)
     (define key (emit-binding-key path))
     (format "~a ~a" key (emit-expr val depth))]
    [(list 'inherit names)
     (format "(inherit ~a)"
             (string-join (map symbol->string names) " "))]
    [(list 'inherit-from src names)
     (format "(inherit-from ~a ~a)"
             (emit-expr src depth)
             (string-join (map symbol->string names) " "))]))

(define (emit-binding-key path)
  (cond
    [(= (length path) 1)
     (match (car path)
       [(? string? s) (format ":~a" s)]
       [(list 'str parts-list)
        (cond
          [(simple-ident-interp-parts? parts-list)
           (extract-ident-interp-parts parts-list)]
          [(parts-list-has-interp? parts-list)
           (emit-str-interp parts-list 0)]
          [else
           (format "~v" (parts-list->raw-string parts-list))])])]
    [else
     (string-append ":"
                    (string-join
                      (map (λ (s)
                             (cond
                               [(string? s) s]
                               [(parts-list-has-interp? (cadr s))
                                (emit-str-interp (cadr s) 0)]
                               [else (format "~v" (parts-list->raw-string (cadr s)))]))
                           path)
                      "."))]))

(define (parts-list-has-interp? parts-list)
  (ormap (λ (p) (and (pair? p) (eq? (car p) 'interp))) parts-list))

(define (simple-ident-interp-parts? parts-list)
  ;; Single (interp <AST>) where the AST is a bare (id name).
  (and (= (length parts-list) 1)
       (let ([p (car parts-list)])
         (and (pair? p) (eq? (car p) 'interp)
              (let ([inner (cadr p)])
                (and (pair? inner) (eq? (car inner) 'id)))))))

(define (extract-ident-interp-parts parts-list)
  ;; Extract the bare ident name (assumes simple-ident-interp-parts? checked).
  (define ast (cadr (car parts-list)))
  (symbol->string (cadr ast)))

(define (parts-list->raw-string parts-list)
  ;; Called only when parts-list has NO interp entries (all literal strings).
  (apply string-append
         (map (λ (p)
                (cond
                  [(string? p) p]
                  [(and (pair? p) (eq? (car p) 'interp))
                   ;; Defensive: should not hit this case, but if it does,
                   ;; re-emit the interp AST surrounded by ${...}.
                   (format "${~a}" (emit-expr (cadr p) 0))]
                  [else (format "~a" p)]))
              parts-list)))

(define (emit-str-interp parts depth)
  ;; parts: list of strings and (interp <AST>) entries.
  ;; Emit as beagle's (s ...) form. The single-interp shortcut emits the
  ;; bare bnix expression so beagle wraps it as ${...} via (s ...).
  (cond
    [(and (= (length parts) 1) (string? (car parts)))
     (format "~v" (escape-literal-dollars (car parts)))]
    [else
     (define s-args
       (map (λ (p)
              (match p
                [(? string? s)
                 (format "~v" (escape-literal-dollars s))]
                [(list 'interp ast-node)
                 (emit-expr ast-node depth)]))
            parts))
     (cond
       ;; Single interp whose inner emit is ALREADY a (s ...) form —
       ;; nested string-with-interp. Don't double-wrap.
       [(and (= (length parts) 1)
             (pair? (car parts))
             (eq? (car (car parts)) 'interp)
             (regexp-match? #rx"^\\(s " (car s-args)))
        (car s-args)]
       [else
        (format "(s ~a)" (string-join s-args " "))])]))

;; Compose an indented Nix string as bnix's ~''…'' reader form.
;; `parts` is a list whose elements are either strings (literal body
;; text from the rnix parser, with no interp) or (interp AST) markers.
;; The output is `~''\n<indented body>\n<close-indent>''` where each
;; body line is prefixed with 2*(depth+1) spaces; the reader's
;; nix-dedent strips that uniformly, so the AST round-trips to the same
;; nix-multiline-string as the legacy single-string-with-\n form.
;;
;; Body escapes (so the reader produces the intended raw characters):
;;   ''  →  '''   (reader's literal-double-quote escape)
;;   ${  →  ''${  (reader's ''$ escape consumes the $; the { that
;;                follows is then just a literal `{` character, so the
;;                resulting AST string holds a literal `${`)
;; The emitter (legacy escape-nix or operative escape-ind-string) re-
;; escapes that literal `${` to `''${` in the Nix output. Real interps
;; come in as (interp AST) markers and emit as ${EXPR} — those are NOT
;; escaped.
(define (emit-ms-tilde parts depth)
  (define body
    (apply string-append
      (for/list ([p (in-list parts)])
        (cond
          [(string? p) (escape-ms-tilde-body p)]
          [(and (pair? p) (eq? (car p) 'interp))
           ;; The reader's ${…} must stay on a single line; collapse any
           ;; newlines+leading-space in the rendered expression to one
           ;; space. For typical interp content (ident, dotted path,
           ;; simple call) this is a no-op.
           (define expr-str (emit-expr (cadr p) depth))
           (format "${~a}" (regexp-replace* #rx"\n[ \t]*" expr-str " "))]
          [else (error 'emit-ms-tilde "unexpected ms part: ~v" p)]))))
  (define ind (indent (+ depth 1)))
  (define close-ind (indent depth))
  (define lines (string-split body "\n" #:trim? #f))
  (define indented
    (string-join
      (for/list ([l (in-list lines)])
        (if (regexp-match? #rx"^[ \t]*$" l) "" (string-append ind l)))
      "\n"))
  (format "~~''\n~a\n~a''" indented close-ind))

(define (escape-ms-tilde-body s)
  (define s1 (regexp-replace* #rx"''" s "'''"))
  ;; Literal replacement "''${" — neither $ nor { is special in Racket
  ;; regexp-replace*'s insert string (only & and \0..\9). See
  ;; escape-literal-dollars below for the same idiom.
  (regexp-replace* #rx"\\$\\{" s1 "''${"))

(define (escape-literal-dollars s)
  ;; Re-escape literal ${ → $${ so beagle's emit-nix produces \${ in the
  ;; output. The Rust parser already unescapes \$ → $ in literal chunks,
  ;; so any $ followed by { in a string-lit here is a literal-dollar that
  ;; must be re-escaped to avoid producing an unintended Nix interpolation.
  (regexp-replace* #rx"\\$\\{" s "$${"))

;; ============================================================================
;; Entry point
;; ============================================================================

(main (current-command-line-arguments))
