aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2020-08-26 23:04:27 -0400
committerEduardo Julian2020-08-26 23:04:27 -0400
commitc8f9f42a258f1f2f961c7f8c5571cce843e97a0a (patch)
tree887cb4d557b149826c6c9e59ea821942045b08d4
parentd77ce19bf01a009cf5255e0a5d8201d8cc2f2178 (diff)
Download and catch dependencies in Aedifex.
-rw-r--r--commands.md4
-rw-r--r--license.json2
-rw-r--r--license.txt4
-rw-r--r--stdlib/source/lux/control/exception.lux2
-rw-r--r--stdlib/source/lux/control/parser/xml.lux43
-rw-r--r--stdlib/source/lux/data/binary.lux18
-rw-r--r--stdlib/source/lux/data/format/xml.lux9
-rw-r--r--stdlib/source/lux/data/number/i64.lux6
-rw-r--r--stdlib/source/lux/data/text.lux22
-rw-r--r--stdlib/source/lux/macro/syntax/common.lux6
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux4
-rw-r--r--stdlib/source/lux/macro/syntax/common/writer.lux7
-rw-r--r--stdlib/source/lux/world/net/http.lux15
-rw-r--r--stdlib/source/lux/world/net/uri.lux8
-rw-r--r--stdlib/source/poly/lux/data/format/json.lux4
-rw-r--r--stdlib/source/program/aedifex.lux94
-rw-r--r--stdlib/source/program/aedifex/artifact.lux68
-rw-r--r--stdlib/source/program/aedifex/cli.lux4
-rw-r--r--stdlib/source/program/aedifex/dependency.lux276
-rw-r--r--stdlib/source/program/aedifex/extension.lux11
-rw-r--r--stdlib/source/program/aedifex/hash.lux16
-rw-r--r--stdlib/source/program/aedifex/local.lux120
-rw-r--r--stdlib/source/program/aedifex/parser.lux15
-rw-r--r--stdlib/source/program/aedifex/pom.lux27
-rw-r--r--stdlib/source/program/aedifex/project.lux35
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux2
-rw-r--r--stdlib/source/test/lux/control/function/memo.lux2
-rw-r--r--stdlib/source/test/lux/macro.lux4
-rw-r--r--stdlib/source/test/lux/macro/code.lux2
-rw-r--r--stdlib/source/test/lux/macro/poly/json.lux47
-rw-r--r--stdlib/source/test/lux/macro/syntax/common.lux134
31 files changed, 836 insertions, 175 deletions
diff --git a/commands.md b/commands.md
index 5cbb12537..0e9fefbd1 100644
--- a/commands.md
+++ b/commands.md
@@ -77,7 +77,7 @@ cd ~/lux/stdlib/ && mvn deploy:deploy-file \
## Generate documentation
```
-cd ~/lux/stdlib/ && lein with-profile scriptum lux auto build
+cd ~/lux/stdlib/ && lein clean && lein with-profile scriptum lux auto build
```
---
@@ -87,7 +87,7 @@ cd ~/lux/stdlib/ && lein with-profile scriptum lux auto build
## Build
```
-cd ~/lux/stdlib/ && lein with-profile aedifex lux auto build
+cd ~/lux/stdlib/ && lein clean && lein with-profile aedifex lux auto build
```
---
diff --git a/license.json b/license.json
index b65c22195..de00bc4d7 100644
--- a/license.json
+++ b/license.json
@@ -4,7 +4,7 @@
"name": "Eduardo Emilio Julián Pereyra",
"period": {
"start": 2014,
- "end": 2019
+ "end": 2020
}
}
],
diff --git a/license.txt b/license.txt
index f4ed59a02..13320e1f8 100644
--- a/license.txt
+++ b/license.txt
@@ -1,7 +1,7 @@
Lux License
0.1
-Copyright (C) 2014-2019 Eduardo Emilio Julián Pereyra
+Copyright (C) 2014-2020 Eduardo Emilio Julián Pereyra
Definitions
@@ -231,4 +231,4 @@ Once The Work has been published under a particular version of This License, Rec
Recipient may also choose to use The Work under the terms of any subsequent version of This License published by The Licensor.
No one other than The Licensor has the right to modify the terms applicable to The Work created under This License.
-END OF TERMS AND CONDITIONS. \ No newline at end of file
+END OF TERMS AND CONDITIONS.
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 8cc4dfe94..f170baffe 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -83,7 +83,7 @@
(..throw exception message)))
(syntax: #export (exception: {export scr.export}
- {t-vars (p.default (list) scr.type-variables)}
+ {t-vars (p.default (list) (s.tuple scr.type-variables))}
{[name inputs] (p.either (p.and s.local-identifier (wrap (list)))
(s.form (p.and s.local-identifier (p.some scr.typed-input))))}
{body (p.maybe s.any)})
diff --git a/stdlib/source/lux/control/parser/xml.lux b/stdlib/source/lux/control/parser/xml.lux
index f734a2684..bea101164 100644
--- a/stdlib/source/lux/control/parser/xml.lux
+++ b/stdlib/source/lux/control/parser/xml.lux
@@ -13,7 +13,7 @@
["." list ("#@." functor)]
["." dictionary]]
[format
- ["/" xml (#+ XML)]]]]
+ ["/" xml (#+ Attribute Tag XML)]]]]
["." //])
(type: #export (Parser a)
@@ -26,13 +26,13 @@
(-> Name Text)
(format namespace ":" name))
-(template [<exception> <header>]
- [(exception: #export (<exception> {label Name})
+(template [<exception> <type> <header>]
+ [(exception: #export (<exception> {label <type>})
(exception.report
[<header> (%.text (..label label))]))]
- [wrong-tag "Tag"]
- [unknown-attribute "Attribute"]
+ [wrong-tag Tag "Tag"]
+ [unknown-attribute Attribute "Attribute"]
)
(def: blank-line
@@ -59,7 +59,7 @@
(exception.throw ..unexpected-input [])))))
(def: #export (node tag)
- (-> Name (Parser Any))
+ (-> Tag (Parser Any))
(function (_ docs)
(case docs
#.Nil
@@ -75,8 +75,23 @@
(#try.Success [docs []])
(exception.throw ..wrong-tag tag))))))
+(def: #export tag
+ (Parser Tag)
+ (function (_ docs)
+ (case docs
+ #.Nil
+ (exception.throw ..empty-input [])
+
+ (#.Cons head _)
+ (case head
+ (#/.Text _)
+ (exception.throw ..unexpected-input [])
+
+ (#/.Node tag _attrs _children)
+ (#try.Success [docs tag])))))
+
(def: #export (attr name)
- (-> Name (Parser Text))
+ (-> Attribute (Parser Text))
(function (_ docs)
(case docs
#.Nil
@@ -95,9 +110,9 @@
(#.Some value)
(#try.Success [docs value]))))))
-(def: (run' reader docs)
+(def: (run' parser docs)
(All [a] (-> (Parser a) (List XML) (Try a)))
- (case (//.run reader docs)
+ (case (//.run parser docs)
(#try.Success [remaining output])
(if (list.empty? remaining)
(#try.Success output)
@@ -106,7 +121,7 @@
(#try.Failure error)
(#try.Failure error)))
-(def: #export (children reader)
+(def: #export (children parser)
(All [a] (-> (Parser a) (Parser a)))
(function (_ docs)
(case docs
@@ -118,9 +133,9 @@
(#/.Text _)
(exception.throw ..unexpected-input [])
- (#/.Node _tag _attrs _children)
+ (#/.Node _tag _attrs children)
(do try.monad
- [output (run' reader _children)]
+ [output (run' parser children)]
(wrap [tail output]))))))
(def: #export ignore
@@ -133,6 +148,6 @@
(#.Cons head tail)
(#try.Success [tail []]))))
-(def: #export (run reader document)
+(def: #export (run parser document)
(All [a] (-> (Parser a) XML (Try a)))
- (run' reader (list document)))
+ (..run' parser (list document)))
diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux
index 8a5157b4a..ed0d992e9 100644
--- a/stdlib/source/lux/data/binary.lux
+++ b/stdlib/source/lux/data/binary.lux
@@ -4,7 +4,8 @@
["@" target]
[abstract
[monad (#+ do)]
- [equivalence (#+ Equivalence)]]
+ [equivalence (#+ Equivalence)]
+ [monoid (#+ Monoid)]]
[control
["." try (#+ Try)]
["." exception (#+ exception:)]]
@@ -302,3 +303,18 @@
(def: #export (slice' from binary)
(-> Nat Binary (Try Binary))
(slice from (dec (..!size binary)) binary))
+
+(structure: #export monoid
+ (Monoid Binary)
+
+ (def: identity
+ (..create 0))
+
+ (def: (compose left right)
+ (let [sizeL (!size left)
+ sizeR (!size right)
+ output (..create (n.+ sizeL sizeR))]
+ (exec
+ (..copy sizeL 0 left 0 output)
+ (..copy sizeR 0 right sizeL output)
+ output))))
diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux
index 83a3209d4..390f070f0 100644
--- a/stdlib/source/lux/data/format/xml.lux
+++ b/stdlib/source/lux/data/format/xml.lux
@@ -22,8 +22,11 @@
(type: #export Tag
Name)
+(type: #export Attribute
+ Name)
+
(type: #export Attrs
- (Dictionary Name Text))
+ (Dictionary Attribute Text))
(def: #export attrs
Attrs
@@ -235,8 +238,8 @@
(structure: #export codec
(Codec Text XML)
- (def: encode write)
- (def: decode read))
+ (def: encode ..write)
+ (def: decode ..read))
(structure: #export equivalence
(Equivalence XML)
diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux
index a9b1afb3b..26bc0cdc9 100644
--- a/stdlib/source/lux/data/number/i64.lux
+++ b/stdlib/source/lux/data/number/i64.lux
@@ -8,9 +8,11 @@
[number
["n" nat]]]])
-(def: #export bits-per-byte 8)
+(def: #export bits-per-byte
+ 8)
-(def: #export bytes-per-i64 8)
+(def: #export bytes-per-i64
+ 8)
(def: #export width
Nat
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 069dd8590..ed4b540f7 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -16,7 +16,8 @@
[collection
["." list ("#@." fold)]]]])
-(type: #export Char Nat)
+(type: #export Char
+ Nat)
## TODO: Instead of ints, chars should be produced fron nats.
## (The JVM specifies chars as 16-bit unsigned integers)
@@ -168,23 +169,31 @@
#.None
template))
-(structure: #export equivalence (Equivalence Text)
+(structure: #export equivalence
+ (Equivalence Text)
+
(def: (= reference sample)
("lux text =" reference sample)))
-(structure: #export order (Order Text)
+(structure: #export order
+ (Order Text)
+
(def: &equivalence ..equivalence)
(def: (< reference sample)
("lux text <" reference sample)))
-(structure: #export monoid (Monoid Text)
+(structure: #export monoid
+ (Monoid Text)
+
(def: identity "")
(def: (compose left right)
("lux text concat" left right)))
-(structure: #export hash (Hash Text)
+(structure: #export hash
+ (Hash Text)
+
(def: &equivalence ..equivalence)
(def: (hash input)
@@ -252,7 +261,8 @@
(-> Text Text)
(..enclose' ..double-quote))
-(def: #export space Text " ")
+(def: #export space
+ " ")
(def: #export (space? char)
{#.doc "Checks whether the character is white-space."}
diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux
index 0729c05fe..15c9a1fc4 100644
--- a/stdlib/source/lux/macro/syntax/common.lux
+++ b/stdlib/source/lux/macro/syntax/common.lux
@@ -18,9 +18,11 @@
#definition-type (Maybe Code)
#definition-value Code
#definition-anns Annotations
- #definition-args (List Text)
- })
+ #definition-args (List Text)})
(type: #export Typed-Input
{#input-binding Code
#input-type Code})
+
+(type: #export Type-Var
+ Text)
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index 5e2d3b0bc..989d2a0e2 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -128,7 +128,7 @@
{#.doc "A reader for definitions that ensures the input syntax is typed."}
(-> Lux (Parser //.Definition))
(do p.monad
- [_definition (definition compiler)
+ [_definition (..definition compiler)
_ (case (get@ #//.definition-type _definition)
(#.Some _)
(wrap [])
@@ -145,4 +145,4 @@
(def: #export type-variables
{#.doc "Reader for the common type var/param used by many macros."}
(Parser (List Text))
- (s.tuple (p.some s.local-identifier)))
+ (p.some s.local-identifier))
diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux
index 541f8849b..a067f0c10 100644
--- a/stdlib/source/lux/macro/syntax/common/writer.lux
+++ b/stdlib/source/lux/macro/syntax/common/writer.lux
@@ -28,6 +28,11 @@
(|>> (list@map (product.both code.tag function.identity))
code.record))
+(def: #export (typed-input value)
+ (-> //.Typed-Input Code)
+ (code.record (list [(get@ #//.input-binding value)
+ (get@ #//.input-type value)])))
+
(def: #export type-variables
- (-> (List Text) (List Code))
+ (-> (List //.Type-Var) (List Code))
(list@map code.local-identifier))
diff --git a/stdlib/source/lux/world/net/http.lux b/stdlib/source/lux/world/net/http.lux
index 67acbde6b..4a98fa492 100644
--- a/stdlib/source/lux/world/net/http.lux
+++ b/stdlib/source/lux/world/net/http.lux
@@ -10,9 +10,11 @@
[context (#+ Context)]]]
[world
[binary (#+ Binary)]]]
- [// (#+ URL)])
+ [// (#+ URL)
+ [uri (#+ URI)]])
-(type: #export Version Text)
+(type: #export Version
+ Text)
(type: #export Method
#Post
@@ -25,9 +27,11 @@
#Options
#Trace)
-(type: #export Port Nat)
+(type: #export Port
+ Nat)
-(type: #export Status Nat)
+(type: #export Status
+ Nat)
(type: #export Header
(-> Context Context))
@@ -38,9 +42,6 @@
(type: #export Body
(Channel Data))
-(type: #export URI
- Text)
-
(type: #export Scheme
#HTTP
#HTTPS)
diff --git a/stdlib/source/lux/world/net/uri.lux b/stdlib/source/lux/world/net/uri.lux
new file mode 100644
index 000000000..e7d70d108
--- /dev/null
+++ b/stdlib/source/lux/world/net/uri.lux
@@ -0,0 +1,8 @@
+(.module:
+ [lux #*])
+
+(type: #export URI
+ Text)
+
+(def: #export separator
+ "/")
diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux
index b324790fb..8992b7ab6 100644
--- a/stdlib/source/poly/lux/data/format/json.lux
+++ b/stdlib/source/poly/lux/data/format/json.lux
@@ -284,12 +284,12 @@
(~+ (list@map (function (_ [tag memberC])
(if (n.= last tag)
(` (|> (~ memberC)
- ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag))))))
((~! p.after) ((~! </>.boolean!) (~ (code.bit #1))))
+ ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag))))))
((~! </>.array))))
(` (|> (~ memberC)
- ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag)))))
((~! p.after) ((~! </>.boolean!) (~ (code.bit #0))))
+ ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag)))))
((~! </>.array))))))
(list.enumerate members))))))))
(do @
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index 6909704dd..0ca614be1 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -12,7 +12,7 @@
[security
["!" capability]]
[concurrency
- ["." promise]]]
+ ["." promise (#+ Promise)]]]
[data
[binary (#+ Binary)]
["." text
@@ -32,7 +32,8 @@
["#." parser]
["#." pom]
["#." cli]
- ["#." local]])
+ ["#." local]
+ ["#." dependency]])
(def: (read-file! path)
(-> Path (IO (Try Binary)))
@@ -40,16 +41,6 @@
[project-file (!.use (:: file.system file) [path])]
(!.use (:: project-file content) [])))
-(def: (write-pom! path project)
- (-> Path /.Project (IO (Try Any)))
- (do (try.with io.monad)
- [file (!.use (:: file.system file) [path])]
- (|> project
- /pom.project
- (:: xml.codec encode)
- encoding.to-utf8
- (!.use (:: file over-write)))))
-
(def: (read-code source-code)
(-> Text (Try Code))
(let [parse (syntax.parse ""
@@ -64,6 +55,61 @@
(#.Right [end lux-code])
(#try.Success lux-code))))
+(def: (write-pom!' path project)
+ (-> Path /.Project (IO (Try Any)))
+ (do (try.with io.monad)
+ [file (!.use (:: file.system file) [path])]
+ (|> project
+ /pom.project
+ (:: xml.codec encode)
+ encoding.to-utf8
+ (!.use (:: file over-write)))))
+
+(def: (write-pom! project)
+ (-> /.Project (IO Any))
+ (do io.monad
+ [outcome (write-pom!' /pom.file project)]
+ (case outcome
+ (#try.Success value)
+ (wrap (log! "Successfully wrote POM file!"))
+
+ (#try.Failure error)
+ (wrap (log! (format "Could not write POM file:" text.new-line
+ error))))))
+
+(def: (install! project)
+ (-> /.Project (Promise Any))
+ (do promise.monad
+ [outcome (/local.install (file.async file.system) project)]
+ (wrap (case outcome
+ (#try.Success _)
+ (log! "Successfully installed locally!")
+
+ (#try.Failure error)
+ (log! (format "Could not install locally:" text.new-line
+ error))))))
+
+(def: (fetch-dependencies! project)
+ (-> /.Project (Promise Any))
+ (do promise.monad
+ [outcome (do (try.with promise.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))]
+ (wrap (case outcome
+ (#try.Success _)
+ (log! "Successfully resolved dependencies!")
+
+ (#try.Failure error)
+ (log! (format "Could not resolve dependencies:" text.new-line
+ error))))))
+
(def: project
(-> Binary (Try /.Project))
(|>> (do> try.monad
@@ -80,26 +126,14 @@
(#try.Success project)
(case command
#/cli.POM
- (do @
- [outcome (..write-pom! /pom.file project)]
- (case outcome
- (#try.Success value)
- (wrap (log! "Successfully wrote POM file!"))
-
- (#try.Failure error)
- (wrap (log! (format "Could not write POM file:" text.new-line
- error)))))
+ (..write-pom! project)
#/cli.Install
- (exec (do promise.monad
- [outcome (/local.install (file.async file.system) project)]
- (wrap (case outcome
- (#try.Success _)
- (log! "Successfully installed locally!")
-
- (#try.Failure error)
- (log! (format "Could not install locally:" text.new-line
- error)))))
+ (exec (..install! project)
+ (wrap []))
+
+ #/cli.Dependencies
+ (exec (..fetch-dependencies! project)
(wrap [])))
(#try.Failure error)
diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux
new file mode 100644
index 000000000..a6865f688
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact.lux
@@ -0,0 +1,68 @@
+(.module:
+ [lux (#- Name)
+ [abstract
+ ["." hash (#+ Hash)]]
+ [data
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#@." monoid)]]]
+ [world
+ [net
+ ["." uri]]]])
+
+(type: #export Group
+ Text)
+
+(type: #export Name
+ Text)
+
+(type: #export Version
+ Text)
+
+(type: #export Artifact
+ {#group Group
+ #name Name
+ #version Version})
+
+(def: #export hash
+ (Hash Artifact)
+ ($_ hash.product
+ text.hash
+ text.hash
+ text.hash
+ ))
+
+(def: group-separator
+ ".")
+
+(def: version-separator
+ "-")
+
+(def: #export (identity artifact)
+ (-> Artifact Text)
+ (format (get@ #name artifact)
+ ..version-separator
+ (get@ #version artifact)))
+
+(def: #export (path artifact)
+ (-> Artifact Text)
+ (let [directory (format (|> artifact
+ (get@ #group)
+ (text.split-all-with ..group-separator)
+ (text.join-with uri.separator))
+ uri.separator
+ (get@ #name artifact)
+ uri.separator
+ (get@ #version artifact))]
+ (format directory
+ uri.separator
+ (..identity artifact))))
+
+(def: #export (local artifact)
+ (-> Artifact (List Text))
+ (list@compose (|> artifact
+ (get@ #group)
+ (text.split-all-with ..group-separator))
+ (list (get@ #name artifact)
+ (get@ #version artifact))))
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
index 5f75cac9b..4ff56ac53 100644
--- a/stdlib/source/program/aedifex/cli.lux
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -6,11 +6,13 @@
(type: #export Command
#POM
- #Install)
+ #Install
+ #Dependencies)
(def: #export command
(Parser Command)
($_ <>.or
(cli.this "pom")
(cli.this "install")
+ (cli.this "deps")
))
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
index 473d5498e..7c40bf2ae 100644
--- a/stdlib/source/program/aedifex/dependency.lux
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -1,12 +1,55 @@
(.module:
- [lux (#- Type)]
+ [lux (#- Name Type)
+ ["." host (#+ import:)]
+ [abstract
+ [monad (#+ do)]
+ ["." hash (#+ Hash)]]
+ [control
+ ["." io (#+ IO)]
+ ["." try (#+ Try)]
+ ["." exception (#+ Exception exception:)]
+ ["<>" parser
+ ["<xml>" xml (#+ Parser)]]]
+ [data
+ ["." binary (#+ Binary)]
+ ["." name]
+ ["." maybe]
+ ["." text
+ ["%" format (#+ format)]
+ ["." encoding]]
+ [number
+ ["." i64]
+ ["n" nat]]
+ [format
+ ["." xml (#+ Tag XML)]]
+ [collection
+ ["." dictionary (#+ Dictionary)]]]
+ [world
+ [net (#+ URL)
+ ["." uri]]]]
["." // #_
+ ["#." extension]
+ ["#." artifact (#+ Artifact)]
["#." hash]])
+(type: #export Repository
+ URL)
+
## https://maven.apache.org/ref/3.6.3/maven-core/artifact-handlers.html
(type: #export Type
Text)
+(type: #export Dependency
+ {#artifact Artifact
+ #type ..Type})
+
+(def: #export hash
+ (Hash Dependency)
+ ($_ hash.product
+ //artifact.hash
+ text.hash
+ ))
+
(template [<type> <name>]
[(def: #export <name>
Type
@@ -15,3 +58,234 @@
["tar" lux-library]
["jar" jvm-library]
)
+
+(import: #long java/lang/String)
+
+(import: #long java/lang/AutoCloseable
+ (close [] #io #try void))
+
+(import: #long java/io/InputStream)
+
+(import: #long java/net/URL
+ (new [java/lang/String])
+ (openStream [] #io #try java/io/InputStream))
+
+(import: #long java/io/BufferedInputStream
+ (new [java/io/InputStream])
+ (read [[byte] int int] #io #try int))
+
+(def: buffer-size
+ (n.* 512 1,024))
+
+(def: (download url)
+ (-> URL (IO (Try Binary)))
+ (do {@ (try.with io.monad)}
+ [input (|> (java/net/URL::new url)
+ java/net/URL::openStream
+ (:: @ map (|>> java/io/BufferedInputStream::new)))
+ #let [buffer (binary.create ..buffer-size)]]
+ (loop [output (:: binary.monoid identity)]
+ (do @
+ [bytes-read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer-size) input)]
+ (case bytes-read
+ -1 (do @
+ [_ (java/lang/AutoCloseable::close input)]
+ (wrap output))
+ _ (if (n.= ..buffer-size bytes-read)
+ (recur (:: binary.monoid compose output buffer))
+ (do @
+ [chunk (:: io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
+ (recur (:: binary.monoid compose output chunk)))))))))
+
+(def: hex-per-byte
+ 2)
+
+(def: hex-per-nat
+ (n.* hex-per-byte i64.bytes-per-i64))
+
+(type: Hash-Reader
+ (-> Binary (Try //hash.Hash)))
+
+(def: (sha1 input)
+ Hash-Reader
+ (do try.monad
+ [input (encoding.from-utf8 input)
+ [left input] (try.from-maybe (text.split ..hex-per-nat input))
+ [middle right] (try.from-maybe (text.split ..hex-per-nat input))
+ #let [output (:: binary.monoid identity)]
+ left (:: n.hex decode left)
+ output (binary.write/64 0 left output)
+ middle (:: n.hex decode middle)
+ output (binary.write/64 i64.bytes-per-i64 middle output)
+ right (:: n.hex decode right)]
+ (binary.write/64 (n.* 2 i64.bytes-per-i64) right output)))
+
+(def: (md5 input)
+ Hash-Reader
+ (do try.monad
+ [input (encoding.from-utf8 input)
+ [left right] (try.from-maybe (text.split ..hex-per-nat input))
+ #let [output (:: binary.monoid identity)]
+ left (:: n.hex decode left)
+ output (binary.write/64 0 left output)
+ right (:: n.hex decode right)]
+ (binary.write/64 i64.bytes-per-i64 right output)))
+
+(template [<name>]
+ [(exception: #export (<name> {dependency Dependency} {hash Text})
+ (let [artifact (get@ #artifact dependency)
+ type (get@ #type dependency)]
+ (exception.report
+ ["Artifact" (format (get@ #//artifact.group artifact)
+ " " (get@ #//artifact.name artifact)
+ " " (get@ #//artifact.version artifact))]
+ ["Type" (%.text type)]
+ ["Hash" (%.text hash)])))]
+
+ [sha1-does-not-match]
+ [md5-does-not-match]
+ )
+
+(type: #export Package
+ {#library Binary
+ #pom XML
+ #dependencies (List Dependency)
+ #sha1 Text
+ #md5 Text})
+
+(def: (verified-hash dependency library url hash reader exception)
+ (-> Dependency Binary URL (-> Binary //hash.Hash) Hash-Reader (Exception [Dependency Text])
+ (IO (Try Text)))
+ (do (try.with io.monad)
+ [#let [reference (hash library)]
+ actual (..download url)]
+ (:: io.monad wrap
+ (do try.monad
+ [output (encoding.from-utf8 actual)
+ actual (reader actual)
+ _ (exception.assert exception [dependency output]
+ (:: binary.equivalence = reference actual))]
+ (wrap output)))))
+
+(def: parse-property
+ (Parser [Tag Text])
+ (do <>.monad
+ [property <xml>.tag
+ _ (<xml>.node property)
+ value (<xml>.children <xml>.text)]
+ (wrap [property value])))
+
+(def: parse-dependency
+ (Parser Dependency)
+ (do {@ <>.monad}
+ [properties (:: @ map (dictionary.from-list name.hash)
+ (<xml>.children (<>.some ..parse-property)))]
+ (<| <>.lift
+ try.from-maybe
+ (do maybe.monad
+ [group (dictionary.get ["" "groupId"] properties)
+ artifact (dictionary.get ["" "artifactId"] properties)
+ version (dictionary.get ["" "version"] properties)]
+ (wrap {#artifact {#//artifact.group group
+ #//artifact.name artifact
+ #//artifact.version version}
+ #type (|> properties
+ (dictionary.get ["" "type"])
+ (maybe.default ..lux-library))})))))
+
+(def: parse-dependencies
+ (Parser (List Dependency))
+ (do {@ <>.monad}
+ [_ (<xml>.node ["" "dependencies"])]
+ (<xml>.children (<>.some ..parse-dependency))))
+
+(def: #export from-pom
+ (-> XML (Try (List Dependency)))
+ (<xml>.run (do {@ <>.monad}
+ [_ (<xml>.node ["" "project"])]
+ (<xml>.children (loop [_ []]
+ (do @
+ [?dependencies (<>.or ..parse-dependencies
+ (<>.maybe <xml>.ignore))]
+ (case ?dependencies
+ (#.Left dependencies)
+ (wrap dependencies)
+
+ (#.Right #.None)
+ (wrap (: (List Dependency)
+ (list)))
+
+ (#.Right (#.Some _))
+ (recur []))))))))
+
+(def: #export (resolve repository dependency)
+ (-> Repository Dependency (IO (Try Package)))
+ (let [[artifact type] dependency
+ prefix (format repository uri.separator (//artifact.path artifact))]
+ (do (try.with io.monad)
+ [library (..download (format prefix "." type))
+ sha1 (..verified-hash dependency library (format prefix //extension.sha1) //hash.sha1 ..sha1 ..sha1-does-not-match)
+ md5 (..verified-hash dependency library (format prefix //extension.md5) //hash.md5 ..md5 ..md5-does-not-match)
+ pom (..download (format prefix //extension.pom))]
+ (:: io.monad wrap
+ (do try.monad
+ [pom (encoding.from-utf8 pom)
+ pom (:: xml.codec decode pom)
+ dependencies (..from-pom pom)]
+ (wrap {#library library
+ #pom pom
+ #dependencies dependencies
+ #sha1 sha1
+ #md5 md5}))))))
+
+(type: #export Resolution
+ (Dictionary Dependency Package))
+
+(def: #export empty
+ Resolution
+ (dictionary.new ..hash))
+
+(exception: #export (cannot-resolve {dependency Dependency})
+ (let [artifact (get@ #artifact dependency)
+ type (get@ #type dependency)]
+ (exception.report
+ ["Artifact" (format (get@ #//artifact.group artifact)
+ " " (get@ #//artifact.name artifact)
+ " " (get@ #//artifact.version artifact))]
+ ["Type" (%.text type)])))
+
+(def: (resolve-any repositories dependency)
+ (-> (List Repository) Dependency (IO (Try Package)))
+ (case repositories
+ #.Nil
+ (|> dependency
+ (exception.throw ..cannot-resolve)
+ (:: io.monad wrap))
+
+ (#.Cons repository alternatives)
+ (do io.monad
+ [outcome (..resolve repository dependency)]
+ (case outcome
+ (#try.Success package)
+ (wrap outcome)
+
+ (#try.Failure error)
+ (resolve-any alternatives dependency)))))
+
+(def: #export (resolve-all repositories dependencies resolution)
+ (-> (List Repository) (List Dependency) Resolution (IO (Try Resolution)))
+ (case dependencies
+ #.Nil
+ (:: (try.with io.monad) wrap resolution)
+
+ (#.Cons head tail)
+ (do (try.with io.monad)
+ [package (case (dictionary.get head resolution)
+ (#.Some package)
+ (wrap package)
+
+ #.None
+ (..resolve-any repositories head))
+ #let [resolution (dictionary.put head package resolution)]
+ resolution (resolve-all repositories (get@ #dependencies package) resolution)]
+ (resolve-all repositories tail resolution))))
diff --git a/stdlib/source/program/aedifex/extension.lux b/stdlib/source/program/aedifex/extension.lux
new file mode 100644
index 000000000..6caa343aa
--- /dev/null
+++ b/stdlib/source/program/aedifex/extension.lux
@@ -0,0 +1,11 @@
+(.module:
+ [lux #*])
+
+(def: #export sha1
+ ".sha1")
+
+(def: #export md5
+ ".md5")
+
+(def: #export pom
+ ".pom")
diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux
index bd4396006..63511a74d 100644
--- a/stdlib/source/program/aedifex/hash.lux
+++ b/stdlib/source/program/aedifex/hash.lux
@@ -2,7 +2,11 @@
[lux #*
["." host (#+ import:)]
[data
- ["." binary (#+ Binary)]]])
+ ["." binary (#+ Binary)]
+ ["." text
+ ["%" format (#+ format)]]
+ [number
+ ["." nat]]]])
## TODO: Replace with pure-Lux implementations of these algorithms
## https://en.wikipedia.org/wiki/SHA-1#SHA-1_pseudocode
@@ -25,3 +29,13 @@
[sha1 "SHA-1"]
[md5 "MD5"]
)
+
+(def: #export representation
+ (-> Hash Text)
+ (binary.fold (function (_ byte representation)
+ (let [hex (:: nat.hex encode byte)
+ hex (case (text.size hex)
+ 1 (format "0" hex)
+ _ hex)]
+ (format representation hex)))
+ ""))
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
index 15d9a9323..8761b573a 100644
--- a/stdlib/source/program/aedifex/local.lux
+++ b/stdlib/source/program/aedifex/local.lux
@@ -15,7 +15,8 @@
["%" format (#+ format)]
["." encoding]]
[collection
- ["." list ("#@." monoid)]]
+ ["." list ("#@." monoid)]
+ ["." dictionary]]
[format
["." binary]
["." tar]
@@ -26,12 +27,12 @@
[compositor
["." export]]]
["." // #_
- ["#." project (#+ Project)]
+ ["/" project (#+ Project)]
+ ["#." extension]
["#." pom]
- ["#." dependency]])
-
-(def: group-separator
- ".")
+ ["#." artifact (#+ Artifact)]
+ ["#." dependency (#+ Package Resolution Dependency)]
+ ["#." hash]])
(def: (local system)
(All [a] (-> (file.System a) Path))
@@ -41,13 +42,12 @@
(All [a] (-> (file.System a) Path))
(format (..local system) (:: system separator) "repository"))
-(def: (guarantee-repository! system project)
- (-> (file.System Promise) Project (Promise (Try Path)))
+(def: (guarantee-repository! system artifact)
+ (-> (file.System Promise) Artifact (Promise (Try Path)))
(do {@ (try.with promise.monad)}
[_ (: (Promise (Try (Directory Promise)))
(file.get-directory promise.monad system (..local system)))
- #let [root (..repository system)
- identity (get@ #//project.identity project)]
+ #let [root (..repository system)]
_ (: (Promise (Try (Directory Promise)))
(file.get-directory promise.monad system root))]
(monad.fold @
@@ -58,11 +58,7 @@
(file.get-directory promise.monad system path))]
(wrap path)))
root
- (list@compose (|> identity
- (get@ #//project.group)
- (text.split-all-with ..group-separator))
- (list (get@ #//project.name identity)
- (get@ #//project.version identity))))))
+ (//artifact.local artifact))))
(def: (save! system content file)
(-> (file.System Promise) Binary Path (Promise (Try Any)))
@@ -74,13 +70,93 @@
(def: #export (install system project)
(-> (file.System Promise) Project (Promise (Try Any)))
(do (try.with promise.monad)
- [repository (..guarantee-repository! system project)
- #let [identity (get@ #//project.identity project)
- artifact-name (format repository
- (:: system separator) (get@ #//project.name identity)
- "-" (get@ #//project.version identity))]
- package (export.library system (get@ #//project.sources project))
+ [repository (..guarantee-repository! system (get@ #/.identity project))
+ #let [identity (get@ #/.identity project)
+ artifact-name (format repository (:: system separator) (//artifact.identity identity))]
+ package (export.library system (get@ #/.sources project))
_ (..save! system (binary.run tar.writer package)
(format artifact-name "." //dependency.lux-library))]
(..save! system (|> project //pom.project (:: xml.codec encode) encoding.to-utf8)
- (format artifact-name //pom.extension))))
+ (format artifact-name //extension.pom))))
+
+(def: #export (cache system [artifact type] package)
+ (-> (file.System Promise) Dependency Package (Promise (Try Any)))
+ (do (try.with promise.monad)
+ [directory (..guarantee-repository! system artifact)
+ #let [prefix (format directory (:: system separator) (//artifact.identity artifact))]
+ directory (: (Promise (Try (Directory Promise)))
+ (file.get-directory promise.monad system directory))
+ _ (..save! system
+ (get@ #//dependency.library package)
+ (format prefix "." type))
+ _ (..save! system
+ (encoding.to-utf8 (get@ #//dependency.sha1 package))
+ (format prefix //extension.sha1))
+ _ (..save! system
+ (encoding.to-utf8 (get@ #//dependency.md5 package))
+ (format prefix //extension.md5))
+ _ (..save! system
+ (|> package (get@ #//dependency.pom) (:: xml.codec encode) encoding.to-utf8)
+ (format prefix //extension.pom))]
+ (wrap [])))
+
+(def: #export (cache-all system resolution)
+ (-> (file.System Promise) Resolution (Promise (Try Any)))
+ (do {@ (try.with promise.monad)}
+ [_ (monad.map @ (function (_ [dependency package])
+ (..cache system dependency package))
+ (dictionary.entries resolution))]
+ (wrap [])))
+
+(def: (read! system path)
+ (-> (file.System Promise) Path (Promise (Try Binary)))
+ (do (try.with promise.monad)
+ [file (: (Promise (Try (File Promise)))
+ (!.use (:: system file) path))]
+ (!.use (:: file content) [])))
+
+(def: #export (cached system [artifact type])
+ (-> (file.System Promise) Dependency (Promise (Try Package)))
+ (do (try.with promise.monad)
+ [directory (..guarantee-repository! system artifact)
+ #let [prefix (format directory (:: system separator) (//artifact.identity artifact))]
+ pom (..read! system (format prefix //extension.pom))
+ [pom dependencies] (:: promise.monad wrap
+ (do try.monad
+ [pom (encoding.from-utf8 pom)
+ pom (:: xml.codec decode pom)
+ dependencies (//dependency.from-pom pom)]
+ (wrap [pom dependencies])))
+ library (..read! system (format prefix "." type))
+ sha1 (..read! system (format prefix //extension.sha1))
+ md5 (..read! system (format prefix //extension.md5))]
+ (wrap {#//dependency.library library
+ #//dependency.pom pom
+ #//dependency.dependencies dependencies
+ #//dependency.sha1 (//hash.representation sha1)
+ #//dependency.md5 (//hash.representation md5)})))
+
+(def: #export (all-cached system dependencies resolution)
+ (-> (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
+ (case dependencies
+ #.Nil
+ (:: (try.with promise.monad) wrap resolution)
+
+ (#.Cons head tail)
+ (do promise.monad
+ [package (case (dictionary.get head resolution)
+ (#.Some package)
+ (wrap (#try.Success package))
+
+ #.None
+ (..cached system head))]
+ (with-expansions [<next> (as-is (all-cached system tail resolution))]
+ (case package
+ (#try.Success package)
+ (let [resolution (dictionary.put head package resolution)]
+ (do (try.with promise.monad)
+ [resolution (all-cached system (get@ #//dependency.dependencies package) resolution)]
+ <next>))
+
+ (#try.Failure error)
+ <next>)))))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 1a4b2f638..78f6dbb60 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -11,26 +11,27 @@
[net (#+ URL)]]]
[//
["/" project]
+ ["//." artifact (#+ Artifact)]
["//." dependency]])
(def: group
- (Parser /.Group)
+ (Parser //artifact.Group)
<c>.text)
(def: name
- (Parser /.Name)
+ (Parser //artifact.Name)
<c>.text)
(def: version
- (Parser /.Version)
+ (Parser //artifact.Version)
<c>.text)
(def: artifact'
- (Parser /.Artifact)
+ (Parser //artifact.Artifact)
($_ <>.and ..group ..name ..version))
(def: artifact
- (Parser /.Artifact)
+ (Parser //artifact.Artifact)
(<c>.tuple ..artifact'))
(def: url
@@ -106,7 +107,7 @@
))
(def: repository
- (Parser /.Repository)
+ (Parser //dependency.Repository)
..url)
(def: type
@@ -114,7 +115,7 @@
<c>.text)
(def: dependency
- (Parser /.Dependency)
+ (Parser //dependency.Dependency)
(<c>.tuple
($_ <>.and
..artifact'
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index 102728e1e..794ed7e12 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -8,17 +8,16 @@
["_" xml (#+ XML)]]
[collection
["." list ("#@." monoid functor)]]]]
- [//
- ["/" project]])
+ ["." // #_
+ ["/" project]
+ ["#." artifact (#+ Artifact)]
+ ["#." dependency (#+ Repository Dependency)]])
## https://maven.apache.org/pom.html
(def: #export file
"pom.xml")
-(def: #export extension
- ".pom")
-
(def: version
XML
(#_.Node ["" "modelVersion"] _.attrs
@@ -31,10 +30,10 @@
(list (#_.Text value))))
(def: (artifact value)
- (-> /.Artifact (List XML))
- (list (..property "groupId" (get@ #/.group value))
- (..property "artifactId" (get@ #/.name value))
- (..property "version" (get@ #/.version value))))
+ (-> Artifact (List XML))
+ (list (..property "groupId" (get@ #//artifact.group value))
+ (..property "artifactId" (get@ #//artifact.name value))
+ (..property "version" (get@ #//artifact.version value))))
(def: distribution
(-> /.Distribution XML)
@@ -50,17 +49,17 @@
(#_.Node ["" "license"] _.attrs)))
(def: repository
- (-> /.Repository XML)
+ (-> Repository XML)
(|>> (..property "url")
list
(#_.Node ["" "repository"] _.attrs)))
-(def: (dependency [artifact type])
- (-> /.Dependency XML)
+(def: (dependency value)
+ (-> Dependency XML)
(#_.Node ["" "dependency"]
_.attrs
- (list@compose (..artifact artifact)
- (list (..property "type" type)))))
+ (list@compose (..artifact (get@ #//dependency.artifact value))
+ (list (..property "type" (get@ #//dependency.type value))))))
(def: scm
(-> /.SCM XML)
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
index 9f98ebc51..385ef8919 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,34 +1,23 @@
(.module:
- [lux (#- Name Info Source)
+ [lux (#- Info Source)
+ [data
+ ["." text]]
[world
[net (#+ URL)]
[file (#+ Path)]]]
[//
+ [artifact (#+ Artifact)]
["." dependency]])
(def: #export file
"project.lux")
-(type: #export Group
- Text)
-
-(type: #export Name
- Text)
-
-(type: #export Version
- Text)
-
-(type: #export Artifact
- {#group Group
- #name Name
- #version Version})
-
(type: #export Distribution
#Repo
#Manual)
(type: #export License
- [Name
+ [Text
URL
Distribution])
@@ -36,14 +25,14 @@
URL)
(type: #export Organization
- [Name
+ [Text
URL])
(type: #export Email
Text)
(type: #export Developer
- [Name
+ [Text
Email
(Maybe Organization)])
@@ -59,18 +48,12 @@
#developers (List Developer)
#contributors (List Contributor)})
-(type: #export Repository
- URL)
-
-(type: #export Dependency
- [Artifact dependency.Type])
-
(type: #export Source
Path)
(type: #export Project
{#identity Artifact
#info Info
- #repositories (List Repository)
- #dependencies (List Dependency)
+ #repositories (List dependency.Repository)
+ #dependencies (List dependency.Dependency)
#sources (List Source)})
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index 4d9632b8c..6c52dc5ad 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -169,7 +169,7 @@
(list@= (list distint/0 distint/1 distint/2)
actual))))
(let [polling-delay 10
- wiggle-room (n.* 3 polling-delay)
+ wiggle-room (n.* 5 polling-delay)
amount-of-polls 5
total-delay (|> polling-delay
(n.* amount-of-polls)
diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux
index 564e37a87..a57adaa53 100644
--- a/stdlib/source/test/lux/control/function/memo.lux
+++ b/stdlib/source/test/lux/control/function/memo.lux
@@ -50,7 +50,7 @@
Test
(<| (_.covering /._)
(do {@ random.monad}
- [input (|> random.nat (:: @ map (|>> (n.% 5) (n.+ 22))))])
+ [input (|> random.nat (:: @ map (|>> (n.% 5) (n.+ 23))))])
(_.with-cover [/.Memo])
($_ _.and
(_.cover [/.closed /.none]
diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux
index 4875820b6..1851fb4a4 100644
--- a/stdlib/source/test/lux/macro.lux
+++ b/stdlib/source/test/lux/macro.lux
@@ -6,7 +6,8 @@
["." /]}
["." / #_
["#." code]
- ["#." syntax]
+ ["#." syntax
+ ["#/." common]]
["#." poly #_
["#/." equivalence]
["#/." functor]
@@ -18,6 +19,7 @@
($_ _.and
/code.test
/syntax.test
+ /syntax/common.test
/poly/equivalence.test
/poly/functor.test
/poly/json.test
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index 0fc1c24be..00a805f26 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -45,7 +45,7 @@
[size (|> random.nat (:: @ map (n.% 3)))]
(random.list size (random.and random random))))
-(def: random
+(def: #export random
(Random Code)
(random.rec
(function (_ random)
diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux
index 5e0bcfbd4..55b2d2dd2 100644
--- a/stdlib/source/test/lux/macro/poly/json.lux
+++ b/stdlib/source/test/lux/macro/poly/json.lux
@@ -1,6 +1,5 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
codec
@@ -20,7 +19,8 @@
[data
["." bit]
["." maybe]
- ["." text]
+ ["." text
+ ["%" format (#+ format)]]
[number
["n" nat]
["." frac]]
@@ -37,7 +37,7 @@
[type
["." unit]]
[math
- ["r" random (#+ Random)]]
+ ["." random (#+ Random)]]
[time
["ti" instant]
["tda" date]
@@ -67,39 +67,39 @@
#list (List Frac)
#dictionary (d.Dictionary Text Frac)
#variant Variant
- #tuple [Bit Frac Text]
+ #tuple [Bit Text Frac]
#recursive Recursive
## #instant ti.Instant
## #duration tdu.Duration
#date tda.Date
- #grams (unit.Qty unit.Gram)
- })
+ #grams (unit.Qty unit.Gram)})
(def: gen-recursive
(Random Recursive)
- (r.rec (function (_ gen-recursive)
- (r.or r.frac
- (r.and r.frac gen-recursive)))))
+ (random.rec
+ (function (_ gen-recursive)
+ (random.or random.frac
+ (random.and random.frac gen-recursive)))))
(derived: recursive-equivalence (poly/equivalence.equivalence Recursive))
(def: qty
(All [unit] (Random (unit.Qty unit)))
- (|> r.int (:: r.monad map unit.in)))
+ (|> random.int (:: random.monad map unit.in)))
(def: gen-record
(Random Record)
- (do {@ r.monad}
- [size (:: @ map (n.% 2) r.nat)]
- ($_ r.and
- r.bit
- r.frac
- (r.unicode size)
- (r.maybe r.frac)
- (r.list size r.frac)
- (r.dictionary text.hash size (r.unicode size) r.frac)
- ($_ r.or r.bit (r.unicode size) r.frac)
- ($_ r.and r.bit r.frac (r.unicode size))
+ (do {@ random.monad}
+ [size (:: @ map (n.% 2) random.nat)]
+ ($_ random.and
+ random.bit
+ random.frac
+ (random.unicode size)
+ (random.maybe random.frac)
+ (random.list size random.frac)
+ (random.dictionary text.hash size (random.unicode size) random.frac)
+ ($_ random.or random.bit (random.unicode size) random.frac)
+ ($_ random.and random.bit (random.unicode size) random.frac)
..gen-recursive
## _instant.instant
## _duration.duration
@@ -112,5 +112,6 @@
(def: #export test
Test
- (<| (_.context (%.name (name-of /._)))
- ($codec.spec ..equivalence ..codec gen-record)))
+ (<| (_.covering /._)
+ (_.with-cover [/.codec]
+ ($codec.spec ..equivalence ..codec ..gen-record))))
diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux
new file mode 100644
index 000000000..1aaf851a9
--- /dev/null
+++ b/stdlib/source/test/lux/macro/syntax/common.lux
@@ -0,0 +1,134 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [math
+ ["." random (#+ Random)]]
+ [abstract
+ [monad (#+ do)]
+ ["." equivalence (#+ Equivalence)]]
+ [control
+ [pipe (#+ case>)]
+ ["." try]
+ ["<>" parser
+ ["<c>" code]]]
+ [data
+ ["." bit ("#@." equivalence)]
+ ["." name]
+ ["." text]
+ [number
+ ["n" nat]]
+ [collection
+ ["." list]]]
+ [macro
+ ["." code]]]
+ {1
+ ["." /
+ ["#." reader]
+ ["#." writer]]}
+ ["." /// #_
+ ["#." code]])
+
+(def: annotations-equivalence
+ (Equivalence /.Annotations)
+ (list.equivalence
+ (equivalence.product name.equivalence
+ code.equivalence)))
+
+(def: random-text
+ (Random Text)
+ (random.ascii/alpha 10))
+
+(def: random-name
+ (Random Name)
+ (random.and ..random-text ..random-text))
+
+(def: random-annotations
+ (Random /.Annotations)
+ (do {@ random.monad}
+ [size (:: @ map (|>> (n.% 3)) random.nat)]
+ (random.list size (random.and random-name
+ ///code.random))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.covering /reader._)
+ (_.covering /writer._)
+ ($_ _.and
+ (do random.monad
+ [expected random.bit]
+ (_.cover [/reader.export /writer.export]
+ (|> expected
+ /writer.export
+ (<c>.run /reader.export)
+ (case> (#try.Success actual)
+ (bit@= expected actual)
+
+ (#try.Failure error)
+ false))))
+ (_.with-cover [/.Annotations]
+ ($_ _.and
+ (do random.monad
+ [expected ..random-annotations]
+ (_.cover [/reader.annotations /writer.annotations]
+ (|> expected
+ /writer.annotations list
+ (<c>.run /reader.annotations)
+ (case> (#try.Success actual)
+ (:: ..annotations-equivalence = expected actual)
+
+ (#try.Failure error)
+ false))))
+ (_.cover [/.empty-annotations]
+ (|> /.empty-annotations
+ /writer.annotations list
+ (<c>.run /reader.annotations)
+ (case> (#try.Success actual)
+ (:: ..annotations-equivalence = /.empty-annotations actual)
+
+ (#try.Failure error)
+ false)))
+ ))
+ (do {@ random.monad}
+ [size (:: @ map (|>> (n.% 3)) random.nat)
+ expected (random.list size ..random-text)]
+ (_.cover [/.Type-Var /reader.type-variables /writer.type-variables]
+ (|> expected
+ /writer.type-variables
+ (<c>.run /reader.type-variables)
+ (case> (#try.Success actual)
+ (:: (list.equivalence text.equivalence) = expected actual)
+
+ (#try.Failure error)
+ false))))
+ (do {@ random.monad}
+ [size (:: @ map (|>> (n.% 3)) random.nat)
+ expected (: (Random /.Declaration)
+ (random.and ..random-text
+ (random.list size ..random-text)))]
+ (_.cover [/.Declaration /reader.declaration /writer.declaration]
+ (|> expected
+ /writer.declaration list
+ (<c>.run /reader.declaration)
+ (case> (#try.Success actual)
+ (let [equivalence (equivalence.product text.equivalence
+ (list.equivalence text.equivalence))]
+ (:: equivalence = expected actual))
+
+ (#try.Failure error)
+ false))))
+ (do {@ random.monad}
+ [expected (: (Random /.Typed-Input)
+ (random.and ///code.random
+ ///code.random))]
+ (_.cover [/.Typed-Input /reader.typed-input /writer.typed-input]
+ (|> expected
+ /writer.typed-input list
+ (<c>.run /reader.typed-input)
+ (case> (#try.Success actual)
+ (let [equivalence (equivalence.product code.equivalence code.equivalence)]
+ (:: equivalence = expected actual))
+
+ (#try.Failure error)
+ false))))
+ )))