idris2-profunctors/Data/Profunctor/Sieve.idr

74 lines
1.9 KiB
Idris
Raw Normal View History

2023-03-06 21:37:27 -05:00
module Data.Profunctor.Sieve
import Control.Applicative.Const
import Control.Monad.Identity
import Data.Morphisms
2023-03-06 21:37:27 -05:00
import Data.Profunctor
%default total
2023-03-07 22:15:08 -05:00
------------------------------------------------------------------------------
-- Interfaces
------------------------------------------------------------------------------
||| A profunctor `p` is a sieve on `f` if it is a subprofunctor of `Star f`.
2023-03-06 21:37:27 -05:00
public export
interface (Profunctor p, Functor f) => Sieve p f | p where
sieve : p a b -> a -> f b
2023-03-07 22:15:08 -05:00
||| A profunctor `p` is a cosieve on `f` if it is a subprofunctor of `Costar f`.
public export
interface (Profunctor p, Functor f) => Cosieve p f | p where
cosieve : p a b -> f a -> b
------------------------------------------------------------------------------
-- Implementations
------------------------------------------------------------------------------
public export
Sieve Morphism Identity where
sieve (Mor f) = Id . f
2023-03-07 22:15:08 -05:00
||| A named implementation of `Sieve` for function types.
||| Use this to avoid having to use a type wrapper like `Morphism`.
public export
[Function] Sieve (\a,b => a -> b) Identity using Profunctor.Function where
sieve = (Id .)
public export
Functor f => Sieve (Kleislimorphism f) f where
sieve = applyKleisli
public export
Functor f => Sieve (Star f) f where
sieve = applyStar
public export
Sieve (Forget r) (Const r) where
sieve (MkForget k) = MkConst . k
public export
Cosieve Morphism Identity where
cosieve (Mor f) = f . runIdentity
namespace Cosieve
2023-03-07 22:15:08 -05:00
||| A named implementation of `Cosieve` for function types.
||| Use this to avoid having to use a type wrapper like `Morphism`.
public export
[Function] Cosieve (\a,b => a -> b) Identity using Profunctor.Function where
cosieve = (. runIdentity)
public export
Functor f => Cosieve (Costar f) f where
cosieve = applyCostar
public export
Cosieve (Coforget r) (Const r) where
cosieve (MkCoforget k) = k . runConst