diff options
| -rw-r--r-- | stdlib/source/lux/control/concurrency/actor.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/host.jvm.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/host.old.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/lux/macro.lux | 93 | ||||
| -rw-r--r-- | stdlib/source/lux/meta/annotation.lux | 95 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/language/lux/syntax.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/lux/type/implicit.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex.lux | 19 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/cli.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/auto.lux | 141 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/build.lux (renamed from stdlib/source/program/aedifex/build.lux) | 72 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/test.lux | 29 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/code.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/annotation.lux | 178 |
18 files changed, 578 insertions, 171 deletions
diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 660b6a9a0..fb782b169 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -24,6 +24,8 @@ ["cs" common ["csr" reader] ["csw" writer]]]] + [meta + ["." annotation]] [type abstract]] [// @@ -196,7 +198,7 @@ (<resolve> de-aliased) (#.Right [_ _ annotations _]) - (case (macro.get-tag-ann (name-of <tag>) annotations) + (case (annotation.tag (name-of <tag>) annotations) (#.Some actor-name) (wrap actor-name) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index c59de8e92..4664a266f 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -27,6 +27,8 @@ [syntax (#+ syntax:)] ["." code] ["." template]] + [meta + ["." annotation]] [target [jvm [encoding @@ -407,7 +409,7 @@ definitions (macro.definitions current-module)] (wrap (list@fold (: (-> [Text Definition] Context Context) (function (_ [short-name [_ _ meta _]] imports) - (case (macro.get-text-ann (name-of #..jvm-class) meta) + (case (annotation.text (name-of #..jvm-class) meta) (#.Some full-class-name) (add-import [short-name full-class-name] imports) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 906ccf639..59f6dd659 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -22,7 +22,9 @@ ["." type ("#@." equivalence)] ["." macro (#+ with-gensyms) ["." code] - [syntax (#+ syntax:)]]]) + [syntax (#+ syntax:)]] + [meta + ["." annotation]]]) (template [<name> <op> <from> <to>] [(def: #export (<name> value) @@ -371,7 +373,7 @@ definitions (macro.definitions current-module)] (wrap (list@fold (: (-> [Text Definition] Class-Imports Class-Imports) (function (_ [short-name [_ _ meta _]] imports) - (case (macro.get-text-ann (name-of #..jvm-class) meta) + (case (annotation.text (name-of #..jvm-class) meta) (#.Some full-class-name) (add-import [short-name full-class-name] imports) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index d3176cd4b..3dadc236d 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -149,99 +149,6 @@ [this-module-name current-module-name] (find-module this-module-name))) -(def: #export (get-ann tag anns) - {#.doc "Looks-up a particular annotation's value within the set of annotations."} - (-> Name Code (Maybe Code)) - (case anns - [_ (#.Record anns)] - (loop [anns anns] - (case anns - (#.Cons [key value] anns') - (case key - [_ (#.Tag tag')] - (if (name@= tag tag') - (#.Some value) - (recur anns')) - - _ - (recur anns')) - - #.Nil - #.None)) - - _ - #.None)) - -(template [<name> <tag> <type>] - [(def: #export (<name> tag anns) - (-> Name Code (Maybe <type>)) - (case (get-ann tag anns) - (#.Some [_ (<tag> value)]) - (#.Some value) - - _ - #.None))] - - [get-bit-ann #.Bit Bit] - [get-int-ann #.Int Int] - [get-frac-ann #.Frac Frac] - [get-text-ann #.Text Text] - [get-identifier-ann #.Identifier Name] - [get-tag-ann #.Tag Name] - [get-form-ann #.Form (List Code)] - [get-tuple-ann #.Tuple (List Code)] - [get-record-ann #.Record (List [Code Code])] - ) - -(def: #export (get-documentation anns) - {#.doc "Looks-up a definition's documentation."} - (-> Code (Maybe Text)) - (get-text-ann (name-of #.doc) anns)) - -(def: #export (flag-set? flag-name anns) - {#.doc "Finds out whether an annotation-as-a-flag is set (has value '#1')."} - (-> Name Code Bit) - (maybe.default #0 (get-bit-ann flag-name anns))) - -(template [<name> <tag> <desc>] - [(def: #export <name> - {#.doc (code.text ($_ text@compose "Checks whether a definition is " <desc> "."))} - (-> Code Bit) - (flag-set? (name-of <tag>)))] - - [structure? #.struct? "a structure"] - [recursive-type? #.type-rec? "a recursive type"] - [signature? #.sig? "a signature"] - ) - -(template [<name> <tag> <type>] - [(def: (<name> input) - (-> Code (Maybe <type>)) - (case input - [_ (<tag> actual-value)] - (#.Some actual-value) - - _ - #.None))] - - [parse-tuple #.Tuple (List Code)] - [parse-text #.Text Text] - ) - -(template [<name> <tag> <desc>] - [(def: #export (<name> anns) - {#.doc <desc>} - (-> Code (List Text)) - (maybe.default (list) - (do {@ maybe.monad} - [_args (get-ann (name-of <tag>) anns) - args (parse-tuple _args)] - (monad.map @ parse-text args))))] - - [function-arguments #.func-args "Looks up the arguments of a function."] - [type-arguments #.type-args "Looks up the arguments of a parameterized type."] - ) - (def: (macro-type? type) (-> Type Bit) (case type diff --git a/stdlib/source/lux/meta/annotation.lux b/stdlib/source/lux/meta/annotation.lux new file mode 100644 index 000000000..fa412d6d0 --- /dev/null +++ b/stdlib/source/lux/meta/annotation.lux @@ -0,0 +1,95 @@ +(.module: + [lux (#- nat int rev) + [abstract + ["." monad (#+ do)]] + [data + ["." maybe] + ["." name ("#@." equivalence)] + ["." text ("#@." monoid)]]]) + +(type: #export Annotation + Code) + +(def: #export (value tag ann) + (-> Name Annotation (Maybe Code)) + (case ann + [_ (#.Record ann)] + (loop [ann ann] + (case ann + (#.Cons [key value] ann') + (case key + [_ (#.Tag tag')] + (if (name@= tag tag') + (#.Some value) + (recur ann')) + + _ + (recur ann')) + + #.Nil + #.None)) + + _ + #.None)) + +(template [<name> <tag> <type>] + [(def: #export (<name> tag ann) + (-> Name Annotation (Maybe <type>)) + (case (..value tag ann) + (#.Some [_ (<tag> value)]) + (#.Some value) + + _ + #.None))] + + [bit #.Bit Bit] + [nat #.Nat Nat] + [int #.Int Int] + [rev #.Rev Rev] + [frac #.Frac Frac] + [text #.Text Text] + [identifier #.Identifier Name] + [tag #.Tag Name] + [form #.Form (List Code)] + [tuple #.Tuple (List Code)] + [record #.Record (List [Code Code])] + ) + +(def: #export documentation + (-> Annotation (Maybe Text)) + (..text (name-of #.doc))) + +(def: #export (flagged? flag) + (-> Name Annotation Bit) + (|>> (..bit flag) (maybe.default false))) + +(template [<name> <tag>] + [(def: #export <name> + (-> Annotation Bit) + (..flagged? (name-of <tag>)))] + + [structure? #.struct?] + [recursive-type? #.type-rec?] + [signature? #.sig?] + ) + +(def: (parse-text input) + (-> Code (Maybe Text)) + (case input + [_ (#.Text actual-value)] + (#.Some actual-value) + + _ + #.None)) + +(template [<name> <tag>] + [(def: #export (<name> ann) + (-> Annotation (List Text)) + (maybe.default (list) + (do {@ maybe.monad} + [args (..tuple (name-of <tag>) ann)] + (monad.map @ ..parse-text args))))] + + [function-arguments #.func-args] + [type-arguments #.type-args] + ) diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux index 0b938b49a..8b6808a2c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux @@ -331,7 +331,7 @@ (and (or (!n/= (char "e") char/0) (!n/= (char "E") char/0)) - (not (is? ..no-exponent exponent))) + (is? ..no-exponent exponent)) (<| (!with-char+ source-code//size source-code (!inc end) char/1 <failure>) (if (or (!n/= (`` (char (~~ (static ..positive-sign)))) char/1) (!n/= (`` (char (~~ (static ..negative-sign)))) char/1)) @@ -403,11 +403,11 @@ (`` (def: (parse-short-name current-module [where offset/0 source-code]) (-> Text (Parser Name)) (<| (!with-char source-code offset/0 char/0 - (!end-of-file where offset/0 source-code current-module)) + (!end-of-file where offset/0 source-code current-module)) (if (!n/= (char (~~ (static ..name-separator))) char/0) (let [offset/1 (!inc offset/0)] (<| (!with-char source-code offset/1 char/1 - (!end-of-file where offset/1 source-code current-module)) + (!end-of-file where offset/1 source-code current-module)) (!parse-half-name offset/1 char/1 current-module))) (!parse-half-name offset/0 char/0 ..prelude))))) @@ -458,7 +458,7 @@ (exec [] (function (recur [where offset/0 source-code]) (<| (!with-char+ source-code//size source-code offset/0 char/0 - (!end-of-file where offset/0 source-code current-module)) + (!end-of-file where offset/0 source-code current-module)) (with-expansions [<composites> (template [<open> <close> <parser>] [[(~~ (static <open>))] (<parser> <recur> <consume-1>) @@ -492,7 +492,7 @@ [(~~ (static ..sigil))] (let [offset/1 (!inc offset/0)] (<| (!with-char+ source-code//size source-code offset/1 char/1 - (!end-of-file where offset/1 source-code current-module)) + (!end-of-file where offset/1 source-code current-module)) ("lux syntax char case!" char/1 [[(~~ (static ..name-separator))] (!parse-short-name current-module <move-2> where #.Tag) @@ -527,7 +527,7 @@ [(~~ (static ..name-separator))] (let [offset/1 (!inc offset/0)] (<| (!with-char+ source-code//size source-code offset/1 char/1 - (!end-of-file where offset/1 source-code current-module)) + (!end-of-file where offset/1 source-code current-module)) (if (!digit? char/1) (parse-rev source-code//size offset/0 where (!inc offset/1) source-code) (!parse-short-name current-module [where offset/1 source-code] where #.Identifier)))) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index c8cebcca9..9944fb488 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -20,6 +20,8 @@ ["." macro ["." code] [syntax (#+ syntax:)]] + [meta + ["." annotation]] ["." type ["." check (#+ Check)]]]) @@ -117,7 +119,7 @@ (-> Text Text (List [Text Definition]) (List [Name Type])) (do list.monad [[name [exported? def-type def-anns def-value]] constants] - (if (and (macro.structure? def-anns) + (if (and (annotation.structure? def-anns) (or (text@= target-module source-module) exported?)) (list [[source-module name] def-type]) @@ -233,9 +235,9 @@ (-> Lux Type-Context Type (Check Instance)) (case (macro.run compiler ($_ macro.either - (do macro.monad [alts local-env] (test-provision provision context dep alts)) - (do macro.monad [alts local-structs] (test-provision provision context dep alts)) - (do macro.monad [alts import-structs] (test-provision provision context dep alts)))) + (do macro.monad [alts ..local-env] (..test-provision provision context dep alts)) + (do macro.monad [alts ..local-structs] (..test-provision provision context dep alts)) + (do macro.monad [alts ..import-structs] (..test-provision provision context dep alts)))) (#.Left error) (check.fail error) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 70cccaaf2..874e32ceb 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -28,13 +28,17 @@ [world ["." file (#+ Path)]]] ["." / #_ + [action (#+ Action)] ["#" project] ["#." parser] ["#." pom] ["#." cli] ["#." local] ["#." dependency] - ["#." build]]) + [command + ["#." build] + ["#." test] + ["#." auto]]]) (def: (read-file! path) (-> Path (IO (Try Binary))) @@ -137,8 +141,17 @@ (exec (..fetch-dependencies! project) (wrap [])) - #/cli.Buikd - (exec (/build.do! project) + (#/cli.Compilation compilation) + (case compilation + #/cli.Build (exec (/build.do! project) + (wrap [])) + #/cli.Test (exec (/test.do! project) + (wrap []))) + + (#/cli.Auto auto) + (exec (case auto + #/cli.Build (/auto.do! /build.do! project) + #/cli.Test (/auto.do! /test.do! project)) (wrap []))) (#try.Failure error) diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index 3b5a33fb1..3cbb2aae8 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -4,11 +4,21 @@ ["<>" parser ["." cli (#+ Parser)]]]]) +(type: #export Compilation + #Build + #Test) + +(def: compilation + (Parser Compilation) + (<>.or (cli.this "build") + (cli.this "test"))) + (type: #export Command #POM #Install #Dependencies - #Buikd) + (#Compilation Compilation) + (#Auto Compilation)) (def: #export command (Parser Command) @@ -16,5 +26,7 @@ (cli.this "pom") (cli.this "install") (cli.this "deps") - (cli.this "buikd") + ..compilation + (<>.after (cli.this "auto") + ..compilation) )) diff --git a/stdlib/source/program/aedifex/command.lux b/stdlib/source/program/aedifex/command.lux new file mode 100644 index 000000000..8b4432a97 --- /dev/null +++ b/stdlib/source/program/aedifex/command.lux @@ -0,0 +1,8 @@ +(.module: + [lux #*] + ["." // #_ + ["#" project] + ["#." action (#+ Action)]]) + +(type: #export (Command a) + (-> //.Project (Action a))) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux new file mode 100644 index 000000000..5bf759a06 --- /dev/null +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -0,0 +1,141 @@ +(.module: + [lux #* + ["." host (#+ import:)] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." io (#+ IO)] + [concurrency + ["." promise]]] + [data + [collection + ["." array] + ["." list]]] + [world + [file (#+ Path)]]] + ["." // #_ + ["/#" // #_ + ["#" project] + ["#." action (#+ Action)] + ["#." command (#+ Command)]]]) + +(import: #long java/nio/file/WatchKey + (reset [] #io boolean)) + +(import: #long java/util/concurrent/TimeUnit + (#enum SECONDS)) + +(import: #long java/nio/file/WatchService + (poll [long java/util/concurrent/TimeUnit] #io #try #? java/nio/file/WatchKey) + (poll #as fetch [] #io #try #? java/nio/file/WatchKey)) + +(import: #long java/nio/file/FileSystem + (newWatchService [] #io #try java/nio/file/WatchService)) + +(import: #long java/nio/file/FileSystems + (#static getDefault [] java/nio/file/FileSystem)) + +(import: #long java/lang/Object) + +(import: #long java/lang/String) + +(import: #long (java/nio/file/WatchEvent$Kind a)) + +(import: #long java/nio/file/StandardWatchEventKinds + (#static ENTRY_CREATE (java/nio/file/WatchEvent$Kind java/nio/file/Path)) + (#static ENTRY_MODIFY (java/nio/file/WatchEvent$Kind java/nio/file/Path)) + (#static ENTRY_DELETE (java/nio/file/WatchEvent$Kind java/nio/file/Path))) + +(import: #long java/nio/file/Path + (register [java/nio/file/WatchService [(java/nio/file/WatchEvent$Kind ?)]] #io #try java/nio/file/WatchKey)) + +(import: #long java/io/File + (new [java/lang/String]) + (exists [] #io #try boolean) + (isDirectory [] #io #try boolean) + (listFiles [] #io #try [java/io/File]) + (getAbsolutePath [] #io #try java/lang/String) + (toPath [] java/nio/file/Path)) + +(def: (targets path) + (-> Path (Action (List Path))) + (promise.future + (loop [path path] + (let [file (java/io/File::new path)] + (do {@ (try.with io.monad)} + [exists? (java/io/File::exists file) + directory? (java/io/File::isDirectory file)] + (if (and exists? + directory?) + (do @ + [children (java/io/File::listFiles file) + children (|> children + array.to-list + (monad.map @ (|>> java/io/File::getAbsolutePath))) + descendants (monad.map @ recur children)] + (wrap (#.Cons path (list.concat descendants)))) + (wrap (list)))))))) + +(type: Watch-Event + (java/nio/file/WatchEvent$Kind java/lang/Object)) + +(def: watch-events + (List Watch-Event) + (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE)) + (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY)) + (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE)))) + +(def: (watch! watcher path) + (-> java/nio/file/WatchService Path (Action Any)) + (promise.future + (do (try.with io.monad) + [_ (java/nio/file/Path::register watcher + (array.from-list ..watch-events) + (|> path java/io/File::new java/io/File::toPath))] + (wrap [])))) + +(def: (poll! watcher) + (-> java/nio/file/WatchService (Action (Maybe java/nio/file/WatchKey))) + (promise.future + (java/nio/file/WatchService::poll 1 java/util/concurrent/TimeUnit::SECONDS watcher))) + +(def: (drain! watcher) + (-> java/nio/file/WatchService (IO (Try Any))) + (do (try.with io.monad) + [?key (java/nio/file/WatchService::fetch watcher)] + (case ?key + (#.Some key) + (do io.monad + [valid? (java/nio/file/WatchKey::reset key)] + (if valid? + (drain! watcher) + (wrap (:: try.monad wrap [])))) + + #.None + (wrap [])))) + +(def: #export (do! command project) + (All [a] (-> (Command a) (Command Any))) + (do {@ ///action.monad} + [#let [fs (java/nio/file/FileSystems::getDefault)] + watcher (promise.future (java/nio/file/FileSystem::newWatchService fs)) + targets (|> project + (get@ #///.sources) + (monad.map @ ..targets) + (:: @ map list.concat)) + _ (monad.map @ (..watch! watcher) targets) + _ (command project)] + (loop [_ []] + (do @ + [?key (..poll! watcher) + _ (case ?key + (#.Some key) + (do @ + [_ (promise.future (..drain! watcher)) + _ (command project)] + (wrap [])) + + #.None + (wrap []))] + (recur []))))) diff --git a/stdlib/source/program/aedifex/build.lux b/stdlib/source/program/aedifex/command/build.lux index 74f64cb59..0e5d1e229 100644 --- a/stdlib/source/program/aedifex/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -2,13 +2,13 @@ [lux (#- Name) ["." host (#+ import:)] [abstract - [monad (#+ Monad do)]] + [monad (#+ do)]] [control ["." try (#+ Try)] ["." exception (#+ exception:)] ["." io (#+ IO)] [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise ("#@." monad)]]] [data ["." product] ["." maybe] @@ -19,17 +19,15 @@ ["." dictionary]]] [world ["." file (#+ Path)]]] - ["." // #_ + ["." /// #_ ["#" project] - ["#." action (#+ Action)] + ["#." action] + ["#." command (#+ Command)] ["#." local] ["#." artifact (#+ Group Name Artifact)] ["#." dependency (#+ Dependency Resolution)] ["#." shell]]) -(type: #export (Command a) - (-> //.Project (Action a))) - (type: Finder (-> Resolution (Maybe Dependency))) @@ -37,8 +35,8 @@ (-> Group Name Finder) (|>> dictionary.entries (list.search (function (_ [dependency package]) - (if (and (text@= group (get@ [#//dependency.artifact #//artifact.group] dependency)) - (text@= name (get@ [#//dependency.artifact #//artifact.name] dependency))) + (if (and (text@= group (get@ [#///dependency.artifact #///artifact.group] dependency)) + (text@= name (get@ [#///dependency.artifact #///artifact.name] dependency))) (#.Some dependency) #.None))))) @@ -58,7 +56,7 @@ (exception: #export no-available-compiler) (exception: #export no-specified-program) -(type: Compiler +(type: #export Compiler (#JVM Artifact) (#JS Artifact)) @@ -66,7 +64,7 @@ (-> Dependency (-> Resolution Resolution)) (|>> dictionary.entries (list.filter (|>> product.left (is? dependency) not)) - (dictionary.from-list //dependency.hash))) + (dictionary.from-list ///dependency.hash))) (def: (compiler resolution) (-> Resolution (Try [Resolution Compiler])) @@ -74,11 +72,11 @@ (..js-compiler resolution)] [(#.Some dependency) _] (#try.Success [(..remove-dependency dependency resolution) - (#JVM (get@ #//dependency.artifact dependency))]) + (#JVM (get@ #///dependency.artifact dependency))]) [_ (#.Some dependency)] (#try.Success [(..remove-dependency dependency resolution) - (#JS (get@ #//dependency.artifact dependency))]) + (#JS (get@ #///dependency.artifact dependency))]) _ (exception.throw ..no-available-compiler []))) @@ -86,8 +84,8 @@ (def: libraries (-> Resolution (List Path)) (|>> dictionary.keys - (list.filter (|>> (get@ #//dependency.type) (text@= //dependency.lux-library))) - (list@map (|>> (get@ #//dependency.artifact) (//local.path file.system))))) + (list.filter (|>> (get@ #///dependency.type) (text@= ///dependency.lux-library))) + (list@map (|>> (get@ #///dependency.artifact) (///local.path file.system))))) (import: #long java/lang/String) @@ -95,7 +93,7 @@ (import: #long java/lang/System (#static getProperty [java/lang/String] #io #? java/lang/String)) -(def: working-directory +(def: #export working-directory (IO (Try Text)) (do io.monad [?value (java/lang/System::getProperty "user.dir")] @@ -110,35 +108,39 @@ (|> values (list@map (|>> (format name " "))) (text.join-with " "))) (def: #export (do! project) - (Command Any) - (case (get@ #//.program project) + (Command [Compiler + Path]) + (case (get@ #///.program project) (#.Some program) - (do //action.monad - [cache (//local.all-cached (file.async file.system) - (get@ #//.dependencies project) - //dependency.empty) + (do ///action.monad + [cache (///local.all-cached (file.async file.system) + (get@ #///.dependencies project) + ///dependency.empty) resolution (promise.future - (//dependency.resolve-all (get@ #//.repositories project) - (get@ #//.dependencies project) - cache)) - _ (//local.cache-all (file.async file.system) - resolution) + (///dependency.resolve-all (get@ #///.repositories project) + (get@ #///.dependencies project) + cache)) + _ (///local.cache-all (file.async file.system) + resolution) [resolution compiler] (promise@wrap (..compiler resolution)) working-directory (promise.future ..working-directory) #let [libraries (..libraries resolution) - prefix (case compiler - (#JVM artifact) (format "java -jar " (//local.path file.system artifact)) - (#JS artifact) (format "node --stack_size=8192 " (//local.path file.system artifact))) - cache-directory (format working-directory (:: file.system separator) (get@ #//.target project)) + [prefix output] (case compiler + (#JVM artifact) [(format "java -jar " (///local.path file.system artifact)) + "program.jar"] + (#JS artifact) [(format "node --stack_size=8192 " (///local.path file.system artifact)) + "program.js"]) + cache-directory (format working-directory (:: file.system separator) (get@ #///.target project)) command (format prefix " build" " " (..plural-parameter "--library" libraries) - " " (..plural-parameter "--source" (get@ #//.sources project)) + " " (..plural-parameter "--source" (get@ #///.sources project)) " " (..singular-parameter "--target" cache-directory) " " (..singular-parameter "--module" program))] #let [_ (log! "[BUILD STARTED]")] - outcome (//shell.execute command working-directory) - #let [_ (log! "[BUILD END]")]] - (wrap [])) + outcome (///shell.execute command working-directory) + #let [_ (log! "[BUILD ENDED]")]] + (wrap [compiler + (format cache-directory (:: file.system separator) output)])) #.None (promise@wrap (exception.throw ..no-specified-program [])))) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux new file mode 100644 index 000000000..a27c07f10 --- /dev/null +++ b/stdlib/source/program/aedifex/command/test.lux @@ -0,0 +1,29 @@ +(.module: + [lux (#- Name) + [abstract + [monad (#+ do)]] + [control + [concurrency + ["." promise]]] + [data + [text + ["%" format (#+ format)]]]] + ["." // #_ + ["#." build] + ["/#" // #_ + ["#." action] + ["#." command (#+ Command)] + ["#." shell]]]) + +(def: #export (do! project) + (Command Any) + (do ///action.monad + [[compiler program] (//build.do! project) + working-directory (promise.future //build.working-directory) + #let [command (case compiler + (#//build.JVM artifact) (format "java -jar " program) + (#//build.JS artifact) (format "node --stack_size=8192 " program))] + #let [_ (log! "[TEST STARTED]")] + outcome (///shell.execute command working-directory) + #let [_ (log! "[TEST ENDED]")]] + (wrap []))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index d3107c0e5..6549f9a17 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -130,6 +130,7 @@ ["#." locale] ["#." macro] ["#." math] + ["#." meta] ["#." time] ## ["#." tool] ["#." type] @@ -319,6 +320,7 @@ /locale.test /macro.test /math.test + /meta.test /time.test ## /tool.test /type.test diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 14189ca35..3b95e6f3a 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -12,11 +12,10 @@ (def: #export test Test - (<| (_.covering /._) - ($_ _.and - /code.test - /template.test - /syntax.test - /syntax/common.test - /poly.test - ))) + ($_ _.and + /code.test + /template.test + /syntax.test + /syntax/common.test + /poly.test + )) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 00a805f26..0cdbc9610 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -121,19 +121,19 @@ (`` ($_ _.and (~~ (template [<coverage> <random> <tag>] [(do {@ random.monad} - [value <random>] + [expected <random>] (_.cover [<coverage>] - (and (case (..read (/.to-text (<coverage> value))) - (#try.Success lux-code) + (and (case (..read (/.to-text (<coverage> expected))) + (#try.Success actual) (:: /.equivalence = - lux-code - (<coverage> value)) + actual + (<coverage> expected)) (#try.Failure error) false) (:: /.equivalence = - [.dummy-cursor (<tag> value)] - (<coverage> value)))))] + [.dummy-cursor (<tag> expected)] + (<coverage> expected)))))] [/.bit random.bit #.Bit] [/.nat random.nat #.Nat] @@ -145,23 +145,22 @@ [/.identifier ..random-name #.Identifier] [/.form (..random-sequence ..random) #.Form] [/.tuple (..random-sequence ..random) #.Tuple] - [/.record (..random-record ..random) #.Record] - )) + [/.record (..random-record ..random) #.Record])) (~~ (template [<coverage> <random> <tag>] [(do {@ random.monad} - [value <random>] + [expected <random>] (_.cover [<coverage>] - (and (case (..read (/.to-text (<coverage> value))) - (#try.Success lux-code) + (and (case (..read (/.to-text (<coverage> expected))) + (#try.Success actual) (:: /.equivalence = - lux-code - (<coverage> value)) + actual + (<coverage> expected)) (#try.Failure error) false) (:: /.equivalence = - [.dummy-cursor (<tag> ["" value])] - (<coverage> value))) + [.dummy-cursor (<tag> ["" expected])] + (<coverage> expected))) ))] [/.local-tag ..random-text #.Tag] diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux new file mode 100644 index 000000000..d0a531404 --- /dev/null +++ b/stdlib/source/test/lux/meta.lux @@ -0,0 +1,14 @@ +(.module: + [lux #* + ["_" test (#+ Test)]] + ## {1 + ## ["." /]} + ["." / #_ + ["#." annotation]]) + +(def: #export test + Test + (<| ## (_.covering /._) + ($_ _.and + /annotation.test + ))) diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux new file mode 100644 index 000000000..f8f569bde --- /dev/null +++ b/stdlib/source/test/lux/meta/annotation.lux @@ -0,0 +1,178 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [math + ["." random (#+ Random)]] + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)]] + [data + ["." product] + ["." bit] + ["." name] + ["." text + ["%" format (#+ format)]] + [number + ["." nat] + ["." int] + ["." rev] + ["." frac]] + [collection + ["." list ("#@." functor)]]] + [macro + ["." code ("#@." equivalence)]]] + {1 + ["." /]} + [/// + [macro + ["_." code]]]) + +(def: random-key + (Random Name) + (random.and (random.ascii/alpha 1) + (random.ascii/alpha 1))) + +(def: (random-sequence random) + (All [a] (-> (Random a) (Random (List a)))) + (do {@ random.monad} + [size (|> random.nat (:: @ map (nat.% 3)))] + (random.list size random))) + +(def: (random-record random) + (All [a] (-> (Random a) (Random (List [a a])))) + (do {@ random.monad} + [size (|> random.nat (:: @ map (nat.% 3)))] + (random.list size (random.and random random)))) + +(template: (!expect <pattern> <value>) + (case <value> + <pattern> true + _ false)) + +(def: (annotation key value) + (-> Name Code /.Annotation) + (code.record (list [(code.tag key) + value]))) + +(def: typed-value + Test + (do {@ random.monad} + [key ..random-key] + (`` ($_ _.and + (~~ (template [<definition> <random> <constructor> <equivalence>] + [(do {@ random.monad} + [expected <random>] + (_.cover [<definition>] + (|> expected <constructor> + (..annotation key) + (<definition> key) + (!expect (^multi (#.Some actual) + (:: <equivalence> = expected actual))))))] + + [/.bit random.bit code.bit bit.equivalence] + [/.nat random.nat code.nat nat.equivalence] + [/.int random.int code.int int.equivalence] + [/.rev random.rev code.rev rev.equivalence] + [/.frac random.frac code.frac frac.equivalence] + [/.text (random.ascii/alpha 1) code.text text.equivalence] + [/.identifier ..random-key code.identifier name.equivalence] + [/.tag ..random-key code.tag name.equivalence] + [/.form (..random-sequence _code.random) code.form (list.equivalence code.equivalence)] + [/.tuple (..random-sequence _code.random) code.tuple (list.equivalence code.equivalence)] + [/.record (..random-record _code.random) code.record (list.equivalence (product.equivalence code.equivalence code.equivalence))] + )) + )))) + +(def: flag + Test + (do {@ random.monad} + [key ..random-key] + (`` ($_ _.and + (do {@ random.monad} + [dummy ..random-key + expected random.bit] + (_.cover [/.flagged?] + (and (|> expected code.bit + (..annotation key) + (/.flagged? key) + (:: bit.equivalence = expected)) + (not (|> expected code.bit + (..annotation dummy) + (/.flagged? key)))))) + (~~ (template [<definition> <tag>] + [(do {@ random.monad} + [expected random.bit] + (_.cover [<definition>] + (and (|> expected code.bit + (..annotation (name-of <tag>)) + <definition> + (:: bit.equivalence = expected)) + (not (|> expected code.bit + (..annotation key) + <definition>)))))] + + [/.structure? #.struct?] + [/.recursive-type? #.type-rec?] + [/.signature? #.sig?] + )) + )))) + +(def: arguments + Test + (do {@ random.monad} + [key ..random-key] + (`` ($_ _.and + (~~ (template [<definition> <tag>] + [(do {@ random.monad} + [expected (random.list 5 (random.ascii/alpha 1))] + (_.cover [<definition>] + (and (|> expected (list@map code.text) code.tuple + (..annotation (name-of <tag>)) + <definition> + (:: (list.equivalence text.equivalence) = expected)) + (|> expected (list@map code.text) code.tuple + (..annotation key) + <definition> + (:: (list.equivalence text.equivalence) = (list))))))] + + [/.function-arguments #.func-args] + [/.type-arguments #.type-args] + )) + )))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Annotation]) + (do {@ random.monad} + [key ..random-key] + ($_ _.and + (do {@ random.monad} + [expected _code.random] + (_.cover [/.value] + (|> expected + (..annotation key) + (/.value key) + (!expect (^multi (#.Some actual) + (code@= expected actual)))))) + + ..typed-value + + (do {@ random.monad} + [expected (random.ascii/alpha 10)] + (_.cover [/.documentation] + (and (not (|> expected code.text + (..annotation key) + /.documentation + (!expect (^multi (#.Some actual) + (:: text.equivalence = expected actual))))) + (|> expected code.text + (..annotation (name-of #.doc)) + /.documentation + (!expect (^multi (#.Some actual) + (:: text.equivalence = expected actual))))))) + + ..flag + ..arguments + )))) |