From 613334af8616613956cbaf06bb3b3933f1280dce Mon Sep 17 00:00:00 2001
From: hellerve <veit@veitheller.de>
Date: Mon, 28 Oct 2019 12:19:01 +0100
Subject: [PATCH] initial

---
 README.md            | 28 +++++++++++++++++++++
 examples/simple.carp | 14 +++++++++++
 lens.carp            | 58 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 100 insertions(+)
 create mode 100644 README.md
 create mode 100644 examples/simple.carp
 create mode 100644 lens.carp

diff --git a/README.md b/README.md
new file mode 100644
index 0000000..0bf14cb
--- /dev/null
+++ b/README.md
@@ -0,0 +1,28 @@
+# lens
+
+*Early WIP, also includes an implementation for Prisms on Maybes only*
+
+A simple Lens library for Carp.
+
+## Usage
+
+```clojure
+(load "git@github.com:hellerve/lens.carp@master")
+
+(deftype Address [city String street (Pair String Int)])
+
+(defn main []
+  (let-do [addr (Lens.for Address street)
+           stre (Lens.for Pair a)
+           comp (Lens.compose &addr &stre)
+           data (Address.init @"Berlin" (Street.init 10 @"Paul-Lincke-Ufer"))]
+    (println* &(~(Lens.get &comp) &data))
+    (println* &(~(Lens.set &comp) @&data @"no"))
+    (println* &(Lens.over &comp @&data &(fn [a] (reverse &a))))
+  )
+)
+```
+
+<hr/>
+
+Have fun!
diff --git a/examples/simple.carp b/examples/simple.carp
new file mode 100644
index 0000000..09ebaa5
--- /dev/null
+++ b/examples/simple.carp
@@ -0,0 +1,14 @@
+(load "lens.carp")
+
+(deftype Address [city String street (Pair String Int)])
+
+(defn main []
+  (let-do [addr (Lens.for Address street)
+           stre (Lens.for Pair a)
+           comp (Lens.compose &addr &stre)
+           data (Address.init @"Berlin" (Pair.init @"Paul-Lincke-Ufer" 10))]
+    (println* &(~(Lens.get &comp) &data))
+    (println* &(~(Lens.set &comp) @&data @"no"))
+    (println* &(Lens.over &comp @&data &(fn [a] (reverse &a))))
+  )
+)
diff --git a/lens.carp b/lens.carp
new file mode 100644
index 0000000..1b50e2e
--- /dev/null
+++ b/lens.carp
@@ -0,0 +1,58 @@
+(deftype (Lens a b) [
+  get (Fn [&a] b)
+  set (Fn [a b] a)
+])
+
+; should be f a b and work with higher orders, but oh well
+(deftype (Prism a b) [
+  get (Fn [&a] (Maybe b))
+  set (Fn [a b] a)
+])
+
+(defmodule Lens
+  (defn compose [ab bc]
+    (Lens.init
+      (fn [a] (~(get bc) &(~(get ab) a)))
+      (fn [a c]
+        (let [inner (~(set bc) (~(get ab) &a) c)]
+          (~(set ab) a inner)))))
+
+  (defn over [l p f]
+    (let [transformed (~f (~(get l) &p))]
+      (~(set l) p transformed)))
+
+  (defn to-prism [l]
+    (Prism.init
+      (fn [a] (Maybe.Just (~(get l) a)))
+      @(set l)))
+
+  (defndynamic for- [t el]
+    (list 'Lens.init
+      (list 'fn ['a] (list 'copy (list (Symbol.prefix t el) 'a)))
+      (Symbol.prefix t (Symbol.join ['set- el]))))
+
+  (defmacro for [t el]
+    (Lens.for- t el))
+)
+
+(defmodule Prism
+  (defn compose [ab bc]
+    (Prism.init
+      (fn [a]
+        (match (~(get ab) a)
+          (Maybe.Nothing) (Maybe.Nothing)
+          (Maybe.Just b) (~(get bc) &b)))
+      (fn [a c]
+        (match (~(get ab) &a)
+          (Maybe.Nothing) a
+          (Maybe.Just b)
+            (let [inner (~(set bc) b c)]
+              (~(set ab) a inner))))))
+
+  (defn over [l p f]
+    (match (~(get l) &p)
+      (Maybe.Nothing) p
+      (Maybe.Just a)
+        (let [transformed (~f a)]
+          (~(set l) p transformed))))
+)