From b1f0014dd9080c6643ecd73db5233fbdff032419 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 29 Aug 2020 01:06:42 -0400 Subject: Test programs + auti build/test. --- stdlib/source/lux/control/concurrency/actor.lux | 4 +- stdlib/source/lux/host.jvm.lux | 4 +- stdlib/source/lux/host.old.lux | 6 +- stdlib/source/lux/macro.lux | 93 ----------- stdlib/source/lux/meta/annotation.lux | 95 +++++++++++ .../lux/tool/compiler/language/lux/syntax.lux | 12 +- stdlib/source/lux/type/implicit.lux | 10 +- stdlib/source/program/aedifex.lux | 19 ++- stdlib/source/program/aedifex/build.lux | 144 ----------------- stdlib/source/program/aedifex/cli.lux | 16 +- stdlib/source/program/aedifex/command.lux | 8 + stdlib/source/program/aedifex/command/auto.lux | 141 ++++++++++++++++ stdlib/source/program/aedifex/command/build.lux | 146 +++++++++++++++++ stdlib/source/program/aedifex/command/test.lux | 29 ++++ stdlib/source/test/lux.lux | 2 + stdlib/source/test/lux/macro.lux | 15 +- stdlib/source/test/lux/macro/code.lux | 31 ++-- stdlib/source/test/lux/meta.lux | 14 ++ stdlib/source/test/lux/meta/annotation.lux | 178 +++++++++++++++++++++ 19 files changed, 687 insertions(+), 280 deletions(-) create mode 100644 stdlib/source/lux/meta/annotation.lux delete mode 100644 stdlib/source/program/aedifex/build.lux create mode 100644 stdlib/source/program/aedifex/command.lux create mode 100644 stdlib/source/program/aedifex/command/auto.lux create mode 100644 stdlib/source/program/aedifex/command/build.lux create mode 100644 stdlib/source/program/aedifex/command/test.lux create mode 100644 stdlib/source/test/lux/meta.lux create mode 100644 stdlib/source/test/lux/meta/annotation.lux 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 @@ ( de-aliased) (#.Right [_ _ annotations _]) - (case (macro.get-tag-ann (name-of ) annotations) + (case (annotation.tag (name-of ) 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 [ ] [(def: #export ( 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 [ ] - [(def: #export ( tag anns) - (-> Name Code (Maybe )) - (case (get-ann tag anns) - (#.Some [_ ( 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 [ ] - [(def: #export - {#.doc (code.text ($_ text@compose "Checks whether a definition is " "."))} - (-> Code Bit) - (flag-set? (name-of )))] - - [structure? #.struct? "a structure"] - [recursive-type? #.type-rec? "a recursive type"] - [signature? #.sig? "a signature"] - ) - -(template [ ] - [(def: ( input) - (-> Code (Maybe )) - (case input - [_ ( actual-value)] - (#.Some actual-value) - - _ - #.None))] - - [parse-tuple #.Tuple (List Code)] - [parse-text #.Text Text] - ) - -(template [ ] - [(def: #export ( anns) - {#.doc } - (-> Code (List Text)) - (maybe.default (list) - (do {@ maybe.monad} - [_args (get-ann (name-of ) 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 [ ] + [(def: #export ( tag ann) + (-> Name Annotation (Maybe )) + (case (..value tag ann) + (#.Some [_ ( 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 [ ] + [(def: #export + (-> Annotation Bit) + (..flagged? (name-of )))] + + [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 [ ] + [(def: #export ( ann) + (-> Annotation (List Text)) + (maybe.default (list) + (do {@ maybe.monad} + [args (..tuple (name-of ) 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 ) (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 [ (template [ ] [[(~~ (static ))] ( ) @@ -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 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/build.lux b/stdlib/source/program/aedifex/build.lux deleted file mode 100644 index 74f64cb59..000000000 --- a/stdlib/source/program/aedifex/build.lux +++ /dev/null @@ -1,144 +0,0 @@ -(.module: - [lux (#- Name) - ["." host (#+ import:)] - [abstract - [monad (#+ Monad do)]] - [control - ["." try (#+ Try)] - ["." exception (#+ exception:)] - ["." io (#+ IO)] - [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] - [data - ["." product] - ["." maybe] - ["." text ("#@." equivalence) - ["%" format (#+ format)]] - [collection - ["." list ("#@." functor)] - ["." dictionary]]] - [world - ["." file (#+ Path)]]] - ["." // #_ - ["#" project] - ["#." action (#+ Action)] - ["#." local] - ["#." artifact (#+ Group Name Artifact)] - ["#." dependency (#+ Dependency Resolution)] - ["#." shell]]) - -(type: #export (Command a) - (-> //.Project (Action a))) - -(type: Finder - (-> Resolution (Maybe Dependency))) - -(def: (dependency-finder group name) - (-> 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))) - (#.Some dependency) - #.None))))) - -(def: lux-group - Group - "com.github.luxlang") - -(template [ ] - [(def: - Finder - (..dependency-finder ..lux-group ))] - - ["lux-jvm" jvm-compiler] - ["lux-js" js-compiler] - ) - -(exception: #export no-available-compiler) -(exception: #export no-specified-program) - -(type: Compiler - (#JVM Artifact) - (#JS Artifact)) - -(def: (remove-dependency dependency) - (-> Dependency (-> Resolution Resolution)) - (|>> dictionary.entries - (list.filter (|>> product.left (is? dependency) not)) - (dictionary.from-list //dependency.hash))) - -(def: (compiler resolution) - (-> Resolution (Try [Resolution Compiler])) - (case [(..jvm-compiler resolution) - (..js-compiler resolution)] - [(#.Some dependency) _] - (#try.Success [(..remove-dependency dependency resolution) - (#JVM (get@ #//dependency.artifact dependency))]) - - [_ (#.Some dependency)] - (#try.Success [(..remove-dependency dependency resolution) - (#JS (get@ #//dependency.artifact dependency))]) - - _ - (exception.throw ..no-available-compiler []))) - -(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))))) - -(import: #long java/lang/String) - -## https://docs.oracle.com/javase/tutorial/essential/environment/sysprop.html -(import: #long java/lang/System - (#static getProperty [java/lang/String] #io #? java/lang/String)) - -(def: working-directory - (IO (Try Text)) - (do io.monad - [?value (java/lang/System::getProperty "user.dir")] - (wrap (#try.Success (maybe.default "~" ?value))))) - -(def: (singular-parameter name value) - (-> Text Text Text) - (format name " " value)) - -(def: (plural-parameter name values) - (-> Text (List Text) Text) - (|> values (list@map (|>> (format name " "))) (text.join-with " "))) - -(def: #export (do! project) - (Command Any) - (case (get@ #//.program project) - (#.Some program) - (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) - [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)) - command (format prefix " build" - " " (..plural-parameter "--library" libraries) - " " (..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 [])) - - #.None - (promise@wrap (exception.throw ..no-specified-program [])))) 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/command/build.lux b/stdlib/source/program/aedifex/command/build.lux new file mode 100644 index 000000000..0e5d1e229 --- /dev/null +++ b/stdlib/source/program/aedifex/command/build.lux @@ -0,0 +1,146 @@ +(.module: + [lux (#- Name) + ["." host (#+ import:)] + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO)] + [concurrency + ["." promise ("#@." monad)]]] + [data + ["." product] + ["." maybe] + ["." text ("#@." equivalence) + ["%" format (#+ format)]] + [collection + ["." list ("#@." functor)] + ["." dictionary]]] + [world + ["." file (#+ Path)]]] + ["." /// #_ + ["#" project] + ["#." action] + ["#." command (#+ Command)] + ["#." local] + ["#." artifact (#+ Group Name Artifact)] + ["#." dependency (#+ Dependency Resolution)] + ["#." shell]]) + +(type: Finder + (-> Resolution (Maybe Dependency))) + +(def: (dependency-finder group name) + (-> 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))) + (#.Some dependency) + #.None))))) + +(def: lux-group + Group + "com.github.luxlang") + +(template [ ] + [(def: + Finder + (..dependency-finder ..lux-group ))] + + ["lux-jvm" jvm-compiler] + ["lux-js" js-compiler] + ) + +(exception: #export no-available-compiler) +(exception: #export no-specified-program) + +(type: #export Compiler + (#JVM Artifact) + (#JS Artifact)) + +(def: (remove-dependency dependency) + (-> Dependency (-> Resolution Resolution)) + (|>> dictionary.entries + (list.filter (|>> product.left (is? dependency) not)) + (dictionary.from-list ///dependency.hash))) + +(def: (compiler resolution) + (-> Resolution (Try [Resolution Compiler])) + (case [(..jvm-compiler resolution) + (..js-compiler resolution)] + [(#.Some dependency) _] + (#try.Success [(..remove-dependency dependency resolution) + (#JVM (get@ #///dependency.artifact dependency))]) + + [_ (#.Some dependency)] + (#try.Success [(..remove-dependency dependency resolution) + (#JS (get@ #///dependency.artifact dependency))]) + + _ + (exception.throw ..no-available-compiler []))) + +(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))))) + +(import: #long java/lang/String) + +## https://docs.oracle.com/javase/tutorial/essential/environment/sysprop.html +(import: #long java/lang/System + (#static getProperty [java/lang/String] #io #? java/lang/String)) + +(def: #export working-directory + (IO (Try Text)) + (do io.monad + [?value (java/lang/System::getProperty "user.dir")] + (wrap (#try.Success (maybe.default "~" ?value))))) + +(def: (singular-parameter name value) + (-> Text Text Text) + (format name " " value)) + +(def: (plural-parameter name values) + (-> Text (List Text) Text) + (|> values (list@map (|>> (format name " "))) (text.join-with " "))) + +(def: #export (do! 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) + resolution (promise.future + (///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 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)) + " " (..singular-parameter "--target" cache-directory) + " " (..singular-parameter "--module" program))] + #let [_ (log! "[BUILD STARTED]")] + 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 [ ] [(do {@ random.monad} - [value ] + [expected ] (_.cover [] - (and (case (..read (/.to-text ( value))) - (#try.Success lux-code) + (and (case (..read (/.to-text ( expected))) + (#try.Success actual) (:: /.equivalence = - lux-code - ( value)) + actual + ( expected)) (#try.Failure error) false) (:: /.equivalence = - [.dummy-cursor ( value)] - ( value)))))] + [.dummy-cursor ( expected)] + ( 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 [ ] [(do {@ random.monad} - [value ] + [expected ] (_.cover [] - (and (case (..read (/.to-text ( value))) - (#try.Success lux-code) + (and (case (..read (/.to-text ( expected))) + (#try.Success actual) (:: /.equivalence = - lux-code - ( value)) + actual + ( expected)) (#try.Failure error) false) (:: /.equivalence = - [.dummy-cursor ( ["" value])] - ( value))) + [.dummy-cursor ( ["" expected])] + ( 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 ) + (case + 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 [ ] + [(do {@ random.monad} + [expected ] + (_.cover [] + (|> expected + (..annotation key) + ( key) + (!expect (^multi (#.Some actual) + (:: = 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 [ ] + [(do {@ random.monad} + [expected random.bit] + (_.cover [] + (and (|> expected code.bit + (..annotation (name-of )) + + (:: bit.equivalence = expected)) + (not (|> expected code.bit + (..annotation key) + )))))] + + [/.structure? #.struct?] + [/.recursive-type? #.type-rec?] + [/.signature? #.sig?] + )) + )))) + +(def: arguments + Test + (do {@ random.monad} + [key ..random-key] + (`` ($_ _.and + (~~ (template [ ] + [(do {@ random.monad} + [expected (random.list 5 (random.ascii/alpha 1))] + (_.cover [] + (and (|> expected (list@map code.text) code.tuple + (..annotation (name-of )) + + (:: (list.equivalence text.equivalence) = expected)) + (|> expected (list@map code.text) code.tuple + (..annotation key) + + (:: (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 + )))) -- cgit v1.2.3