aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library/lux/tool/compiler/meta/archive/document.lux')
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/archive/document.lux72
1 files changed, 72 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
new file mode 100644
index 000000000..ea5ce1006
--- /dev/null
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
@@ -0,0 +1,72 @@
+(.module:
+ [library
+ [lux (#- Module)
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]
+ ["<>" parser
+ [binary (#+ Parser)]]]
+ [data
+ [collection
+ ["." dictionary (#+ Dictionary)]]
+ [format
+ ["." binary (#+ Writer)]]]
+ [type (#+ :share)
+ abstract]]]
+ [//
+ ["." signature (#+ Signature)]
+ ["." key (#+ Key)]
+ [descriptor (#+ Module)]])
+
+(exception: #export (invalid-signature {expected Signature} {actual Signature})
+ (exception.report
+ ["Expected" (signature.description expected)]
+ ["Actual" (signature.description actual)]))
+
+(abstract: #export (Document d)
+ {#signature Signature
+ #content d}
+
+ (def: #export (read key document)
+ (All [d] (-> (Key d) (Document Any) (Try d)))
+ (let [[document//signature document//content] (:representation document)]
+ (if (\ signature.equivalence =
+ (key.signature key)
+ document//signature)
+ (#try.Success (:share [e]
+ (Key e)
+ key
+
+ e
+ (:assume document//content)))
+ (exception.throw ..invalid-signature [(key.signature key)
+ document//signature]))))
+
+ (def: #export (write key content)
+ (All [d] (-> (Key d) d (Document d)))
+ (:abstraction {#signature (key.signature key)
+ #content content}))
+
+ (def: #export (check key document)
+ (All [d] (-> (Key d) (Document Any) (Try (Document d))))
+ (do try.monad
+ [_ (..read key document)]
+ (wrap (:assume document))))
+
+ (def: #export signature
+ (-> (Document Any) Signature)
+ (|>> :representation (get@ #signature)))
+
+ (def: #export (writer content)
+ (All [d] (-> (Writer d) (Writer (Document d))))
+ (let [writer (binary.and signature.writer
+ content)]
+ (|>> :representation writer)))
+
+ (def: #export parser
+ (All [d] (-> (Parser d) (Parser (Document d))))
+ (|>> (<>.and signature.parser)
+ (\ <>.monad map (|>> :abstraction))))
+ )