Skip to content

Commit

Permalink
feat: Add basic lens functionality to standard library
Browse files Browse the repository at this point in the history
  • Loading branch information
bch29 committed Dec 15, 2020
1 parent fcd3a29 commit 28399bb
Show file tree
Hide file tree
Showing 2 changed files with 71 additions and 0 deletions.
27 changes: 27 additions & 0 deletions std/functor/const.glu
Original file line number Diff line number Diff line change
@@ -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 }
44 changes: 44 additions & 0 deletions std/lens.glu
Original file line number Diff line number Diff line change
@@ -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, (^), (&), (^.) }

0 comments on commit 28399bb

Please sign in to comment.