use(require(“atomy”)) io = require(“io”) pretty = require(“pretty”)

require(“stringio”)

hl = require(“hl”) token = require(“hl/token”) atomy = hl load(“atomy”)

use(require(“anatomy/html”)) base = require(“anatomy/base”) data = require(“anatomy/data”)

require(“atomy/message_structure”)

fn(format-inline(tokens, link-only = nil)):

tokens collect [t]:
  data Element new(
    -- constants, identifiers, and operators
    if((link-only && link-only include?(t contents)) ||
        (!link-only && ["no", "n", "o"] include?(t type tag)))
      then:
        data ResolveElement new(
          [part]:
            tag = part find-tag(t contents)
            if(tag)
              then: data Reference new(tag, t contents)
              else: t contents)
      else: t contents
    .class(t type tag))

fn(format-block(tokens, link-only = nil)):

data Block new(
  base verbatim(format-inline(tokens, link-only))
  .class("highlight"))

– redirect ALL stdout/stderr for interaction fn(with-all-output-to(out, err) &action):

before-out = io OutputPort instance-variable-get(."@default")
before-err = io ErrorPort instance-variable-get(."@default")

{ io OutputPort instance-variable-set(."@default", out)
  io ErrorPort instance-variable-set(."@default", err)

  io with-output-to(out):
    io with-error-to(err):
      action call
} ensuring:
  io OutputPort instance-variable-set(."@default", before-out)
  io ErrorPort instance-variable-set(."@default", before-err)

fn(interactive-line(mod, input, line, context)):

out = StringIO new
err = StringIO new

output-tokens =
  with-restarts(use-tokens(ts): ts) {
    res =
      with-all-output-to(out, err):
        mod eval(input, line)

    -- shorten the long-form inspections that show the ivars
    atomy lex(pretty show(res) sub(r"#<([^\s]+)\s+@.*$", "#<\\1>"))
  } bind:
    (e & Error):
      restart(
        .use-tokens
        [ token Token new(
            token Tagged new(.gr)
            i"#{e name}: #{e message}")
        ])

[ format-inline(
    token Token new(token Tagged new(.caret), "> ") .
      atomy lex(input))
  "\n"
  out string
  unless(err string empty?):
    data Element new(err string, .class("gr"))
  format-inline(output-tokens)
  "\n"
]

def(hl(x)): base code(format-inline(atomy new(x) run)) def(atomy(x)): format-block(atomy new(x) run)

fn(new-interaction-env(where = nil)):

Atomy Module new(where || "interaction") tap [mod]:
  mod use("atomy")

environments = #{} def(interaction(x, where = nil)):

mod =
  if(where)
    then:
      environments[where] ||= new-interaction-env(where)
    else:
      new-interaction-env(where)

data Block new(
  data Block new(
    x split("\n") collect with-index [input, line]:
      interactive-line(mod, input, line + 1, where)
    .tt)
  .class("interaction"))

def(example(x, where = nil)):

data Block new(
  [ data Paragraph new([data Element new("Example:", .italic)])
    interaction(x, where)
  ]
  .class("example"))

def(example-segment(x)):

data Block new(
  [ data Paragraph new([data Element new("Example:", .italic)])
    format-block(atomy new(x) run)
  ]
  .class("example"))

def(define(what, *rules, returns, body)):

thumb = Atomy Parser parse-string(what)

structure = Atomy MessageStructure new(thumb nodes first)
message-name = structure name to-s
tag-name =
  if(message-name =~ r"^[\p{Ll}_]")
    then: message-name tr("_", "-")
    else: message-name

display = format-inline(atomy lex(what), [tag-name])
data Block new(
  [ base target-element(tag-name)
    data Block new(
      [ data Block new(
          [ display
            data Element new(
              " => "
              .class("definition_result_arrow"))
            format-inline(atomy lex(returns))
            rules collect [rule]:
              ["\n  | ", format-inline(atomy lex(rule))]
          ]
          .tt)
      ]
      .class("thumb"))
    body
  ]
  .class("definition"))

def(assign(name, to, body)):

display = format-inline(atomy lex(name), [name])
data Block new(
  [ base target-element(name)
    data Block new(
      [ data Block new(
          [ display
            data Element new(
              " = "
              .class("definition_result_arrow"))
            format-inline(atomy lex(to))
          ]
          .tt)
      ]
      .class("thumb"))
    body
  ]
  .class("definition", "assign"))

fn(find-tags(tags, c & Atomy Grammar AST Constant)): tags << c name to-s fn(find-tags(tags, `((~what)(~*_)))): find-tags(tags, what) fn(find-tags(tags, `(~what: ~*childs))):

find-tags(tags, what)

childs each [c]:
  find-tags(tags, c)

def(data(tree, body)):

tree-ast = Atomy Parser parse-string(tree) nodes first

tag-names = []
find-tags(tag-names, tree-ast)

display = format-inline(atomy lex(tree), tag-names)
data Block new(
  [ tag-names collect [name]: base target-element(name)
    data Block new([base verbatim(display)], .class("thumb"))
    body
  ]
  .class("definition", "data"))

def(macro(pattern, *tag-names, result, body)):

display = format-inline(atomy lex(pattern), tag-names)
data Block new(
  [ tag-names collect [name]: base target-element(name)
    data Block new([data Block new([display], .tt)], .class("thumb"))
    body
  ]
  .class("definition", "macro"))