about summary refs log tree commit diff
path: root/users/Profpatsch/lens.nix
blob: 28f7506bddae52e67adbfcc38b6121531d3087b1 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
{ ... }:
let
  id = x: x;

  const = x: y: x;

  comp = f: g: x: f (g x);

  _ = v: f: f v;

  # Profunctor (p :: Type -> Type -> Type)
  Profunctor = rec {
    # dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
    dimap = f: g: x: lmap f (rmap g x);
    # lmap :: (a -> b) -> p b c -> p a c
    lmap = f: dimap f id;
    # rmap :: (c -> d) -> p b c -> p b d
    rmap = g: dimap id g;
  };

  # Profunctor (->)
  profunctorFun = Profunctor // {
    # dimap :: (a -> b) -> (c -> d) -> (b -> c) -> a -> d
    dimap = ab: cd: bc: a: cd (bc (ab a));
    # lmap :: (a -> b) -> (b -> c) -> (a -> c)
    lmap = ab: bc: a: bc (ab a);
    # rmap :: (c -> d) -> (b -> c) -> (b -> d)
    rmap = cd: bc: b: cd (bc b);
  };

  tuple = fst: snd: {
    inherit fst snd;
  };

  swap = { fst, snd }: {
    fst = snd;
    snd = fst;
  };

  # Profunctor p => Strong (p :: Type -> Type -> Type)
  Strong = pro: pro // rec {
    # firstP :: p a b -> p (a, c) (b, c)
    firstP = pab: pro.dimap swap swap (pro.secondP pab);
    # secondP :: p a b -> p (c, a) (c, b)
    secondP = pab: pro.dimap swap swap (pro.firstP pab);
  };

  # Strong (->)
  strongFun = Strong profunctorFun // {
    # firstP :: (a -> b) -> (a, c) -> (b, c)
    firstP = f: { fst, snd }: { fst = f fst; inherit snd; };
    # secondP :: (a -> b) -> (c, a) -> (c, b)
    secondP = f: { snd, fst }: { snd = f snd; inherit fst; };
  };

  # Iso s t a b :: forall p. Profunctor p -> p a b -> p s t

  # iso :: (s -> a) -> (b -> t) -> Iso s t a b
  iso = pro: pro.dimap;

  # Lens s t a b :: forall p. Strong p -> p a b -> p s t

  # lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
  lens = strong: get: set: pab:
    lensP
      strong
      (s: tuple (get s) (b: set s b))
      pab;

  # lensP :: (s -> (a, b -> t)) -> Lens s t a b
  lensP = strong: to: pab:
    strong.dimap
      to
      ({ fst, snd }: snd fst)
      (strong.firstP pab);

  # first element of a tuple
  # _1 :: Lens (a, c) (b, c) a b
  _1 = strong: strong.firstP;

  # second element of a tuple
  # _2 :: Lens (c, a) (c, b) a b
  _2 = strong: strong.secondP;

  # a the given field in the record
  # field :: (f :: String) -> Lens { f :: a; ... } { f :: b; ... } a b
  field = name: strong:
    lens
      strong
      (attrs: attrs.${name})
      (attrs: a: attrs // { ${name} = a; });

  # Setter :: (->) a b -> (->) s t
  # Setter :: (a -> b) -> (s -> t)


  # Subclasses of profunctor for (->).
  # We only have Strong for now, but when we implement Choice we need to add it here.
  profunctorSubclassesFun = strongFun;

  # over :: Setter s t a b -> (a -> b) -> s -> t
  over = setter:
    # A setter needs to be instanced to the profunctor-subclass instances of (->).
    (setter profunctorSubclassesFun);

  # set :: Setter s t a b -> b -> s -> t
  set = setter: b: over setter (const b);

  # combine a bunch of optics, for the subclass instance of profunctor you give it.
  optic = accessors: profunctorSubclass:
    builtins.foldl' comp id
      (map (accessor: accessor profunctorSubclass) accessors);


in
{
  inherit
    id
    _
    const
    comp
    Profunctor
    profunctorFun
    Strong
    strongFun
    iso
    lens
    optic
    _1
    _2
    field
    tuple
    swap
    over
    set
    ;
}