0 | module Data.Profunctor.Sieve
 1 |
 2 | import Control.Applicative.Const
 3 | import Control.Monad.Identity
 4 | import Data.Morphisms
 5 | import Data.Profunctor
 6 |
 7 | %default total
 8 |
 9 |
10 | ------------------------------------------------------------------------------
11 | -- Interfaces
12 | ------------------------------------------------------------------------------
13 |
14 |
15 | ||| A profunctor `p` is a sieve on `f` if it is a subprofunctor of `Star f`.
16 | public export
17 | interface (Profunctor pFunctor f) => Sieve p f | p where
18 |   sieve : p a b -> a -> f b
19 |
20 |
21 | ||| A profunctor `p` is a cosieve on `f` if it is a subprofunctor of `Costar f`.
22 | public export
23 | interface (Profunctor pFunctor f) => Cosieve p f | p where
24 |   cosieve : p a b -> f a -> b
25 |
26 |
27 | ------------------------------------------------------------------------------
28 | -- Implementations
29 | ------------------------------------------------------------------------------
30 |
31 |
32 | public export
33 | Sieve Morphism Identity where
34 |   sieve (Mor f) = Id . f
35 |
36 | ||| A named implementation of `Sieve` for function types.
37 | ||| Use this to avoid having to use a type wrapper like `Morphism`.
38 | public export
39 | [Function] Sieve (\a,b => a -> b) Prelude.id using Profunctor.Function FunctorId where
40 |   sieve = id
41 |
42 | public export
43 | Functor f => Sieve (Kleislimorphism f) f where
44 |   sieve = applyKleisli
45 |
46 | public export
47 | Functor f => Sieve (Star f) f where
48 |   sieve = applyStar
49 |
50 | public export
51 | Sieve (Forget r) (Const r) where
52 |   sieve (MkForget k) = MkConst . k
53 |
54 |
55 | public export
56 | Cosieve Morphism Identity where
57 |   cosieve (Mor f) = f . runIdentity
58 |
59 | namespace Cosieve
60 |   ||| A named implementation of `Cosieve` for function types.
61 |   ||| Use this to avoid having to use a type wrapper like `Morphism`.
62 |   public export
63 |   [Function] Cosieve (\a,b => a -> b) Prelude.id using Profunctor.Function FunctorId where
64 |     cosieve = id
65 |
66 | public export
67 | Functor f => Cosieve (Costar f) f where
68 |   cosieve = applyCostar
69 |
70 | public export
71 | Cosieve (Coforget r) (Const r) where
72 |   cosieve (MkCoforget k) = k . runConst
73 |