Re-named "to-text" functions to "format".

4 files changed, 163 insertions, 67 deletions

diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index a4b076733..b63aa2972 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -69,6 +69,6 @@
          pom (promise@wrap (///pom.project profile))
          _ (deploy! ///artifact/type.pom (|> pom (:: xml.codec encode) encoding.to-utf8))
          _ (deploy! ///artifact/type.lux-library library)
-         _ (deploy! "sha1" (///hash.sha1 library))
-         _ (deploy! "md5" (///hash.md5 library))]
+         _ (deploy! "sha1" (///hash.data (///hash.sha1 library)))
+         _ (deploy! "md5" (///hash.data (///hash.md5 library)))]
         (wrap [])))))
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
index 52a1f00c5..de6a1e4cf 100644
--- a/stdlib/source/program/aedifex/dependency.lux
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -2,6 +2,7 @@
   [lux (#- Name)
    ["." host (#+ import:)]
    [abstract
+    [codec (#+ Codec)]
     [monad (#+ do)]
     ["." equivalence (#+ Equivalence)]
     ["." hash (#+ Hash)]]
@@ -93,40 +94,6 @@
                 [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)
@@ -149,18 +116,21 @@
    #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)))
+(def: (verified-hash dependency library url hash codec exception)
+  (All [h]
+    (-> Dependency Binary URL
+        (-> Binary (//hash.Hash h)) (Codec Text (//hash.Hash h))
+        (Exception [Dependency Text])
+        (IO (Try Text))))
   (do (try.with io.monad)
-    [#let [reference (hash library)]
+    [#let [expected (hash library)]
      actual (..download url)]
     (:: io.monad wrap
         (do try.monad
           [output (encoding.from-utf8 actual)
-           actual (reader actual)
+           actual (:: codec decode output)
            _ (exception.assert exception [dependency output]
-                               (:: binary.equivalence = reference actual))]
+                               (:: //hash.equivalence = expected actual))]
           (wrap output)))))
 
 (def: parse-property
@@ -220,8 +190,8 @@
         prefix (format repository uri.separator (//artifact.path artifact))]
     (do (try.with io.monad)
       [library (..download (format prefix (//artifact/extension.extension type)))
-       sha1 (..verified-hash dependency library (format prefix //artifact/extension.sha1) //hash.sha1 ..sha1 ..sha1-does-not-match)
-       md5 (..verified-hash dependency library (format prefix //artifact/extension.md5) //hash.md5 ..md5 ..md5-does-not-match)
+       sha1 (..verified-hash dependency library (format prefix //artifact/extension.sha1) //hash.sha1 //hash.sha1-codec ..sha1-does-not-match)
+       md5 (..verified-hash dependency library (format prefix //artifact/extension.md5) //hash.md5 //hash.md5-codec ..md5-does-not-match)
        pom (..download (format prefix //artifact/extension.pom))]
       (:: io.monad wrap
           (do try.monad
diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux
index 86fe4319d..2f63d0edd 100644
--- a/stdlib/source/program/aedifex/hash.lux
+++ b/stdlib/source/program/aedifex/hash.lux
@@ -1,12 +1,23 @@
 (.module:
   [lux #*
    ["." host (#+ import:)]
+   [abstract
+    [codec (#+ Codec)]
+    [equivalence (#+ Equivalence)]
+    [monad (#+ do)]]
+   [control
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]]
    [data
     ["." binary (#+ Binary)]
     ["." text
-     ["%" format (#+ format)]]
+     ["%" format (#+ Format format)]
+     ["." encoding]]
     [number
-     ["." nat]]]])
+     ["." i64]
+     ["n" nat]]]
+   [type
+    abstract]])
 
 ## TODO: Replace with pure-Lux implementations of these algorithms
 ## https://en.wikipedia.org/wiki/SHA-1#SHA-1_pseudocode
@@ -17,25 +28,136 @@
   (#static getInstance [java/lang/String] java/security/MessageDigest)
   (digest [[byte]] [byte]))
 
-(type: #export Hash
-  Binary)
+(abstract: #export SHA-1 Any)
+(abstract: #export MD5 Any)
 
-(template [<name> <algorithm>]
-  [(def: #export (<name> value)
-     (-> Binary Hash)
-     (|> (java/security/MessageDigest::getInstance [<algorithm>])
-         (java/security/MessageDigest::digest [value])))]
+(abstract: #export (Hash h)
+  Binary
 
-  [sha1 "SHA-1"]
-  [md5 "MD5"]
-  )
+  (def: #export data
+    (All [h] (-> (Hash h) Binary))
+    (|>> :representation))
+
+  (template [<name> <kind> <algorithm>]
+    [(def: #export (<name> value)
+       (-> Binary (Hash <kind>))
+       (|> (java/security/MessageDigest::getInstance [<algorithm>])
+           (java/security/MessageDigest::digest [value])
+           :abstraction))]
+
+    [sha1 ..SHA-1 "SHA-1"]
+    [md5 ..MD5 "MD5"]
+    )
+
+  (def: encode
+    (Format Binary)
+    (binary.fold (function (_ byte representation)
+                   (let [hex (:: n.hex encode byte)
+                         hex (case (text.size hex)
+                               1 (format "0" hex)
+                               _ hex)]
+                     (format representation hex)))
+                 ""))
+
+  (template [<factor> <name>]
+    [(def: <name>
+       Nat
+       <factor>)]
+
+    [20 sha1::size]
+    [16 md5::size]
+    )
+
+  (def: hex-per-byte
+    2)
+
+  (def: hex-per-chunk
+    (n.* hex-per-byte i64.bytes-per-i64))
+
+  (exception: #export (not-a-hash {size Nat} {value Text})
+    (exception.report
+     ["Pseudo hash" (%.text value)]
+     ["Expected size" (%.nat size)]
+     ["Actual size" (%.nat (text.size value))]))
+  
+  (template [<name> <size>]
+    [(exception: #export (<name> {data Binary})
+       (exception.report
+        ["Pseudo hash" (%.text (..encode data))]
+        ["Expected size" (%.nat <size>)]
+        ["Actual size" (%.nat (binary.size data))]))]
+
+    [not-a-sha1 ..sha1::size]
+    [not-a-md5 ..md5::size]
+    )
 
-(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)))
-               ""))
+  (template [<name> <kind> <size> <exception>]
+    [(def: #export (<name> data)
+       (-> Binary (Try (Hash <kind>)))
+       (if (n.= <size> (binary.size data))
+         (#try.Success (:abstraction data))
+         (exception.throw <exception> [data])))]
+
+    [as-sha1 SHA-1 ..sha1::size ..not-a-sha1]
+    [as-md5 MD5 ..md5::size ..not-a-md5]
+    )
+
+  (def: hash-size
+    (-> Text Nat)
+    (|>> text.size (n./ ..hex-per-byte)))
+
+  (def: encoding-size
+    (-> Nat Nat)
+    (n.* ..hex-per-byte))
+
+  (def: (decode size constructor encoded)
+    (All [h]
+      (-> Nat (-> Binary (Try (Hash h)))
+          (-> Text (Try (Hash h)))))
+    (let [hash-size (..hash-size encoded)]
+      (if (n.= size hash-size)
+        (loop [input encoded
+               chunk 0
+               output (binary.create hash-size)]
+          (let [index (n.* chunk i64.bytes-per-i64)]
+            (case (text.split ..hex-per-chunk input)
+              (#.Some [head tail])
+              (do try.monad
+                [head (:: n.hex decode head)
+                 output (binary.write/64 index head output)]
+                (recur tail (inc chunk) output))
+              
+              #.None
+              (case (..hash-size input)
+                0 (constructor output)
+                (^template [<size> <write>]
+                  <size>
+                  (do try.monad
+                    [head (:: n.hex decode input)
+                     output (<write> index head output)]
+                    (constructor output)))
+                ([1 binary.write/8]
+                 [2 binary.write/16]
+                 [4 binary.write/32])
+                _ (exception.throw ..not-a-hash [(..encoding-size size) encoded])))))
+        (exception.throw ..not-a-hash [(..encoding-size size) encoded]))))
+
+  (template [<codec> <hash> <nat> <constructor>]
+    [(structure: #export <codec>
+       (Codec Text (Hash <hash>))
+
+       (def: encode (|>> :representation ..encode))
+       (def: decode (..decode <nat> <constructor>)))]
+
+    [sha1-codec SHA-1 ..sha1::size ..as-sha1]
+    [md5-codec MD5 ..md5::size ..as-md5]
+    )
+
+  (structure: #export equivalence
+    (All [h] (Equivalence (Hash h)))
+
+    (def: (= reference subject)
+      (:: binary.equivalence =
+          (:representation reference)
+          (:representation subject))))
+  )
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
index affbb659e..626996ef3 100644
--- a/stdlib/source/program/aedifex/local.lux
+++ b/stdlib/source/program/aedifex/local.lux
@@ -141,8 +141,12 @@
     (wrap {#//dependency.library library
            #//dependency.pom pom
            #//dependency.dependencies dependencies
-           #//dependency.sha1 (//hash.representation sha1)
-           #//dependency.md5 (//hash.representation md5)})))
+           #//dependency.sha1 (|> sha1
+                                  (:coerce (//hash.Hash //hash.SHA-1))
+                                  (:: //hash.sha1-codec encode))
+           #//dependency.md5 (|> md5
+                                 (:coerce (//hash.Hash //hash.MD5))
+                                 (:: //hash.md5-codec encode))})))
 
 (def: #export (all-cached system dependencies resolution)
   (-> (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))