idris2-lens/src/Control/Lens/Internal/Bicontravariant.idr
Kiana Sheibani 69870ff394
Implement basic optic functions
Most of these functions are taken from `fresnel`, but I intend to
implement more convenient utilities from `lens`.
2023-04-12 11:34:33 -04:00

42 lines
1.1 KiB
Idris

module Control.Lens.Internal.Bicontravariant
import Data.Morphisms
import Data.Contravariant
import Data.Profunctor
%default total
public export
interface Bicontravariant f where
contrabimap : (a -> b) -> (c -> d) -> f b d -> f a c
contrabimap f g = contramapFst f . contramapSnd g
contramapFst : (a -> b) -> f b c -> f a c
contramapFst f = contrabimap f id
contramapSnd : (b -> c) -> f a c -> f a b
contramapSnd = contrabimap id
public export
Contravariant f => Bicontravariant (Star f) where
contrabimap f g = MkStar . dimap @{Function} f (contramap g) . applyStar
public export
Contravariant f => Bicontravariant (Kleislimorphism f) where
contrabimap f g = Kleisli . dimap @{Function} f (contramap g) . applyKleisli
public export
Bicontravariant (Forget {k=Type} r) where
contrabimap f _ = MkForget . lmap @{Function} f . runForget
public export
rphantom : (Profunctor p, Bicontravariant p) => p a b -> p a c
rphantom = contramapSnd (const ()) . rmap (const ())
public export
biphantom : (Bifunctor p, Bicontravariant p) => p a b -> p c d
biphantom = contrabimap (const ()) (const ()) . bimap (const ()) (const ())