path: root/src/unheard/strudel/mini_notation_compiler.clj

(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 get-value]
  "Parse a single atom (note, number, or rest).
  Uses get-value function to convert note names to values."
  (cond
    (= s "~") :r
    (re-matches #"\d+(/\d+)?" s) (parse-number s)
    :else (get-value 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 get-value]
  "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
                 ;; Create parallel composition of forked groups
                 (let [groups (split-on-comma inner-content)
                       parsed-groups (map #(parse-sequence % get-value) groups)
                       ;; Wrap each group in fork (unless single element)
                       forked-groups (map (fn [group]
                                           (let [elements (vec group)]
                                             (if (= 1 (count elements))
                                               (first elements)
                                               (cons 'f elements))))
                                         parsed-groups)]
                   (if (= 1 (count forked-groups))
                     (first forked-groups)
                     (cons 'p forked-groups)))
                 ;; Normal handling without commas
                 (let [elements (parse-sequence inner-content get-value)]
                   (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 get-value]
  "Parse comma-separated elements into parallel structure."
  (if (str/includes? token ",")
    (let [parts (str/split token #",")
          elements (map #(parse-element % get-value) parts)]
      (cons 'p elements))
    (parse-element token get-value)))

(defn- parse-element [token get-value]
  "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 get-value)

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

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

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

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

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

  Takes a string in Strudel mini-notation and a function to convert
  note names to values.

  Arguments:
    s - The mini-notation string to compile
    get-value - Function of one argument that converts note names to values
                (defaults to keyword)

  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\" keyword)
    => (l :c :e :g)

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

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

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

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