- Implemented a few comonads.

3 files changed, 99 insertions, 0 deletions

diff --git a/stdlib/source/lux/data/env.lux b/stdlib/source/lux/data/env.lux
new file mode 100644
index 000000000..7c29f5833
--- /dev/null
+++ b/stdlib/source/lux/data/env.lux
@@ -0,0 +1,24 @@
+(;module:
+  lux
+  (lux (control functor
+                comonad)))
+
+(type: #export (Env e a)
+  {#env e
+   #value a})
+
+(struct: #export Functor<Env> (All [e] (Functor (Env e)))
+  (def: (map f fa)
+    (update@ #value f fa)))
+
+(struct: #export CoMonad<Env> (All [e] (CoMonad (Env e)))
+  (def: functor Functor<Env>)
+
+  (def: unwrap (get@ #value))
+
+  (def: (split wa)
+    (set@ #value wa wa)))
+
+(def: #export (local change env)
+  (All [e a] (-> (-> e e) (Env e a) (Env e a)))
+  (update@ #env change env))
diff --git a/stdlib/source/lux/data/store.lux b/stdlib/source/lux/data/store.lux
new file mode 100644
index 000000000..4badfb382
--- /dev/null
+++ b/stdlib/source/lux/data/store.lux
@@ -0,0 +1,42 @@
+(;module:
+  lux
+  (lux (control functor
+                comonad)
+       (type auto)))
+
+(type: #export (Store s a)
+  {#cursor s
+   #peek (-> s a)})
+
+(def: (extend f wa)
+  (All [s a b] (-> (-> (Store s a) b) (Store s a) (Store s b)))
+  {#cursor (get@ #cursor wa)
+   #peek (lambda [s] (f (set@ #cursor s wa)))})
+
+(struct: #export Functor<Store> (All [s] (Functor (Store s)))
+  (def: (map f fa)
+    (extend (lambda [store] (f (:: store peek (:: store cursor))))
+            fa)))
+
+(struct: #export CoMonad<Store> (All [s] (CoMonad (Store s)))
+  (def: functor Functor<Store>)
+
+  (def: (unwrap wa) (::: peek (::: cursor)))
+
+  (def: split (extend id)))
+
+(def: #export (peeks trans store)
+  (All [s a] (-> (-> s s) (Store s a) a))
+  (|> (::: cursor) trans (::: peek)))
+
+(def: #export (seek cursor store)
+  (All [s a] (-> s (Store s a) (Store s a)))
+  (:: (::: split store) peek cursor))
+
+(def: #export (seeks change store)
+  (All [s a] (-> (-> s s) (Store s a) (Store s a)))
+  (|> store (::: split) (peeks change)))
+
+(def: #export (experiment Functor<f> change store)
+  (All [f s a] (-> (Functor f) (-> s (f s)) (Store s a) (f a)))
+  (:: Functor<f> map (::: peek) (change (::: cursor))))
diff --git a/stdlib/source/lux/data/trace.lux b/stdlib/source/lux/data/trace.lux
new file mode 100644
index 000000000..f8094565b
--- /dev/null
+++ b/stdlib/source/lux/data/trace.lux
@@ -0,0 +1,33 @@
+(;module:
+  lux
+  (lux (control ["m" monoid]
+                functor
+                comonad)
+       [macro]))
+
+(type: #export (Trace t a)
+  {#monoid (m;Monoid t)
+   #trace (-> t a)})
+
+(struct: #export Functor<Trace> (All [t] (Functor (Trace t)))
+  (def: (map f fa)
+    (update@ #trace (. f) fa)))
+
+(struct: #export CoMonad<Trace> (All [t] (CoMonad (Trace t)))
+  (def: functor Functor<Trace>)
+
+  (def: (unwrap wa)
+    ((get@ #trace wa)
+     (get@ [#monoid #m;unit] wa)))
+
+  (def: (split wa)
+    (let [monoid (get@ #monoid wa)]
+      {#monoid monoid
+       #trace (lambda [t1]
+                {#monoid monoid
+                 #trace (lambda [t2] ((get@ #trace wa)
+                                 (:: monoid append t1 t2)))})})))
+
+(def: #export (run context tracer)
+  (All [t a] (-> t (Trace t a) a))
+  (:: tracer trace context))