{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  MPTCs, fundeps
--
----------------------------------------------------------------------------
module Data.Profunctor.Sieve
  ( Sieve(..)
  , Cosieve(..)
  ) where

import Control.Applicative
import Control.Arrow
import Control.Comonad
import Data.Functor.Identity
import Data.Profunctor
import Data.Proxy
import Data.Tagged

-- | A 'Profunctor' @p@ is a 'Sieve' __on__ @f@ if it is a subprofunctor of @'Star' f@.
--
-- That is to say it is a subset of @Hom(-,f=)@ closed under 'lmap' and 'rmap'.
--
-- Alternately, you can view it as a sieve __in__ the comma category @Hask/f@.
class (Profunctor p, Functor f) => Sieve p f | p -> f where
  sieve :: p a b -> a -> f b

instance Sieve (->) Identity where
  sieve :: forall a b. (a -> b) -> a -> Identity b
sieve a -> b
f = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  {-# INLINE sieve #-}

instance (Monad m, Functor m) => Sieve (Kleisli m) m where
  sieve :: forall a b. Kleisli m a b -> a -> m b
sieve = Kleisli m a b -> a -> m b
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli
  {-# INLINE sieve #-}

instance Functor f => Sieve (Star f) f where
  sieve :: forall a b. Star f a b -> a -> f b
sieve = Star f a b -> a -> f b
forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar
  {-# INLINE sieve #-}

instance Sieve (Forget r) (Const r) where
  sieve :: forall a b. Forget r a b -> a -> Const r b
sieve = (r -> Const r b
forall {k} a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> r) -> a -> Const r b)
-> (Forget r a b -> a -> r) -> Forget r a b -> a -> Const r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forget r a b -> a -> r
forall {k} r a (b :: k). Forget r a b -> a -> r
runForget
  {-# INLINE sieve #-}

-- | A 'Profunctor' @p@ is a 'Cosieve' __on__ @f@ if it is a subprofunctor of @'Costar' f@.
--
-- That is to say it is a subset of @Hom(f-,=)@ closed under 'lmap' and 'rmap'.
--
-- Alternately, you can view it as a cosieve __in__ the comma category @f/Hask@.
class (Profunctor p, Functor f) => Cosieve p f | p -> f where
  cosieve :: p a b -> f a -> b

instance Cosieve (->) Identity where
  cosieve :: forall a b. (a -> b) -> Identity a -> b
cosieve a -> b
f (Identity a
d) = a -> b
f a
d
  {-# INLINE cosieve #-}

instance Functor w => Cosieve (Cokleisli w) w where
  cosieve :: forall a b. Cokleisli w a b -> w a -> b
cosieve = Cokleisli w a b -> w a -> b
forall {k} (w :: k -> *) (a :: k) b. Cokleisli w a b -> w a -> b
runCokleisli
  {-# INLINE cosieve #-}

instance Cosieve Tagged Proxy where
  cosieve :: forall a b. Tagged a b -> Proxy a -> b
cosieve (Tagged b
a) Proxy a
_ = b
a
  {-# INLINE cosieve #-}

instance Functor f => Cosieve (Costar f) f where
  cosieve :: forall a b. Costar f a b -> f a -> b
cosieve = Costar f a b -> f a -> b
forall {k} (f :: k -> *) (d :: k) c. Costar f d c -> f d -> c
runCostar
  {-# INLINE cosieve #-}