diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/program/scriptum.lux | 448 |
1 files changed, 225 insertions, 223 deletions
diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index 420b40a8b..cdbdb0569 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -1,171 +1,174 @@ (.module: - [lux #* - [abstract - ["." monad (#+ do)] - ["." enum]] - [control - [pipe (#+ when>)] - ["." try (#+ Try)] - ["ex" exception (#+ exception:)] - [security - ["!" capability]]] - [cli (#+ program:)] - [data - ["." maybe] - ["." product] - [number - ["n" nat]] - [format - ["md" markdown (#+ Markdown Span Block)]] - ["." text ("#\." equivalence) - ["%" format (#+ format)] - ["." encoding]] - [collection - ["." sequence (#+ Sequence) ("#\." functor)] - ["." list ("#\." functor fold)]]] - ["." function] - ["." type ("#\." equivalence)] - ["." macro] - ["." io (#+ IO io)] - [world - ["." file (#+ File)]]] + [library + [lux #* + [program (#+ program:)] + ["." type ("#\." equivalence)] + ["." debug] + [abstract + ["." monad (#+ do)] + ["." enum]] + [control + [pipe (#+ when> new>)] + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + ["." function]] + [data + ["." maybe] + ["." product] + [format + ["md" markdown (#+ Markdown Span Block)]] + ["." text ("#\." equivalence) + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." sequence (#+ Sequence) ("#\." functor)] + ["." list ("#\." functor fold)]]] + [math + [number + ["n" nat]]] + ["." meta + ["." annotation]] + [world + ["." file]]]] ## This was added to make sure that all tested modules are picked up ## and their documentation is generated. [test/lux (#+)]) -(def: name-options "abcdefghijklmnopqrstuvwxyz") -(def: name-options-count (text.size name-options)) +(def: name_options "abcdefghijklmnopqrstuvwxyz") +(def: name_options_count (text.size name_options)) -(def: (parameter-type-name id) +(def: (parameter_type_name id) (-> Nat Text) - (case (text.nth id ..name-options) + (case (text.nth id ..name_options) (#.Some char) - (text.from-code char) + (text.from_code char) #.None - (format (parameter-type-name (n./ name-options-count id)) - (parameter-type-name (n.% name-options-count id))))) + (format (parameter_type_name (n./ name_options_count id)) + (parameter_type_name (n.% name_options_count id))))) -(def: type-var-names +(def: type_var_names (Sequence Text) - (|> 0 (sequence.iterate inc) (sequence\map parameter-type-name))) + (|> 0 (sequence.iterate inc) (sequence\map parameter_type_name))) (template [<name> <partition>] [(def: (<name> id) (-> Nat Bit) (<partition> id))] - [type-func? n.even?] - [type-arg? n.odd?] + [type_func? n.even?] + [type_arg? n.odd?] ) -(def: (arg-id level id) +(def: (arg_id level id) (-> Nat Nat Nat) (n.- (n./ 2 id) level)) -(def: (parameter->name [type-func-name type-function-arguments] level id) +(def: (parameter_to_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) + (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)) + (|> 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) +(def: (level_to_args offset level) (-> Nat Nat (List Text)) (if (n.= 0 level) (list) (|> level dec (enum.range n.enum 0) - (list\map (|>> (n.+ (inc offset)) parameter-type-name))))) + (list\map (|>> (n.+ (inc offset)) parameter_type_name))))) -(def: (prefix-lines prefix lines) +(def: (prefix_lines prefix lines) (-> Text Text Text) (|> lines - (text.split-all-with text.new-line) + (text.split_all_with text.new_line) (list\map (|>> (format prefix))) - (text.join-with text.new-line))) + (text.join_with text.new_line))) -(def: (pprint-type-definition level type-func-info tags module signature? recursive-type? type) +(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])) + (^ (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) "}")) + (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] + (case [recursive_type? type] [_ (#.Primitive name params)] (case params #.Nil (format "(primitive " (%.text name) ")") _ - (format "(primitive " (%.text name) " " (|> params (list\map (pprint-type-definition level type-func-info #.None module signature? recursive-type?)) (text.join-with " ")) ")")) + (format "(primitive " (%.text 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)] + (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 " ")) + (list\map (pprint_type_definition level type_func_info #.None module signature? recursive_type?)) + (text.join_with " ")) ")") _ (|> members (list.zip/2 tags) - (list\map (function (_ [[_ t-name] type]) + (list\map (function (_ [[_ t_name] type]) (case type (#.Product _) - (let [types (type.flatten-tuple type)] - (format "(#" t-name " " + (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 " ")) + (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)))) + (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)] + (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 " ")) "]") + (format "[" (|> members (list\map (pprint_type_definition level type_func_info #.None module signature? recursive_type?)) (text.join_with " ")) "]") _ - (let [member-docs (|> members + (let [member_docs (|> members (list.zip/2 tags) - (list\map (function (_ [[_ t-name] type]) + (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 " ")))] + (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 "}"))))) + 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 " ")) + (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) + (pprint_type_definition level type_func_info #.None module signature? recursive_type? out) ")")) [_ (#.Parameter idx)] - (parameter->name type-func-info level idx) + (parameter_to_name type_func_info level idx) (^template [<tag> <pre> <post>] [[_ (<tag> id)] @@ -176,25 +179,25 @@ (^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) "]" + args (level_to_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 " " body_doc) _ - (format text.new-line (prefix-lines " " body-doc))) + (format text.new_line (prefix_lines " " body_doc))) ")"))]) - ([#.UnivQ "All" type.flatten-univ-q] - [#.ExQ "Ex" type.flatten-ex-q]) + ([#.UnivQ "All" type.flatten_univ_q] + [#.ExQ "Ex" type.flatten_ex_q]) [true (#.Apply (#.Parameter 1) (#.Parameter 0))] - (product.left type-func-info) + (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 " ")) ")")) + (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) @@ -202,7 +205,7 @@ (%.name [_module _name])) ))) -(def: (pprint-type level type-func-name module type) +(def: (pprint_type level type_func_name module type) (-> Nat Text Text Type Text) (case type (#.Primitive name params) @@ -211,26 +214,26 @@ (format "(primitive " (%.text name) ")") _ - (format "(primitive " (%.text name) " " (|> params (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) ")")) + (format "(primitive " (%.text 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 "")) ")")) + (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 "")) "]")) + (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)] + (let [[ins out] (type.flatten_function type)] (format "(-> " - (|> ins (list\map (pprint-type level type-func-name module)) (list.interpose " ") (text.join-with "")) + (|> ins (list\map (pprint_type level type_func_name module)) (list.interpose " ") (text.join_with "")) " " - (pprint-type level type-func-name module out) + (pprint_type level type_func_name module out) ")")) (#.Parameter idx) - (parameter->name [type-func-name (list)] level idx) + (parameter_to_name [type_func_name (list)] level idx) (^template [<tag> <pre> <post>] [(<tag> id) @@ -241,17 +244,17 @@ (^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) + args (level_to_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]) + ([#.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 "")) ")")) + (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) @@ -262,7 +265,8 @@ (type: (Mutation a) (-> a a)) -(type: Value [Text Code Type]) +(type: Value + [Text Code Type]) (type: Organization {#types (List Value) @@ -270,68 +274,68 @@ #implementations (List Value) #values (List Value)}) -(def: (lux-module? module-name) +(def: (lux_module? module_name) (-> Text Bit) (let [prefix (format .prelude_module "/")] - (or (text\= .prelude_module module-name) - (text.starts-with? prefix module-name)))) + (or (text\= .prelude_module module_name) + (text.starts_with? prefix module_name)))) -(def: (add-definition [name [def-type def-annotations def-value]] organization) +(def: (add_definition [name [exported? def_type def_annotations def_value]] organization) (-> [Text Definition] Organization Organization) - (cond (type\= .Type def-type) + (cond (type\= .Type def_type) (update@ #types (: (Mutation (List Value)) - (|>> (#.Cons [name def-annotations (:as Type def-value)]))) + (|>> (#.Cons [name def_annotations (:as Type def_value)]))) organization) - (type\= .Macro def-type) + (type\= .Macro def_type) (update@ #macros (: (Mutation (List [Text Code])) - (|>> (#.Cons [name def-annotations]))) + (|>> (#.Cons [name def_annotations]))) organization) - (macro.implementation? def-annotations) + (annotation.implementation? def_annotations) (update@ #implementations (: (Mutation (List Value)) - (|>> (#.Cons [name def-annotations def-type]))) + (|>> (#.Cons [name def_annotations def_type]))) organization) ## else (update@ #values (: (Mutation (List Value)) - (|>> (#.Cons [name def-annotations def-type]))) + (|>> (#.Cons [name def_annotations def_type]))) organization))) -(def: name-sort +(def: name_sort (All [r] (-> [Text r] [Text r] Bit)) (let [text\< (\ text.order <)] (function (_ [n1 _] [n2 _]) (text\< n1 n2)))) -(def: (organize-definitions defs) +(def: (organize_definitions defs) (-> (List [Text Definition]) Organization) (let [init {#types (list) #macros (list) #implementations (list) #values (list)}] - (|> (list\fold add-definition init defs) - (update@ #types (list.sort name-sort)) - (update@ #macros (list.sort name-sort)) - (update@ #implementations (list.sort name-sort)) - (update@ #values (list.sort name-sort))))) + (|> (list\fold add_definition init defs) + (update@ #types (list.sort name_sort)) + (update@ #macros (list.sort name_sort)) + (update@ #implementations (list.sort name_sort)) + (update@ #values (list.sort name_sort))))) -(def: (unravel-type-func level type) +(def: (unravel_type_func level type) (-> Nat Type Type) (if (n.> 0 level) (case type (#.UnivQ _env _type) - (unravel-type-func (dec level) _type) + (unravel_type_func (dec level) _type) _ type) type)) -(def: (unrecurse-type type) +(def: (unrecurse_type type) (-> Type Type) (case type (#.Apply _ (#.UnivQ _env _type)) @@ -340,50 +344,51 @@ _ type)) -(exception: #export (anonymous-type-definition {type Type}) - (ex.report ["Type" (%.type type)])) +(exception: #export (anonymous_type_definition {type Type}) + (exception.report + ["Type" (%.type type)])) -(def: (document-type module type def-annotations) +(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-arguments (macro.type-arguments def-annotations) - signature? (macro.signature? def-annotations) - usage (case type-arguments + (#.Named type_name type) + (do meta.monad + [tags (meta.tags_of type_name) + #let [[_ _name] type_name + recursive_type? (annotation.recursive_type? def_annotations) + type_arguments (annotation.type_arguments def_annotations) + signature? (annotation.signature? def_annotations) + usage (case type_arguments #.Nil _name _ - (format "(" (text.join-with " " (list& _name type-arguments)) ")")) - nesting (list.size type-arguments)]] + (format "(" (text.join_with " " (list& _name type_arguments)) ")")) + nesting (list.size type_arguments)]] (wrap (md.code (format (if signature? "(interface: " "(type: ") - (if recursive-type? "#rec " "") - usage text.new-line + (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) + (unravel_type_func nesting) + (when> [(new> 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)) + (text.join_with text.new_line)) ")")))) _ - (macro.fail (ex.construct anonymous-type-definition type)))) + (meta.fail (exception.construct anonymous_type_definition type)))) -(def: (document-types module types) +(def: (document_types module types) (-> Text (List Value) (Meta (Markdown Block))) - (do {! macro.monad} - [type-docs (monad.map ! + (do {! meta.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)] + (function (_ [name def_annotations type]) + (do meta.monad + [#let [?doc (annotation.documentation def_annotations)] + type_code (document_type module type def_annotations)] (wrap ($_ md.then (md.heading/3 name) (case ?doc @@ -392,23 +397,23 @@ _ md.empty) - type-code))))) + type_code))))) types)] (wrap (list\fold (function.flip md.then) (md.heading/2 "Types") - type-docs)))) + type_docs)))) -(def: (document-macros module-name names) +(def: (document_macros module_name names) (-> Text (List [Text Code]) (Markdown Block)) (|> names (list\map (: (-> [Text Code] (Markdown Block)) - (function (_ [name def-annotations]) + (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)] + [documentation (annotation.documentation def_annotations)] (wrap (md.code documentation)))))))) (list\fold (function.flip md.then) (md.heading/2 "Macros")))) @@ -416,19 +421,19 @@ (template [<singular> <plural> <header>] [(def: (<singular> module type) (-> Text Type (Markdown Block)) - (md.code (pprint-type (dec 0) "?" module type))) + (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) + (list\map (function (_ [name def_annotations value_type]) + (let [?doc (annotation.documentation def_annotations) + usage (case (annotation.function_arguments def_annotations) #.Nil name args - (format "(" (text.join-with " " (list& name args)) ")"))] + (format "(" (text.join_with " " (list& name args)) ")"))] ($_ md.then (md.heading/3 usage) (case ?doc @@ -437,83 +442,80 @@ _ md.empty) - (<singular> module value-type))))) + (<singular> module value_type))))) (list\fold (function.flip md.then) (md.heading/2 <header>))))] - [document-implementation document-implementations "Implementations"] - [document-value document-values "Values"] + [document_implementation document_implementations "Implementations"] + [document_value document_values "Values"] ) -(def: (enclose-lines pre+post block) +(def: (enclose_lines pre+post block) (-> [Text Text] Text Text) (|> block - (text.split-all-with text.new-line) + (text.split_all_with text.new_line) (list\map (text.enclose pre+post)) - (text.join-with text.new-line))) + (text.join_with text.new_line))) -(def: (document-module [[module-name module] organization]) +(def: (document_module [[module_name module] organization]) (-> [[Text Module] Organization] (Meta [Text (Markdown Block)])) - (do macro.monad + (do meta.monad [#let [(^slots [#types #macros #implementations #values]) organization annotations (|> module - (get@ #.module-annotations) + (get@ #.module_annotations) (maybe.default (' {})) - macro.get-documentation) + annotation.documentation) description (case annotations - (#.Some doc-text) - (md.quote (md.paragraph (md.text doc-text))) + (#.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)) + 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? implementations) empty-block (document-implementations module-name implementations)) - (if (list.empty? values) empty-block (document-values module-name values)))]] - (wrap [module-name + types_documentation + (if (list.empty? macros) empty_block (document_macros module_name macros)) + (if (list.empty? implementations) empty_block (document_implementations module_name implementations)) + (if (list.empty? values) empty_block (document_values module_name values)))]] + (wrap [module_name ($_ md.then - (md.heading/1 module-name) + (md.heading/1 module_name) description documentation)]))) -(exception: #export (io-error {error Text}) +(exception: #export (io_error {error Text}) error) -(def: (save-documentation! [module-name documentation]) +(def: (save_documentation! [module_name documentation]) (-> [Text (Markdown Block)] (IO Any)) - (let [path (format (text.replace-all "/" "_" module-name) ".md")] + (let [path (format (text.replace_all "/" "_" module_name) ".md")] (do io.monad - [outcome (do (try.with io.monad) - [target (: (IO (Try (File IO))) - (file.get-file io.monad file.default path))] - (!.use (\ target over-write) (\ encoding.utf8 encode (md.markdown documentation))))] - (case outcome - (#try.Failure error) - (wrap (log! (ex.construct io-error error))) - - (#try.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.zip/2 lux-modules) - (monad.map ! document-module)) - #let [_ (io.run (monad.map io.monad save-documentation! module-documentation))]] + [outcome (\ file.default write (\ utf8.codec encode (md.markdown documentation)) path)] + (wrap (case outcome + (#try.Failure error) + (debug.log! (exception.construct io_error error)) + + (#try.Success _) + []))))) + +(macro: (gen_documentation! _) + (do {! meta.monad} + [all_modules meta.modules + #let [lux_modules (|> all_modules + (list.filter (function.compose lux_module? product.left)) + (list.sort name_sort))] + lux_exports (monad.map ! (function.compose meta.exports product.left) + lux_modules) + module_documentation (|> (list\map organize_definitions lux_exports) + (list.zip/2 lux_modules) + (monad.map ! document_module)) + #let [_ (io.run (monad.map io.monad save_documentation! module_documentation))]] (wrap (list)))) -(gen-documentation!) +(gen_documentation!) (program: args - (io (log! "Done!"))) + (io (debug.log! "Done!"))) |