(.using [library [lux {"-" Symbol} ["[0]" meta] [abstract [monad {"+" do}]] [control ["[0]" io] ["[0]" maybe] ["<>" parser ("[1]#[0]" monad) ["<[0]>" code {"+" Parser}]]] [data ["[0]" product] ["[0]" text ["%" format]] [collection ["[0]" list ("[1]#[0]" functor)]]] [type abstract] [macro {"+" with_symbols} [syntax {"+" syntax:}] ["[0]" code] ["[0]" template]]]]) (abstract: .public (Object brand) Any) (template [] [(with_expansions [ (template.symbol [ "'"])] (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_symbol ..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_symbol (<>.maybe (<>.after (.this! (' "as")) .local_symbol)) (.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_symbol)])))) (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_symbol (<>#in (list))) (.form (<>.and .local_symbol (<>.some .local_symbol))))) (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_symbols [g!temp g!_] (case import {#Class [[class_name class_parameters] format members]} (with_symbols [g!object] (let [qualify (: (-> Text Code) (function (_ member_name) (|> format (text.replaced "[1]" class_name) (text.replaced "[0]" member_name) code.local_symbol))) class_parameters (list#each code.local_symbol class_parameters) declaration (` ((~ (code.local_symbol 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_symbol (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_symbol (<>.some .local_symbol)))]) (with_symbols [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_symbol (%.format head "." next))) (~+ (list#each code.local_symbol 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 (_ []) ))))])