Most of these functions are taken from `fresnel`, but I intend to implement more convenient utilities from `lens`.
42 lines
1.1 KiB
Idris
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 ())
|