diff options
author | Eduardo Julian | 2017-08-27 11:58:36 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-08-27 11:58:36 -0400 |
commit | 4ecf0d69f7b983722f5b0024992e9b510bea5a2f (patch) | |
tree | e8f30b202195ea891c067673faeac0ead10d99a0 /luxdoc | |
parent | 11ad64c0cf9da63e10bbb9bfe6e81168013b954e (diff) |
- Integrated documentation into the main repo (powered by mkdocs).
Diffstat (limited to 'luxdoc')
-rw-r--r-- | luxdoc/project.clj | 11 | ||||
-rw-r--r-- | luxdoc/source/program.lux | 601 |
2 files changed, 612 insertions, 0 deletions
diff --git a/luxdoc/project.clj b/luxdoc/project.clj new file mode 100644 index 000000000..f2e960afb --- /dev/null +++ b/luxdoc/project.clj @@ -0,0 +1,11 @@ +(defproject luxdoc "0.5.0" + :description "Documentation generator for the Lux programming language's ." + :url "https://github.com/LuxLang/luxdoc" + :license {:name "Mozilla Public License (Version 2.0)" + :url "https://www.mozilla.org/en-US/MPL/2.0/"} + :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 new file mode 100644 index 000000000..4e1c1c6b4 --- /dev/null +++ b/luxdoc/source/program.lux @@ -0,0 +1,601 @@ +## 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 (:! 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? "(sig: " "(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 "<" "<") + (text;replace ">" ">"))] + 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 "<" "<") + (text;replace ">" ">"))] + (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 "<" "<") + (text;replace ">" ">"))] + (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!"))) |