{-|
Module      : Data.Profunctor.Filtrator
Description : filtrators
Copyright   : (C) 2026 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable
-}

module Data.Profunctor.Filtrator
  ( -- * Filtrator
    Filtrator (filtrate)
  , mfiltrate
  ) where

import Control.Applicative
import Control.Arrow
import Control.Lens.PartialIso
import Control.Lens.Internal.Profunctor
import Control.Monad
import Data.Profunctor
import Data.Profunctor.Distributor
import Data.Profunctor.Monad
import Data.Profunctor.Monadic (Monadic)
import Data.Profunctor.Yoneda
import Witherable

{- | The `Filtrator` class extends `Cochoice`,
as well as `Filterable`, adding the `filtrate` method,
which is an oplax monoidal structure morphism dual to `>+<`.

prop> filtrate . uncurry (>+<) = id
prop> uncurry (>+<) . filtrate = id
-}
class (Cochoice p, forall x. Filterable (p x))
  => Filtrator p where

    {- |
    prop> unleft = fst . filtrate
    prop> unright = snd . filtrate

    `filtrate` is a distant relative to `Data.Either.partitionEithers`.

    `filtrate` has a default for `Choice`.
    -}
    filtrate
      :: p (Either a c) (Either b d)
      -> (p a b, p c d)
    default filtrate
      :: Choice p
      => p (Either a c) (Either b d)
      -> (p a b, p c d)
    filtrate =
      (a -> Maybe (Either a c))
-> (Either b d -> Maybe b) -> p (Either a c) (Either b d) -> p a b
forall (p :: * -> * -> *) s a b t.
(Choice p, Cochoice p) =>
(s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
dimapMaybe (Either a c -> Maybe (Either a c)
forall a. a -> Maybe a
Just (Either a c -> Maybe (Either a c))
-> (a -> Either a c) -> a -> Maybe (Either a c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a c
forall a b. a -> Either a b
Left) ((b -> Maybe b) -> (d -> Maybe b) -> Either b d -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> d -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing))
      (p (Either a c) (Either b d) -> p a b)
-> (p (Either a c) (Either b d) -> p c d)
-> p (Either a c) (Either b d)
-> (p a b, p c d)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
      (c -> Maybe (Either a c))
-> (Either b d -> Maybe d) -> p (Either a c) (Either b d) -> p c d
forall (p :: * -> * -> *) s a b t.
(Choice p, Cochoice p) =>
(s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
dimapMaybe (Either a c -> Maybe (Either a c)
forall a. a -> Maybe a
Just (Either a c -> Maybe (Either a c))
-> (c -> Either a c) -> c -> Maybe (Either a c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either a c
forall a b. b -> Either a b
Right) ((b -> Maybe d) -> (d -> Maybe d) -> Either b d -> Maybe d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe d -> b -> Maybe d
forall a b. a -> b -> a
const Maybe d
forall a. Maybe a
Nothing) d -> Maybe d
forall a. a -> Maybe a
Just)

-- | `mfiltrate` can be used as `filtrate`, for `Monadic` `Alternator`s.
--
-- prop> mfiltrate = filtrate
mfiltrate
  :: (Monadic p, Alternator p)
  => p (Either a c) (Either b d)
  -> (p a b, p c d)
mfiltrate :: forall (p :: * -> * -> *) a c b d.
(Monadic p, Alternator p) =>
p (Either a c) (Either b d) -> (p a b, p c d)
mfiltrate =
  ((a -> Either a c)
-> p (Either a c) (Either b d) -> p a (Either b d)
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> Either a c
forall a b. a -> Either a b
Left (p (Either a c) (Either b d) -> p a (Either b d))
-> (Either b d -> p a b) -> p (Either a c) (Either b d) -> p a b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (b -> p a b) -> (d -> p a b) -> Either b d -> p a b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> p a b
forall a. a -> p a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (p a b -> d -> p a b
forall a b. a -> b -> a
const p a b
forall a. p a a
forall (f :: * -> *) a. Alternative f => f a
empty))
  (p (Either a c) (Either b d) -> p a b)
-> (p (Either a c) (Either b d) -> p c d)
-> p (Either a c) (Either b d)
-> (p a b, p c d)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
  ((c -> Either a c)
-> p (Either a c) (Either b d) -> p c (Either b d)
forall a b c. (a -> b) -> p b c -> p a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap c -> Either a c
forall a b. b -> Either a b
Right (p (Either a c) (Either b d) -> p c (Either b d))
-> (Either b d -> p c d) -> p (Either a c) (Either b d) -> p c d
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (b -> p c d) -> (d -> p c d) -> Either b d -> p c d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (p c d -> b -> p c d
forall a b. a -> b -> a
const p c d
forall a. p c a
forall (f :: * -> *) a. Alternative f => f a
empty) d -> p c d
forall a. a -> p c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

instance (Profunctor p, forall x. Functor (p x), Filterable f)
  => Filtrator (WrappedPafb f p) where
    filtrate :: forall a c b d.
WrappedPafb f p (Either a c) (Either b d)
-> (WrappedPafb f p a b, WrappedPafb f p c d)
filtrate (WrapPafb p (Either a c) (f (Either b d))
p) =
      ( p a (f b) -> WrappedPafb f p a b
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb (p a (f b) -> WrappedPafb f p a b)
-> p a (f b) -> WrappedPafb f p a b
forall a b. (a -> b) -> a -> b
$ (a -> Either a c)
-> (f (Either b d) -> f b)
-> p (Either a c) (f (Either b d))
-> p a (f b)
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> Either a c
forall a b. a -> Either a b
Left ((Either b d -> Maybe b) -> f (Either b d) -> f b
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((b -> Maybe b) -> (d -> Maybe b) -> Either b d -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> d -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing))) p (Either a c) (f (Either b d))
p
      , p c (f d) -> WrappedPafb f p c d
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb (p c (f d) -> WrappedPafb f p c d)
-> p c (f d) -> WrappedPafb f p c d
forall a b. (a -> b) -> a -> b
$ (c -> Either a c)
-> (f (Either b d) -> f d)
-> p (Either a c) (f (Either b d))
-> p c (f d)
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap c -> Either a c
forall a b. b -> Either a b
Right ((Either b d -> Maybe d) -> f (Either b d) -> f d
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((b -> Maybe d) -> (d -> Maybe d) -> Either b d -> Maybe d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe d -> b -> Maybe d
forall a b. a -> b -> a
const Maybe d
forall a. Maybe a
Nothing) d -> Maybe d
forall a. a -> Maybe a
Just)) p (Either a c) (f (Either b d))
p
      )
instance Filtrator p => Filtrator (Coyoneda p) where
  filtrate :: forall a c b d.
Coyoneda p (Either a c) (Either b d)
-> (Coyoneda p a b, Coyoneda p c d)
filtrate Coyoneda p (Either a c) (Either b d)
p =
    let (p a b
q,p c d
r) = p (Either a c) (Either b d) -> (p a b, p c d)
forall a c b d. p (Either a c) (Either b d) -> (p a b, p c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate (Coyoneda p (Either a c) (Either b d) -> p (Either a c) (Either b d)
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Coyoneda p (Either a c) (Either b d)
p)
    in (p a b -> Coyoneda p a b
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p a b
q, p c d -> Coyoneda p c d
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p c d
r)
instance Filtrator p => Filtrator (Yoneda p) where
  filtrate :: forall a c b d.
Yoneda p (Either a c) (Either b d) -> (Yoneda p a b, Yoneda p c d)
filtrate Yoneda p (Either a c) (Either b d)
p =
    let (p a b
q,p c d
r) = p (Either a c) (Either b d) -> (p a b, p c d)
forall a c b d. p (Either a c) (Either b d) -> (p a b, p c d)
forall (p :: * -> * -> *) a c b d.
Filtrator p =>
p (Either a c) (Either b d) -> (p a b, p c d)
filtrate (Yoneda p (Either a c) (Either b d) -> p (Either a c) (Either b d)
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract Yoneda p (Either a c) (Either b d)
p)
    in (p a b -> Yoneda p a b
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p a b
q, p c d -> Yoneda p c d
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn p c d
r)
instance Filtrator (Forget r) where
  filtrate :: forall a c b d.
Forget r (Either a c) (Either b d) -> (Forget r a b, Forget r c d)
filtrate (Forget Either a c -> r
f) = ((a -> r) -> Forget r a b
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget (Either a c -> r
f (Either a c -> r) -> (a -> Either a c) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a c
forall a b. a -> Either a b
Left), (c -> r) -> Forget r c d
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget (Either a c -> r
f (Either a c -> r) -> (c -> Either a c) -> c -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either a c
forall a b. b -> Either a b
Right))
instance (Filterable f, Traversable f) => Filtrator (Star f) where
  filtrate :: forall a c b d.
Star f (Either a c) (Either b d) -> (Star f a b, Star f c d)
filtrate (Star Either a c -> f (Either b d)
f) =
    ( (a -> f b) -> Star f a b
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((Either b d -> Maybe b) -> f (Either b d) -> f b
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((b -> Maybe b) -> (d -> Maybe b) -> Either b d -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> d -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing)) (f (Either b d) -> f b) -> (a -> f (Either b d)) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a c -> f (Either b d)
f (Either a c -> f (Either b d))
-> (a -> Either a c) -> a -> f (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a c
forall a b. a -> Either a b
Left)
    , (c -> f d) -> Star f c d
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((Either b d -> Maybe d) -> f (Either b d) -> f d
forall a b. (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((b -> Maybe d) -> (d -> Maybe d) -> Either b d -> Maybe d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe d -> b -> Maybe d
forall a b. a -> b -> a
const Maybe d
forall a. Maybe a
Nothing) d -> Maybe d
forall a. a -> Maybe a
Just) (f (Either b d) -> f d) -> (c -> f (Either b d)) -> c -> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a c -> f (Either b d)
f (Either a c -> f (Either b d))
-> (c -> Either a c) -> c -> f (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either a c
forall a b. b -> Either a b
Right)
    )
instance Filtrator (PartialExchange a b) where
  filtrate :: forall a c b d.
PartialExchange a b (Either a c) (Either b d)
-> (PartialExchange a b a b, PartialExchange a b c d)
filtrate (PartialExchange Either a c -> Maybe a
f b -> Maybe (Either b d)
g) =
    ( (a -> Maybe a) -> (b -> Maybe b) -> PartialExchange a b a b
forall a b s t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialExchange a b s t
PartialExchange (Either a c -> Maybe a
f (Either a c -> Maybe a) -> (a -> Either a c) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a c
forall a b. a -> Either a b
Left) ((b -> Maybe b) -> (d -> Maybe b) -> Either b d -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Maybe b
forall a. a -> Maybe a
Just (Maybe b -> d -> Maybe b
forall a. a -> d -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing) (Either b d -> Maybe b)
-> (b -> Maybe (Either b d)) -> b -> Maybe b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< b -> Maybe (Either b d)
g)
    , (c -> Maybe a) -> (b -> Maybe d) -> PartialExchange a b c d
forall a b s t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialExchange a b s t
PartialExchange (Either a c -> Maybe a
f (Either a c -> Maybe a) -> (c -> Either a c) -> c -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either a c
forall a b. b -> Either a b
Right) ((b -> Maybe d) -> (d -> Maybe d) -> Either b d -> Maybe d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe d -> b -> Maybe d
forall a. a -> b -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe d
forall a. Maybe a
Nothing) d -> Maybe d
forall a. a -> Maybe a
Just (Either b d -> Maybe d)
-> (b -> Maybe (Either b d)) -> b -> Maybe d
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< b -> Maybe (Either b d)
g)
    )