(ns unheard.strudel.mini-notation-compiler
  "Compiler for Strudel mini-notation to unheard.cycles code.

  Note: This namespace excludes clojure.core/compile to avoid naming conflict.

  Translates Strudel's text-based pattern notation into equivalent
  unheard.cycles expressions.

  Supported syntax:
  - Spaces: Sequential events (l combinator)
  - []: Subdivision/grouping (l combinator)
  - <> : Alternating events (f combinator)
  - ,: Parallel/simultaneous events (p combinator)
  - *N: Speed multiplication (rate modifier)
  - /N: Speed division (rate modifier)
  - @N: Elongation (elongate modifier)
  - !N: Replication (rep modifier)
  - ~: Rest literal (becomes :r)

  Not yet supported:
  - ?: Probabilistic removal
  - |: Random selection
  - (): Euclidean rhythms

  See: https://strudel.cc/learn/mini-notation/

  Examples:
    (compile \"c e g\")
    => (l :c :e :g)

    (compile \"c [e g] b\")
    => (l :c (l :e :g) :b)

    (compile \"<c e g>\")
    => (f :c :e :g)

    (compile \"[c,e,g] [d,f,a]\")
    => (l (p :c :e :g) (p :d :f :a))

    (compile \"c*2\")
    => (rate 2 :c)

    (compile \"c@3\")
    => (elongate 3 :c)"
  (:refer-clojure :exclude [compile])
  (:require [clojure.string :as str]))

(defn- parse-number [s]
  "Parse a number, returning either a long or ratio."
  (if (str/includes? s "/")
    (let [[num denom] (str/split s #"/")]
      (/ (parse-long num) (parse-long denom)))
    (parse-long s)))

(declare parse-sequence)
(declare parse-element)

(defn- parse-atom [s]
  "Parse a single atom (note, number, or rest)."
  (cond
    (= s "~") :r
    (re-matches #"\d+(/\d+)?" s) (parse-number s)
    :else (keyword s)))

(defn- apply-modifiers [expr modifiers]
  "Apply modifiers to an expression.
  Modifiers is a map with keys: :rate, :elongate, :rep
  Order: elongate/rep first (innermost), then rate (outermost)"
  (cond-> expr
    (:elongate modifiers) (#(list 'elongate (:elongate modifiers) %))
    (:rep modifiers) (#(list 'rep (:rep modifiers) %))
    (:rate modifiers) (#(list 'rate (:rate modifiers) %))))

(defn- parse-token-with-modifiers [token]
  "Parse a token that may have modifiers like *2, /3, @2, !3"
  (let [;; Extract modifiers (note: /N is division, not a rational number in this context)
        ;; Check for *N/M first (multiplication with rational)
        rate-match (re-find #"\*(\d+(?:/\d+)?)" token)
        ;; Only match /N if it's NOT part of *N/M (no preceding * and digits)
        div-match (when-not rate-match
                    (re-find #"/(\d+)" token))
        elong-match (re-find #"@(\d+(?:/\d+)?)" token)
        rep-match (re-find #"!(\d+)" token)

        ;; Remove modifiers to get base token
        base (-> token
                 (str/replace #"\*\d+(?:/\d+)?" "")
                 (str/replace #"/\d+" "")
                 (str/replace #"@\d+(?:/\d+)?" "")
                 (str/replace #"!\d+" ""))

        modifiers (cond-> {}
                    rate-match (assoc :rate (parse-number (second rate-match)))
                    div-match (assoc :rate (list '/ 1 (parse-long (second div-match))))
                    elong-match (assoc :elongate (parse-number (second elong-match)))
                    rep-match (assoc :rep (parse-long (second rep-match))))]

    [base modifiers]))

(defn- split-on-comma [s]
  "Split string on commas at depth 0 (not inside nested brackets).
  Returns vector of substrings."
  (loop [chars (seq s)
         groups []
         current []
         depth 0]
    (if (empty? chars)
      (conj groups (str/join current))
      (let [c (first chars)]
        (cond
          ;; Track bracket depth
          (or (= c \[) (= c \<) (= c \())
          (recur (rest chars) groups (conj current c) (inc depth))

          (or (= c \]) (= c \>) (= c \)))
          (recur (rest chars) groups (conj current c) (dec depth))

          ;; Comma at depth 0 - split here
          (and (= c \,) (zero? depth))
          (if (seq current)
            (recur (rest chars) (conj groups (str/join current)) [] depth)
            (recur (rest chars) groups [] depth))

          :else
          (recur (rest chars) groups (conj current c) depth))))))

(defn- parse-group [s open-char close-char combinator]
  "Parse a bracketed group with a specific combinator."
  ;; Find the matching closing bracket, then extract modifiers after it
  (let [close-idx (.lastIndexOf s (int close-char))
        brackets-part (subs s 0 (inc close-idx))
        modifiers-part (subs s (inc close-idx))
        ;; Extract modifiers from the part AFTER the closing bracket
        [_ modifiers] (parse-token-with-modifiers modifiers-part)
        ;; Extract content between brackets
        inner-content (subs brackets-part 1 close-idx)

        ;; Special handling for angle brackets with commas (polymeter)
        result (if (and (= combinator 'f) (str/includes? inner-content ","))
                 ;; Split on commas and parse each group
                 (let [groups (split-on-comma inner-content)
                       parsed-groups (map parse-sequence groups)
                       ;; Zip groups together element-by-element and wrap in parallel
                       max-length (apply max (map count parsed-groups))
                       zipped (for [i (range max-length)]
                                (let [elements (keep #(nth (vec %) i nil) parsed-groups)]
                                  (if (= 1 (count elements))
                                    (first elements)
                                    (cons 'p elements))))]
                   (if (= 1 (count zipped))
                     (first zipped)
                     (cons 'f zipped)))
                 ;; Normal handling without commas
                 (let [elements (parse-sequence inner-content)]
                   (if (= 1 (count elements))
                     (first elements)
                     (cons combinator elements))))]
    (apply-modifiers result modifiers)))

(defn- tokenize [s]
  "Tokenize a mini-notation string, respecting nested brackets."
  (loop [chars (seq s)
         tokens []
         current []
         depth 0]
    (if (empty? chars)
      (if (seq current)
        (conj tokens (str/join current))
        tokens)
      (let [c (first chars)]
        (cond
          ;; Track bracket depth
          (or (= c \[) (= c \<) (= c \())
          (recur (rest chars) tokens (conj current c) (inc depth))

          (or (= c \]) (= c \>) (= c \)))
          (recur (rest chars) tokens (conj current c) (dec depth))

          ;; Space separates tokens only at depth 0
          (and (= c \space) (zero? depth))
          (if (seq current)
            (recur (rest chars) (conj tokens (str/join current)) [] depth)
            (recur (rest chars) tokens [] depth))

          :else
          (recur (rest chars) tokens (conj current c) depth))))))

(defn- parse-parallel [token]
  "Parse comma-separated elements into parallel structure."
  (if (str/includes? token ",")
    (let [parts (str/split token #",")
          elements (map parse-element parts)]
      (cons 'p elements))
    (parse-element token)))

(defn- parse-element [token]
  "Parse a single element (may be atom, group, or have modifiers)."
  (cond
    ;; Square brackets - subdivision (l)
    ;; Check if starts with [ (may have modifiers at end)
    (str/starts-with? token "[")
    (parse-group token \[ \] 'l)

    ;; Angle brackets - alternation (f)
    ;; Check if starts with < (may have modifiers at end)
    (str/starts-with? token "<")
    (parse-group token \< \> 'f)

    ;; Contains comma - parallel (p)
    (str/includes? token ",")
    (parse-parallel token)

    ;; Token with modifiers
    :else
    (let [[base modifiers] (parse-token-with-modifiers token)]
      (apply-modifiers (parse-atom base) modifiers))))

(defn- parse-sequence [s]
  "Parse a space-separated sequence."
  (let [tokens (tokenize s)]
    (map parse-element tokens)))

(defn compile
  "Compile a Strudel mini-notation string to unheard.cycles code.

  Returns a quoted expression that can be evaluated in the context
  where unheard.cycles functions are available.

  Newlines in the input string are automatically converted to spaces
  to allow for multi-line pattern notation.

  Examples:
    (compile \"c e g\")
    => (l :c :e :g)

    (compile \"c [e g] b\")
    => (l :c (l :e :g) :b)

    (compile \"<c e g b>*2\")
    => (rate 2 (f :c :e :g :b))

    (compile \"[c,e,g] [d,f,a]\")
    => (l (p :c :e :g) (p :d :f :a))

    (compile \"<a b\\nc d>\")
    => (f :a :b :c :d)"
  [s]
  (let [normalized (str/replace s #"\n" " ")
        elements (parse-sequence (str/trim normalized))]
    (if (= 1 (count elements))
      (first elements)
      (cons 'l elements))))