aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/abstract/comonad.lux4
-rw-r--r--stdlib/source/lux/abstract/comonad/cofree.lux27
-rw-r--r--stdlib/source/lux/data/collection/dictionary/plist.lux41
-rw-r--r--stdlib/source/program/aedifex.lux5
-rw-r--r--stdlib/source/program/aedifex/cli.lux4
-rw-r--r--stdlib/source/program/aedifex/command/clean.lux47
-rw-r--r--stdlib/source/test/aedifex.lux2
-rw-r--r--stdlib/source/test/aedifex/cli.lux3
-rw-r--r--stdlib/source/test/aedifex/command/clean.lux118
-rw-r--r--stdlib/source/test/lux/abstract.lux16
-rw-r--r--stdlib/source/test/lux/abstract/comonad/cofree.lux51
-rw-r--r--stdlib/source/test/lux/control/parser/code.lux2
-rw-r--r--stdlib/source/test/lux/data/collection.lux4
-rw-r--r--stdlib/source/test/lux/data/collection/dictionary/plist.lux91
14 files changed, 395 insertions, 20 deletions
diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux
index 0722d7a1b..94b3d06c8 100644
--- a/stdlib/source/lux/abstract/comonad.lux
+++ b/stdlib/source/lux/abstract/comonad.lux
@@ -22,10 +22,6 @@
(-> (w a) (w (w a))))
split))
-(type: #export (CoFree F a)
- {#.doc "The CoFree CoMonad."}
- [a (F (CoFree F a))])
-
(macro: #export (be tokens state)
{#.doc (doc "A co-monadic parallel to the 'do' macro."
(let [square (function (_ n) (* n n))]
diff --git a/stdlib/source/lux/abstract/comonad/cofree.lux b/stdlib/source/lux/abstract/comonad/cofree.lux
new file mode 100644
index 000000000..eadfa788f
--- /dev/null
+++ b/stdlib/source/lux/abstract/comonad/cofree.lux
@@ -0,0 +1,27 @@
+(.module:
+ [lux #*]
+ [// (#+ CoMonad)
+ [//
+ [functor (#+ Functor)]]])
+
+(type: #export (CoFree F a)
+ {#.doc "The CoFree CoMonad."}
+ [a (F (CoFree F a))])
+
+(structure: #export (functor dsl)
+ (All [F] (-> (Functor F) (Functor (CoFree F))))
+
+ (def: (map f [head tail])
+ [(f head) (:: dsl map (map f) tail)]))
+
+(structure: #export (comonad dsl)
+ (All [F] (-> (Functor F) (CoMonad (CoFree F))))
+
+ (def: &functor (..functor dsl))
+
+ (def: (unwrap [head tail])
+ head)
+
+ (def: (split [head tail])
+ [[head tail]
+ (:: dsl map split tail)]))
diff --git a/stdlib/source/lux/data/collection/dictionary/plist.lux b/stdlib/source/lux/data/collection/dictionary/plist.lux
index 2e08d72f2..ae62ee303 100644
--- a/stdlib/source/lux/data/collection/dictionary/plist.lux
+++ b/stdlib/source/lux/data/collection/dictionary/plist.lux
@@ -1,14 +1,30 @@
(.module:
[lux #*
+ [abstract
+ ["." equivalence (#+ Equivalence)]]
[data
["." product]
- ["." text ("#;." equivalence)]
+ ["." text ("#@." equivalence)]
[collection
- ["." list ("#;." functor)]]]])
+ ["." list ("#@." functor)]]
+ [number
+ ["n" nat]]]])
(type: #export (PList a)
(List [Text a]))
+(def: #export empty
+ PList
+ #.Nil)
+
+(def: #export size
+ (All [a] (-> (PList a) Nat))
+ list.size)
+
+(def: #export empty?
+ (All [a] (-> (PList a) Bit))
+ (|>> ..size (n.= 0)))
+
(def: #export (get key properties)
(All [a] (-> Text (PList a) (Maybe a)))
(case properties
@@ -16,14 +32,14 @@
#.None
(#.Cons [k' v'] properties')
- (if (text;= key k')
+ (if (text@= key k')
(#.Some v')
(get key properties'))))
(template [<name> <type> <access>]
[(def: #export <name>
(All [a] (-> (PList a) (List <type>)))
- (list;map <access>))]
+ (list@map <access>))]
[keys Text product.left]
[values a product.right]
@@ -31,12 +47,12 @@
(def: #export (contains? key properties)
(All [a] (-> Text (PList a) Bit))
- (case (get key properties)
+ (case (..get key properties)
(#.Some _)
- #1
+ true
#.None
- #0))
+ false))
(def: #export (put key val properties)
(All [a] (-> Text a (PList a) (PList a)))
@@ -45,7 +61,7 @@
(list [key val])
(#.Cons [k' v'] properties')
- (if (text;= key k')
+ (if (text@= key k')
(#.Cons [key val]
properties')
(#.Cons [k' v']
@@ -58,7 +74,7 @@
#.Nil
(#.Cons [k' v'] properties')
- (if (text;= key k')
+ (if (text@= key k')
(#.Cons [k' (f v')] properties')
(#.Cons [k' v'] (update key f properties')))))
@@ -69,7 +85,12 @@
properties
(#.Cons [k' v'] properties')
- (if (text;= key k')
+ (if (text@= key k')
properties'
(#.Cons [k' v']
(remove key properties')))))
+
+(def: #export equivalence
+ (All [a] (-> (Equivalence a) (Equivalence (PList a))))
+ (|>> (equivalence.product text.equivalence)
+ list.equivalence))
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index a3712a19f..d4c9036f3 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -41,6 +41,7 @@
["#." dependency #_
["#" resolution]]
["#." command
+ ["#/." clean]
["#/." pom]
["#/." install]
["#/." build]
@@ -75,6 +76,10 @@
(case ?profile
(#try.Success profile)
(case operation
+ #/cli.Clean
+ (exec (/command/clean.do! (file.async file.default) profile)
+ (wrap []))
+
#/cli.POM
(exec (/command/pom.do! (file.async file.default) profile)
(wrap []))
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
index 666e5a701..9d73f9181 100644
--- a/stdlib/source/program/aedifex/cli.lux
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -32,6 +32,7 @@
(cli.this "test")))
(type: #export Command
+ #Clean
#POM
#Dependencies
#Install
@@ -42,6 +43,8 @@
(def: #export equivalence
(Equivalence Command)
($_ equivalence.sum
+ ## #Clean
+ ..any-equivalence
## #POM
..any-equivalence
## #Dependencies
@@ -61,6 +64,7 @@
(def: command'
(Parser Command)
($_ <>.or
+ (cli.this "clean")
(cli.this "pom")
(cli.this "deps")
(cli.this "install")
diff --git a/stdlib/source/program/aedifex/command/clean.lux b/stdlib/source/program/aedifex/command/clean.lux
new file mode 100644
index 000000000..f4f5e1f9e
--- /dev/null
+++ b/stdlib/source/program/aedifex/command/clean.lux
@@ -0,0 +1,47 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." try (#+ Try)]
+ [security
+ ["!" capability]]
+ [concurrency
+ ["." promise (#+ Promise)]]]
+ [world
+ ["." file (#+ Path File Directory)]]]
+ ["." /// #_
+ [command (#+ Command)]
+ ["#" profile]
+ ["#." action (#+ Action)]])
+
+(def: (clean-files! root)
+ (-> (Directory Promise) (Promise (Try Any)))
+ (do {! ///action.monad}
+ [nodes (: (Promise (Try (List (File Promise))))
+ (!.use (:: root files) []))
+ _ (monad.map ! (function (_ node)
+ (!.use (:: node delete) []))
+ nodes)]
+ (wrap [])))
+
+(def: #export (do! fs profile)
+ (-> (file.System Promise) (Command Any))
+ (case (get@ #///.target profile)
+ (#.Some target)
+ (do {! ///action.monad}
+ [target (: (Promise (Try (Directory Promise)))
+ (!.use (:: fs directory) target))
+ _ (loop [root target]
+ (do !
+ [_ (..clean-files! root)
+ subs (: (Promise (Try (List (Directory Promise))))
+ (!.use (:: root directories) []))
+ _ (monad.map ! recur subs)]
+ (!.use (:: root discard) [])))]
+ (exec (log! "No 'target' defined for clean-up.")
+ (wrap [])))
+
+ #.None
+ (exec (log! "No 'target' defined for clean-up.")
+ (:: ///action.monad wrap []))))
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index ed32b969c..a4fd15bec 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -9,6 +9,7 @@
["#." artifact]
["#." input]
["#." command #_
+ ["#/." clean]
["#/." pom]
["#/." install]]
["#." local]
@@ -27,6 +28,7 @@
($_ _.and
/artifact.test
/input.test
+ /command/clean.test
/command/pom.test
/command/install.test
/local.test
diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux
index dfbf0b7a9..0dde0402a 100644
--- a/stdlib/source/test/aedifex/cli.lux
+++ b/stdlib/source/test/aedifex/cli.lux
@@ -29,6 +29,8 @@
(def: command
(Random /.Command)
($_ random.or
+ ## #Clean
+ (random@wrap [])
## #POM
(random@wrap [])
## #Dependencies
@@ -54,6 +56,7 @@
(def: (format value)
(-> /.Command (List Text))
(case value
+ #/.Clean (list "clean")
#/.POM (list "pom")
#/.Dependencies (list "deps")
#/.Install (list "install")
diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux
new file mode 100644
index 000000000..73207fa14
--- /dev/null
+++ b/stdlib/source/test/aedifex/command/clean.lux
@@ -0,0 +1,118 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." try (#+ Try)]
+ [concurrency
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
+ [data
+ [binary (#+ Binary)]
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
+ [number
+ ["n" nat]]
+ [collection
+ ["." list ("#@." functor)]
+ ["." set]]]
+ [math
+ ["." random (#+ Random)]]
+ [world
+ ["." file (#+ Path File)]]]
+ [///
+ ["@." profile]
+ [//
+ [lux
+ [data
+ ["_." binary]]]]]
+ {#program
+ ["." /
+ ["//#" /// #_
+ ["#" profile]
+ ["#." action (#+ Action)]]]})
+
+(def: node-name
+ (Random Text)
+ (random.ascii/alpha 10))
+
+(def: (files prefix)
+ (-> Path (Random (List [Path Binary])))
+ (do {! random.monad}
+ [count (:: ! map (n.% 10) random.nat)
+ names (random.set text.hash count ..node-name)
+ contents (random.list count (_binary.random 100))]
+ (wrap (list.zip/2 (list@map (|>> (format prefix)) (set.to-list names))
+ contents))))
+
+(def: (create-file! fs [path content])
+ (-> (file.System Promise) [Path Binary] (Promise (Try Any)))
+ (do {! (try.with promise.monad)}
+ [file (: (Promise (Try (File Promise)))
+ (file.get-file promise.monad fs path))]
+ (!.use (:: file over-write) content)))
+
+(def: (create-directory! fs path files)
+ (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any)))
+ (do {! (try.with promise.monad)}
+ [_ (: (Promise (Try Path))
+ (file.make-directories promise.monad fs path))
+ _ (monad.map ! (..create-file! fs) files)]
+ (wrap [])))
+
+(def: (directory-exists? fs)
+ (-> (file.System Promise) Path (Promise (Try Bit)))
+ (|>> (file.directory-exists? promise.monad fs) (try.lift promise.monad)))
+
+(def: (file-exists? fs)
+ (-> (file.System Promise) Path (Promise (Try Bit)))
+ (|>> (file.file-exists? promise.monad fs) (try.lift promise.monad)))
+
+(def: (assets-exist? fs directory-path files)
+ (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Bit)))
+ (do {! (try.with promise.monad)}
+ [directory-exists? (..directory-exists? fs directory-path)
+ files-exist? (: (Action (List Bit))
+ (|> files
+ (list@map product.left)
+ (monad.map ///action.monad (..file-exists? fs))))]
+ (wrap (and directory-exists?
+ (list.every? (|>>) files-exist?)))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {! random.monad}
+ [context ..node-name
+ target ..node-name
+ sub ..node-name
+ #let [fs (file.mock (:: file.default separator))
+ / (:: fs separator)
+ target-path (format context / target)
+ sub-path (format target-path / sub)]
+ direct-files (..files (format target-path /))
+ sub-files (..files (format sub-path /))
+
+ dummy @profile.random]
+ (wrap (do promise.monad
+ [verdict (do {! (try.with promise.monad)}
+ [_ (..create-directory! fs target-path direct-files)
+ _ (..create-directory! fs sub-path sub-files)
+ context-exists!/pre (..directory-exists? fs context)
+ target-exists!/pre (..assets-exist? fs target-path direct-files)
+ sub-exists!/pre (..assets-exist? fs sub-path sub-files)
+ _ (/.do! fs (set@ #///.target (#.Some target-path) dummy))
+ context-exists!/post (..directory-exists? fs context)
+ target-exists!/post (..assets-exist? fs target-path direct-files)
+ sub-exists!/post (..assets-exist? fs sub-path sub-files)]
+ (wrap (and (and context-exists!/pre
+ context-exists!/post)
+ (and target-exists!/pre
+ (not target-exists!/post))
+ (and sub-exists!/pre
+ (not sub-exists!/post)))))]
+ (_.claim [/.do!]
+ (try.default false verdict)))))))
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index d99d3c063..9fd3986b8 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -4,7 +4,8 @@
["." / #_
["#." apply]
["#." codec]
- ["#." comonad]
+ ["#." comonad
+ ["#/." cofree]]
["#." enum]
["#." equivalence]
["#." fold]
@@ -31,19 +32,26 @@
/monad/free.test
))
+(def: comonad
+ Test
+ ($_ _.and
+ /comonad.test
+ /comonad/cofree.test
+ ))
+
(def: #export test
Test
($_ _.and
/apply.test
/codec.test
- /comonad.test
/enum.test
/equivalence.test
/fold.test
- ..functor
/interval.test
- ..monad
/monoid.test
/order.test
/predicate.test
+ ..functor
+ ..monad
+ ..comonad
))
diff --git a/stdlib/source/test/lux/abstract/comonad/cofree.lux b/stdlib/source/test/lux/abstract/comonad/cofree.lux
new file mode 100644
index 000000000..6cf767e65
--- /dev/null
+++ b/stdlib/source/test/lux/abstract/comonad/cofree.lux
@@ -0,0 +1,51 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [functor (#+ Functor)]
+ [comonad (#+ CoMonad)]
+ {[0 #spec]
+ [/
+ ["$." functor (#+ Injection Comparison)]
+ ["$." comonad]]}]
+ [control
+ ["//" continuation]]
+ [data
+ [collection
+ ["." list]
+ ["." sequence (#+ Sequence) ("#@." comonad)]]]
+ [math
+ ["." random]]]
+ {1
+ ["." /]})
+
+(def: (injection value)
+ (Injection (/.CoFree Sequence))
+ [value (sequence@map injection (sequence.repeat value))])
+
+(def: (interpret [head tail])
+ (All [a] (-> (/.CoFree Sequence a) (Sequence a)))
+ (|> tail
+ (sequence@map (:: (/.comonad sequence.functor) unwrap))
+ [head]
+ //.pending))
+
+(def: comparison
+ (Comparison (/.CoFree Sequence))
+ (function (_ == left right)
+ (:: (list.equivalence ==) =
+ (sequence.take 100 (..interpret left))
+ (sequence.take 100 (..interpret right)))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.CoFree])
+ ($_ _.and
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison (: (Functor (/.CoFree Sequence))
+ (/.functor sequence.functor))))
+ (_.with-cover [/.comonad]
+ ($comonad.spec ..injection ..comparison (: (CoMonad (/.CoFree Sequence))
+ (/.comonad sequence.functor))))
+ )))
diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux
index de2601c45..a4f25df4d 100644
--- a/stdlib/source/test/lux/control/parser/code.lux
+++ b/stdlib/source/test/lux/control/parser/code.lux
@@ -71,7 +71,7 @@
[/.nat /.nat! random.nat code.nat nat.equivalence]
[/.int /.int! random.int code.int int.equivalence]
[/.rev /.rev! random.rev code.rev rev.equivalence]
- [/.frac /.frac! random.frac code.frac frac.equivalence]
+ [/.frac /.frac! random.safe-frac code.frac frac.equivalence]
[/.text /.text! (random.unicode 1) code.text text.equivalence]
[/.identifier /.identifier! ..random-name code.identifier name.equivalence]
[/.tag /.tag! ..random-name code.tag name.equivalence]
diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux
index 0d6cb1e64..82643dfde 100644
--- a/stdlib/source/test/lux/data/collection.lux
+++ b/stdlib/source/test/lux/data/collection.lux
@@ -9,7 +9,8 @@
["#." sequence]
["#." stack]
["#." dictionary
- ["#/." ordered]]
+ ["#/." ordered]
+ ["#/." plist]]
["#." queue
["#/." priority]]
["#." set
@@ -22,6 +23,7 @@
($_ _.and
/dictionary.test
/dictionary/ordered.test
+ /dictionary/plist.test
))
(def: queue
diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux
new file mode 100644
index 000000000..cac27e0cf
--- /dev/null
+++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux
@@ -0,0 +1,91 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [data
+ ["." bit ("#@." equivalence)]
+ ["." maybe ("#@." monad)]
+ ["." text]
+ [number
+ ["n" nat]]
+ [collection
+ ["." set]
+ ["." list]]]
+ [math
+ ["." random (#+ Random)]]]
+ {1
+ ["." /]})
+
+(def: #export (random size gen-key gen-value)
+ (All [v]
+ (-> Nat (Random Text) (Random v) (Random (/.PList v))))
+ (do random.monad
+ [keys (random.set text.hash size gen-key)
+ values (random.list size gen-value)]
+ (wrap (list.zip/2 (set.to-list keys) values))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.PList])
+ (do {! random.monad}
+ [#let [gen-key (random.ascii/alpha 10)]
+ size (:: ! map (n.% 100) random.nat)
+ sample (..random size gen-key random.nat)
+
+ #let [keys (|> sample /.keys (set.from-list text.hash))]
+ extra-key (random.filter (|>> (set.member? keys) not)
+ gen-key)
+ extra-value random.nat
+ shift random.nat]
+ ($_ _.and
+ (_.with-cover [/.equivalence]
+ ($equivalence.spec (/.equivalence n.equivalence)
+ (..random size gen-key random.nat)))
+
+ (_.cover [/.size]
+ (n.= size (/.size sample)))
+ (_.cover [/.empty?]
+ (bit@= (n.= 0 (/.size sample))
+ (/.empty? sample)))
+ (_.cover [/.empty]
+ (/.empty? /.empty))
+ (_.cover [/.keys /.values]
+ (:: (/.equivalence n.equivalence) =
+ sample
+ (list.zip/2 (/.keys sample)
+ (/.values sample))))
+ (_.cover [/.contains?]
+ (and (list.every? (function (_ key)
+ (/.contains? key sample))
+ (/.keys sample))
+ (not (/.contains? extra-key sample))))
+ (_.cover [/.put]
+ (let [sample+ (/.put extra-key extra-value sample)]
+ (and (not (/.contains? extra-key sample))
+ (/.contains? extra-key sample+)
+ (n.= (inc (/.size sample))
+ (/.size sample+)))))
+ (_.cover [/.get]
+ (|> sample
+ (/.put extra-key extra-value)
+ (/.get extra-key)
+ (maybe@map (n.= extra-value))
+ (maybe.default false)))
+ (_.cover [/.update]
+ (|> sample
+ (/.put extra-key extra-value)
+ (/.update extra-key (n.+ shift))
+ (/.get extra-key)
+ (maybe@map (n.= (n.+ shift extra-value)))
+ (maybe.default false)))
+ (_.cover [/.remove]
+ (|> sample
+ (/.put extra-key extra-value)
+ (/.remove extra-key)
+ (:: (/.equivalence n.equivalence) = sample)))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 16:54:57 +0000