From be5710d104e6ee085dcb9d871be0b80305e48f8b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 5 Feb 2019 02:14:27 -0400
Subject: Migrated documentation tool's code into stdlib.

---
 luxdoc/project.clj                             |  11 -
 luxdoc/source/program.lux                      | 601 -------------------------
 stdlib/project.clj                             |   9 +-
 stdlib/source/lux.lux                          |   7 -
 stdlib/source/lux/control/comonad.lux          |  18 +-
 stdlib/source/lux/control/continuation.lux     |  78 ++--
 stdlib/source/lux/data/collection/sequence.lux |  25 +-
 stdlib/source/lux/data/format/markdown.lux     |  14 +-
 stdlib/source/lux/data/text.lux                |   3 -
 stdlib/source/lux/macro.lux                    |  20 +-
 stdlib/source/program/scriptum.lux             | 518 +++++++++++++++++++++
 11 files changed, 605 insertions(+), 699 deletions(-)
 delete mode 100644 luxdoc/project.clj
 delete mode 100644 luxdoc/source/program.lux
 create mode 100644 stdlib/source/program/scriptum.lux

diff --git a/luxdoc/project.clj b/luxdoc/project.clj
deleted file mode 100644
index de51950bb..000000000
--- a/luxdoc/project.clj
+++ /dev/null
@@ -1,11 +0,0 @@
-(defproject luxdoc "0.5.0"
-  :description "Documentation generator for the Lux programming language's ."
-  :url "https://github.com/LuxLang/luxdoc"
-  :license {:name "Lux License v0.1"
-            :url "https://github.com/LuxLang/lux/blob/master/license.txt"}
-  :plugins [[com.github.luxlang/lein-luxc "0.5.0"]]
-  :dependencies []
-  :repositories [["snapshots" "https://oss.sonatype.org/content/repositories/snapshots/"]
-                 ["releases" "https://oss.sonatype.org/service/local/staging/deploy/maven2/"]]
-  :source-paths ["source"]
-  :lux {:program "program"})
diff --git a/luxdoc/source/program.lux b/luxdoc/source/program.lux
deleted file mode 100644
index 94b5df37f..000000000
--- a/luxdoc/source/program.lux
+++ /dev/null
@@ -1,601 +0,0 @@
-##  Copyright (c) Eduardo Julian. All rights reserved.
-##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-##  If a copy of the MPL was not distributed with this file,
-##  You can obtain one at http://mozilla.org/MPL/2.0/.
-
-(;module:
-  lux
-  (lux [cli #+ program:]
-       [compiler #+ Monad<Lux>]
-       host
-       [lexer]
-       [macro]
-       [math]
-       [pipe]
-       [random]
-       [regex]
-       [test]
-       [type]
-       (codata [cont]
-               [env]
-               function
-               [io #- run]
-               [state]
-               (struct [stream #+ Stream "Stream/" Functor<Stream>]))
-       (concurrency [actor]
-                    [atom]
-                    [frp]
-                    [promise]
-                    [stm])
-       (control [applicative]
-                [bounded]
-                [codec]
-                [comonad]
-                [effect]
-                [enum]
-                [eq]
-                [fold]
-                [functor]
-                [hash]
-                monad
-                [monoid]
-                ["_;" number]
-                [ord])
-       (data [bit]
-             [bool]
-             [char]
-             [error]
-             [ident "Ident/" Codec<Text,Ident>]
-             [identity]
-             [log]
-             maybe
-             [number #* "Nat/" Codec<Text,Nat>]
-             [product]
-             [sum]
-             [text "Text/" Monoid<Text> Eq<Text>]
-             (error [exception])
-             (format [json])
-             (struct [array]
-                     [dict]
-                     [list #+ "List/" Monoid<List> Functor<List> Fold<List>]
-                     [queue]
-                     [set]
-                     [stack]
-                     [tree]
-                     [vector]
-                     [zipper])
-             text/format)
-       (macro [ast]
-              [poly]
-              ["s" syntax]
-              (poly ["poly_;" eq]
-                    ["poly_;" functor]
-                    ["poly_;" text-encoder])
-              (syntax [common]))
-       (math [complex]
-             [ratio]
-             [simple])
-       (type [auto]
-             [check])
-       ))
-
-(def: name-options "abcdefghijklmnopqrstuvwxyz")
-(def: name-options-count (text;size name-options))
-
-(def: (id->name id)
-  (-> Nat Text)
-  (if (n.> name-options-count id)
-    (format (id->name (n./ name-options-count id))
-            (id->name (n.% name-options-count id)))
-    (char;as-text (default #"?" (text;at id name-options)))))
-
-(def: type-var-names
-  (Stream Text)
-  (Stream/map id->name (stream;iterate n.inc +0)))
-
-(def: (type-arg? id)
-  (-> Nat Bool)
-  (n.= +1 (n.% +2 id)))
-
-(def: (arg-id level id)
-  (-> Nat Nat Nat)
-  (n.- (n./ +2 id) level))
-
-(def: (bound->name [type-fun-name type-fun-args] level id)
-  (-> [Text (List Text)] Nat Nat Text)
-  (if (type-arg? id)
-    (let [_arg-id (arg-id level id)]
-      (case (list;at _arg-id type-fun-args)
-        (#;Some found)
-        found
-
-        _
-        (|> type-var-names
-            (stream;filter (lambda [var-name] (not (list;member? text;Eq<Text> type-fun-args var-name))))
-            (stream;at _arg-id))))      
-    type-fun-name))
-
-(do-template [<name> <base> <tag>]
-  [(def: (<base> level type)
-     (-> Nat Type [Nat Type])
-     (case type
-       (<tag> env type')
-       (<base> (n.inc level) type')
-
-       _
-       [level type]))
-
-   (def: <name> (<base> +0))]
-
-  [unravel-univ unravel-univ' #;UnivQ]
-  [unravel-ex   unravel-ex'   #;ExQ])
-
-(def: (level->args offset level)
-  (-> Nat Nat (List Text))
-  (if (n.= +0 level)
-    (list)
-    (|> level
-        n.dec
-        (list;n.range +0)
-        (List/map (|>. (n.+ (n.inc offset)) id->name)))))
-
-(def: (prefix-lines prefix lines)
-  (-> Text Text Text)
-  (|> lines
-      text;split-lines
-      (List/map (Text/append prefix))
-      ## (list;interpose "\n")
-      (text;join-with "")))
-
-(def: (pprint-type-def level type-fun-info tags module sig? type-rec? type)
-  (-> Nat [Text (List Text)] (List Ident) Text Bool Bool Type Text)
-  (case tags
-    (^ (list [_ single-tag]))
-    (if sig?
-      (format "(: " (pprint-type-def level type-fun-info #;None module sig? type-rec? type) "\n   " single-tag ")")
-      (format "{#" single-tag " " (pprint-type-def level type-fun-info #;None module sig? type-rec? type) "}"))
-
-    _
-    (case [type-rec? type]
-      [_ (#;HostT name params)]
-      (case params
-        #;Nil
-        (format "(host " name ")")
-
-        _
-        (format "(host " name " " (|> params (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?)) (text;join-with " ")) ")"))
-
-      [_ #;VoidT]
-      "Void"
-
-      [_ #;UnitT]
-      "Unit"
-
-      [_ (#;SumT _)]
-      (let [members (type;flatten-variant type)]
-        (case tags
-          #;Nil
-          (format "(| "
-                  (|> members
-                      (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?))
-                      (text;join-with " "))
-                  ")")
-
-          _
-          (|> members
-              (list;zip2 tags)
-              (List/map (lambda [[[_ t-name] type]]
-                          (case type
-                            #;UnitT
-                            (format "#" t-name)
-
-                            (#;ProdT _)
-                            (let [types (type;flatten-tuple type)]
-                              (format "(#" t-name " "
-                                      (|> types
-                                          (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?))
-                                          (text;join-with " "))
-                                      ")"))
-
-                            _
-                            (format "(#" t-name " " (pprint-type-def level type-fun-info #;None module sig? type-rec? type) ")"))))
-              (text;join-with "\n"))))
-
-      [_ (#;ProdT _)]
-      (let [members (type;flatten-tuple type)]
-        (case tags
-          #;Nil
-          (format "[" (|> members (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?)) (text;join-with " ")) "]")
-
-          _
-          (let [member-docs (|> members
-                                (list;zip2 tags)
-                                (List/map (lambda [[[_ t-name] type]]
-                                            (if sig?
-                                              (format "(: " (pprint-type-def level type-fun-info #;None module sig? type-rec? type) "\n   "  t-name ")")
-                                              (format "#" t-name " " (pprint-type-def level type-fun-info #;None module sig? type-rec? type)))))
-                                (text;join-with "\n "))]
-            (if sig?
-              member-docs
-              (format "{" member-docs "}")))))
-
-      [_ (#;LambdaT input output)]
-      (let [[ins out] (type;flatten-function type)]
-        (format  "(-> " (|> ins (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?)) (text;join-with " "))
-                 " "
-                 (pprint-type-def level type-fun-info #;None module sig? type-rec? out)
-                 ")"))
-
-      [_ (#;BoundT idx)]
-      (bound->name type-fun-info level idx)
-
-      (^template [<tag> <pre> <post>]
-        [_ (<tag> id)]
-        (format <pre> (Nat/encode id) <post>))
-      ([#;VarT "⌈v:" "⌋"]
-       [#;ExT  "⟨e:" "⟩"])
-      
-      (^template [<tag> <name> <unravel>]
-        [_ (<tag> _)]
-        (let [[level' body] (<unravel> type)
-              args (level->args level level')
-              body-doc (pprint-type-def (n.+ level level') type-fun-info tags module sig? type-rec? body)]
-          (format "(" <name> " " "[" (text;join-with " " args) "]"
-                  (case tags
-                    #;Nil
-                    (format " " body-doc)
-
-                    _
-                    (format "\n" (prefix-lines "  " body-doc)))
-                  ")")))
-      ([#;UnivQ "All" unravel-univ]
-       [#;ExQ   "Ex"  unravel-ex])
-
-      [true (#;AppT (#;BoundT +0) (#;BoundT +1))]
-      (product;left type-fun-info)
-      
-      [_ (#;AppT fun param)]
-      (let [[type-fun type-args] (type;flatten-application type)]
-        (format  "(" (pprint-type-def level type-fun-info tags module sig? type-rec? type-fun) " " (|> type-args (List/map (pprint-type-def level type-fun-info #;None module sig? type-rec?)) (text;join-with " ")) ")"))
-      
-      [_ (#;NamedT [_module _name] type)]
-      (if (Text/= module _module)
-        _name
-        (Ident/encode [_module _name]))
-      )))
-
-(def: (pprint-type level type-fun-name module type)
-  (-> Nat Text Text Type Text)
-  (case type
-    (#;HostT name params)
-    (case params
-      #;Nil
-      (format "(host " name ")")
-
-      _
-      (format "(host " name " " (|> params (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with "")) ")"))
-
-    #;VoidT
-    "Void"
-
-    (#;SumT _)
-    (let [members (type;flatten-variant type)]
-      (format "(| " (|> members (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with "")) ")"))
-
-    #;UnitT
-    "Unit"
-
-    (#;ProdT _)
-    (let [members (type;flatten-tuple type)]
-      (format "[" (|> members (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with "")) "]"))
-
-    (#;LambdaT input output)
-    (let [[ins out] (type;flatten-function type)]
-      (format  "(-> "
-               (|> ins (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with ""))
-               " "
-               (pprint-type level type-fun-name module out)
-               ")"))
-
-    (#;BoundT idx)
-    (bound->name [type-fun-name (list)] level idx)
-
-    (^template [<tag> <pre> <post>]
-      (<tag> id)
-      (format <pre> (Nat/encode id) <post>))
-    ([#;VarT "⌈" "⌋"]
-     [#;ExT  "⟨" "⟩"])
-
-    (^template [<tag> <name> <unravel>]
-      (<tag> _)
-      (let [[level' body] (<unravel> type)
-            args (level->args level level')
-            body-doc (pprint-type (n.+ level level') type-fun-name module body)]
-        (format "(" <name> " " "[" (|> args (list;interpose " ") (text;join-with "")) "]"
-                (format " " body-doc)
-                ")")))
-    ([#;UnivQ "All" unravel-univ]
-     [#;ExQ   "Ex"  unravel-ex])
-
-    (#;AppT fun param)
-    (let [[type-fun type-args] (type;flatten-application type)]
-      (format  "(" (pprint-type level type-fun-name module type-fun) " " (|> type-args (List/map (pprint-type level type-fun-name module)) (list;interpose " ") (text;join-with "")) ")"))
-
-    (#;NamedT [_module _name] type)
-    (if (Text/= module _module)
-      _name
-      (Ident/encode [_module _name]))
-    ))
-
-(type: Markdown
-  Text)
-
-(type: DefOrg
-  {#types (List [Text Anns Type])
-   #macros (List [Text Anns])
-   #structs (List [Text Anns Type])
-   #values (List [Text Anns Type])})
-
-(def: (lux-module? module-name)
-  (-> Text Bool)
-  (or (Text/= "lux" module-name)
-      (text;starts-with? "lux/" module-name)))
-
-(do-template [<name> <joiner>]
-  [(def: (<name> docs)
-     (-> (List Markdown) Markdown)
-     (text;join-with "\n\n" docs))]
-
-  [join-def-docs     "\n\n"]
-  [join-doc-sections "\n\n"]
-  )
-
-(def: (cons h t)
-  (All [a] (-> a (List a) (List a)))
-  (#;Cons h t))
-
-(def: (add-def [name [def-type def-meta def-value]] org)
-  (-> [Text Def] DefOrg DefOrg)
-  (cond (compiler;type? def-meta)
-        (update@ #types (cons [name def-meta (:coerce Type def-value)]) org)
-        
-        (compiler;macro? def-meta)
-        (update@ #macros (cons [name def-meta]) org)
-
-        (compiler;struct? def-meta)
-        (update@ #structs (cons [name def-meta def-type]) org)
-
-        ## else
-        (update@ #values (cons [name def-meta def-type]) org)))
-
-(def: def-sorter
-  (All [r] (-> (List [Text r]) (List [Text r])))
-  (list;sort (: (All [r] (-> [Text r] [Text r] Bool))
-                (lambda [[n1 _] [n2 _]] (:: text;Ord<Text> < n1 n2)))))
-
-(def: (organize-defs defs)
-  (-> (List [Text Def]) DefOrg)
-  (let [init {#types (list)
-              #macros (list)
-              #structs (list)
-              #values (list)}]
-    (|> (List/fold add-def init defs)
-        (update@ #types def-sorter)
-        (update@ #macros def-sorter)
-        (update@ #structs def-sorter)
-        (update@ #values def-sorter))))
-
-(def: (unravel-type-func level type)
-  (-> Nat Type Type)
-  (if (n.> +0 level)
-    (case type
-      (#;UnivQ _env _type)
-      (unravel-type-func (n.dec level) _type)
-
-      _
-      type)
-    type))
-
-(def: (unrecurse-type type)
-  (-> Type Type)
-  (case type
-    (#;AppT (#;UnivQ _env _type) _)
-    _type
-
-    _
-    type))
-
-(def: #export (when! test f x)
-  (All [a] (-> Bool (-> a a) a a))
-  (if test
-    (f x)
-    x))
-
-(def: #export (if! test f g x)
-  (All [a b] (-> Bool (-> a b) (-> a b) a b))
-  (if test
-    (f x)
-    (g x)))
-
-(def: (doc-type module type def-meta)
-  (-> Text Type Anns (Lux Markdown))
-  (case type
-    (#;NamedT type-name type)
-    (do Monad<Lux>
-      [tags (compiler;tags-of type-name)
-       #let [[_ _name] type-name
-             type-rec? (compiler;type-rec? def-meta)
-             type-args (compiler;type-args def-meta)
-             sig? (compiler;sig? def-meta)
-             usage (case type-args
-                     #;Nil
-                     _name
-
-                     _
-                     (format "(" (text;join-with " " (list& _name type-args)) ")"))
-             nesting (list;size type-args)]]
-      (wrap (format (if sig? "(signature: " "(type: ") (if type-rec? "#rec " "") usage "\n"
-                    (|> (pprint-type-def (n.dec nesting)
-                                         [_name type-args]
-                                         tags module sig? type-rec?
-                                         (|> type
-                                             (unravel-type-func nesting)
-                                             (when! type-rec? unrecurse-type)))
-                        text;split-lines
-                        (List/map (Text/append "  "))
-                        (text;join-with "\n"))
-                    ")")))
-
-    _
-    (compiler;fail (format "A type definition must always be named! - " (type;to-text type)))))
-
-(def: (doc-types module types)
-  (-> Text (List [Text Anns Type]) (Lux Markdown))
-  (do Monad<Lux>
-    [type-docs (mapM @
-                     (: (-> [Text Anns Type] (Lux Markdown))
-                        (lambda [[name def-meta type]]
-                          (do Monad<Lux>
-                            [#let [?doc (compiler;get-doc def-meta)
-                                   name (|> name
-                                            (text;replace "<" "&lt;")
-                                            (text;replace ">" "&gt;"))]
-                             type-doc (doc-type module type def-meta)]
-                            (wrap (format "### " name "\n"
-                                          (case ?doc
-                                            (#;Some doc)
-                                            (format doc "\n")
-
-                                            _
-                                            "")
-                                          "```\n" type-doc "\n```")))))
-                     types)]
-    (|> type-docs
-        join-def-docs
-        (format "## Types\n")
-        wrap)))
-
-(def: (doc-macros module-name names)
-  (-> Text (List [Text Anns]) Markdown)
-  (|> names
-      (List/map (: (-> [Text Anns] Markdown)
-                   (lambda [[name def-meta]]
-                     (let [name (|> name
-                                    (text;replace "<" "&lt;")
-                                    (text;replace ">" "&gt;"))]
-                       (format "### " name "\n"
-                               (default ""
-                                 (do Monad<Maybe>
-                                   [doc (compiler;get-doc def-meta)]
-                                   (wrap (format "```\n" doc "\n```")))))))))
-      join-def-docs
-      (format "## Macros\n")))
-
-(do-template [<singular> <plural> <header>]
-  [(def: <singular>
-     (-> Text Type Markdown)
-     (pprint-type (n.dec +0) "?"))
-
-   (def: (<plural> module values)
-     (-> Text (List [Text Anns Type]) Markdown)
-     (|> values
-         (List/map (lambda [[name def-meta value-type]]
-                      (let [?doc (compiler;get-doc def-meta)
-                            usage (case (compiler;func-args def-meta)
-                                    #;Nil
-                                    name
-
-                                    args
-                                    (format "(" (text;join-with " " (list& name args)) ")"))
-                            usage (|> usage
-                                      (text;replace "<" "&lt;")
-                                      (text;replace ">" "&gt;"))]
-                        (format "### " usage "\n"
-                                (case ?doc
-                                  (#;Some doc)
-                                  (format "```\n" doc "\n```\n")
-
-                                  _
-                                  "")
-                                "`" (<singular> module value-type) "`"))))
-         join-def-docs
-         (format <header>)))]
-
-  [doc-struct doc-structs "## Structs\n"]
-  [doc-value  doc-values  "## Values\n"]
-  )
-
-(def: (enclose-lines pre+post block)
-  (-> [Text Text] Text Text)
-  (|> block
-      text;split-lines
-      (List/map (text;enclose pre+post))
-      (text;join-with "\n")))
-
-(def: (doc-module [[module-name module] org])
-  (-> [[Text Module] DefOrg] (Lux [Text Markdown]))
-  (do Monad<Lux>
-    [#let [(^slots [#types #macros #structs #values]) org
-           anns (|> module (get@ #;module-anns) compiler;get-doc)]
-     types-md (if (list;empty? types)
-                (wrap "")
-                (doc-types module-name types))
-     #let [doc-desc (case anns
-                      #;None
-                      ""
-
-                      (#;Some doc)
-                      (format "\n" (enclose-lines ["> " ""] doc) "\n"))
-           doc-body (join-doc-sections (list types-md
-                                             (if (list;empty? macros) "" (doc-macros module-name macros))
-                                             (if (list;empty? structs) "" (doc-structs module-name structs))
-                                             (if (list;empty? values) "" (doc-values module-name values))))]]
-    (wrap [module-name
-           (format "## " module-name "\n"
-                   doc-desc "\n"
-                   doc-body)])))
-
-(jvm-import java.io.File
-  (new [java.lang.String]))
-
-(jvm-import java.io.PrintWriter
-  (new [java.io.File] #io #try)
-  (println [java.lang.String] #io void))
-
-(jvm-import java.io.Writer
-  (flush [] #io #try void))
-
-(def: (save-docs! [module-name docs])
-  (-> [Text Markdown] (IO Unit))
-  (do Monad<IO>
-    [?target (|> (format (text;replace "/" "_" module-name) ".md")
-                 File.new
-                 PrintWriter.new)]
-    (case ?target
-      (#;Left _)
-      (wrap [])
-      
-      (#;Right target)
-      (do @
-        [_ (PrintWriter.println docs target)
-         _ (Writer.flush [] target)]
-        (wrap [])))))
-
-(macro: (gen-docs! _)
-  (do Monad<Lux>
-    [all-modules compiler;modules
-     #let [lux-modules (|> all-modules
-                           (list;filter (. lux-module? product;left))
-                           (list;sort (lambda [[left _] [right _]]
-                                        (:: text;Ord<Text> < left right))))]
-     lux-exports (mapM @ (. compiler;exports product;left) lux-modules)
-     module-docs (mapM @ doc-module
-                       (list;zip2 lux-modules
-                                  (List/map organize-defs lux-exports)))
-     #let [_ (io;run (mapM Monad<IO> save-docs! module-docs))]]
-    (wrap (list))))
-
-(gen-docs!)
-
-(program: args
-  (io (log! "Done!")))
diff --git a/stdlib/project.clj b/stdlib/project.clj
index e9ed11d34..79319f540 100644
--- a/stdlib/project.clj
+++ b/stdlib/project.clj
@@ -16,9 +16,10 @@
   :scm {:name "git"
         :url "https://github.com/LuxLang/lux.git"}
 
-  :dependencies []
-  
   :source-paths ["source"]
-  :test-paths ["test"]
-  :lux {:tests {:jvm "test"}}
+  :profiles {:library {:dependencies []
+                       :test-paths ["test"]
+                       :lux {:tests {:jvm "test"}}}
+             :documentation {:dependencies []
+                             :lux {:program {:jvm "program/scriptum"}}}}
   )
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 1a35b4ebd..e0717c88c 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5999,13 +5999,6 @@
     _
     (#Left (..wrong-syntax-error (name-of ..char)))))
 
-(def: #export (when test f)
-  (All [a] (-> Bit (-> a a) (-> a a)))
-  (function (_ value)
-    (if test
-      (f value)
-      value)))
-
 (def: target
   (Meta Text)
   (function (_ compiler)
diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux
index 853c43615..980935216 100644
--- a/stdlib/source/lux/control/comonad.lux
+++ b/stdlib/source/lux/control/comonad.lux
@@ -2,17 +2,15 @@
   [lux #*
    [data
     [collection
-     ["." list ("list/." Fold)]
-     ["." sequence]]]]
+     ["." list ("list/." fold)]]]]
   [//
-   ["F" functor]])
+   ["." functor (#+ Functor)]])
 
-## [Signatures]
 (signature: #export (CoMonad w)
   {#.doc (doc "CoMonads are the opposite/complement to monads."
               "CoMonadic structures are often infinite in size and built upon lazily-evaluated functions.")}
-  (: (F.Functor w)
-     functor)
+  (: (Functor w)
+     &functor)
   (: (All [a]
        (-> (w a) a))
      unwrap)
@@ -20,18 +18,16 @@
        (-> (w a) (w (w a))))
      split))
 
-## [Types]
 (type: #export (CoFree F a)
   {#.doc "The CoFree CoMonad."}
   [a (F (CoFree F a))])
 
-## [Syntax]
 (def: _cursor Cursor ["" 0 0])
 
 (macro: #export (be tokens state)
   {#.doc (doc "A co-monadic parallel to the 'do' macro."
               (let [square (function (_ n) (i/* n n))]
-                (be sequence.comonad
+                (be comonad
                   [inputs (iterate inc +2)]
                   (square (head inputs)))))}
   (case tokens
@@ -53,7 +49,9 @@
                              body
                              (list.reverse (list.as-pairs bindings)))]
         (#.Right [state (#.Cons (` ({(~' @)
-                                     ({{#functor {#F.map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
+                                     ({{#&functor {#functor.map (~ g!map)}
+                                        #unwrap (~' unwrap)
+                                        #split (~ g!split)}
                                        (~ body')}
                                       (~' @))}
                                     (~ comonad)))
diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux
index 66233773a..7a1fd7be8 100644
--- a/stdlib/source/lux/control/continuation.lux
+++ b/stdlib/source/lux/control/continuation.lux
@@ -3,29 +3,59 @@
    [control
     [functor (#+ Functor)]
     [apply (#+ Apply)]
-    monad]
-   function
+    [monad (#+ Monad do)]]
+   ["." function]
    [macro (#+ with-gensyms)
-    [code]
-    [syntax (#+ syntax:)]]])
+    ["." code]
+    ["s" syntax (#+ syntax:)]]])
 
 (type: #export (Cont i o)
   {#.doc "Continuations."}
   (-> (-> i o) o))
 
-(def: #export (continue k cont)
-  {#.doc "Forces a continuation thunk to be evaluated."}
+(def: #export (continue next cont)
+  {#.doc "Continues a thunk."}
   (All [i o] (-> (-> i o) (Cont i o) o))
-  (cont k))
+  (cont next))
 
 (def: #export (run cont)
   {#.doc "Forces a continuation thunk to be evaluated."}
   (All [a] (-> (Cont a a) a))
-  (cont id))
+  (cont function.identity))
+
+(def: #export (call/cc f)
+  {#.doc "Call with current continuation."}
+  (All [a b z]
+    (-> (-> (-> a (Cont b z))
+            (Cont a z))
+        (Cont a z)))
+  (function (_ k)
+    (f (function (_ a) (function (_ _) (k a)))
+       k)))
+
+(syntax: #export (pending expr)
+  {#.doc (doc "Turns any expression into a function that is pending a continuation."
+              (pending (some-function some-input)))}
+  (with-gensyms [g!_ g!k]
+    (wrap (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr))))))))
+
+(def: #export (reset scope)
+  (All [i o] (-> (Cont i i) (Cont i o)))
+  (function (_ k)
+    (k (run scope))))
+
+(def: #export (shift f)
+  (All [a]
+    (-> (-> (-> a (Cont a a))
+            (Cont a a))
+        (Cont a a)))
+  (function (_ oc)
+    (f (function (_ a) (function (_ ic) (ic (oc a))))
+       function.identity)))
 
 (structure: #export functor (All [o] (Functor (All [i] (Cont i o))))
   (def: (map f fv)
-    (function (_ k) (fv (compose k f)))))
+    (function (_ k) (fv (function.compose k f)))))
 
 (structure: #export apply (All [o] (Apply (All [i] (Cont i o))))
   (def: &functor ..functor)
@@ -46,22 +76,6 @@
     (function (_ k)
       (ffa (continue k)))))
 
-(def: #export (call/cc f)
-  {#.doc "Call with current continuation."}
-  (All [a b z]
-    (-> (-> (-> a (Cont b z))
-            (Cont a z))
-        (Cont a z)))
-  (function (_ k)
-    (f (function (_ a) (function (_ _) (k a)))
-       k)))
-
-(syntax: #export (pending expr)
-  {#.doc (doc "Turns any expression into a function that is pending a continuation."
-              (pending (some-function some-input)))}
-  (with-gensyms [g!_ g!k]
-    (wrap (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr))))))))
-
 (def: #export (portal init)
   (All [i o z]
     (-> i
@@ -74,17 +88,3 @@
                               (k [nexus val]))]
                 _ (k [nexus init])]
                (wrap (undefined))))))
-
-(def: #export (reset scope)
-  (All [i o] (-> (Cont i i) (Cont i o)))
-  (function (_ k)
-    (k (run scope))))
-
-(def: #export (shift f)
-  (All [a]
-    (-> (-> (-> a (Cont a a))
-            (Cont a a))
-        (Cont a a)))
-  (function (_ oc)
-    (f (function (_ a) (function (_ ic) (ic (oc a))))
-       id)))
diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux
index 30b2bf46e..bd2c7ae03 100644
--- a/stdlib/source/lux/data/collection/sequence.lux
+++ b/stdlib/source/lux/data/collection/sequence.lux
@@ -1,16 +1,15 @@
 (.module:
   [lux #*
    [control
-    functor
-    monad
-    comonad
+    [functor (#+ Functor)]
+    [comonad (#+ CoMonad)]
     ["." continuation (#+ pending Cont)]
     ["p" parser]]
    [macro (#+ with-gensyms)
     ["." code]
     ["s" syntax (#+ syntax: Syntax)]]
    [data
-    bit
+    ["." bit]
     [collection
      [list ("list/." monad)]]]])
 
@@ -22,8 +21,11 @@
   (All [a]
     (-> a (List a) a (List a) (Sequence a)))
   (case xs
-    #.Nil           (pending [x (cycle' init full init full)])
-    (#.Cons x' xs') (pending [x (cycle' x' xs' init full)])))
+    #.Nil
+    (pending [x (cycle' init full init full)])
+    
+    (#.Cons x' xs')
+    (pending [x (cycle' x' xs' init full)])))
 
 (def: #export (iterate f x)
   {#.doc "Create a sequence by applying a function to a value, and to its result, on and on..."}
@@ -43,8 +45,11 @@
   (All [a]
     (-> (List a) (Maybe (Sequence a))))
   (case xs
-    #.Nil          #.None
-    (#.Cons x xs') (#.Some (cycle' x xs' x xs'))))
+    #.Nil
+    #.None
+    
+    (#.Cons x xs')
+    (#.Some (cycle' x xs' x xs'))))
 
 (do-template [<name> <return> <part>]
   [(def: #export (<name> s)
@@ -106,12 +111,12 @@
       (pending [x (filter p xs')])
       (filter p xs'))))
 
-(def: #export (partition p xs)
+(def: #export (partition left? xs)
   {#.doc (doc "Split a sequence in two based on a predicate."
               "The left side contains all entries for which the predicate is #1."
               "The right side contains all entries for which the predicate is #0.")}
   (All [a] (-> (-> a Bit) (Sequence a) [(Sequence a) (Sequence a)]))
-  [(filter p xs) (filter (complement p) xs)])
+  [(filter left? xs) (filter (bit.complement left?) xs)])
 
 (structure: #export functor (Functor Sequence)
   (def: (map f fa)
diff --git a/stdlib/source/lux/data/format/markdown.lux b/stdlib/source/lux/data/format/markdown.lux
index 757fca9b3..5fcf85cbf 100644
--- a/stdlib/source/lux/data/format/markdown.lux
+++ b/stdlib/source/lux/data/format/markdown.lux
@@ -38,14 +38,20 @@
 
   Text
 
+  (def: #export empty
+    Markdown
+    (:abstraction ""))
+
   (def: #export text
     (-> Text (Markdown Span))
     (|>> ..sanitize :abstraction))
 
+  (def: blank-line (format text.new-line text.new-line))
+
   (do-template [<name> <prefix>]
     [(def: #export (<name> content)
        (-> Text Markdown)
-       (:abstraction (format <prefix> (..sanitize content) text.new-line)))]
+       (:abstraction (format <prefix> " " (..sanitize content) ..blank-line)))]
 
     [heading/1 "#"]
     [heading/2 "##"]
@@ -55,8 +61,6 @@
     [heading/6 "######"]
     )
 
-  (def: blank-line (format text.new-line text.new-line))
-
   (def: (block content)
     (-> Text (Markdown Block))
     (:abstraction (format content ..blank-line)))
@@ -136,7 +140,9 @@
   (def: #export code
     {#.doc "A block of code."}
     (-> Text (Markdown Block))
-    (|>> ..indent ..block))
+    (let [open (format "```" text.new-line)
+          close (format text.new-line "```")]
+      (|>> (text.enclose [open close]) ..block)))
 
   (def: #export (image description url)
     (-> Text URL (Markdown Span))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 921e7c96c..a87aa0626 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -150,9 +150,6 @@
     #.None
     (#.Cons sample #.Nil)))
 
-(def: #export split-lines
-  (..split-all-with ..new-line))
-
 (def: #export (replace-once pattern value template)
   (-> Text Text Text Text)
   (<| (maybe.default template)
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index abfcd4d86..a4b439c62 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -185,7 +185,7 @@
   [get-record-ann     #.Record     (List [Code Code])]
   )
 
-(def: #export (get-doc anns)
+(def: #export (get-documentation anns)
   {#.doc "Looks-up a definition's documentation."}
   (-> Code (Maybe Text))
   (get-text-ann (name-of #.doc) anns))
@@ -201,12 +201,12 @@
      (-> Code Bit)
      (flag-set? (name-of <tag>)))]
 
-  [export?   #.export?   "exported"]
-  [macro?    #.macro?    "a macro"]
-  [type?     #.type?     "a type"]
-  [struct?   #.struct?   "a structure"]
-  [type-rec? #.type-rec? "a recursive type"]
-  [sig?      #.sig?      "a signature"]
+  [export?         #.export?   "exported"]
+  [macro?          #.macro?    "a macro"]
+  [type?           #.type?     "a type"]
+  [structure?      #.struct?   "a structure"]
+  [recursive-type? #.type-rec? "a recursive type"]
+  [signature?      #.sig?      "a signature"]
   )
 
 (def: #export (aliased? annotations)
@@ -242,9 +242,9 @@
                        args (parse-tuple _args)]
                       (monad.map @ parse-text args))))]
 
-  [func-args     #.func-args "Looks up the arguments of a function."]
-  [type-args     #.type-args "Looks up the arguments of a parameterized type."]
-  [declared-tags #.tags      "Looks up the tags of a tagged (variant or record) type."]
+  [function-arguments #.func-args "Looks up the arguments of a function."]
+  [type-arguments     #.type-args "Looks up the arguments of a parameterized type."]
+  [declared-tags      #.tags      "Looks up the tags of a tagged (variant or record) type."]
   )
 
 (def: (find-macro' modules this-module module name)
diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux
new file mode 100644
index 000000000..a9a72ca36
--- /dev/null
+++ b/stdlib/source/program/scriptum.lux
@@ -0,0 +1,518 @@
+(.module:
+  [lux #*
+   [control
+    [pipe (#+ when>)]
+    ["." monad (#+ do)]
+    ["ex" exception (#+ exception:)]
+    [security
+     ["!" capability]]]
+   [cli (#+ program:)]
+   [data
+    ["." maybe]
+    ["." product]
+    ["." error (#+ Error)]
+    [format
+     ["md" markdown (#+ Markdown Span Block)]]
+    ["." text ("text/." equivalence)
+     format
+     ["." encoding]]
+    [collection
+     ["." sequence (#+ Sequence) ("sequence/." functor)]
+     ["." list ("list/." functor fold)]]]
+   ["." function]
+   ["." type]
+   ["." macro]
+   ["." io (#+ IO io)]
+   [world
+    ["." file (#+ File)]]])
+
+(def: name-options "abcdefghijklmnopqrstuvwxyz")
+(def: name-options-count (text.size name-options))
+
+(def: (parameter-type-name id)
+  (-> Nat Text)
+  (case (text.nth id ..name-options)
+    (#.Some char)
+    (text.from-code char)
+
+    #.None
+    (format (parameter-type-name (n// name-options-count id))
+            (parameter-type-name (n/% name-options-count id)))))
+
+(def: type-var-names
+  (Sequence Text)
+  (|> 0 (sequence.iterate inc) (sequence/map parameter-type-name)))
+
+(do-template [<name> <partition>]
+  [(def: (<name> id)
+     (-> Nat Bit)
+     (<partition> id))]
+
+  [type-func? n/even?]
+  [type-arg? n/odd?]
+  )
+
+(def: (arg-id level id)
+  (-> Nat Nat Nat)
+  (n/- (n// 2 id) level))
+
+(def: (parameter->name [type-func-name type-function-arguments] level id)
+  (-> [Text (List Text)] Nat Nat Text)
+  (if (type-arg? id)
+    (let [arg-id (..arg-id level id)]
+      (case (list.nth arg-id type-function-arguments)
+        (#.Some found)
+        found
+
+        _
+        (|> type-var-names
+            (sequence.filter (function (_ var-name)
+                               (not (list.member? text.equivalence type-function-arguments var-name))))
+            (sequence.nth arg-id))))      
+    type-func-name))
+
+(def: (level->args offset level)
+  (-> Nat Nat (List Text))
+  (if (n/= 0 level)
+    (list)
+    (|> level
+        dec
+        (list.n/range 0)
+        (list/map (|>> (n/+ (inc offset)) parameter-type-name)))))
+
+(def: (prefix-lines prefix lines)
+  (-> Text Text Text)
+  (|> lines
+      (text.split-all-with text.new-line)
+      (list/map (|>> (format prefix)))
+      (text.join-with text.new-line)))
+
+(def: (pprint-type-definition level type-func-info tags module signature? recursive-type? type)
+  (-> Nat [Text (List Text)] (List Name) Text Bit Bit Type Text)
+  (case tags
+    (^ (list [_ single-tag]))
+    (if signature?
+      (format "(: " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) text.new-line "   " single-tag ")")
+      (format "{#" single-tag " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) "}"))
+
+    _
+    (case [recursive-type? type]
+      [_ (#.Primitive name params)]
+      (case params
+        #.Nil
+        (format "(primitive " (%t name) ")")
+
+        _
+        (format "(primitive " (%t name) " " (|> params (list/map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")"))
+
+      [_ (#.Sum _)]
+      (let [members (type.flatten-variant type)]
+        (case tags
+          #.Nil
+          (format "(| "
+                  (|> members
+                      (list/map (pprint-type-definition level type-func-info #.None module signature? recursive-type?))
+                      (text.join-with " "))
+                  ")")
+
+          _
+          (|> members
+              (list.zip2 tags)
+              (list/map (function (_ [[_ t-name] type])
+                          (case type
+                            (#.Product _)
+                            (let [types (type.flatten-tuple type)]
+                              (format "(#" t-name " "
+                                      (|> types
+                                          (list/map (pprint-type-definition level type-func-info #.None module signature? recursive-type?))
+                                          (text.join-with " "))
+                                      ")"))
+
+                            _
+                            (format "(#" t-name " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) ")"))))
+              (text.join-with text.new-line))))
+
+      [_ (#.Product _)]
+      (let [members (type.flatten-tuple type)]
+        (case tags
+          #.Nil
+          (format "[" (|> members (list/map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) "]")
+
+          _
+          (let [member-docs (|> members
+                                (list.zip2 tags)
+                                (list/map (function (_ [[_ t-name] type])
+                                            (if signature?
+                                              (format "(: " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type) text.new-line "   "  t-name ")")
+                                              (format "#" t-name " " (pprint-type-definition level type-func-info #.None module signature? recursive-type? type)))))
+                                (text.join-with (format text.new-line " ")))]
+            (if signature?
+              member-docs
+              (format "{" member-docs "}")))))
+
+      [_ (#.Function input output)]
+      (let [[ins out] (type.flatten-function type)]
+        (format  "(-> " (|> ins (list/map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " "))
+                 " "
+                 (pprint-type-definition level type-func-info #.None module signature? recursive-type? out)
+                 ")"))
+
+      [_ (#.Parameter idx)]
+      (parameter->name type-func-info level idx)
+
+      (^template [<tag> <pre> <post>]
+        [_ (<tag> id)]
+        (format <pre> (%n id) <post>))
+      ([#.Var "⌈v:" "⌋"]
+       [#.Ex  "⟨e:" "⟩"])
+
+      (^template [<tag> <name> <flatten>]
+        [_ (<tag> _)]
+        (let [[level' body] (<flatten> type)
+              args (level->args level level')
+              body-doc (pprint-type-definition (n/+ level level') type-func-info tags module signature? recursive-type? body)]
+          (format "(" <name> " " "[" (text.join-with " " args) "]"
+                  (case tags
+                    #.Nil
+                    (format " " body-doc)
+
+                    _
+                    (format text.new-line (prefix-lines "  " body-doc)))
+                  ")")))
+      ([#.UnivQ "All" type.flatten-univ-q]
+       [#.ExQ   "Ex"  type.flatten-ex-q])
+
+      [true (#.Apply (#.Parameter 1) (#.Parameter 0))]
+      (product.left type-func-info)
+
+      [_ (#.Apply param fun)]
+      (let [[type-func type-arguments] (type.flatten-application type)]
+        (format  "(" (pprint-type-definition level type-func-info tags module signature? recursive-type? type-func) " " (|> type-arguments (list/map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")"))
+
+      [_ (#.Named [_module _name] type)]
+      (if (text/= module _module)
+        _name
+        (%name [_module _name]))
+      )))
+
+(def: (pprint-type level type-func-name module type)
+  (-> Nat Text Text Type Text)
+  (case type
+    (#.Primitive name params)
+    (case params
+      #.Nil
+      (format "(primitive " (%t name) ")")
+
+      _
+      (format "(primitive " (%t name) " " (|> params (list/map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")"))
+
+    (#.Sum _)
+    (let [members (type.flatten-variant type)]
+      (format "(| " (|> members (list/map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")"))
+
+    (#.Product _)
+    (let [members (type.flatten-tuple type)]
+      (format "[" (|> members (list/map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) "]"))
+
+    (#.Function input output)
+    (let [[ins out] (type.flatten-function type)]
+      (format  "(-> "
+               (|> ins (list/map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with ""))
+               " "
+               (pprint-type level type-func-name module out)
+               ")"))
+
+    (#.Parameter idx)
+    (parameter->name [type-func-name (list)] level idx)
+
+    (^template [<tag> <pre> <post>]
+      (<tag> id)
+      (format <pre> (%n id) <post>))
+    ([#.Var "⌈" "⌋"]
+     [#.Ex  "⟨" "⟩"])
+
+    (^template [<tag> <name> <flatten>]
+      (<tag> _)
+      (let [[level' body] (<flatten> type)
+            args (level->args level level')
+            body-doc (pprint-type (n/+ level level') type-func-name module body)]
+        (format "(" <name> " " "[" (|> args (list.interpose " ") (text.join-with "")) "]"
+                (format " " body-doc)
+                ")")))
+    ([#.UnivQ "All" type.flatten-univ-q]
+     [#.ExQ   "Ex"  type.flatten-ex-q])
+
+    (#.Apply param fun)
+    (let [[type-func type-arguments] (type.flatten-application type)]
+      (format  "(" (pprint-type level type-func-name module type-func) " " (|> type-arguments (list/map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")"))
+
+    (#.Named [_module _name] type)
+    (if (text/= module _module)
+      _name
+      (%name [_module _name]))
+    ))
+
+(type: (Mutation a)
+  (-> a a))
+
+(type: Value [Text Code Type])
+
+(type: Organization
+  {#types (List Value)
+   #macros (List [Text Code])
+   #structures (List Value)
+   #values (List Value)})
+
+(def: (lux-module? module-name)
+  (-> Text Bit)
+  (or (text/= "lux" module-name)
+      (text.starts-with? "lux/" module-name)))
+
+(def: (add-definition [name [def-type def-annotations def-value]] organization)
+  (-> [Text Definition] Organization Organization)
+  (cond (macro.type? def-annotations)
+        (update@ #types
+                 (: (Mutation (List Value))
+                    (|>> (#.Cons [name def-annotations (:coerce Type def-value)])))
+                 organization)
+
+        (macro.macro? def-annotations)
+        (update@ #macros
+                 (: (Mutation (List [Text Code]))
+                    (|>> (#.Cons [name def-annotations])))
+                 organization)
+
+        (macro.structure? def-annotations)
+        (update@ #structures
+                 (: (Mutation (List Value))
+                    (|>> (#.Cons [name def-annotations def-type])))
+                 organization)
+
+        ## else
+        (update@ #values
+                 (: (Mutation (List Value))
+                    (|>> (#.Cons [name def-annotations def-type])))
+                 organization)))
+
+(def: name-sort
+  (All [r] (-> [Text r] [Text r] Bit))
+  (let [text/< (:: text.order <)]
+    (function (_ [n1 _] [n2 _])
+      (text/< n1 n2))))
+
+(def: (organize-definitions defs)
+  (-> (List [Text Definition]) Organization)
+  (let [init {#types (list)
+              #macros (list)
+              #structures (list)
+              #values (list)}]
+    (|> (list/fold add-definition init defs)
+        (update@ #types (list.sort name-sort))
+        (update@ #macros (list.sort name-sort))
+        (update@ #structures (list.sort name-sort))
+        (update@ #values (list.sort name-sort)))))
+
+(def: (unravel-type-func level type)
+  (-> Nat Type Type)
+  (if (n/> 0 level)
+    (case type
+      (#.UnivQ _env _type)
+      (unravel-type-func (dec level) _type)
+
+      _
+      type)
+    type))
+
+(def: (unrecurse-type type)
+  (-> Type Type)
+  (case type
+    (#.Apply _ (#.UnivQ _env _type))
+    _type
+
+    _
+    type))
+
+(exception: #export (anonymous-type-definition {type Type})
+  (ex.report ["Type" (%type type)]))
+
+(def: (document-type module type def-annotations)
+  (-> Text Type Code (Meta (Markdown Block)))
+  (case type
+    (#.Named type-name type)
+    (do macro.monad
+      [tags (macro.tags-of type-name)
+       #let [[_ _name] type-name
+             recursive-type? (macro.recursive-type? def-annotations)
+             ## type (: Type
+             ##         (case [recursive-type? type]
+             ##           [#1 (#.Apply dummyT (#.UnivQ _closure recursiveT))]
+             ##           recursiveT
+
+             ##           _
+             ##           type))
+             type-arguments (macro.type-arguments def-annotations)
+             signature? (macro.signature? def-annotations)
+             usage (case type-arguments
+                     #.Nil
+                     _name
+
+                     _
+                     (format "(" (text.join-with " " (list& _name type-arguments)) ")"))
+             nesting (list.size type-arguments)]]
+      (wrap (md.code (format (if signature? "(signature: " "(type: ")
+                             (if recursive-type? "#rec " "")
+                             usage text.new-line
+                             (|> type
+                                 (unravel-type-func nesting)
+                                 (when> recursive-type? [unrecurse-type])
+                                 (pprint-type-definition (dec nesting) [_name type-arguments] (maybe.default (list) tags) module signature? recursive-type?)
+                                 (text.split-all-with text.new-line)
+                                 (list/map (|>> (format "  ")))
+                                 (text.join-with text.new-line))
+                             ")"))))
+
+    _
+    (macro.fail (ex.construct anonymous-type-definition type))))
+
+(def: (document-types module types)
+  (-> Text (List Value) (Meta (Markdown Block)))
+  (do macro.monad
+    [type-docs (monad.map @
+                          (: (-> Value (Meta (Markdown Block)))
+                             (function (_ [name def-annotations type])
+                               (do macro.monad
+                                 [#let [?doc (macro.get-documentation def-annotations)]
+                                  type-code (document-type module type def-annotations)]
+                                 (wrap ($_ md.then
+                                           (md.heading/3 name)
+                                           (case ?doc
+                                             (#.Some doc)
+                                             (md.paragraph (md.text doc))
+
+                                             _
+                                             md.empty)
+                                           type-code)))))
+                          types)]
+    (wrap (list/fold (function.flip md.then)
+                     (md.heading/2 "Types")
+                     type-docs))))
+
+(def: (document-macros module-name names)
+  (-> Text (List [Text Code]) (Markdown Block))
+  (|> names
+      (list/map (: (-> [Text Code] (Markdown Block))
+                   (function (_ [name def-annotations])
+                     ($_ md.then
+                         (md.heading/3 name)
+                         (<| (: (Markdown Block))
+                             (maybe.default md.empty)
+                             (do maybe.monad
+                               [documentation (macro.get-documentation def-annotations)]
+                               (wrap (md.code documentation))))))))
+      (list/fold (function.flip md.then)
+                 (md.heading/2 "Macros"))))
+
+(do-template [<singular> <plural> <header>]
+  [(def: (<singular> module type)
+     (-> Text Type (Markdown Block))
+     (md.code (pprint-type (dec 0) "?" module type)))
+
+   (def: (<plural> module values)
+     (-> Text (List Value) (Markdown Block))
+     (|> values
+         (list/map (function (_ [name def-annotations value-type])
+                     (let [?doc (macro.get-documentation def-annotations)
+                           usage (case (macro.function-arguments def-annotations)
+                                   #.Nil
+                                   name
+
+                                   args
+                                   (format "(" (text.join-with " " (list& name args)) ")"))]
+                       ($_ md.then
+                           (md.heading/3 usage)
+                           (case ?doc
+                             (#.Some doc)
+                             (md.code doc)
+
+                             _
+                             md.empty)
+                           (<singular> module value-type)))))
+         (list/fold (function.flip md.then)
+                    (md.heading/2 <header>))))]
+
+  [document-structure document-structures "Structures"]
+  [document-value     document-values     "Values"]
+  )
+
+(def: (enclose-lines pre+post block)
+  (-> [Text Text] Text Text)
+  (|> block
+      (text.split-all-with text.new-line)
+      (list/map (text.enclose pre+post))
+      (text.join-with text.new-line)))
+
+(def: (document-module [[module-name module] organization])
+  (-> [[Text Module] Organization] (Meta [Text (Markdown Block)]))
+  (do macro.monad
+    [#let [(^slots [#types #macros #structures #values]) organization
+           annotations (|> module
+                           (get@ #.module-annotations)
+                           (maybe.default (' {}))
+                           macro.get-documentation)
+           description (case annotations
+                         (#.Some doc-text)
+                         (md.quote (md.paragraph (md.text doc-text)))
+
+                         #.None
+                         md.empty)
+           empty-block (: (Markdown Block) md.empty)]
+     types-documentation (if (list.empty? types)
+                           (wrap empty-block)
+                           (document-types module-name types))
+     #let [documentation ($_ md.then
+                             types-documentation
+                             (if (list.empty? macros) empty-block (document-macros module-name macros))
+                             (if (list.empty? structures) empty-block (document-structures module-name structures))
+                             (if (list.empty? values) empty-block (document-values module-name values)))]]
+    (wrap [module-name
+           ($_ md.then
+               (md.heading/1 module-name)
+               description
+               documentation)])))
+
+(exception: #export (io-error {error Text})
+  error)
+
+(def: (save-documentation! [module-name documentation])
+  (-> [Text (Markdown Block)] (IO Any))
+  (let [path (format (text.replace-all "/" "_" module-name) ".md")]
+    (do io.monad
+      [outcome (do (error.with-error io.monad)
+                 [target (: (IO (Error (File IO)))
+                            (file.get-file io.monad file.system path))]
+                 (!.use (:: target over-write) (encoding.to-utf8 (md.markdown documentation))))]
+      (case outcome
+        (#error.Failure error)
+        (wrap (log! (ex.construct io-error error)))
+
+        (#error.Success _)
+        (wrap [])))))
+
+(macro: (gen-documentation! _)
+  (do macro.monad
+    [all-modules macro.modules
+     #let [lux-modules (|> all-modules
+                           (list.filter (function.compose lux-module? product.left))
+                           (list.sort name-sort))]
+     lux-exports (monad.map @ (function.compose macro.exports product.left)
+                            lux-modules)
+     module-documentation (|> (list/map organize-definitions lux-exports)
+                              (list.zip2 lux-modules)
+                              (monad.map @ document-module))
+     #let [_ (io.run (monad.map io.monad save-documentation! module-documentation))]]
+    (wrap (list))))
+
+(gen-documentation!)
+
+(program: args
+  (io (log! "Done!")))
-- 
cgit v1.2.3