{- |
Module      : Control.Lens.PartialIso
Description : partial isomorphisms
Copyright   : (C) 2025 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable

See Rendel & Ostermann,
[Invertible syntax descriptions](https://www.informatik.uni-marburg.de/~rendel/unparse/)
-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Control.Lens.PartialIso
  ( -- * PartialIso
    dimapMaybe
  , PartialIso
  , PartialIso'
  , APartialIso
  , PartialExchange (PartialExchange)
    -- Combinators
  , partialIso
  , withPartialIso
  , clonePartialIso
  , coPartialIso
  , crossPartialIso
  , altPartialIso
    -- * Actions
  , (>?)
  , (?<)
  , (>?<)
  , mapIso
  , coPrism
    -- * Patterns
  , satisfied
  , nulled
  , notNulled
  , streamed
  , maybeEot
  , listEot
    -- * Iterations
  , iterating
  , difoldl1
  , difoldr1
  , difoldl
  , difoldr
  , difoldl'
  , difoldr'
  ) where

import Control.Lens
import Control.Lens.Internal.Profunctor
import Control.Monad
import Data.Functor.Compose
import Data.Profunctor
import Data.Profunctor.Monad
import Data.Profunctor.Yoneda
import Witherable

{- | The `dimapMaybe` function endows
`Choice` & `Cochoice` "partial profunctors"
with an action `>?<` of `PartialIso`s.
-}
dimapMaybe
  :: (Choice p, Cochoice p)
  => (s -> Maybe a) -> (b -> Maybe t)
  -> p a b -> p s t
dimapMaybe :: forall (p :: * -> * -> *) s a b t.
(Choice p, Cochoice p) =>
(s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
dimapMaybe s -> Maybe a
f b -> Maybe t
g =
  let
    m2e :: (a -> Maybe b) -> a -> Either () b
m2e a -> Maybe b
h = Either () b -> (b -> Either () b) -> Maybe b -> Either () b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either () b
forall a b. a -> Either a b
Left ()) b -> Either () b
forall a b. b -> Either a b
Right (Maybe b -> Either () b) -> (a -> Maybe b) -> a -> Either () b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
h
    fg :: p (Either () a) (Either () b) -> p (Either () s) (Either () t)
fg = (Either () s -> Either () a)
-> (Either () b -> Either () t)
-> p (Either () a) (Either () b)
-> p (Either () s) (Either () t)
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 (Either () s -> (s -> Either () a) -> Either () a
forall a b. Either () a -> (a -> Either () b) -> Either () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> Maybe a) -> s -> Either () a
forall {a} {b}. (a -> Maybe b) -> a -> Either () b
m2e s -> Maybe a
f) (Either () b -> (b -> Either () t) -> Either () t
forall a b. Either () a -> (a -> Either () b) -> Either () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> Maybe t) -> b -> Either () t
forall {a} {b}. (a -> Maybe b) -> a -> Either () b
m2e b -> Maybe t
g)
  in
    p (Either () s) (Either () t) -> p s t
forall d a b. p (Either d a) (Either d b) -> p a b
forall (p :: * -> * -> *) d a b.
Cochoice p =>
p (Either d a) (Either d b) -> p a b
unright (p (Either () s) (Either () t) -> p s t)
-> (p a b -> p (Either () s) (Either () t)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Either () a) (Either () b) -> p (Either () s) (Either () t)
fg (p (Either () a) (Either () b) -> p (Either () s) (Either () t))
-> (p a b -> p (Either () a) (Either () b))
-> p a b
-> p (Either () s) (Either () t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Either () a) (Either () b)
forall a b c. p a b -> p (Either c a) (Either c b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

{- | `PartialIso` is a first class inexhaustive pattern,
similar to how `Control.Lens.Prism.Prism` is a first class exhaustive pattern,
by combining `Control.Lens.Prism.Prism`s and coPrisms.

Every `Control.Lens.Iso.Iso` & `Control.Lens.Prism.Prism` is `APartialIso`.

`PartialIso`s are isomorphic to `PartialExchange`s.
-}
type PartialIso s t a b = forall p f.
  (Choice p, Cochoice p, Applicative f, Filterable f)
    => p a (f b) -> p s (f t)

{- |
A simple `PartialIso'` @s a@ is an identification of
a subset of @s@ with a subset of @a@.

Given a simple `PartialIso'`, @partialIso f g@, has properties:

prop> Just = f <=< g
prop> Just = g <=< f

These are left and right inverse laws for proper `PartialIso'`s.
However, sometimes an improper `PartialIso'` will be useful.
For an improper `PartialIso'`, only the left inverse law holds.

prop> Just = f <=< g

For an improper `PartialIso'`, @norm = g <=< f@ is an idempotent

prop> norm = norm <=< norm

and can be regarded as a normalization within
some equivalence class of terms.
-}
type PartialIso' s a = PartialIso s s a a

{- | If you see `APartialIso` in a signature for a function,
the function is expecting a `PartialIso`. -}
type APartialIso s t a b =
  PartialExchange a b a (Maybe b) -> PartialExchange a b s (Maybe t)

{- | A `PartialExchange` provides efficient access
to the two functions that make up a `PartialIso`.
-}
data PartialExchange a b s t =
  PartialExchange (s -> Maybe a) (b -> Maybe t)
instance Functor (PartialExchange a b s) where fmap :: forall a b.
(a -> b) -> PartialExchange a b s a -> PartialExchange a b s b
fmap = (a -> b) -> PartialExchange a b s a -> PartialExchange a b s b
forall b c a.
(b -> c) -> PartialExchange a b a b -> PartialExchange a b a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
instance Filterable (PartialExchange a b s) where
  mapMaybe :: forall a b.
(a -> Maybe b)
-> PartialExchange a b s a -> PartialExchange a b s b
mapMaybe = (s -> Maybe s)
-> (a -> Maybe b)
-> PartialExchange a b s a
-> PartialExchange a b s b
forall (p :: * -> * -> *) s a b t.
(Choice p, Cochoice p) =>
(s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
dimapMaybe s -> Maybe s
forall a. a -> Maybe a
Just
instance Profunctor (PartialExchange a b) where
  dimap :: forall a b c d.
(a -> b)
-> (c -> d) -> PartialExchange a b b c -> PartialExchange a b a d
dimap a -> b
f' c -> d
g' (PartialExchange b -> Maybe a
f b -> Maybe c
g) =
    (a -> Maybe a) -> (b -> Maybe d) -> PartialExchange a b a d
forall a b s t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialExchange a b s t
PartialExchange (b -> Maybe a
f (b -> Maybe a) -> (a -> b) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f') ((c -> d) -> Maybe c -> Maybe d
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g' (Maybe c -> Maybe d) -> (b -> Maybe c) -> b -> Maybe d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe c
g)
instance Choice (PartialExchange a b) where
  left' :: forall a b c.
PartialExchange a b a b
-> PartialExchange a b (Either a c) (Either b c)
left' (PartialExchange a -> Maybe a
f b -> Maybe b
g) =
    (Either a c -> Maybe a)
-> (b -> Maybe (Either b c))
-> PartialExchange a b (Either a c) (Either b c)
forall a b s t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialExchange a b s t
PartialExchange ((a -> Maybe a) -> (c -> Maybe a) -> Either a c -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
f (Maybe a -> c -> Maybe a
forall a. a -> c -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)) ((b -> Either b c
forall a b. a -> Either a b
Left (b -> Either b c) -> Maybe b -> Maybe (Either b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe b -> Maybe (Either b c))
-> (b -> Maybe b) -> b -> Maybe (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
g)
  right' :: forall a b c.
PartialExchange a b a b
-> PartialExchange a b (Either c a) (Either c b)
right' (PartialExchange a -> Maybe a
f b -> Maybe b
g) =
    (Either c a -> Maybe a)
-> (b -> Maybe (Either c b))
-> PartialExchange a b (Either c a) (Either c b)
forall a b s t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialExchange a b s t
PartialExchange ((c -> Maybe a) -> (a -> Maybe a) -> Either c a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> c -> Maybe a
forall a. a -> c -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
f) ((b -> Either c b
forall a b. b -> Either a b
Right (b -> Either c b) -> Maybe b -> Maybe (Either c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe b -> Maybe (Either c b))
-> (b -> Maybe b) -> b -> Maybe (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
g)
instance Cochoice (PartialExchange a b) where
  unleft :: forall a d b.
PartialExchange a b (Either a d) (Either b d)
-> PartialExchange a b a b
unleft (PartialExchange Either a d -> 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 d -> Maybe a
f (Either a d -> Maybe a) -> (a -> Either a d) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a d
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)
  unright :: forall d a b.
PartialExchange a b (Either d a) (Either d b)
-> PartialExchange a b a b
unright (PartialExchange Either d a -> Maybe a
f b -> Maybe (Either d b)
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 d a -> Maybe a
f (Either d a -> Maybe a) -> (a -> Either d a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either d a
forall a b. b -> Either a b
Right) ((d -> Maybe b) -> (b -> Maybe b) -> Either d b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (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) b -> Maybe b
forall a. a -> Maybe a
Just (Either d b -> Maybe b)
-> (b -> Maybe (Either d b)) -> b -> Maybe b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< b -> Maybe (Either d b)
g)

{- | Build a `PartialIso`. -}
partialIso :: (s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso :: forall s a b t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso s -> Maybe a
f b -> Maybe t
g =
  p (Either () s) (Either () (f t)) -> p s (f t)
forall d a b. p (Either d a) (Either d b) -> p a b
forall (p :: * -> * -> *) d a b.
Cochoice p =>
p (Either d a) (Either d b) -> p a b
unright (p (Either () s) (Either () (f t)) -> p s (f t))
-> (p a (f b) -> p (Either () s) (Either () (f t)))
-> p a (f b)
-> p s (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either () s -> Either () a)
-> (f b -> f t) -> Iso (Either () s) (f t) (Either () a) (f b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Either () a -> (a -> Either () a) -> Maybe a -> Either () a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either () a
forall a b. a -> Either a b
Left ()) a -> Either () a
forall a b. b -> Either a b
Right (Maybe a -> Either () a) -> (s -> Maybe a) -> s -> Either () a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe a
f (s -> Either () a) -> Either () s -> Either () a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) ((b -> Maybe t) -> f b -> f t
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 t
g) (p (Either () a) (Either () (f b))
 -> p (Either () s) (Either () (f t)))
-> (p a (f b) -> p (Either () a) (Either () (f b)))
-> p a (f b)
-> p (Either () s) (Either () (f t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> p (Either () a) (Either () (f b))
forall a b c. p a b -> p (Either c a) (Either c b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

{- | Convert `APartialIso` to the pair of functions that characterize it. -}
withPartialIso
  :: APartialIso s t a b
  -> ((s -> Maybe a) -> (b -> Maybe t) -> r)
  -> r
withPartialIso :: forall s t a b r.
APartialIso s t a b -> ((s -> Maybe a) -> (b -> Maybe t) -> r) -> r
withPartialIso APartialIso s t a b
i (s -> Maybe a) -> (b -> Maybe t) -> r
k =
  case APartialIso s t a b
i ((a -> Maybe a)
-> (b -> Maybe (Maybe b)) -> PartialExchange a b a (Maybe b)
forall a b s t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialExchange a b s t
PartialExchange a -> Maybe a
forall a. a -> Maybe a
Just (Maybe b -> Maybe (Maybe b)
forall a. a -> Maybe a
Just (Maybe b -> Maybe (Maybe b))
-> (b -> Maybe b) -> b -> Maybe (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just)) of
    PartialExchange s -> Maybe a
f b -> Maybe (Maybe t)
g -> (s -> Maybe a) -> (b -> Maybe t) -> r
k s -> Maybe a
f (Maybe (Maybe t) -> Maybe t
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe t) -> Maybe t)
-> (b -> Maybe (Maybe t)) -> b -> Maybe t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe (Maybe t)
g)

{- | Clone `APartialIso` so that you can reuse the same
monomorphically typed partial isomorphism for different purposes.
-}
clonePartialIso
  :: APartialIso s t a b
  -> PartialIso s t a b
clonePartialIso :: forall s t a b. APartialIso s t a b -> PartialIso s t a b
clonePartialIso APartialIso s t a b
i = APartialIso s t a b
-> ((s -> Maybe a) -> (b -> Maybe t) -> p a (f b) -> p s (f t))
-> p a (f b)
-> p s (f t)
forall s t a b r.
APartialIso s t a b -> ((s -> Maybe a) -> (b -> Maybe t) -> r) -> r
withPartialIso APartialIso s t a b
i (((s -> Maybe a) -> (b -> Maybe t) -> p a (f b) -> p s (f t))
 -> p a (f b) -> p s (f t))
-> ((s -> Maybe a) -> (b -> Maybe t) -> p a (f b) -> p s (f t))
-> p a (f b)
-> p s (f t)
forall a b. (a -> b) -> a -> b
$ \s -> Maybe a
f b -> Maybe t
g -> (s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
forall s a b t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso s -> Maybe a
f b -> Maybe t
g

{- | Clone and invert `APartialIso`. -}
coPartialIso
  :: APartialIso b a t s
  -> PartialIso s t a b
coPartialIso :: forall b a t s. APartialIso b a t s -> PartialIso s t a b
coPartialIso APartialIso b a t s
i =
  APartialIso b a t s
-> ((b -> Maybe t) -> (s -> Maybe a) -> p a (f b) -> p s (f t))
-> p a (f b)
-> p s (f t)
forall s t a b r.
APartialIso s t a b -> ((s -> Maybe a) -> (b -> Maybe t) -> r) -> r
withPartialIso APartialIso b a t s
i (((b -> Maybe t) -> (s -> Maybe a) -> p a (f b) -> p s (f t))
 -> p a (f b) -> p s (f t))
-> ((b -> Maybe t) -> (s -> Maybe a) -> p a (f b) -> p s (f t))
-> p a (f b)
-> p s (f t)
forall a b. (a -> b) -> a -> b
$ \b -> Maybe t
f s -> Maybe a
g -> (s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
forall s a b t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso s -> Maybe a
g b -> Maybe t
f

{- | Construct a `PartialIso` on pairs from components. -}
crossPartialIso
  :: APartialIso s t a b
  -> APartialIso u v c d
  -> PartialIso (s,u) (t,v) (a,c) (b,d)
crossPartialIso :: forall s t a b u v c d.
APartialIso s t a b
-> APartialIso u v c d -> PartialIso (s, u) (t, v) (a, c) (b, d)
crossPartialIso APartialIso s t a b
x APartialIso u v c d
y =
  APartialIso s t a b
-> ((s -> Maybe a)
    -> (b -> Maybe t) -> p (a, c) (f (b, d)) -> p (s, u) (f (t, v)))
-> p (a, c) (f (b, d))
-> p (s, u) (f (t, v))
forall s t a b r.
APartialIso s t a b -> ((s -> Maybe a) -> (b -> Maybe t) -> r) -> r
withPartialIso APartialIso s t a b
x (((s -> Maybe a)
  -> (b -> Maybe t) -> p (a, c) (f (b, d)) -> p (s, u) (f (t, v)))
 -> p (a, c) (f (b, d)) -> p (s, u) (f (t, v)))
-> ((s -> Maybe a)
    -> (b -> Maybe t) -> p (a, c) (f (b, d)) -> p (s, u) (f (t, v)))
-> p (a, c) (f (b, d))
-> p (s, u) (f (t, v))
forall a b. (a -> b) -> a -> b
$ \s -> Maybe a
e b -> Maybe t
f ->
  APartialIso u v c d
-> ((u -> Maybe c)
    -> (d -> Maybe v) -> p (a, c) (f (b, d)) -> p (s, u) (f (t, v)))
-> p (a, c) (f (b, d))
-> p (s, u) (f (t, v))
forall s t a b r.
APartialIso s t a b -> ((s -> Maybe a) -> (b -> Maybe t) -> r) -> r
withPartialIso APartialIso u v c d
y (((u -> Maybe c)
  -> (d -> Maybe v) -> p (a, c) (f (b, d)) -> p (s, u) (f (t, v)))
 -> p (a, c) (f (b, d)) -> p (s, u) (f (t, v)))
-> ((u -> Maybe c)
    -> (d -> Maybe v) -> p (a, c) (f (b, d)) -> p (s, u) (f (t, v)))
-> p (a, c) (f (b, d))
-> p (s, u) (f (t, v))
forall a b. (a -> b) -> a -> b
$ \u -> Maybe c
g d -> Maybe v
h ->
    ((s, u) -> Maybe (a, c))
-> ((b, d) -> Maybe (t, v))
-> PartialIso (s, u) (t, v) (a, c) (b, d)
forall s a b t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso
      (\(s
s,u
u) -> (,) (a -> c -> (a, c)) -> Maybe a -> Maybe (c -> (a, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe a
e s
s Maybe (c -> (a, c)) -> Maybe c -> Maybe (a, c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u -> Maybe c
g u
u)
      (\(b
t,d
v) -> (,) (t -> v -> (t, v)) -> Maybe t -> Maybe (v -> (t, v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> Maybe t
f b
t Maybe (v -> (t, v)) -> Maybe v -> Maybe (t, v)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> Maybe v
h d
v)

{- | Construct a `PartialIso` on `Either`s from components. -}
altPartialIso
  :: APartialIso s t a b
  -> APartialIso u v c d
  -> PartialIso
      (Either s u) (Either t v)
      (Either a c) (Either b d)
altPartialIso :: forall s t a b u v c d.
APartialIso s t a b
-> APartialIso u v c d
-> PartialIso (Either s u) (Either t v) (Either a c) (Either b d)
altPartialIso APartialIso s t a b
x APartialIso u v c d
y =
  APartialIso s t a b
-> ((s -> Maybe a)
    -> (b -> Maybe t)
    -> p (Either a c) (f (Either b d))
    -> p (Either s u) (f (Either t v)))
-> p (Either a c) (f (Either b d))
-> p (Either s u) (f (Either t v))
forall s t a b r.
APartialIso s t a b -> ((s -> Maybe a) -> (b -> Maybe t) -> r) -> r
withPartialIso APartialIso s t a b
x (((s -> Maybe a)
  -> (b -> Maybe t)
  -> p (Either a c) (f (Either b d))
  -> p (Either s u) (f (Either t v)))
 -> p (Either a c) (f (Either b d))
 -> p (Either s u) (f (Either t v)))
-> ((s -> Maybe a)
    -> (b -> Maybe t)
    -> p (Either a c) (f (Either b d))
    -> p (Either s u) (f (Either t v)))
-> p (Either a c) (f (Either b d))
-> p (Either s u) (f (Either t v))
forall a b. (a -> b) -> a -> b
$ \s -> Maybe a
e b -> Maybe t
f ->
  APartialIso u v c d
-> ((u -> Maybe c)
    -> (d -> Maybe v)
    -> p (Either a c) (f (Either b d))
    -> p (Either s u) (f (Either t v)))
-> p (Either a c) (f (Either b d))
-> p (Either s u) (f (Either t v))
forall s t a b r.
APartialIso s t a b -> ((s -> Maybe a) -> (b -> Maybe t) -> r) -> r
withPartialIso APartialIso u v c d
y (((u -> Maybe c)
  -> (d -> Maybe v)
  -> p (Either a c) (f (Either b d))
  -> p (Either s u) (f (Either t v)))
 -> p (Either a c) (f (Either b d))
 -> p (Either s u) (f (Either t v)))
-> ((u -> Maybe c)
    -> (d -> Maybe v)
    -> p (Either a c) (f (Either b d))
    -> p (Either s u) (f (Either t v)))
-> p (Either a c) (f (Either b d))
-> p (Either s u) (f (Either t v))
forall a b. (a -> b) -> a -> b
$ \u -> Maybe c
g d -> Maybe v
h ->
    (Either s u -> Maybe (Either a c))
-> (Either b d -> Maybe (Either t v))
-> PartialIso (Either s u) (Either t v) (Either a c) (Either b d)
forall s a b t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso
      ((s -> Maybe (Either a c))
-> (u -> Maybe (Either a c)) -> Either s u -> Maybe (Either a c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> Either a c
forall a b. a -> Either a b
Left (a -> Either a c) -> Maybe a -> Maybe (Either a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe a -> Maybe (Either a c))
-> (s -> Maybe a) -> s -> Maybe (Either a c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe a
e) ((c -> Either a c
forall a b. b -> Either a b
Right (c -> Either a c) -> Maybe c -> Maybe (Either a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe c -> Maybe (Either a c))
-> (u -> Maybe c) -> u -> Maybe (Either a c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> Maybe c
g))
      ((b -> Maybe (Either t v))
-> (d -> Maybe (Either t v)) -> Either b d -> Maybe (Either t v)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((t -> Either t v
forall a b. a -> Either a b
Left (t -> Either t v) -> Maybe t -> Maybe (Either t v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe t -> Maybe (Either t v))
-> (b -> Maybe t) -> b -> Maybe (Either t v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe t
f) ((v -> Either t v
forall a b. b -> Either a b
Right (v -> Either t v) -> Maybe v -> Maybe (Either t v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe v -> Maybe (Either t v))
-> (d -> Maybe v) -> d -> Maybe (Either t v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Maybe v
h))

{- | Action of `APrism` on `Choice` `Profunctor`s. -}
(>?)
  :: Choice p
  => APrism s t a b
  -> p a b
  -> p s t
>? :: forall (p :: * -> * -> *) s t a b.
Choice p =>
APrism s t a b -> p a b -> p s t
(>?) APrism s t a b
pat = APrism s t a b
-> ((b -> t) -> (s -> Either t a) -> p a b -> p s t)
-> p a b
-> p s t
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
pat (((b -> t) -> (s -> Either t a) -> p a b -> p s t)
 -> p a b -> p s t)
-> ((b -> t) -> (s -> Either t a) -> p a b -> p s t)
-> p a b
-> p s t
forall a b. (a -> b) -> a -> b
$ \b -> t
f s -> Either t a
g -> (s -> Either t a)
-> (Either t b -> t) -> p (Either t a) (Either t b) -> p s t
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 s -> Either t a
g ((t -> t) -> (b -> t) -> Either t b -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> t
forall a. a -> a
id b -> t
f) (p (Either t a) (Either t b) -> p s t)
-> (p a b -> p (Either t a) (Either t b)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Either t a) (Either t b)
forall a b c. p a b -> p (Either c a) (Either c b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
infixl 4 >?

{- | Action of a coPrism on `Cochoice` `Profunctor`s. -}
(?<)
  :: Cochoice p
  => APrism b a t s
  -> p a b
  -> p s t
?< :: forall (p :: * -> * -> *) b a t s.
Cochoice p =>
APrism b a t s -> p a b -> p s t
(?<) APrism b a t s
pat = APrism b a t s
-> ((s -> a) -> (b -> Either a t) -> p a b -> p s t)
-> p a b
-> p s t
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism b a t s
pat (((s -> a) -> (b -> Either a t) -> p a b -> p s t)
 -> p a b -> p s t)
-> ((s -> a) -> (b -> Either a t) -> p a b -> p s t)
-> p a b
-> p s t
forall a b. (a -> b) -> a -> b
$ \s -> a
f b -> Either a t
g -> p (Either a s) (Either a t) -> p s t
forall d a b. p (Either d a) (Either d b) -> p a b
forall (p :: * -> * -> *) d a b.
Cochoice p =>
p (Either d a) (Either d b) -> p a b
unright (p (Either a s) (Either a t) -> p s t)
-> (p a b -> p (Either a s) (Either a t)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a s -> a)
-> (b -> Either a t) -> p a b -> p (Either a s) (Either a t)
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 -> a) -> (s -> a) -> Either a s -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id s -> a
f) b -> Either a t
g
infixl 4 ?<

{- | Action of `APartialIso` on `Choice` and `Cochoice` `Profunctor`s. -}
(>?<)
  :: (Choice p, Cochoice p)
  => APartialIso s t a b
  -> p a b
  -> p s t
>?< :: forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
(>?<) APartialIso s t a b
pat = APartialIso s t a b
-> ((s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t)
-> p a b
-> p s t
forall s t a b r.
APartialIso s t a b -> ((s -> Maybe a) -> (b -> Maybe t) -> r) -> r
withPartialIso APartialIso s t a b
pat (s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
forall (p :: * -> * -> *) s a b t.
(Choice p, Cochoice p) =>
(s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
dimapMaybe
infixl 4 >?<

{- | Action of `AnIso` on `Profunctor`s. -}
mapIso :: Profunctor p => AnIso s t a b -> p a b -> p s t
mapIso :: forall (p :: * -> * -> *) s t a b.
Profunctor p =>
AnIso s t a b -> p a b -> p s t
mapIso AnIso s t a b
i = AnIso s t a b
-> ((s -> a) -> (b -> t) -> p a b -> p s t) -> p a b -> p s t
forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso s t a b
i (s -> a) -> (b -> t) -> p a b -> p s t
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

{- | Action of a `coPrism`
on the composition of a `Profunctor` and `Filterable`.
-}
coPrism :: (Profunctor p, Filterable f) => APrism b a t s -> p a (f b) -> p s (f t)
coPrism :: forall (p :: * -> * -> *) (f :: * -> *) b a t s.
(Profunctor p, Filterable f) =>
APrism b a t s -> p a (f b) -> p s (f t)
coPrism APrism b a t s
p = WrappedPafb f p s t -> p s (f t)
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p s t -> p s (f t))
-> (p a (f b) -> WrappedPafb f p s t) -> p a (f b) -> p s (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism b a t s -> WrappedPafb f p a b -> WrappedPafb f p s t
forall (p :: * -> * -> *) b a t s.
Cochoice p =>
APrism b a t s -> p a b -> p s t
(?<) APrism b a t s
p (WrappedPafb f p a b -> WrappedPafb f p s t)
-> (p a (f b) -> WrappedPafb f p a b)
-> p a (f b)
-> WrappedPafb f p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> WrappedPafb f p a b
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb

{- | `satisfied` is the prototypical proper partial isomorphism,
identifying a subset which satisfies a predicate. -}
satisfied :: (a -> Bool) -> PartialIso' a a
satisfied :: forall a. (a -> Bool) -> PartialIso' a a
satisfied a -> Bool
f = (a -> Maybe a) -> (a -> Maybe a) -> PartialIso a a a a
forall s a b t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso a -> Maybe a
satiate a -> Maybe a
satiate where
  satiate :: a -> Maybe a
satiate a
a = if a -> Bool
f a
a then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing

{- | `nulled` matches an `Empty` pattern, like `_Empty`. -}
nulled :: (AsEmpty s, AsEmpty t) => PartialIso s t () ()
nulled :: forall s t. (AsEmpty s, AsEmpty t) => PartialIso s t () ()
nulled = (s -> Maybe ()) -> (() -> Maybe t) -> PartialIso s t () ()
forall s a b t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso s -> Maybe ()
forall {p}. AsEmpty p => p -> Maybe ()
empA () -> Maybe t
forall {a} {p}. AsEmpty a => p -> Maybe a
empB where
  empA :: p -> Maybe ()
empA p
s = if APrism p p () () -> p -> Bool
forall s t a b. APrism s t a b -> s -> Bool
isn't APrism p p () ()
forall a. AsEmpty a => Prism' a ()
Prism' p ()
_Empty p
s then Maybe ()
forall a. Maybe a
Nothing else () -> Maybe ()
forall a. a -> Maybe a
Just ()
  empB :: p -> Maybe a
empB p
_ = a -> Maybe a
forall a. a -> Maybe a
Just a
forall s. AsEmpty s => s
Empty

{- | `notNulled` matches a non-`Empty` pattern. -}
notNulled :: (AsEmpty s, AsEmpty t) => PartialIso s t s t
notNulled :: forall s t. (AsEmpty s, AsEmpty t) => PartialIso s t s t
notNulled = (s -> Maybe s) -> (t -> Maybe t) -> PartialIso s t s t
forall s a b t.
(s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso s -> Maybe s
forall {p}. AsEmpty p => p -> Maybe p
nonEmp t -> Maybe t
forall {p}. AsEmpty p => p -> Maybe p
nonEmp where
  nonEmp :: p -> Maybe p
nonEmp p
s = if APrism p p () () -> p -> Bool
forall s t a b. APrism s t a b -> s -> Bool
isn't APrism p p () ()
forall a. AsEmpty a => Prism' a ()
Prism' p ()
_Empty p
s then p -> Maybe p
forall a. a -> Maybe a
Just p
s else Maybe p
forall a. Maybe a
Nothing

{- | `streamed` is an isomorphism between
two stream types with the same token type. -}
streamed
  :: (AsEmpty s, AsEmpty t, Cons s s c c, Cons t t c c)
  => Iso' s t
streamed :: forall s t c.
(AsEmpty s, AsEmpty t, Cons s s c c, Cons t t c c) =>
Iso' s t
streamed = (s -> t) -> (t -> s) -> Iso s s t t
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso s -> t
forall {b} {t} {a}.
(AsEmpty b, Cons t t a a, Cons b b a a) =>
t -> b
convertStream t -> s
forall {b} {t} {a}.
(AsEmpty b, Cons t t a a, Cons b b a a) =>
t -> b
convertStream
  where
    convertStream :: t -> b
convertStream t
s =
      b -> ((a, t) -> b) -> Maybe (a, t) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        b
forall s. AsEmpty s => s
Empty
        (\(a
h,t
t) -> a -> b -> b
forall s a. Cons s s a a => a -> s -> s
cons a
h (t -> b
convertStream t
t))
        (t -> Maybe (a, t)
forall s a. Cons s s a a => s -> Maybe (a, s)
uncons t
s)

{- | The either-of-tuples representation of `Maybe`. -}
maybeEot :: Iso (Maybe a) (Maybe b) (Either () a) (Either () b)
maybeEot :: forall a b (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Either () a) (f (Either () b)) -> p (Maybe a) (f (Maybe b))
maybeEot = (Maybe a -> Either () a)
-> (Either () b -> Maybe b)
-> Iso (Maybe a) (Maybe b) (Either () a) (Either () b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
  (Either () a -> (a -> Either () a) -> Maybe a -> Either () a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either () a
forall a b. a -> Either a b
Left ()) a -> Either () a
forall a b. b -> Either a b
Right)
  ((() -> Maybe b) -> (b -> Maybe b) -> Either () b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> () -> Maybe b
forall a. a -> () -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just)

{- | The either-of-tuples representation of list-like streams. -}
listEot
  :: (Cons s s a a, AsEmpty t, Cons t t b b)
  => Iso s t (Either () (a,s)) (Either () (b,t))
listEot :: forall s a t b.
(Cons s s a a, AsEmpty t, Cons t t b b) =>
Iso s t (Either () (a, s)) (Either () (b, t))
listEot = (s -> Either () (a, s))
-> (Either () (b, t) -> t)
-> Iso s t (Either () (a, s)) (Either () (b, t))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
  (Either () (a, s)
-> ((a, s) -> Either () (a, s)) -> Maybe (a, s) -> Either () (a, s)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either () (a, s)
forall a b. a -> Either a b
Left ()) (a, s) -> Either () (a, s)
forall a b. b -> Either a b
Right (Maybe (a, s) -> Either () (a, s))
-> (s -> Maybe (a, s)) -> s -> Either () (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (a, s)
forall s a. Cons s s a a => s -> Maybe (a, s)
uncons)
  ((() -> t) -> ((b, t) -> t) -> Either () (b, t) -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (t -> () -> t
forall a b. a -> b -> a
const t
forall s. AsEmpty s => s
Empty) (AReview t (b, t) -> (b, t) -> t
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview t (b, t)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism t t (b, t) (b, t)
_Cons))

{- | Iterate the application of a partial isomorphism,
useful for constructing fold/unfold isomorphisms. -}
iterating :: APartialIso a b a b -> Iso a b a b
iterating :: forall a b. APartialIso a b a b -> Iso a b a b
iterating APartialIso a b a b
i = APartialIso a b a b
-> ((a -> Maybe a) -> (b -> Maybe b) -> p a (f b) -> p a (f b))
-> p a (f b)
-> p a (f b)
forall s t a b r.
APartialIso s t a b -> ((s -> Maybe a) -> (b -> Maybe t) -> r) -> r
withPartialIso APartialIso a b a b
i (((a -> Maybe a) -> (b -> Maybe b) -> p a (f b) -> p a (f b))
 -> p a (f b) -> p a (f b))
-> ((a -> Maybe a) -> (b -> Maybe b) -> p a (f b) -> p a (f b))
-> p a (f b)
-> p a (f b)
forall a b. (a -> b) -> a -> b
$ \a -> Maybe a
f b -> Maybe b
g ->
  (a -> a) -> (b -> b) -> Iso a b a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((a -> Maybe a) -> a -> a
forall {a}. (a -> Maybe a) -> a -> a
iter a -> Maybe a
f) ((b -> Maybe b) -> b -> b
forall {a}. (a -> Maybe a) -> a -> a
iter b -> Maybe b
g) where
    iter :: (a -> Maybe a) -> a -> a
iter a -> Maybe a
h a
state = a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
state ((a -> Maybe a) -> a -> a
iter a -> Maybe a
h) (a -> Maybe a
h a
state)

{- | Left fold & unfold `APartialIso` to an `Control.Lens.Iso.Iso`. -}
difoldl1
  :: Cons s t a b
  => APartialIso (c,a) (d,b) c d
  -> Iso (c,s) (d,t) (c,s) (d,t)
difoldl1 :: forall s t a b c d.
Cons s t a b =>
APartialIso (c, a) (d, b) c d -> Iso (c, s) (d, t) (c, s) (d, t)
difoldl1 APartialIso (c, a) (d, b) c d
i =
  let
    associate :: PartialExchange (c, s) (d, t) ((a, b), b) (Maybe ((a, a), b))
-> PartialExchange (c, s) (d, t) (a, (b, b)) (Maybe (a, (a, b)))
associate = ((a, (b, b)) -> ((a, b), b))
-> (((a, a), b) -> (a, (a, b)))
-> Iso (a, (b, b)) (a, (a, b)) ((a, b), b) ((a, a), b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
      (\(a
c,(b
a,b
s)) -> ((a
c,b
a),b
s))
      (\((a
d,a
b),b
t) -> (a
d,(a
b,b
t)))
    step :: PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
-> PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
step
      = APartialIso c d c d
-> APartialIso s t (a, s) (b, t)
-> PartialIso (c, s) (d, t) (c, (a, s)) (d, (b, t))
forall s t a b u v c d.
APartialIso s t a b
-> APartialIso u v c d -> PartialIso (s, u) (t, v) (a, c) (b, d)
crossPartialIso APartialIso c d c d
forall a. a -> a
id APartialIso s t (a, s) (b, t)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism s t (a, s) (b, t)
_Cons
      (PartialExchange (c, s) (d, t) (c, (a, s)) (Maybe (d, (b, t)))
 -> PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t)))
-> (PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
    -> PartialExchange (c, s) (d, t) (c, (a, s)) (Maybe (d, (b, t))))
-> PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
-> PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialExchange (c, s) (d, t) ((c, a), s) (Maybe ((d, b), t))
-> PartialExchange (c, s) (d, t) (c, (a, s)) (Maybe (d, (b, t)))
forall {a} {b} {b} {a} {a} {b}.
PartialExchange (c, s) (d, t) ((a, b), b) (Maybe ((a, a), b))
-> PartialExchange (c, s) (d, t) (a, (b, b)) (Maybe (a, (a, b)))
associate
      (PartialExchange (c, s) (d, t) ((c, a), s) (Maybe ((d, b), t))
 -> PartialExchange (c, s) (d, t) (c, (a, s)) (Maybe (d, (b, t))))
-> (PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
    -> PartialExchange (c, s) (d, t) ((c, a), s) (Maybe ((d, b), t)))
-> PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
-> PartialExchange (c, s) (d, t) (c, (a, s)) (Maybe (d, (b, t)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APartialIso (c, a) (d, b) c d
-> APartialIso s t s t
-> PartialIso ((c, a), s) ((d, b), t) (c, s) (d, t)
forall s t a b u v c d.
APartialIso s t a b
-> APartialIso u v c d -> PartialIso (s, u) (t, v) (a, c) (b, d)
crossPartialIso APartialIso (c, a) (d, b) c d
i APartialIso s t s t
forall a. a -> a
id
  in (PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
 -> PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t)))
-> Iso (c, s) (d, t) (c, s) (d, t)
forall a b. APartialIso a b a b -> Iso a b a b
iterating PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
-> PartialExchange (c, s) (d, t) (c, s) (Maybe (d, t))
step

{- | Right fold & unfold `APartialIso` to an `Control.Lens.Iso.Iso`. -}
difoldr1
  :: Cons s t a b
  => APartialIso (a,c) (b,d) c d
  -> Iso (s,c) (t,d) (s,c) (t,d)
difoldr1 :: forall s t a b c d.
Cons s t a b =>
APartialIso (a, c) (b, d) c d -> Iso (s, c) (t, d) (s, c) (t, d)
difoldr1 APartialIso (a, c) (b, d) c d
i =
  let
    reorder :: PartialExchange (s, c) (t, d) (a, (a, b)) (Maybe (b, (a, b)))
-> PartialExchange (s, c) (t, d) ((a, a), b) (Maybe ((a, b), b))
reorder = (((a, a), b) -> (a, (a, b)))
-> ((b, (a, b)) -> ((a, b), b))
-> Iso ((a, a), b) ((a, b), b) (a, (a, b)) (b, (a, b))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
      (\((a
a,a
s),b
c) -> (a
s,(a
a,b
c)))
      (\(b
t,(a
b,b
d)) -> ((a
b,b
t),b
d))
    step :: PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
-> PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
step
      = APartialIso s t (a, s) (b, t)
-> APartialIso c d c d
-> PartialIso (s, c) (t, d) ((a, s), c) ((b, t), d)
forall s t a b u v c d.
APartialIso s t a b
-> APartialIso u v c d -> PartialIso (s, u) (t, v) (a, c) (b, d)
crossPartialIso APartialIso s t (a, s) (b, t)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism s t (a, s) (b, t)
_Cons APartialIso c d c d
forall a. a -> a
id
      (PartialExchange (s, c) (t, d) ((a, s), c) (Maybe ((b, t), d))
 -> PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d)))
-> (PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
    -> PartialExchange (s, c) (t, d) ((a, s), c) (Maybe ((b, t), d)))
-> PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
-> PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialExchange (s, c) (t, d) (s, (a, c)) (Maybe (t, (b, d)))
-> PartialExchange (s, c) (t, d) ((a, s), c) (Maybe ((b, t), d))
forall {a} {a} {b} {b} {a} {b}.
PartialExchange (s, c) (t, d) (a, (a, b)) (Maybe (b, (a, b)))
-> PartialExchange (s, c) (t, d) ((a, a), b) (Maybe ((a, b), b))
reorder
      (PartialExchange (s, c) (t, d) (s, (a, c)) (Maybe (t, (b, d)))
 -> PartialExchange (s, c) (t, d) ((a, s), c) (Maybe ((b, t), d)))
-> (PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
    -> PartialExchange (s, c) (t, d) (s, (a, c)) (Maybe (t, (b, d))))
-> PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
-> PartialExchange (s, c) (t, d) ((a, s), c) (Maybe ((b, t), d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APartialIso s t s t
-> APartialIso (a, c) (b, d) c d
-> PartialIso (s, (a, c)) (t, (b, d)) (s, c) (t, d)
forall s t a b u v c d.
APartialIso s t a b
-> APartialIso u v c d -> PartialIso (s, u) (t, v) (a, c) (b, d)
crossPartialIso APartialIso s t s t
forall a. a -> a
id APartialIso (a, c) (b, d) c d
i
  in (PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
 -> PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d)))
-> Iso (s, c) (t, d) (s, c) (t, d)
forall a b. APartialIso a b a b -> Iso a b a b
iterating PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
-> PartialExchange (s, c) (t, d) (s, c) (Maybe (t, d))
step

{- | Left fold & unfold `APartialIso` to a `PartialIso`. -}
difoldl
  :: (AsEmpty s, AsEmpty t, Cons s t a b)
  => APartialIso (c,a) (d,b) c d
  -> PartialIso (c,s) (d,t) c d
difoldl :: forall s t a b c d.
(AsEmpty s, AsEmpty t, Cons s t a b) =>
APartialIso (c, a) (d, b) c d -> PartialIso (c, s) (d, t) c d
difoldl APartialIso (c, a) (d, b) c d
i =
  let
    unit' :: p a (f a) -> p (a, ()) (f (a, ()))
unit' = ((a, ()) -> a) -> (a -> (a, ())) -> Iso (a, ()) (a, ()) a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
      (\(a
a,()) -> a
a)
      (\a
a -> (a
a,()))
  in
    APartialIso (c, a) (d, b) c d -> Iso (c, s) (d, t) (c, s) (d, t)
forall s t a b c d.
Cons s t a b =>
APartialIso (c, a) (d, b) c d -> Iso (c, s) (d, t) (c, s) (d, t)
difoldl1 APartialIso (c, a) (d, b) c d
i
    (p (c, s) (f (d, t)) -> p (c, s) (f (d, t)))
-> (p c (f d) -> p (c, s) (f (d, t)))
-> p c (f d)
-> p (c, s) (f (d, t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APartialIso c d c d
-> APartialIso s t () ()
-> PartialIso (c, s) (d, t) (c, ()) (d, ())
forall s t a b u v c d.
APartialIso s t a b
-> APartialIso u v c d -> PartialIso (s, u) (t, v) (a, c) (b, d)
crossPartialIso APartialIso c d c d
forall a. a -> a
id APartialIso s t () ()
forall s t. (AsEmpty s, AsEmpty t) => PartialIso s t () ()
PartialIso s t () ()
nulled
    (p (c, ()) (f (d, ())) -> p (c, s) (f (d, t)))
-> (p c (f d) -> p (c, ()) (f (d, ())))
-> p c (f d)
-> p (c, s) (f (d, t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p c (f d) -> p (c, ()) (f (d, ()))
forall {a} {a}. p a (f a) -> p (a, ()) (f (a, ()))
unit'

{- | Right fold & unfold `APartialIso` to a `PartialIso`. -}
difoldr
  :: (AsEmpty s, AsEmpty t, Cons s t a b)
  => APartialIso (a,c) (b,d) c d
  -> PartialIso (s,c) (t,d) c d
difoldr :: forall s t a b c d.
(AsEmpty s, AsEmpty t, Cons s t a b) =>
APartialIso (a, c) (b, d) c d -> PartialIso (s, c) (t, d) c d
difoldr APartialIso (a, c) (b, d) c d
i =
  let
    unit' :: p a (f b) -> p ((), a) (f ((), b))
unit' = (((), a) -> a) -> (b -> ((), b)) -> Iso ((), a) ((), b) a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
      (\((),a
c) -> a
c)
      (\b
d -> ((),b
d))
  in
    APartialIso (a, c) (b, d) c d -> Iso (s, c) (t, d) (s, c) (t, d)
forall s t a b c d.
Cons s t a b =>
APartialIso (a, c) (b, d) c d -> Iso (s, c) (t, d) (s, c) (t, d)
difoldr1 APartialIso (a, c) (b, d) c d
i
    (p (s, c) (f (t, d)) -> p (s, c) (f (t, d)))
-> (p c (f d) -> p (s, c) (f (t, d)))
-> p c (f d)
-> p (s, c) (f (t, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APartialIso s t () ()
-> APartialIso c d c d -> PartialIso (s, c) (t, d) ((), c) ((), d)
forall s t a b u v c d.
APartialIso s t a b
-> APartialIso u v c d -> PartialIso (s, u) (t, v) (a, c) (b, d)
crossPartialIso APartialIso s t () ()
forall s t. (AsEmpty s, AsEmpty t) => PartialIso s t () ()
PartialIso s t () ()
nulled APartialIso c d c d
forall a. a -> a
id
    (p ((), c) (f ((), d)) -> p (s, c) (f (t, d)))
-> (p c (f d) -> p ((), c) (f ((), d)))
-> p c (f d)
-> p (s, c) (f (t, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p c (f d) -> p ((), c) (f ((), d))
forall {a} {b}. p a (f b) -> p ((), a) (f ((), b))
unit'

{- | Left fold & unfold `Control.Lens.Prism.APrism'`
to a `Control.Lens.Prism.Prism'`. -}
difoldl'
  :: (AsEmpty s, Cons s s a a)
  => APrism' (c,a) c
  -> Prism' (c,s) c
difoldl' :: forall s a c.
(AsEmpty s, Cons s s a a) =>
APrism' (c, a) c -> Prism' (c, s) c
difoldl' APrism' (c, a) c
i =
  let
    unit' :: p a (f a) -> p (a, ()) (f (a, ()))
unit' = ((a, ()) -> a) -> (a -> (a, ())) -> Iso (a, ()) (a, ()) a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
      (\(a
a,()) -> a
a)
      (\a
a -> (a
a,()))
  in
    APartialIso (c, a) (c, a) c c -> Iso (c, s) (c, s) (c, s) (c, s)
forall s t a b c d.
Cons s t a b =>
APartialIso (c, a) (d, b) c d -> Iso (c, s) (d, t) (c, s) (d, t)
difoldl1 (APrism' (c, a) c -> Prism (c, a) (c, a) c c
forall s t a b. APrism s t a b -> Prism s t a b
clonePrism APrism' (c, a) c
i)
    (p (c, s) (f (c, s)) -> p (c, s) (f (c, s)))
-> (p c (f c) -> p (c, s) (f (c, s)))
-> p c (f c)
-> p (c, s) (f (c, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism s s () () -> Prism (c, s) (c, s) (c, ()) (c, ())
forall s t a b e.
APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b)
aside APrism s s () ()
forall a. AsEmpty a => Prism' a ()
Prism' s ()
_Empty
    (p (c, ()) (f (c, ())) -> p (c, s) (f (c, s)))
-> (p c (f c) -> p (c, ()) (f (c, ())))
-> p c (f c)
-> p (c, s) (f (c, s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p c (f c) -> p (c, ()) (f (c, ()))
forall {a} {a}. p a (f a) -> p (a, ()) (f (a, ()))
unit'

{- | Right fold & unfold `Control.Lens.Prism.APrism'`
to a `Control.Lens.Prism.Prism'`. -}
difoldr'
  :: (AsEmpty s, Cons s s a a)
  => APrism' (a,c) c
  -> Prism' (s,c) c
difoldr' :: forall s a c.
(AsEmpty s, Cons s s a a) =>
APrism' (a, c) c -> Prism' (s, c) c
difoldr' APrism' (a, c) c
i =
  let
    unit' :: p a (f b) -> p ((), a) (f ((), b))
unit' = (((), a) -> a) -> (b -> ((), b)) -> Iso ((), a) ((), b) a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
      (\((),a
c) -> a
c)
      (\b
c -> ((),b
c))
    asideFst :: APrism s t a b -> p (a, b) (f (b, b)) -> p (s, b) (f (t, b))
asideFst APrism s t a b
k =
      APrism s t a b
-> ((b -> t)
    -> (s -> Either t a) -> p (a, b) (f (b, b)) -> p (s, b) (f (t, b)))
-> p (a, b) (f (b, b))
-> p (s, b) (f (t, b))
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
k (((b -> t)
  -> (s -> Either t a) -> p (a, b) (f (b, b)) -> p (s, b) (f (t, b)))
 -> p (a, b) (f (b, b)) -> p (s, b) (f (t, b)))
-> ((b -> t)
    -> (s -> Either t a) -> p (a, b) (f (b, b)) -> p (s, b) (f (t, b)))
-> p (a, b) (f (b, b))
-> p (s, b) (f (t, b))
forall a b. (a -> b) -> a -> b
$ \b -> t
bt s -> Either t a
seta ->
        ((b, b) -> (t, b))
-> ((s, b) -> Either (t, b) (a, b))
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p (a, b) (f (b, b)) -> p (s, b) (f (t, b))
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> t) -> (b, b) -> (t, b)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' b -> t
bt) (((s, b) -> Either (t, b) (a, b))
 -> forall {p :: * -> * -> *} {f :: * -> *}.
    (Choice p, Applicative f) =>
    p (a, b) (f (b, b)) -> p (s, b) (f (t, b)))
-> ((s, b) -> Either (t, b) (a, b))
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p (a, b) (f (b, b)) -> p (s, b) (f (t, b))
forall a b. (a -> b) -> a -> b
$ \(s
s,b
e) ->
          case s -> Either t a
seta s
s of
            Left t
t -> (t, b) -> Either (t, b) (a, b)
forall a b. a -> Either a b
Left  (t
t,b
e)
            Right a
a -> (a, b) -> Either (t, b) (a, b)
forall a b. b -> Either a b
Right (a
a,b
e)
  in
    APartialIso (a, c) (a, c) c c -> Iso (s, c) (s, c) (s, c) (s, c)
forall s t a b c d.
Cons s t a b =>
APartialIso (a, c) (b, d) c d -> Iso (s, c) (t, d) (s, c) (t, d)
difoldr1 (APrism' (a, c) c -> Prism (a, c) (a, c) c c
forall s t a b. APrism s t a b -> Prism s t a b
clonePrism APrism' (a, c) c
i)
    (p (s, c) (f (s, c)) -> p (s, c) (f (s, c)))
-> (p c (f c) -> p (s, c) (f (s, c)))
-> p c (f c)
-> p (s, c) (f (s, c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism s s () () -> p ((), c) (f ((), c)) -> p (s, c) (f (s, c))
forall {p :: * -> * -> *} {f :: * -> *} {s} {t} {a} {b} {b}.
(Choice p, Applicative f) =>
APrism s t a b -> p (a, b) (f (b, b)) -> p (s, b) (f (t, b))
asideFst APrism s s () ()
forall a. AsEmpty a => Prism' a ()
Prism' s ()
_Empty
    (p ((), c) (f ((), c)) -> p (s, c) (f (s, c)))
-> (p c (f c) -> p ((), c) (f ((), c)))
-> p c (f c)
-> p (s, c) (f (s, c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p c (f c) -> p ((), c) (f ((), c))
forall {a} {b}. p a (f b) -> p ((), a) (f ((), b))
unit'

-- Orphanage --

instance (Profunctor p, Functor f)
  => Functor (WrappedPafb f p a) where fmap :: forall a b. (a -> b) -> WrappedPafb f p a a -> WrappedPafb f p a b
fmap = (a -> b) -> WrappedPafb f p a a -> WrappedPafb f p a b
forall b c a.
(b -> c) -> WrappedPafb f p a b -> WrappedPafb f p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
deriving via Compose (p a) f instance
  (Profunctor p, Functor (p a), Filterable f)
    => Filterable (WrappedPafb f p a)
instance (Profunctor p, Filterable f)
  => Cochoice (WrappedPafb f p) where
    unleft :: forall a d b.
WrappedPafb f p (Either a d) (Either b d) -> WrappedPafb f p a b
unleft (WrapPafb p (Either a d) (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 d)
-> (f (Either b d) -> f b)
-> p (Either a d) (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 d
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 d) (f (Either b d))
p
    unright :: forall d a b.
WrappedPafb f p (Either d a) (Either d b) -> WrappedPafb f p a b
unright (WrapPafb p (Either d a) (f (Either d b))
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 d a)
-> (f (Either d b) -> f b)
-> p (Either d a) (f (Either d b))
-> 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 d a
forall a b. b -> Either a b
Right ((Either d b -> Maybe b) -> f (Either d b) -> 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 ((d -> Maybe b) -> (b -> Maybe b) -> Either d b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> d -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just)) p (Either d a) (f (Either d b))
p
instance (Profunctor p, Filterable (p a))
  => Filterable (Yoneda p a) where
    catMaybes :: forall a. Yoneda p a (Maybe a) -> Yoneda p a a
catMaybes = p a a -> Yoneda p a a
p :-> Yoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Yoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p a a -> Yoneda p a a)
-> (Yoneda p a (Maybe a) -> p a a)
-> Yoneda p a (Maybe a)
-> Yoneda p a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (Maybe a) -> p a a
forall a. p a (Maybe a) -> p a a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (p a (Maybe a) -> p a a)
-> (Yoneda p a (Maybe a) -> p a (Maybe a))
-> Yoneda p a (Maybe a)
-> p a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda p a (Maybe a) -> p a (Maybe a)
Yoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Yoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
instance (Profunctor p, Filterable (p a))
  => Filterable (Coyoneda p a) where
    catMaybes :: forall a. Coyoneda p a (Maybe a) -> Coyoneda p a a
catMaybes = p a a -> Coyoneda p a a
p :-> Coyoneda p
forall (p :: * -> * -> *). Profunctor p => p :-> Coyoneda p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorMonad t, Profunctor p) =>
p :-> t p
proreturn (p a a -> Coyoneda p a a)
-> (Coyoneda p a (Maybe a) -> p a a)
-> Coyoneda p a (Maybe a)
-> Coyoneda p a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (Maybe a) -> p a a
forall a. p a (Maybe a) -> p a a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (p a (Maybe a) -> p a a)
-> (Coyoneda p a (Maybe a) -> p a (Maybe a))
-> Coyoneda p a (Maybe a)
-> p a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda p a (Maybe a) -> p a (Maybe a)
Coyoneda p :-> p
forall (p :: * -> * -> *). Profunctor p => Coyoneda p :-> p
forall (t :: (* -> * -> *) -> * -> * -> *) (p :: * -> * -> *).
(ProfunctorComonad t, Profunctor p) =>
t p :-> p
proextract
instance Filterable (Forget r a) where
  catMaybes :: forall a. Forget r a (Maybe a) -> Forget r a a
catMaybes (Forget a -> r
f) = (a -> r) -> Forget r a a
forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget a -> r
f
instance Filterable f => Filterable (Star f a) where
  catMaybes :: forall a. Star f a (Maybe a) -> Star f a a
catMaybes (Star a -> f (Maybe a)
f) = (a -> f a) -> Star f a a
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star (f (Maybe a) -> f a
forall a. f (Maybe a) -> f a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (f (Maybe a) -> f a) -> (a -> f (Maybe a)) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f (Maybe a)
f)