(.module: [library [lux "*" ["." meta] [abstract [monad {"+" [do]}]] [control ["." io] ["." maybe] ["<>" parser ("#\." monad) ["<.>" code {"+" [Parser]}]]] [data ["." product] ["." text ["%" format]] [collection ["." list ("#\." functor)]]] [type abstract] [macro {"+" [with_identifiers]} [syntax {"+" [syntax:]}] ["." code] ["." template]]]]) (abstract: .public (Object brand) {} Any) (template [] [(with_expansions [ (template.identifier [ "'"])] (abstract: {} Any (type: .public (Object ))))] [Function] [Symbol] [Null] [Undefined] ) (template [ ] [(type: .public )] [Boolean Bit] [Number Frac] [String Text] ) (type: Nullable [Bit Code]) (def: nullable (Parser Nullable) (let [token (' "?")] (<| (<>.and (<>.parses? (.this! token))) (<>.after (<>.not (.this! token))) .any))) (type: Constructor (List Nullable)) (def: constructor (Parser Constructor) (.form (<>.after (.this! (' new)) (.tuple (<>.some ..nullable))))) (type: Field [Bit Text Nullable]) (def: static! (Parser Any) (.this! (' "static"))) (def: field (Parser Field) (.form ($_ <>.and (<>.parses? ..static!) .local_identifier ..nullable))) (type: Common_Method (Record [#name Text #alias (Maybe Text) #inputs (List Nullable) #io? Bit #try? Bit #output Nullable])) (type: Static_Method Common_Method) (type: Virtual_Method Common_Method) (type: Method (Variant (#Static Static_Method) (#Virtual Virtual_Method))) (def: common_method (Parser Common_Method) ($_ <>.and .local_identifier (<>.maybe (<>.after (.this! (' "as")) .local_identifier)) (.tuple (<>.some ..nullable)) (<>.parses? (.this! (' "io"))) (<>.parses? (.this! (' "try"))) ..nullable)) (def: static_method (<>.after ..static! ..common_method)) (def: method (Parser Method) (.form (<>.or ..static_method ..common_method))) (type: Member (Variant (#Constructor Constructor) (#Field Field) (#Method Method))) (def: member (Parser Member) ($_ <>.or ..constructor ..field ..method )) (def: input_variables (-> (List Nullable) (List [Bit Code])) (|>> list.enumeration (list\each (function (_ [idx [nullable? type]]) [nullable? (|> idx %.nat code.local_identifier)])))) (def: (nullable_type [nullable? type]) (-> Nullable Code) (if nullable? (` (.Maybe (~ type))) type)) (def: (with_null g!temp [nullable? input]) (-> Code [Bit Code] Code) (if nullable? (` (case (~ input) (#.Some (~ g!temp)) (~ g!temp) #.None ("js object null"))) input)) (def: .public (null _) (-> Any Nothing) (:expected ("js object null"))) (def: .public null? (-> Any Bit) (|>> "js object null?")) (def: (without_null g!temp [nullable? outputT] output) (-> Code Nullable Code Code) (if nullable? (` (let [(~ g!temp) (~ output)] (if ("js object null?" (~ g!temp)) #.None (#.Some (~ g!temp))))) (` (let [(~ g!temp) (~ output)] (if (not ("js object null?" (~ g!temp))) (~ g!temp) (.panic! "Null is an invalid value.")))))) (type: Class_Declaration [Text (List Text)]) (type: Import (Variant (#Class [Class_Declaration Text (List Member)]) (#Function Static_Method))) (def: class_declaration (Parser Class_Declaration) (<>.either (<>.and .local_identifier (<>\in (list))) (.form (<>.and .local_identifier (<>.some .local_identifier))))) (def: import (Parser Import) (<>.or (<>.and ..class_declaration (<>.else ["" (list)] (.tuple (<>.and .text (<>.some member))))) (.form ..common_method))) (def: (with_io with? without) (-> Bit Code Code) (if with? (` (io.io (~ without))) without)) (def: (io_type io? rawT) (-> Bit Code Code) (if io? (` (io.IO (~ rawT))) rawT)) (def: (with_try with? without_try) (-> Bit Code Code) (if with? (` (.try (~ without_try))) without_try)) (def: (try_type try? rawT) (-> Bit Code Code) (if try? (` (.Either .Text (~ rawT))) rawT)) (def: (make_function g!method g!temp source inputsT io? try? outputT) (-> Code Code Text (List Nullable) Bit Bit Nullable Code) (let [g!inputs (input_variables inputsT)] (` (def: ((~ g!method) [(~+ (list\each product.right g!inputs))]) (-> [(~+ (list\each nullable_type inputsT))] (~ (|> (nullable_type outputT) (try_type try?) (io_type io?)))) (:expected (~ (<| (with_io io?) (with_try try?) (without_null g!temp outputT) (` ("js apply" ("js constant" (~ (code.text source))) (~+ (list\each (with_null g!temp) g!inputs))))))))))) (syntax: .public (import: [import ..import]) (with_identifiers [g!temp g!_] (case import (#Class [[class_name class_parameters] format members]) (with_identifiers [g!object] (let [qualify (: (-> Text Code) (function (_ member_name) (|> format (text.replaced "#" class_name) (text.replaced "." member_name) code.local_identifier))) class_parameters (list\each code.local_identifier class_parameters) declaration (` ((~ (code.local_identifier class_name)) (~+ class_parameters))) real_class (text.replaced "/" "." class_name)] (in (list& (` (type: (~ declaration) (..Object (primitive (~ (code.text real_class)))))) (list\each (function (_ member) (case member (#Constructor inputsT) (let [g!inputs (input_variables inputsT)] (` (def: ((~ (qualify "new")) [(~+ (list\each product.right g!inputs))]) (All ((~ g!_) (~+ class_parameters)) (-> [(~+ (list\each nullable_type inputsT))] (~ declaration))) (:expected ("js object new" ("js constant" (~ (code.text real_class))) [(~+ (list\each (with_null g!temp) g!inputs))]))))) (#Field [static? field fieldT]) (if static? (` ((~! syntax:) ((~ (qualify field)) []) (\ (~! meta.monad) (~' in) (list (` (.:as (~ (nullable_type fieldT)) ("js constant" (~ (code.text (%.format real_class "." field)))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (All ((~ g!_) (~+ class_parameters)) (-> (~ declaration) (~ (nullable_type fieldT)))) (:expected (~ (without_null g!temp fieldT (` ("js object get" (~ (code.text field)) (~ g!object))))))))) (#Method method) (case method (#Static [method alias inputsT io? try? outputT]) (..make_function (qualify (maybe.else method alias)) g!temp (%.format real_class "." method) inputsT io? try? outputT) (#Virtual [method alias inputsT io? try? outputT]) (let [g!inputs (input_variables inputsT)] (` (def: ((~ (qualify (maybe.else method alias))) [(~+ (list\each product.right g!inputs))] (~ g!object)) (All ((~ g!_) (~+ class_parameters)) (-> [(~+ (list\each nullable_type inputsT))] (~ declaration) (~ (|> (nullable_type outputT) (try_type try?) (io_type io?))))) (:expected (~ (<| (with_io io?) (with_try try?) (without_null g!temp outputT) (` ("js object do" (~ (code.text method)) (~ g!object) [(~+ (list\each (with_null g!temp) g!inputs))]))))))))))) members))))) (#Function [name alias inputsT io? try? outputT]) (in (list (..make_function (code.local_identifier (maybe.else name alias)) g!temp name inputsT io? try? outputT))) ))) (template: .public (type_of object) [("js type-of" object)]) (syntax: .public (constant [type .any [head tail] (.tuple (<>.and .local_identifier (<>.some .local_identifier)))]) (with_identifiers [g!_] (let [constant (` ("js constant" (~ (code.text head))))] (case tail #.End (in (list (` (: (.Maybe (~ type)) (case (..type_of (~ constant)) "undefined" #.None (~ g!_) (#.Some (:as (~ type) (~ constant)))))))) (#.Item [next tail]) (let [separator "."] (in (list (` (: (.Maybe (~ type)) (case (..type_of (~ constant)) "undefined" #.None (~ g!_) (..constant (~ type) [(~ (code.local_identifier (%.format head "." next))) (~+ (list\each code.local_identifier tail))]))))))))))) (template: (!defined? ) [(.case (..constant Any ) #.None .false (#.Some _) .true)]) (template [ ] [(def: .public Bit (!defined? ))] [on_browser? [window]] [on_nashorn? [java lang Object]] ) (def: .public on_node_js? Bit (case (..constant (Object Any) [process]) (#.Some process) (case (:as Text ("js apply" ("js constant" "Object.prototype.toString.call") process)) "[object process]" true _ false) #.None false)) (template: .public (closure ) [(.:as ..Function (`` ("js function" (~~ (template.amount )) (.function (_ []) ))))])