Update schemas for new embedded syntax; steps toward pattern support

syndicate/private/install.rkt

@@ -6,12 +6,15 @@
 (require preserves-schema/bin/preserves-schema-rkt)
 (require (only-in racket/file delete-directory/files))
 
+(require (only-in "../schema-compiler.rkt" schema-compiler-plugin))
+
 (define (pre-installer _collects-path syndicate-path)
   (define output-directory (build-path syndicate-path "schemas/gen"))
   (delete-directory/files output-directory #:must-exist? #f)
   (batch-compile #:inputs (list (build-path syndicate-path "schemas/**.prs"))
                  #:additional-modules (hash '(Actor) 'syndicate/actor)
-                 #:output-directory output-directory))
+                 #:output-directory output-directory
+                 #:plugins (list schema-compiler-plugin)))
 
 (define-runtime-path syndicate-path "..")
 (define (regenerate!)

syndicate/schema-compiler.rkt

@@ -0,0 +1,15 @@
+#lang racket/base
+
+(provide schema-compiler-plugin)
+
+(require racket/match)
+(require preserves-schema/compiler)
+
+(define (schema-compiler-plugin schema options)
+  (match-define (schema-compiler-options _name
+                                         lookup-module-path
+                                         paths) options)
+  (define ds-path (lookup-module-path '(dataspace-patterns)))
+  (if (equal? ds-path (schema-translation-paths-relative-output-path paths))
+      `(begin)
+      `(begin (require (prefix-in :pat: ,ds-path)))))

syndicate/schemas/dataspace-patterns.prs

@@ -0,0 +1,11 @@
+version 1 .
+
+; Dataspace patterns: a sublanguage of attenuation patterns.
+Pattern = DDiscard / DBind / DLit / DCompound .
+
+DDiscard = <_>.
+DBind = <bind @name symbol @pattern Pattern>.
+DLit = <lit @value any>.
+DCompound = @rec  <compound <rec @label any @arity int> @members { int: Pattern ...:... }>
+          / @arr  <compound <arr @arity int>            @members { int: Pattern ...:... }>
+          / @dict <compound <dict>                      @members { any: Pattern ...:... }> .

syndicate/schemas/dataspace.prs

@@ -1,9 +1,4 @@
 version 1 .
 embeddedType Actor.Ref .
 
-;As implemented
-Observe = <Observe @label symbol @observer embedded>.
-
-; ;As will be implemented soon
-; Observe = <Observe @pattern Pattern @observer embedded>.
-.
+Observe = <Observe @pattern dataspace-patterns.Pattern @observer #!any>.

syndicate/schemas/gatekeeper.prs

@@ -1,5 +1,5 @@
 version 1 .
 embeddedType Actor.Ref .
 
-Resolve = <resolve @sturdyref sturdy.SturdyRef @observer embedded>.
-Bind = <bind @oid any @key bytes @target embedded>.
+Resolve = <resolve @sturdyref sturdy.SturdyRef @observer #!#!any>.
+Bind = <bind @oid any @key bytes @target #!any>.

syndicate/schemas/protocol.prs

@@ -11,4 +11,4 @@ TurnEvent = [@oid Oid @event Event].
 Assert = <assert @assertion Assertion @handle Handle>.
 Retract = <retract @handle Handle>.
 Message = <message @body Assertion>.
-Sync = <sync @peer embedded>.
+Sync = <sync @peer #!#t>.

syndicate/schemas/secure-chat-protocol.prs

@@ -3,9 +3,16 @@ embeddedType Actor.Ref .
 
 UserId = int .
 
-Join = <joinedUser @uid UserId @handle embedded>.
+Join = <joinedUser @uid UserId @handle #!Session>.
 
-NickClaim = <claimNick @uid UserId @name string @k embedded>.
+Session = @observeUsers <Observe =user @observer #!UserInfo>
+        / @observeSpeech <Observe =says @observer #!Says>
+        / NickClaim
+        / Says
+.
+
+NickClaim = <claimNick @uid UserId @name string @k #!NickClaimResponse>.
+NickClaimResponse = #t / NickConflict .
 
 UserInfo = <user @uid UserId @name string>.