Skip to content

Commit 28399bb

Browse files
committed
feat: Add basic lens functionality to standard library
1 parent fcd3a29 commit 28399bb

File tree

2 files changed

+71
-0
lines changed

2 files changed

+71
-0
lines changed

std/functor/const.glu

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
let { Functor } = import! std.functor
2+
3+
let { Applicative } = import! std.applicative
4+
5+
let { Monoid, empty } = import! std.monoid
6+
7+
let { (<>) } = import! std.semigroup
8+
9+
type Const s a = { value : s }
10+
11+
#[implicit]
12+
let functor : forall s . Functor (Const s) = {
13+
map = \f -> \c -> { value = c.value },
14+
}
15+
16+
#[implicit]
17+
let applicative : forall s . [Monoid s] -> Applicative (Const s) = {
18+
functor,
19+
apply = \f x -> { value = f.value <> x.value },
20+
wrap = \_ -> { value = empty }
21+
}
22+
23+
let app : s -> Const s a = \value -> { value }
24+
25+
let run : Const s a -> s = \c -> c.value
26+
27+
{ Const, functor, app, run }

std/lens.glu

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
let { Functor, map } = import! std.functor
2+
let const @ { Const, ? } = import! std.functor.const
3+
let identity = import! std.identity
4+
5+
6+
type Lens s t a b = { app : forall f . [Functor f] -> (a -> f b) -> s -> f t }
7+
8+
9+
type Lens' s a = Lens s s a a
10+
11+
12+
let view lens x : Lens s t a b -> s -> a =
13+
let res = lens.app const.app x
14+
res.value
15+
16+
17+
let over lens f y : Lens s t a b -> (a -> b) -> s -> t =
18+
lens.app ?identity.functor (\x -> (f x)) y
19+
20+
21+
let set lens x : Lens s t a b -> b -> s -> t = over lens (\_ -> x)
22+
23+
24+
let make view set : (s -> a) -> (b -> s -> t) -> Lens s t a b =
25+
{
26+
app = \k x -> map (\y -> set y x) (k (view x)),
27+
}
28+
29+
30+
#[infix(right, 8)]
31+
let (^) g f : Lens j k s t -> Lens s t a b -> Lens j k a b = {
32+
app = \k -> g.app (f.app k),
33+
}
34+
35+
36+
#[infix(left, 1)]
37+
let (&) x g : a -> (a -> b) -> b = g x
38+
39+
40+
#[infix(right, 9)]
41+
let (^.) x lens : s -> Lens s t a b -> a = view lens x
42+
43+
44+
{ Lens, Lens', view, set, over, make, (^), (&), (^.) }

0 commit comments

Comments
 (0)