diff options
Diffstat (limited to 'stdlib/source/program')
| -rw-r--r-- | stdlib/source/program/aedifex.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/auto.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/build.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/dependency/deployment.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/dependency/resolution.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/format.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/hash.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/input.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/parser.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/repository.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/repository/remote.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/program/compositor.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/program/compositor/import.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/program/scriptum.lux | 606 |
14 files changed, 327 insertions, 327 deletions
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 2e557839b..123433b8c 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -71,7 +71,7 @@ (list\each (|>> (/repository/remote.repository http.default #.None) /repository.async)))) (def: (with_dependencies program console command profile) - (All [a] + (All (_ a) (-> (Program Async) (Console Async) (-> (Console Async) (Program Async) (file.System Async) (Shell Async) Resolution (Command [Exit a])) (Command a))) @@ -112,7 +112,7 @@ (\ program.default exit shell.error))) (def: (command action) - (All [a] (-> (Async (Try a)) (IO Any))) + (All (_ a) (-> (Async (Try a)) (IO Any))) (exec (do async.monad [outcome action] (async.future diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index 77a0c8714..a4f6e0fca 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -44,7 +44,7 @@ (async.after delay (#try.Success []))) (def: .public (do! delay watcher command) - (All [a] + (All (_ a) (-> Nat (Watcher Async) (-> (Console Async) (Program Async) (file.System Async) (Shell Async) Resolution (Command [Exit a])) (-> (Console Async) (Program Async) (file.System Async) (Shell Async) Resolution (Command [Exit Any])))) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index ff4ace158..421fd7086 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -110,7 +110,7 @@ (exception.except ..no_available_compiler [])))) (def: (path fs home dependency) - (All [!] (-> (file.System !) Path Dependency Path)) + (All (_ !) (-> (file.System !) Path Dependency Path)) (let [/ (\ fs separator) artifact (value@ #///dependency.artifact dependency)] (|> artifact @@ -120,7 +120,7 @@ (text.suffix (format "." (value@ #///dependency.type dependency)))))) (def: (libraries fs home) - (All [!] (-> (file.System !) Path Resolution (List Path))) + (All (_ !) (-> (file.System !) Path Resolution (List Path))) (|>> dictionary.keys (list.only (|>> (value@ #///dependency.type) (text\= ///artifact/type.lux_library))) @@ -155,7 +155,7 @@ false)))) (def: .public (host_dependencies fs home) - (All [!] (-> (file.System !) Path Resolution (List Path))) + (All (_ !) (-> (file.System !) Path Resolution (List Path))) (|>> dictionary.keys (list.only (|>> (value@ #///dependency.type) (text\= ///artifact/type.lux_library) diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux index 22788dc3d..92f0b55bf 100644 --- a/stdlib/source/program/aedifex/dependency/deployment.lux +++ b/stdlib/source/program/aedifex/dependency/deployment.lux @@ -44,7 +44,7 @@ (-> (Repository Async) ///artifact.Version Dependency [Binary Status] (Async (Try Any))) (let [artifact (format (///artifact.uri version_template artifact) (///artifact/extension.extension type)) - deploy_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Async (Try Any)))) + deploy_hash (: (All (_ h) (-> (Codec Text (Hash h)) Extension (Hash h) (Async (Try Any)))) (function (_ codec extension hash) (|> hash (\ codec encoded) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 8de6d2423..a90712796 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -74,7 +74,7 @@ (trim [] java/lang/String)]) (def: (verified_hash library repository version_template artifact extension hash codec exception) - (All [h] + (All (_ h) (-> Binary (Repository Async) Version Artifact Extension (-> Binary (Hash h)) (Codec Text (Hash h)) (Exception [Artifact Extension Text]) diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux index d36d597b3..1933d2be0 100644 --- a/stdlib/source/program/aedifex/format.lux +++ b/stdlib/source/program/aedifex/format.lux @@ -68,7 +68,7 @@ (dictionary.empty text.hash)) (def: (on_maybe field value format aggregate) - (All [a] + (All (_ a) (-> Text (Maybe a) (Format a) Aggregate Aggregate)) (case value #.None @@ -78,7 +78,7 @@ (dictionary.has field (format value) aggregate))) (def: (on_list field value format aggregate) - (All [a] + (All (_ a) (-> Text (List a) (Format a) Aggregate Aggregate)) (case value #.End @@ -88,12 +88,12 @@ (dictionary.has field (` [(~+ (list\each format value))]) aggregate))) (def: (on_set field value format aggregate) - (All [a] + (All (_ a) (-> Text (Set a) (Format a) Aggregate Aggregate)) (..on_list field (set.list value) format aggregate)) (def: (on_dictionary field value key_format value_format aggregate) - (All [k v] + (All (_ k v) (-> Text (Dictionary k v) (Format k) (Format v) Aggregate Aggregate)) (if (dictionary.empty? value) aggregate diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux index 74e78ca55..403fdb677 100644 --- a/stdlib/source/program/aedifex/hash.lux +++ b/stdlib/source/program/aedifex/hash.lux @@ -40,7 +40,7 @@ Binary (def: .public data - (All [h] (-> (Hash h) Binary)) + (All (_ h) (-> (Hash h) Binary)) (|>> :representation)) (template [<name> <kind> <algorithm>] @@ -116,7 +116,7 @@ (n.* ..hex_per_byte)) (def: (decoded size constructor encoded) - (All [h] + (All (_ h) (-> Nat (-> Binary (Try (Hash h))) (-> Text (Try (Hash h))))) (let [hash_size (..hash_size encoded)] @@ -159,7 +159,7 @@ ) (implementation: .public equivalence - (All [h] (Equivalence (Hash h))) + (All (_ h) (Equivalence (Hash h))) (def: (= reference subject) (\ binary.equivalence = diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux index 43edc3404..08f309968 100644 --- a/stdlib/source/program/aedifex/input.lux +++ b/stdlib/source/program/aedifex/input.lux @@ -50,7 +50,7 @@ [(list) (<code>.result //parser.project)]))) (def: .public (read monad fs profiles) - (All [!] (-> (Monad !) (file.System !) (List Name) (! (Try Profile)))) + (All (_ !) (-> (Monad !) (file.System !) (List Name) (! (Try Profile)))) (|> //project.file (\ fs read) (\ monad each diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 8ece73b51..21c8ac270 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -38,12 +38,12 @@ (list))) (def: (singular input tag parser) - (All [a] (-> (Dictionary Text Code) Text (Parser a) (Parser a))) + (All (_ a) (-> (Dictionary Text Code) Text (Parser a) (Parser a))) (<code>.local (..as_input (dictionary.value tag input)) parser)) (def: (plural input tag parser) - (All [a] (-> (Dictionary Text Code) Text (Parser a) (Parser (List a)))) + (All (_ a) (-> (Dictionary Text Code) Text (Parser a) (Parser (List a)))) (<code>.local (..as_input (dictionary.value tag input)) (<code>.tuple (<>.some parser)))) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index d1aa5a1b9..38fb27ead 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -46,7 +46,7 @@ on_upload))) (def: .public (mock mock init) - (All [s] (-> (Mock s) s (Repository Async))) + (All (_ s) (-> (Mock s) s (Repository Async))) (let [state (stm.var init)] (implementation (def: description diff --git a/stdlib/source/program/aedifex/repository/remote.lux b/stdlib/source/program/aedifex/repository/remote.lux index d6cea3f06..af9613db7 100644 --- a/stdlib/source/program/aedifex/repository/remote.lux +++ b/stdlib/source/program/aedifex/repository/remote.lux @@ -55,7 +55,7 @@ (list ["User-Agent" ..user_agent])) (implementation: .public (repository http identity address) - (All [s] (-> (http.Client IO) (Maybe Identity) Address (//.Repository IO))) + (All (_ s) (-> (http.Client IO) (Maybe Identity) Address (//.Repository IO))) (def: description address) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 637ed76e1..bca81bd88 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -58,7 +58,7 @@ ["#." import]]) (def: (or_crash! failure_description action) - (All [a] + (All (_ a) (-> Text (Async (Try a)) (Async a))) (do async.monad [?output action] @@ -73,7 +73,7 @@ (in output)))) (def: (timed process) - (All [a] + (All (_ a) (-> (Async (Try a)) (Async (Try a)))) (do async.monad [.let [start (io.run! instant.now)] @@ -115,7 +115,7 @@ expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender service packager,package) - (All [<parameters>] + (All (_ <parameters>) (-> Static Expander analysis.Bundle diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index d05867201..230b0325e 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -30,7 +30,7 @@ [cli (#+ Library)]]) (def: Action - (type (All [a] (Async (Try a))))) + (type (All (_ a) (Async (Try a))))) (exception: .public useless_tar_entry) diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index 6841682df..438b071ec 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -36,59 +36,59 @@ ... and their documentation is generated. [test/lux (#+)]) -(def: name_options "abcdefghijklmnopqrstuvwxyz") -(def: name_options_count (text.size name_options)) - -(def: (parameter_type_name id) - (-> Nat Text) - (case (text.char id ..name_options) - (#.Some char) - (text.of_char 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.iterations ++) (sequence\each parameter_type_name))) - -(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.item arg_id type_function_arguments) - (#.Some found) - found - - _ - (|> type_var_names - (sequence.only (function (_ var_name) - (not (list.member? text.equivalence type_function_arguments var_name)))) - (sequence.item arg_id)))) - type_func_name)) - -(def: (level_parameters offset level) - (-> Nat Nat (List Text)) - (if (n.= 0 level) - (list) - (|> level - -- - (enum.range n.enum 0) - (list\each (|>> (n.+ (++ offset)) parameter_type_name))))) +... (def: parameter_name_options "abcdefghijklmnopqrstuvwxyz") +... (def: parameter_name_options_count (text.size parameter_name_options)) + +... (def: (parameter_type_name id) +... (-> Nat Text) +... (case (text.char id ..parameter_name_options) +... (#.Some char) +... (text.of_char char) + +... #.None +... (format (parameter_type_name (n./ parameter_name_options_count id)) +... (parameter_type_name (n.% parameter_name_options_count id))))) + +... (def: type_variable_names +... (Sequence Text) +... (|> 0 (sequence.iterations ++) (sequence\each parameter_type_name))) + +... (template [<name> <partition>] +... [(def: (<name> id) +... (-> Nat Bit) +... (<partition> id))] + +... [type_function? n.even?] +... [type_parameter? n.odd?] +... ) + +... (def: (parameter_id level id) +... (-> Nat Nat Nat) +... (n.- (n./ 2 id) level)) + +... (def: (parameter_name [type_function_name type_function_arguments] level id) +... (-> [Text (List Text)] Nat Nat Text) +... (if (type_parameter? id) +... (let [parameter_id (..parameter_id level id)] +... (case (list.item parameter_id type_function_arguments) +... (#.Some found) +... found + +... _ +... (|> type_variable_names +... (sequence.only (function (_ var_name) +... (not (list.member? text.equivalence type_function_arguments var_name)))) +... (sequence.item parameter_id)))) +... type_function_name)) + +... (def: (level_parameters offset level) +... (-> Nat Nat (List Text)) +... (if (n.= 0 level) +... (list) +... (|> level +... -- +... (enum.range n.enum 0) +... (list\each (|>> (n.+ (++ offset)) parameter_type_name))))) (def: (prefix_lines prefix lines) (-> Text Text Text) @@ -97,13 +97,13 @@ (list\each (|>> (format prefix))) (text.interposed text.new_line))) -(def: (pprint_type_definition level type_func_info tags module interface? recursive_type? type) +(def: (pprint_type_definition level type_function_info tags module interface? recursive_type? type) (-> Nat [Text (List Text)] (List Name) Text Bit Bit Type Text) (case tags (^ (list [_ single_tag])) (if interface? - (format "(: " (pprint_type_definition level type_func_info #.None module interface? recursive_type? type) text.new_line " " single_tag ")") - (format "{#" single_tag " " (pprint_type_definition level type_func_info #.None module interface? recursive_type? type) "}")) + (format "(: " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) text.new_line " " single_tag ")") + (format "{#" single_tag " " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) "}")) _ (case [recursive_type? type] @@ -113,7 +113,7 @@ (format "(primitive " (%.text name) ")") _ - (format "(primitive " (%.text name) " " (|> params (list\each (pprint_type_definition level type_func_info #.None module interface? recursive_type?)) (text.interposed " ")) ")")) + (format "(primitive " (%.text name) " " (|> params (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) ")")) [_ (#.Sum _)] (let [members (type.flat_variant type)] @@ -121,7 +121,7 @@ #.End (format "(Or " (|> members - (list\each (pprint_type_definition level type_func_info #.None module interface? recursive_type?)) + (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) ")") @@ -134,27 +134,27 @@ (let [types (type.flat_tuple type)] (format "(#" t_name " " (|> types - (list\each (pprint_type_definition level type_func_info #.None module interface? recursive_type?)) + (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) ")")) _ - (format "(#" t_name " " (pprint_type_definition level type_func_info #.None module interface? recursive_type? type) ")")))) + (format "(#" t_name " " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) ")")))) (text.interposed text.new_line)))) [_ (#.Product _)] (let [members (type.flat_tuple type)] (case tags #.End - (format "[" (|> members (list\each (pprint_type_definition level type_func_info #.None module interface? recursive_type?)) (text.interposed " ")) "]") + (format "[" (|> members (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) "]") _ (let [member_docs (|> members (list.zipped/2 tags) (list\each (function (_ [[_ t_name] type]) (if interface? - (format "(: " (pprint_type_definition level type_func_info #.None module interface? recursive_type? type) text.new_line " " t_name ")") - (format "#" t_name " " (pprint_type_definition level type_func_info #.None module interface? recursive_type? type))))) + (format "(: " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type) text.new_line " " t_name ")") + (format "#" t_name " " (pprint_type_definition level type_function_info #.None module interface? recursive_type? type))))) (text.interposed (format text.new_line " ")))] (if interface? member_docs @@ -162,13 +162,13 @@ [_ (#.Function input output)] (let [[ins out] (type.flat_function type)] - (format "(-> " (|> ins (list\each (pprint_type_definition level type_func_info #.None module interface? recursive_type?)) (text.interposed " ")) + (format "(-> " (|> ins (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) " " - (pprint_type_definition level type_func_info #.None module interface? recursive_type? out) + (pprint_type_definition level type_function_info #.None module interface? recursive_type? out) ")")) [_ (#.Parameter idx)] - (parameter_name type_func_info level idx) + (parameter_name type_function_info level idx) (^template [<tag> <pre> <post>] [[_ (<tag> id)] @@ -180,7 +180,7 @@ [[_ (<tag> _)] (let [[level' body] (<flat> type) args (level_parameters level level') - body_doc (pprint_type_definition (n.+ level level') type_func_info tags module interface? recursive_type? body)] + body_doc (pprint_type_definition (n.+ level level') type_function_info tags module interface? recursive_type? body)] (format "(" <name> " " "[" (text.interposed " " args) "]" (case tags #.End @@ -193,11 +193,11 @@ [#.ExQ "Ex" type.flat_ex_q]) [true (#.Apply (#.Parameter 1) (#.Parameter 0))] - (product.left type_func_info) + (product.left type_function_info) [_ (#.Apply param fun)] (let [[type_func type_arguments] (type.flat_application type)] - (format "(" (pprint_type_definition level type_func_info tags module interface? recursive_type? type_func) " " (|> type_arguments (list\each (pprint_type_definition level type_func_info #.None module interface? recursive_type?)) (text.interposed " ")) ")")) + (format "(" (pprint_type_definition level type_function_info tags module interface? recursive_type? type_func) " " (|> type_arguments (list\each (pprint_type_definition level type_function_info #.None module interface? recursive_type?)) (text.interposed " ")) ")")) [_ (#.Named [_module _name] type)] (if (text\= module _module) @@ -205,124 +205,124 @@ (%.name [_module _name])) ))) -(def: (pprint_type level type_func_name module type) - (-> Nat Text Text Type Text) - (case type - (#.Primitive name params) - (case params - #.End - (format "(primitive " (%.text name) ")") - - _ - (format "(primitive " (%.text name) " " (|> params (list\each (pprint_type level type_func_name module)) (text.interposed " ")) ")")) - - (#.Sum _) - (let [members (type.flat_variant type)] - (format "(Or " (|> members (list\each (pprint_type level type_func_name module)) (text.interposed " ")) ")")) - - (#.Product _) - (let [members (type.flat_tuple type)] - (format "[" (|> members (list\each (pprint_type level type_func_name module)) (text.interposed " ")) "]")) - - (#.Function input output) - (let [[ins out] (type.flat_function type)] - (format "(-> " - (|> ins (list\each (pprint_type level type_func_name module)) (text.interposed " ")) - " " - (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> (%.nat id) <post>)]) - ([#.Var "⌈" "⌋"] - [#.Ex "⟨" "⟩"]) - - (^template [<tag> <name> <flat>] - [(<tag> _) - (let [[level' body] (<flat> type) - args (level_parameters level level') - body_doc (pprint_type (n.+ level level') type_func_name module body)] - (format "(" <name> " " "[" (|> args (text.interposed " ")) "]" - (format " " body_doc) - ")"))]) - ([#.UnivQ "All" type.flat_univ_q] - [#.ExQ "Ex" type.flat_ex_q]) - - (#.Apply param fun) - (let [[type_func type_arguments] (type.flat_application type)] - (format "(" (pprint_type level type_func_name module type_func) " " (|> type_arguments (list\each (pprint_type level type_func_name module)) (text.interposed " ")) ")")) - - (#.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]) - #implementations (List Value) - #values (List Value)}) - -(def: (lux_module? module_name) - (-> Text Bit) - (let [prefix (format .prelude_module "/")] - (or (text\= .prelude_module module_name) - (text.starts_with? prefix module_name)))) - -(def: (add_definition [name [exported? def_type def_annotations def_value]] organization) - (-> [Text Definition] Organization Organization) - (cond (type\= .Type def_type) - (revised@ #types - (: (Mutation (List Value)) - (|>> (#.Item [name def_annotations (:as Type def_value)]))) - organization) - - (type\= .Macro def_type) - (revised@ #macros - (: (Mutation (List [Text Code])) - (|>> (#.Item [name def_annotations]))) - organization) - - (annotation.implementation? def_annotations) - (revised@ #implementations - (: (Mutation (List Value)) - (|>> (#.Item [name def_annotations def_type]))) - organization) - - ... else - (revised@ #values - (: (Mutation (List Value)) - (|>> (#.Item [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) - #implementations (list) - #values (list)}] - (|> (list\mix add_definition init defs) - (revised@ #types (list.sorted name_sort)) - (revised@ #macros (list.sorted name_sort)) - (revised@ #implementations (list.sorted name_sort)) - (revised@ #values (list.sorted name_sort))))) +... (def: (pprint_type level type_function_name module type) +... (-> Nat Text Text Type Text) +... (case type +... (#.Primitive name params) +... (case params +... #.End +... (format "(primitive " (%.text name) ")") + +... _ +... (format "(primitive " (%.text name) " " (|> params (list\each (pprint_type level type_function_name module)) (text.interposed " ")) ")")) + +... (#.Sum _) +... (let [members (type.flat_variant type)] +... (format "(Or " (|> members (list\each (pprint_type level type_function_name module)) (text.interposed " ")) ")")) + +... (#.Product _) +... (let [members (type.flat_tuple type)] +... (format "[" (|> members (list\each (pprint_type level type_function_name module)) (text.interposed " ")) "]")) + +... (#.Function input output) +... (let [[ins out] (type.flat_function type)] +... (format "(-> " +... (|> ins (list\each (pprint_type level type_function_name module)) (text.interposed " ")) +... " " +... (pprint_type level type_function_name module out) +... ")")) + +... (#.Parameter idx) +... (parameter_name [type_function_name (list)] level idx) + +... (^template [<tag> <pre> <post>] +... [(<tag> id) +... (format <pre> (%.nat id) <post>)]) +... ([#.Var "⌈" "⌋"] +... [#.Ex "⟨" "⟩"]) + +... (^template [<tag> <name> <flat>] +... [(<tag> _) +... (let [[level' body] (<flat> type) +... args (level_parameters level level') +... body_doc (pprint_type (n.+ level level') type_function_name module body)] +... (format "(" <name> " " "[" (|> args (text.interposed " ")) "]" +... (format " " body_doc) +... ")"))]) +... ([#.UnivQ "All" type.flat_univ_q] +... [#.ExQ "Ex" type.flat_ex_q]) + +... (#.Apply param fun) +... (let [[type_func type_arguments] (type.flat_application type)] +... (format "(" (pprint_type level type_function_name module type_func) " " (|> type_arguments (list\each (pprint_type level type_function_name module)) (text.interposed " ")) ")")) + +... (#.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]) +... #implementations (List Value) +... #values (List Value)}) + +... (def: (lux_module? module_name) +... (-> Text Bit) +... (let [prefix (format .prelude_module "/")] +... (or (text\= .prelude_module module_name) +... (text.starts_with? prefix module_name)))) + +... (def: (add_definition [name [exported? def_type def_annotations def_value]] organization) +... (-> [Text Definition] Organization Organization) +... (cond (type\= .Type def_type) +... (revised@ #types +... (: (Mutation (List Value)) +... (|>> (#.Item [name def_annotations (:as Type def_value)]))) +... organization) + +... (type\= .Macro def_type) +... (revised@ #macros +... (: (Mutation (List [Text Code])) +... (|>> (#.Item [name def_annotations]))) +... organization) + +... (annotation.implementation? def_annotations) +... (revised@ #implementations +... (: (Mutation (List Value)) +... (|>> (#.Item [name def_annotations def_type]))) +... organization) + +... ... else +... (revised@ #values +... (: (Mutation (List Value)) +... (|>> (#.Item [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) +... #implementations (list) +... #values (list)}] +... (|> (list\mix add_definition init defs) +... (revised@ #types (list.sorted name_sort)) +... (revised@ #macros (list.sorted name_sort)) +... (revised@ #implementations (list.sorted name_sort)) +... (revised@ #values (list.sorted name_sort))))) (def: (unravel_type_func level type) (-> Nat Type Type) @@ -403,119 +403,119 @@ (md.heading/2 "Types") type_docs)))) -(def: (document_macros module_name names) - (-> Text (List [Text Code]) (Markdown Block)) - (|> names - (list\each (: (-> [Text Code] (Markdown Block)) - (function (_ [name def_annotations]) - ($_ md.then - (md.heading/3 name) - (<| (: (Markdown Block)) - (maybe.else md.empty) - (do maybe.monad - [documentation (annotation.documentation def_annotations)] - (in (md.code documentation)))))))) - (list\mix (function.flipped md.then) - (md.heading/2 "Macros")))) - -(template [<singular> <plural> <header>] - [(def: (<singular> module type) - (-> Text Type (Markdown Block)) - (md.code (pprint_type (-- 0) "?" module type))) - - (def: (<plural> module values) - (-> Text (List Value) (Markdown Block)) - (|> values - (list\each (function (_ [name def_annotations value_type]) - (let [?doc (annotation.documentation def_annotations) - usage (case (annotation.function_arguments def_annotations) - #.End - name - - args - (format "(" (text.interposed " " (list& name args)) ")"))] - ($_ md.then - (md.heading/3 usage) - (case ?doc - (#.Some doc) - (md.code doc) - - _ - md.empty) - (<singular> module value_type))))) - (list\mix (function.flipped md.then) - (md.heading/2 <header>))))] - - [document_implementation document_implementations "Implementations"] - [document_value document_values "Values"] - ) - -(def: (enclose_lines pre+post block) - (-> [Text Text] Text Text) - (|> block - (text.all_split_by text.new_line) - (list\each (text.enclosed pre+post)) - (text.interposed text.new_line))) - -(def: (document_module [[module_name module] organization]) - (-> [[Text Module] Organization] (Meta [Text (Markdown Block)])) - (do meta.monad - [.let [(^slots [#types #macros #implementations #values]) organization - annotations (|> module - (value@ #.module_annotations) - (maybe.else (' {})) - annotation.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) - (in 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)))]] - (in [module_name - ($_ md.then - (md.heading/1 module_name) - description - documentation)]))) - -(exception: .public (io_error {error Text}) - error) - -(def: (save_documentation! [module_name documentation]) - (-> [Text (Markdown Block)] (IO Any)) - (let [path (format (text.replaced "/" "_" module_name) ".md")] - (do io.monad - [outcome (\ file.default write (\ utf8.codec encoded (md.markdown documentation)) path)] - (in (case outcome - (#try.Failure error) - (debug.log! (exception.error io_error error)) - - (#try.Success _) - []))))) - -(macro: (gen_documentation! _) - (do {! meta.monad} - [all_modules meta.modules - .let [lux_modules (|> all_modules - (list.only (function.composite lux_module? product.left)) - (list.sorted name_sort))] - lux_exports (monad.each ! (function.composite meta.exports product.left) - lux_modules) - module_documentation (|> (list\each organize_definitions lux_exports) - (list.zipped/2 lux_modules) - (monad.each ! document_module)) - .let [_ (io.run! (monad.each io.monad save_documentation! module_documentation))]] - (in (list)))) - -(gen_documentation!) - -(program: args - (io (debug.log! "Done!"))) +... (def: (document_macros module_name names) +... (-> Text (List [Text Code]) (Markdown Block)) +... (|> names +... (list\each (: (-> [Text Code] (Markdown Block)) +... (function (_ [name def_annotations]) +... ($_ md.then +... (md.heading/3 name) +... (<| (: (Markdown Block)) +... (maybe.else md.empty) +... (do maybe.monad +... [documentation (annotation.documentation def_annotations)] +... (in (md.code documentation)))))))) +... (list\mix (function.flipped md.then) +... (md.heading/2 "Macros")))) + +... (template [<singular> <plural> <header>] +... [(def: (<singular> module type) +... (-> Text Type (Markdown Block)) +... (md.code (pprint_type (-- 0) "?" module type))) + +... (def: (<plural> module values) +... (-> Text (List Value) (Markdown Block)) +... (|> values +... (list\each (function (_ [name def_annotations value_type]) +... (let [?doc (annotation.documentation def_annotations) +... usage (case (annotation.function_arguments def_annotations) +... #.End +... name + +... args +... (format "(" (text.interposed " " (list& name args)) ")"))] +... ($_ md.then +... (md.heading/3 usage) +... (case ?doc +... (#.Some doc) +... (md.code doc) + +... _ +... md.empty) +... (<singular> module value_type))))) +... (list\mix (function.flipped md.then) +... (md.heading/2 <header>))))] + +... [document_implementation document_implementations "Implementations"] +... [document_value document_values "Values"] +... ) + +... (def: (enclose_lines pre+post block) +... (-> [Text Text] Text Text) +... (|> block +... (text.all_split_by text.new_line) +... (list\each (text.enclosed pre+post)) +... (text.interposed text.new_line))) + +... (def: (document_module [[module_name module] organization]) +... (-> [[Text Module] Organization] (Meta [Text (Markdown Block)])) +... (do meta.monad +... [.let [(^slots [#types #macros #implementations #values]) organization +... annotations (|> module +... (value@ #.module_annotations) +... (maybe.else (' {})) +... annotation.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) +... (in 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)))]] +... (in [module_name +... ($_ md.then +... (md.heading/1 module_name) +... description +... documentation)]))) + +... (exception: .public (io_error {error Text}) +... error) + +... (def: (save_documentation! [module_name documentation]) +... (-> [Text (Markdown Block)] (IO Any)) +... (let [path (format (text.replaced "/" "_" module_name) ".md")] +... (do io.monad +... [outcome (\ file.default write (\ utf8.codec encoded (md.markdown documentation)) path)] +... (in (case outcome +... (#try.Failure error) +... (debug.log! (exception.error io_error error)) + +... (#try.Success _) +... []))))) + +... (macro: (gen_documentation! _) +... (do {! meta.monad} +... [all_modules meta.modules +... .let [lux_modules (|> all_modules +... (list.only (function.composite lux_module? product.left)) +... (list.sorted name_sort))] +... lux_exports (monad.each ! (function.composite meta.exports product.left) +... lux_modules) +... module_documentation (|> (list\each organize_definitions lux_exports) +... (list.zipped/2 lux_modules) +... (monad.each ! document_module)) +... .let [_ (io.run! (monad.each io.monad save_documentation! module_documentation))]] +... (in (list)))) + +... (gen_documentation!) + +... (program: args +... (io (debug.log! "Done!"))) |