tvl-depot/users/Profpatsch/lens.nix

{ ... }:
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
    ;
}