From 28399bbdb422393511551e3a8cc2497131aec364 Mon Sep 17 00:00:00 2001
From: bch29 <bradleyhardy29@gmail.com>
Date: Tue, 15 Dec 2020 14:20:25 +0000
Subject: [PATCH] feat: Add basic lens functionality to standard library

---
 std/functor/const.glu | 27 ++++++++++++++++++++++++++
 std/lens.glu          | 44 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+)
 create mode 100644 std/functor/const.glu
 create mode 100644 std/lens.glu

diff --git a/std/functor/const.glu b/std/functor/const.glu
new file mode 100644
index 0000000000..af568e9a32
--- /dev/null
+++ b/std/functor/const.glu
@@ -0,0 +1,27 @@
+let { Functor } = import! std.functor
+
+let { Applicative } = import! std.applicative
+
+let { Monoid, empty } = import! std.monoid
+
+let { (<>) } = import! std.semigroup
+
+type Const s a = { value : s }
+
+#[implicit]
+let functor : forall s . Functor (Const s) = {
+    map = \f -> \c -> { value = c.value },
+}
+
+#[implicit]
+let applicative : forall s . [Monoid s] -> Applicative (Const s) = {
+    functor,
+    apply = \f x -> { value = f.value <> x.value },
+    wrap = \_ -> { value = empty }
+}
+
+let app : s -> Const s a = \value -> { value }
+
+let run : Const s a -> s = \c -> c.value
+
+{ Const, functor, app, run }
diff --git a/std/lens.glu b/std/lens.glu
new file mode 100644
index 0000000000..3183cfd8c1
--- /dev/null
+++ b/std/lens.glu
@@ -0,0 +1,44 @@
+let { Functor, map } = import! std.functor
+let const @ { Const, ? } = import! std.functor.const
+let identity = import! std.identity
+
+
+type Lens s t a b = { app : forall f . [Functor f] -> (a -> f b) -> s -> f t }
+
+
+type Lens' s a = Lens s s a a
+
+
+let view lens x : Lens s t a b -> s -> a =
+    let res = lens.app const.app x
+    res.value
+
+
+let over lens f y : Lens s t a b -> (a -> b) -> s -> t =
+    lens.app ?identity.functor (\x -> (f x)) y
+
+
+let set lens x : Lens s t a b -> b -> s -> t = over lens (\_ -> x)
+
+
+let make view set : (s -> a) -> (b -> s -> t) -> Lens s t a b =
+    {
+        app = \k x -> map (\y -> set y x) (k (view x)),
+    }
+
+
+#[infix(right, 8)]
+let (^) g f : Lens j k s t -> Lens s t a b -> Lens j k a b = {
+    app = \k -> g.app (f.app k),
+}
+
+
+#[infix(left, 1)]
+let (&) x g : a -> (a -> b) -> b = g x
+
+
+#[infix(right, 9)]
+let (^.) x lens : s -> Lens s t a b -> a = view lens x
+
+
+{ Lens, Lens', view, set, over, make, (^), (&), (^.) }