anatomy-0.3: 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 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\""

-- 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) atomo: (e: Expression) :=
  (a pretty: e) in-tag: "code"

-- pretty-printing a single expr, block
(a: A) atomo-line: (e: Expression) :=
  (a pretty: e) in-tag: "pre class=\"verbatim\""

-- pretty-print a block of expressions
(a: A) atomo-segment: (e: Expression) :=
  (a evaluate: e) contents (map: { c | a pretty: c }) (join: "\n")
    in-tag: "pre class=\"verbatim\""

-- example code (unevaluated)
(a: A) example-segment: (e: Expression) :=
  ("<em>Example:</em>" .. (a atomo-segment: e))
    in-tag: "div class=\"example\""

-- pretty-print a block of Atomo code, multiline
(a: A) atomo-block: (e: Expression) :=
  a atomo-block: (a evaluate: e)
(a: A) atomo-block: (b: Block) :=
  with: multiline-pretty? as: True do: {
    b contents (map: { e | a atomo-line: e }) join
  }

-- example interaction session
(a: A) example: (e: Expression) :=
  ("<em>Example:</em>" .. (a interaction: e))
    in-tag: "div class=\"example\""

-- a REPL simulator
(a: A) interaction: (e: Expression) :=
  a interaction: (a evaluate: e) on: Lobby clone
(a: A) interaction: (b: Block) :=
  a interaction: b on: Lobby clone

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

    log =  b contents (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: "error-output")
            s
          } call
      }

      res = {
        with: [
          value-output? -> True
          *error-output* -> error
        ] do: {
          with-output-to: output do: {
            a pretty: (env evaluate: e expand)
          }
        }
      } catch: { e |
        (a pretty: e) type: "error"
      }

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

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