Added CoMonad for CoFree.

8 files changed, 281 insertions, 6 deletions

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)))
+            ))))