anatomy-0.4: lib/core.atomo

require: "pretty.atomo"
require: "util.atomo"

(a: A) evaluate: (e: Expression) :=
  a environment evaluate: e

-- various semantic helpers
A bold: s := s in-tag: "strong"
A italic: s := s in-tag: "em"
A underline: s := s in-tag: "span style=\"text-decoration: underline\""
A code: (s: String) := s escape in-tag: "code"
A list: s := s in-tag: "ul"
A numbered-list: s := s in-tag: "ol"
A item: s := s in-tag: "li"
A definitions: s := s in-tag: "dl"
A item: s is: v := (s in-tag: "dt") .. (v in-tag: "dd")
A verbatim: (s: String) :=
  s escape in-tag: "pre class=\"verbatim\""

-- annotated source code
(a: A) heading: (h: String) :=
  "<tr><th class=\"prose\"><h1>" .. h .. "</h1></th><th class=\"code\"></th></tr>"

(a: A) row: (s: String) :=
  "<tr><td class=\"prose\">" .. s .. "</td><td class=\"code\"></td></tr>"

(a: A) row: (s: String) is: (c: String) :=
  "<tr><td class=\"prose\">" .. s .. "</td><td class=\"code\">" .. (a atomo: c) .. "</td></tr>"

(a: A) row: (s: String) is: (c: String) on: target :=
  "<tr><td class=\"prose\">" .. s .. "</td><td class=\"code\">" .. (a atomo: c on: target) .. "</td></tr>"

-- external link
(a: A) link: name to: (url: Expression) := a link: name to: (a evaluate: url)
(a: A) link: (name: Expression) to: url := a link: (a evaluate: name) to: url
A link: (name: String) to: (url: String) :=
  name in-tag: ("a href=\"" .. url .. "\" class=\"external\"")

-- pretty-printing a single expr, inline
(a: A) hl: (e: Expression) :=
  a hl: (a evaluate: e)
(a: A) hl: (s: String) :=
  (a highlight: s) in-tag: "code"

-- pretty-printing a block of code
(a: A) atomo: (s: String) on: (t: Expression) :=
  a atomo: s on: (a evaluate: t)
(a: A) atomo: (s: String) on: env :=
  { do-input: s in: env
    a atomo: s
  } call

-- example interaction session
(a: A) example: (s: String) :=
  a example: s on: Lobby clone
(a: A) example: (s: String) on: (t: Expression) :=
  a example: s on: (a evaluate: t)
(a: A) example: (s: String) on: env :=
  ("<em>Example:</em>" .. (a interaction: s on: env))
    in-tag: "div class=\"example\""

-- example interaction session
(a: A) example-segment: (s: String) :=
  ("<em>Example:</em>" .. (a atomo: s))
    in-tag: "div class=\"example\""

-- a REPL simulator
(a: A) interaction: (s: String) :=
  a interaction: s on: Lobby clone

-- a REPL simulator locked into an environment
(a: A) interaction: (s: String) on: (t: Expression) :=
  a interaction: s on: (a evaluate: t)
(a: A) interaction: (s: String) on: env :=
  { ("interaction: " .. s show) print

    log = s lines (map: { e |
      output = String-Port new do: {
        display: s :=
          { output contents = output contents .. s (as: String) escape
            s
          } call
      }

      error = String-Port new do: {
        display: s :=
          { error contents = error contents .. (s as: String)
            output contents = output contents .. (s (as: String) escape type: "gr")
            s
          } call
      }

      res = {
        with: [
          value-output? -> True
          *error-output* -> error
        ] do: {
          with-output-to: output do: {
            a highlight: (do-input: e in: env) show
          }
        }
      } catch: { e |
        ("ERROR: " .. (a highlight: e show)) type: "gr"
      }

      [ "&gt;" type: "caret"
        " "
        a highlight: e
        "\n"
        output contents
        res
        "\n"
      ] join
    }) join

    log in-tag: "pre class=\"interaction\""
  } call

evaluate-all: [] in: _ := error: @no-expressions
evaluate-all: [e] in: t := t evaluate: e
evaluate-all: (e . es) in: t :=
  { t evaluate: e
    evaluate-all: es in: t
  } call

do-input: (s: String) in: env :=
  s parse-expressions match: {
    [] -> @undefined
    es -> evaluate-all: (es map: @expand) in: env
  }