aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/control/concurrency/actor.lux4
-rw-r--r--stdlib/source/lux/host.jvm.lux4
-rw-r--r--stdlib/source/lux/host.old.lux6
-rw-r--r--stdlib/source/lux/macro.lux93
-rw-r--r--stdlib/source/lux/meta/annotation.lux95
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/syntax.lux12
-rw-r--r--stdlib/source/lux/type/implicit.lux10
-rw-r--r--stdlib/source/program/aedifex.lux19
-rw-r--r--stdlib/source/program/aedifex/cli.lux16
-rw-r--r--stdlib/source/program/aedifex/command.lux8
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux141
-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.lux29
-rw-r--r--stdlib/source/test/lux.lux2
-rw-r--r--stdlib/source/test/lux/macro.lux15
-rw-r--r--stdlib/source/test/lux/macro/code.lux31
-rw-r--r--stdlib/source/test/lux/meta.lux14
-rw-r--r--stdlib/source/test/lux/meta/annotation.lux178
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
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 14:08:05 +0000