From 56a74d844d6325fe105769b3d859f857e4af3c35 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 7 Jul 2018 14:44:09 -0400
Subject: - Implemented document archiving. It will play a crucial role later
 when LuxC (Lux compiler) turns into LuxMC (Lux Meta-Compiler).

---
 stdlib/source/lux/lang/compiler/meta/archive.lux | 87 ++++++++++++++++++++++++
 1 file changed, 87 insertions(+)
 create mode 100644 stdlib/source/lux/lang/compiler/meta/archive.lux

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/lang/compiler/meta/archive.lux b/stdlib/source/lux/lang/compiler/meta/archive.lux
new file mode 100644
index 000000000..f61476111
--- /dev/null
+++ b/stdlib/source/lux/lang/compiler/meta/archive.lux
@@ -0,0 +1,87 @@
+(.module:
+  lux
+  (lux (control ["ex" exception #+ exception:]
+                [equivalence #+ Equivalence]
+                [monad #+ do])
+       (data [error #+ Error]
+             [ident]
+             [text]
+             text/format
+             (coll (dictionary ["dict" unordered #+ Dict])))
+       (lang [type #+ :share])
+       (type abstract))
+  [////])
+
+## Key
+(abstract: #export (Key k)
+  {}
+
+  {#name Ident
+   #version Text}
+
+  (def: Equivalence<Key>'
+    (equivalence.product ident.Equivalence<Ident> text.Equivalence<Text>))
+  
+  (struct: #export Equivalence<Key>
+    (All [k] (Equivalence (Key k)))
+    (def: (= reference sample)
+      (:: Equivalence<Key>' = (:representation reference) (:representation sample))))
+
+  (def: #export default
+    (Key Nothing)
+    (:abstraction {#name ["" ""]
+                   #version ////.version}))
+
+  (def: (describe (^:representation key))
+    (-> (Key Any) Text)
+    (format (%ident (get@ #name key)) " " (get@ #version key)))
+  )
+
+## Document
+(exception: #export (invalid-key-for-document {expected (Key Any)} {actual (Key Any)})
+  (ex.report ["Expected" (describe expected)]
+             ["Actual" (describe actual)]))
+
+(type: #export (Document d)
+  {#key (Key d)
+   #value d})
+
+(def: #export (open expected [actual value])
+  (All [e] (-> (Key e) (Document Any) (Error e)))
+  (if (:: Equivalence<Key> = expected actual)
+    (#error.Success (:share [e]
+                            {(Key e)
+                             expected}
+                            {e
+                             value}))
+    (ex.throw invalid-key-for-document [expected actual])))
+
+## 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 (get@ #key old))]
+             ["New document's key" (describe (get@ #key new))]))
+
+(type: #export Archive
+  (Dict Text (Ex [d] (Document d))))
+
+(def: #export empty Archive (dict.new text.Hash<Text>))
+
+(def: #export (add name document archive)
+  (-> Text (Ex [d] (Document d)) Archive (Error Archive))
+  (case (dict.get name archive)
+    (#.Some existing)
+    (if (is? document existing)
+      (#error.Success archive)
+      (ex.throw cannot-replace-document-in-archive [name existing document]))
+    
+    #.None
+    (#error.Success (dict.put name document 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 additions)))
-- 
cgit v1.2.3