Split-out the lux/compiler/meta/archive module.

5 files changed, 152 insertions, 111 deletions

diff --git a/stdlib/source/lux/compiler/meta/archive.lux b/stdlib/source/lux/compiler/meta/archive.lux
index 457e3b874..f36a0b754 100644
--- a/stdlib/source/lux/compiler/meta/archive.lux
+++ b/stdlib/source/lux/compiler/meta/archive.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #*
+  [lux (#- Module)
    [control
     ["ex" exception (#+ exception:)]
     ["." equivalence (#+ Equivalence)]
@@ -10,120 +10,66 @@
     ["." text
      format]
     [collection
-     ["dict" dictionary (#+ Dictionary)]]]
+     ["." dictionary (#+ Dictionary)]]]
    [type (#+ :share)
     abstract]
    [world
     [file (#+ File)]]]
   [///
-   [default
-    ["." init (#+ Version)]]])
-
-## Key
-(type: #export Signature
-  {#name Name
-   #version Version})
-
-(def: Equivalence<Signature>
-  (Equivalence Signature)
-  (equivalence.product name.Equivalence<Name> text.Equivalence<Text>))
-
-(def: (describe signature)
-  (-> Signature Text)
-  (format (%name (get@ #name signature)) " " (get@ #version signature)))
-
-(abstract: #export (Key k)
-  {}
-
-  Signature
-
-  (structure: #export Equivalence<Key>
-    (All [k] (Equivalence (Key k)))
-    (def: (= reference sample)
-      (:: Equivalence<Signature> = (:representation reference) (:representation sample))))
-
-  (def: #export default
-    (Key Nothing)
-    (:abstraction {#name ["" ""]
-                   #version init.version}))
-
-  (def: #export signature
-    (-> (Key Any) Signature)
-    (|>> :representation))
-  )
-
-## Document
-(exception: #export (invalid-key-for-document {expected (Key Any)} {actual (Key Any)})
-  (ex.report ["Expected" (describe (..signature expected))]
-             ["Actual" (describe (..signature actual))]))
-
-(exception: #export (signature-does-not-match-key {key (Key Any)} {signature Signature})
-  (ex.report ["Key" (describe (..signature key))]
-             ["Signature" (describe signature)]))
-
-(type: #export Reference Text)
-
-(type: #export Descriptor
-  {#hash Nat
-   #file File
-   #references (List Reference)
-   #state Module-State})
-
-(type: #export (Document d)
-  {#key (Key d)
-   #descriptor Descriptor
-   #content d})
-
-(def: #export (open expected [actual _descriptor content])
-  (All [d] (-> (Key d) (Document Any) (Error d)))
-  (if (:: Equivalence<Key> = expected actual)
-    (#error.Success (:share [e]
-                            {(Key e)
-                             expected}
-                            {e
-                             content}))
-    (ex.throw invalid-key-for-document [expected actual])))
-
-(def: #export (close key signature descriptor content)
-  (All [d] (-> (Key d) Signature Descriptor d (Error (Document d))))
-  (if (:: Equivalence<Signature> = (..signature key) signature)
-    (#error.Success {#key key
-                     #descriptor descriptor
-                     #content content})
-    (ex.throw signature-does-not-match-key [key signature])))
+   [default (#+ Version)]]
+  [/
+   ["." signature (#+ Signature)]
+   ["." key (#+ Key)]
+   ["." descriptor (#+ Module Descriptor)]
+   ["." document (#+ Document)]])
 
 ## Archive
-(exception: #export (cannot-replace-document-in-archive {name Text} {old (Document Any)} {new (Document Any)})
-  (ex.report ["Module's name" name]
-             ["Old document's key" (describe (..signature (get@ #key old)))]
-             ["New document's key" (describe (..signature (get@ #key new)))]))
-
-(abstract: #export Archive
-  {}
-  
-  (Dictionary Text (Ex [d] (Document d)))
-
-  (def: #export empty
-    Archive
-    (:abstraction (dict.new text.Hash<Text>)))
-
-  (def: #export (add name document archive)
-    (-> Text (Ex [d] (Document d)) Archive (Error Archive))
-    (case (dict.get name (:representation archive))
-      (#.Some existing)
-      (if (is? document existing)
-        (#error.Success archive)
-        (ex.throw cannot-replace-document-in-archive [name existing document]))
-      
-      #.None
-      (#error.Success (:abstraction (dict.put name document
-                                              (:representation archive))))))
-
-  (def: #export (merge additions archive)
-    (-> Archive Archive (Error Archive))
-    (monad.fold error.Monad<Error>
-                (function (_ [name' document'] archive')
-                  (..add name' document' archive'))
-                archive
-                (dict.entries (:representation additions))))
-  )
+(exception: #export (unknown-document {name Module})
+  (ex.report ["Module" name]))
+
+(exception: #export (cannot-replace-document {name Module}
+                                             {old (Document Any)}
+                                             {new (Document Any)})
+  (ex.report ["Module" name]
+             ["Old key" (signature.description (document.signature old))]
+             ["New key" (signature.description (document.signature new))]))
+
+(with-expansions [<Document> (as-is (type (Ex [d] (Document d))))]
+  (abstract: #export Archive
+    {}
+    
+    (Dictionary Text <Document>)
+
+    (def: #export empty
+      Archive
+      (:abstraction (dictionary.new text.Hash<Text>)))
+
+    (def: #export (add name document archive)
+      (-> Module <Document> Archive (Error Archive))
+      (case (dictionary.get name (:representation archive))
+        (#.Some existing)
+        (if (is? document existing)
+          (#error.Success archive)
+          (ex.throw cannot-replace-document [name existing document]))
+        
+        #.None
+        (#error.Success (:abstraction (dictionary.put name document
+                                                      (:representation archive))))))
+
+    (def: #export (find name archive)
+      (-> Module Archive (Error <Document>))
+      (case (dictionary.get name (:representation archive))
+        (#.Some document)
+        (#error.Success document)
+        
+        #.None
+        (ex.throw unknown-document [name])))
+
+    (def: #export (merge additions archive)
+      (-> Archive Archive (Error Archive))
+      (monad.fold error.Monad<Error>
+                  (function (_ [name' document'] archive')
+                    (..add name' document' archive'))
+                  archive
+                  (dictionary.entries (:representation additions))))
+    ))
diff --git a/stdlib/source/lux/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/compiler/meta/archive/descriptor.lux
new file mode 100644
index 000000000..6c7e6744e
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/archive/descriptor.lux
@@ -0,0 +1,13 @@
+(.module:
+  [lux (#- Module)
+   [world
+    [file (#+ File)]]])
+
+(type: #export Module Text)
+
+(type: #export Descriptor
+  {#hash Nat
+   #name Module
+   #file File
+   #references (List Module)
+   #state Module-State})
diff --git a/stdlib/source/lux/compiler/meta/archive/document.lux b/stdlib/source/lux/compiler/meta/archive/document.lux
new file mode 100644
index 000000000..237b092da
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/archive/document.lux
@@ -0,0 +1,51 @@
+(.module:
+  [lux (#- Module)
+   [control
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error (#+ Error)]
+    [collection
+     ["." dictionary (#+ Dictionary)]]]
+   [type (#+ :share)
+    abstract]]
+  [//
+   ["." signature (#+ Signature)]
+   ["." key (#+ Key)]
+   ["." descriptor (#+ Module Descriptor)]])
+
+## Document
+(exception: #export (invalid-key {module Module} {expected (Key Any)} {actual (Key Any)})
+  (ex.report ["Module" module]
+             ["Expected" (signature.description (get@ #key.signature expected))]
+             ["Actual" (signature.description (get@ #key.signature actual))]))
+
+(abstract: #export (Document d)
+  {}
+  
+  {#key (Key d)
+   #descriptor Descriptor
+   #content d}
+
+  (def: #export (read key document)
+    (All [d] (-> (Key d) (Document Any) (Error d)))
+    (let [[document//key document//descriptor document//content] (:representation document)]
+      (if (:: signature.Equivalence<Signature> =
+              (get@ #key.signature key)
+              (get@ #key.signature document//key))
+        (#error.Success (:share [e]
+                                {(Key e)
+                                 key}
+                                {e
+                                 document//content}))
+        (ex.throw invalid-key [(get@ #descriptor.name document//descriptor) key document//key]))))
+
+  (def: #export (write key descriptor content)
+    (All [d] (-> (Key d) Descriptor d (Document d)))
+    (:abstraction {#key key
+                   #descriptor descriptor
+                   #content content}))
+
+  (def: #export signature
+    (-> (Document Any) Signature)
+    (|>> :representation (get@ #key) (get@ #key.signature)))
+  )
diff --git a/stdlib/source/lux/compiler/meta/archive/key.lux b/stdlib/source/lux/compiler/meta/archive/key.lux
new file mode 100644
index 000000000..1758facf4
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/archive/key.lux
@@ -0,0 +1,8 @@
+(.module:
+  [lux #*]
+  [//
+   [signature (#+ Signature)]])
+
+(type: #export (Key k)
+  {#signature Signature
+   #default k})
diff --git a/stdlib/source/lux/compiler/meta/archive/signature.lux b/stdlib/source/lux/compiler/meta/archive/signature.lux
new file mode 100644
index 000000000..5332b79c3
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/archive/signature.lux
@@ -0,0 +1,23 @@
+(.module:
+  [lux #*
+   [control
+    ["." equivalence (#+ Equivalence)]]
+   [data
+    ["." name]
+    ["." text
+     format]]]
+  [////
+   [default (#+ Version)]])
+
+## Key
+(type: #export Signature
+  {#name Name
+   #version Version})
+
+(def: #export Equivalence<Signature>
+  (Equivalence Signature)
+  (equivalence.product name.Equivalence<Name> text.Equivalence<Text>))
+
+(def: #export (description signature)
+  (-> Signature Text)
+  (format (%name (get@ #name signature)) " " (get@ #version signature)))