rose-ash/lib/content/md-import.sx

;; content-on-sx — Markdown import adapter (markdown text -> block document).
;;
;; A line-based parser, the inverse of markdown.sx's asMarkdown. Confined to the
;; adapter boundary: the core knows nothing about Markdown. Handles ATX headings
;; (#..######), fenced code (```lang), blockquotes (> ), unordered (- / * ) and
;; ordered (1. ) lists, thematic breaks (--- / ***), and paragraphs (consecutive
;; plain lines joined with a space). Block ids are assigned sequentially b0,b1…
;;
;; Requires (loaded by harness): block.sx, doc.sx (and markdown.sx for the
;; adapter's export side).

(define md/-id (fn (i) (str "b" i)))
(define md/-blank? (fn (s) (= s "")))
(define md/-hr? (fn (s) (if (= s "---") true (= s "***"))))

(define
  ct-in?
  (fn
    (x xs)
    (cond
      ((= (len xs) 0) false)
      ((= (first xs) x) true)
      (else (ct-in? x (rest xs))))))

(define
  ct-starts-with?
  (fn
    (s prefix)
    (and
      (>= (string-length s) (string-length prefix))
      (= (substring s 0 (string-length prefix)) prefix))))

(define
  md/-drop
  (fn (s prefix) (substring s (string-length prefix) (string-length s))))

(define
  md/-join-with
  (fn
    (sep parts)
    (cond
      ((= (len parts) 0) "")
      ((= (len parts) 1) (first parts))
      (else (str (first parts) sep (md/-join-with sep (rest parts)))))))
(define md/-join-sp (fn (parts) (md/-join-with " " parts)))
(define md/-join-nl (fn (parts) (md/-join-with (str "\n") parts)))

;; ── heading detection (leading #s then a space) ──
(define
  md/-hashes
  (fn
    (s n)
    (if
      (and
        (< n (string-length s))
        (= (substring s n (+ n 1)) "#"))
      (md/-hashes s (+ n 1))
      n)))
(define
  md/-heading?
  (fn
    (line)
    (let
      ((n (md/-hashes line 0)))
      (and
        (> n 0)
        (<= n 6)
        (> (string-length line) n)
        (= (substring line n (+ n 1)) " ")))))
(define
  md/-heading-block
  (fn
    (line i)
    (let
      ((n (md/-hashes line 0)))
      (mk-heading
        (md/-id i)
        n
        (substring line (+ n 1) (string-length line))))))

;; ── list detection ──
(define
  ct-digit?
  (fn (ch) (ct-in? ch (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))))
(define
  md/-digits
  (fn
    (s n)
    (if
      (and
        (< n (string-length s))
        (ct-digit? (substring s n (+ n 1))))
      (md/-digits s (+ n 1))
      n)))
(define
  md/-ol?
  (fn
    (line)
    (let
      ((n (md/-digits line 0)))
      (and
        (> n 0)
        (>= (string-length line) (+ n 2))
        (= (substring line n (+ n 2)) ". ")))))
(define
  md/-drop-ol
  (fn
    (line)
    (let
      ((n (md/-digits line 0)))
      (substring line (+ n 2) (string-length line)))))
(define
  md/-ul?
  (fn
    (line)
    (if (ct-starts-with? line "- ") true (ct-starts-with? line "* "))))
(define
  md/-drop-ul
  (fn (line) (substring line 2 (string-length line))))

(define
  md/-plain?
  (fn
    (line)
    (if
      (md/-blank? line)
      false
      (if
        (ct-starts-with? line "```")
        false
        (if
          (md/-heading? line)
          false
          (if
            (ct-starts-with? line "> ")
            false
            (if
              (md/-hr? line)
              false
              (if (md/-ul? line) false (if (md/-ol? line) false true)))))))))

;; ── multi-line collectors ──
(define
  md/-code
  (fn
    (lines i acc)
    (md/-code-collect
      (rest lines)
      (md/-drop (first lines) "```")
      (list)
      i
      acc)))
(define
  md/-code-collect
  (fn
    (lines lang body i acc)
    (cond
      ((= (len lines) 0)
        (md/-walk
          lines
          (+ i 1)
          (cons (mk-code (md/-id i) lang (md/-join-nl (reverse body))) acc)))
      ((= (first lines) "```")
        (md/-walk
          (rest lines)
          (+ i 1)
          (cons (mk-code (md/-id i) lang (md/-join-nl (reverse body))) acc)))
      (else
        (md/-code-collect (rest lines) lang (cons (first lines) body) i acc)))))

(define
  md/-list-collect
  (fn
    (lines items i acc ordered)
    (if
      (= (len lines) 0)
      (md/-walk
        lines
        (+ i 1)
        (cons (mk-list (md/-id i) ordered (reverse items)) acc))
      (let
        ((line (first lines)))
        (cond
          (ordered
            (if
              (md/-ol? line)
              (md/-list-collect
                (rest lines)
                (cons (md/-drop-ol line) items)
                i
                acc
                ordered)
              (md/-walk
                lines
                (+ i 1)
                (cons (mk-list (md/-id i) ordered (reverse items)) acc))))
          (else
            (if
              (md/-ul? line)
              (md/-list-collect
                (rest lines)
                (cons (md/-drop-ul line) items)
                i
                acc
                ordered)
              (md/-walk
                lines
                (+ i 1)
                (cons (mk-list (md/-id i) ordered (reverse items)) acc)))))))))

(define
  md/-para-collect
  (fn
    (lines parts i acc)
    (if
      (= (len lines) 0)
      (md/-walk
        lines
        (+ i 1)
        (cons (mk-text (md/-id i) (md/-join-sp (reverse parts))) acc))
      (let
        ((line (first lines)))
        (if
          (md/-plain? line)
          (md/-para-collect (rest lines) (cons line parts) i acc)
          (md/-walk
            lines
            (+ i 1)
            (cons (mk-text (md/-id i) (md/-join-sp (reverse parts))) acc)))))))

;; ── main walk ──
(define
  md/-walk
  (fn
    (lines i acc)
    (if
      (= (len lines) 0)
      (reverse acc)
      (let
        ((line (first lines)))
        (cond
          ((md/-blank? line) (md/-walk (rest lines) i acc))
          ((ct-starts-with? line "```") (md/-code lines i acc))
          ((md/-heading? line)
            (md/-walk
              (rest lines)
              (+ i 1)
              (cons (md/-heading-block line i) acc)))
          ((ct-starts-with? line "> ")
            (md/-walk
              (rest lines)
              (+ i 1)
              (cons (mk-quote (md/-id i) "" (md/-drop line "> ")) acc)))
          ((md/-hr? line)
            (md/-walk
              (rest lines)
              (+ i 1)
              (cons (mk-divider (md/-id i)) acc)))
          ((md/-ul? line) (md/-list-collect lines (list) i acc false))
          ((md/-ol? line) (md/-list-collect lines (list) i acc true))
          (else (md/-para-collect lines (list) i acc)))))))

(define
  md/parse
  (fn (text) (md/-walk (split text (str "\n")) 0 (list))))

;; ── adapter ──
(define md/import (fn (text doc-id) (doc-new doc-id (md/parse text))))
(define content/from-markdown md/import)
(define markdown-adapter {:export (fn (doc) (asMarkdown doc)) :import md/import})