From c006a5fe8e82f6fc7c8cdb9db0f44c06d229f34e Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 15 Oct 2020 01:01:21 -0400
Subject: Re-named "to-text" functions to "format".

---
 stdlib/source/test/aedifex/hash.lux | 95 +++++++++++++++++++++++++++++++++++++
 1 file changed, 95 insertions(+)
 create mode 100644 stdlib/source/test/aedifex/hash.lux

(limited to 'stdlib/source/test/aedifex/hash.lux')

diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux
new file mode 100644
index 000000000..21e318be6
--- /dev/null
+++ b/stdlib/source/test/aedifex/hash.lux
@@ -0,0 +1,95 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]
+      ["$." codec]]}]
+   [control
+    ["." try]
+    ["." exception]]
+   [data
+    ["." binary (#+ Binary)]
+    [number
+     ["n" nat]]
+    [text
+     ["%" format (#+ format)]]]
+   [math
+    ["." random (#+ Random)]]]
+  {#program
+   ["." /]}
+  [test
+   [lux
+    [data
+     ["_." binary]]]])
+
+(def: (random hash)
+  (All [h]
+    (-> (-> Binary (/.Hash h))
+        (Random (/.Hash h))))
+  (do {@ random.monad}
+    [size (:: @ map (n.% 100) random.nat)]
+    (:: @ map hash (_binary.random size))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.Hash /.SHA-1 /.MD5])
+      (`` ($_ _.and
+              (_.with-cover [/.equivalence]
+                ($_ _.and
+                    ($equivalence.spec /.equivalence (..random /.sha1))
+                    ($equivalence.spec /.equivalence (..random /.md5))
+                    ))
+              (_.with-cover [/.data]
+                ($_ _.and
+                    (~~ (template [<hash> <constructor> <exception>]
+                          [(do random.monad
+                             [expected (..random <hash>)]
+                             (_.cover [<hash> <constructor> <exception>]
+                                      (and (case (<constructor> (/.data expected))
+                                             (#try.Success actual)
+                                             (:: /.equivalence = expected actual)
+
+                                             (#try.Failure error)
+                                             false)
+                                           (case (<constructor> (:: binary.monoid compose
+                                                                    (/.data expected)
+                                                                    (/.data expected)))
+                                             (#try.Success actual)
+                                             false
+
+                                             (#try.Failure error)
+                                             (exception.match? <exception> error)))))]
+
+                          [/.sha1 /.as-sha1 /.not-a-sha1]
+                          [/.md5 /.as-md5 /.not-a-md5]
+                          ))))
+              (~~ (template [<codec> <hash>]
+                    [(_.with-cover [<codec>]
+                       ($codec.spec /.equivalence <codec> (..random <hash>)))]
+                    
+                    [/.sha1-codec /.sha1]
+                    [/.md5-codec /.md5]
+                    ))
+              (_.with-cover [/.not-a-hash]
+                ($_ _.and
+                    (~~ (template [<codec> <hash>]
+                          [(do random.monad
+                             [expected (..random <hash>)]
+                             (_.cover [<codec>]
+                                      (case (:: <codec> decode
+                                                (format (:: <codec> encode expected)
+                                                        "AABBCC"))
+                                        (#try.Success actual)
+                                        false
+
+                                        (#try.Failure error)
+                                        (exception.match? /.not-a-hash error))))]
+
+                          [/.sha1-codec /.sha1]
+                          [/.md5-codec /.md5]
+                          ))))
+              ))))
-- 
cgit v1.2.3