aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/aedifex/artifact/snapshot.lux72
-rw-r--r--stdlib/source/program/aedifex/artifact/snapshot/stamp.lux19
2 files changed, 84 insertions, 7 deletions
diff --git a/stdlib/source/program/aedifex/artifact/snapshot.lux b/stdlib/source/program/aedifex/artifact/snapshot.lux
new file mode 100644
index 000000000..0488d76dd
--- /dev/null
+++ b/stdlib/source/program/aedifex/artifact/snapshot.lux
@@ -0,0 +1,72 @@
+(.module:
+ [lux (#- Name Type)
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<.>" xml (#+ Parser)]
+ ["<.>" text]]]
+ [data
+ ["." sum]
+ [format
+ ["." xml (#+ XML)]]]]
+ ["." / #_
+ ["#." stamp (#+ Stamp)]])
+
+(type: #export Snapshot
+ #Local
+ (#Remote Stamp))
+
+(structure: any_equivalence
+ (Equivalence Any)
+
+ (def: (= _ _)
+ true))
+
+(def: #export equivalence
+ (Equivalence Snapshot)
+ ($_ sum.equivalence
+ ..any_equivalence
+ /stamp.equivalence
+ ))
+
+(template [<definition> <tag>]
+ [(def: <definition> xml.Tag ["" <tag>])]
+
+ [<local_copy> "localCopy"]
+ [<snapshot> "snapshot"]
+ )
+
+(def: local_copy_value
+ "true")
+
+(def: local_copy_format
+ XML
+ (#xml.Node <local_copy>
+ xml.attributes
+ (list (#xml.Text ..local_copy_value))))
+
+(def: local_copy_parser
+ (Parser Any)
+ (do <>.monad
+ [_ (<xml>.node ..<local_copy>)]
+ (<xml>.children (<text>.embed (<text>.this ..local_copy_value)
+ <xml>.text))))
+
+(def: #export (format snapshot)
+ (-> Snapshot XML)
+ (<| (#xml.Node ..<snapshot> xml.attributes)
+ (case snapshot
+ #Local
+ (list ..local_copy_format)
+
+ (#Remote stamp)
+ (/stamp.format stamp))))
+
+(def: #export parser
+ (Parser Snapshot)
+ (do <>.monad
+ [_ (<xml>.node <snapshot>)]
+ (<xml>.children (<>.or ..local_copy_parser
+ /stamp.parser))))
diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
index c1efcc8ee..ca59b11a6 100644
--- a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
+++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
@@ -1,11 +1,16 @@
(.module:
[lux #*
[abstract
- [equivalence (#+ Equivalence)]]
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<.>" xml (#+ Parser)]
+ ["<.>" text]]]
[data
["." product]
[format
- [xml (#+ XML)]]]]
+ ["." xml (#+ XML)]]]]
["." // #_
["#." time (#+ Time)]
["#." build (#+ Build)]])
@@ -21,22 +26,22 @@
//build.equivalence
))
+(def: <timestamp>
+ xml.Tag
+ ["" "timestamp"])
+
(def: time_format
(-> Time XML)
(|>> //time.format
#xml.Text
list
- (#xml.Node ..tag xml.attributes)))
+ (#xml.Node ..<timestamp> xml.attributes)))
(def: #export (format (^slots [#time #build]))
(-> Stamp (List XML))
(list (..time_format time)
(//build.format build)))
-(def: <timestamp>
- xml.Tag
- ["" "timestamp"])
-
## (exception: #export (mismatch {expected Instant} {actual Instant})
## (exception.report
## ["Expected" (%.instant expected)]