From b47835644a16f43155b44333c0218293bcaf20a6 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 9 Dec 2018 17:12:33 -0400
Subject: Basic implementation for sessions.

---
 stdlib/test/test/lux/concurrency/session.lux | 78 ++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100644 stdlib/test/test/lux/concurrency/session.lux

(limited to 'stdlib/test')

diff --git a/stdlib/test/test/lux/concurrency/session.lux b/stdlib/test/test/lux/concurrency/session.lux
new file mode 100644
index 000000000..ad0343d15
--- /dev/null
+++ b/stdlib/test/test/lux/concurrency/session.lux
@@ -0,0 +1,78 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]]
+   [concurrency
+    ["." promise]
+    ["$" session (#+ Session choice: << >> ?? !! +<< -<< \/ /\)]]
+   [data
+    [text
+     format]]
+   [math
+    ["r" random]]]
+  lux/test)
+
+(choice: Calculation [#Add #Negate])
+
+(def: $add (<| (!! Int) (!! Int) (?? Int) >>))
+(def: $negate (<| (!! Int) (?? Int) >>))
+
+(def: (add-session _)
+  (-> [] (:~ (<< $add)))
+  (<| $.send $.send $.receive $.end))
+
+(def: (negate-session _)
+  (-> [] (:~ (<< $negate)))
+  (<| $.send $.receive $.end))
+
+(def: $calculation
+  Session
+  ($_ \/
+      $add
+      $negate))
+
+(def: (calculation-session _)
+  (-> [] (:~ (<< $calculation)))
+  ($_ $.fork
+      (add-session [])
+      (negate-session [])))
+
+(def: (__my-calculation _)
+  (-> [] (:~ (+<< $calculation)))
+  ($.my (calculation-session [])))
+
+(def: (__your-calculation _)
+  (-> [] (:~ (-<< $calculation)))
+  ($.your (calculation-session [])))
+
+(context: "Sessions."
+  (do @
+    [#let [[$me $you] (calculation-session [])]
+     param r.int
+     subject r.int]
+    ($_ seq
+        (wrap (do promise.Monad<Promise>
+                [$me ($me (#Add id))
+                 $me ($me param)
+                 $me ($me subject)
+                 [output $end] $me]
+                (assert "Client [#Add]"
+                        (i/= (i/+ param subject) output))))
+        (wrap (do promise.Monad<Promise>
+                [choice $you]
+                (case choice
+                  (#Add $you)
+                  (do @
+                    [[param-input $you] $you
+                     [subject-input $you] $you
+                     $end ($you (i/+ param-input subject-input))]
+                    (assert "Server [#Add]"
+                            true))
+                  
+                  (#Negate $you)
+                  (do @
+                    [[subject $you] $you
+                     $end ($you (i/* -1 subject))]
+                    (assert "Server [#Negate]"
+                            true)))))
+        )))
-- 
cgit v1.2.3