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

module Control.Lens.Bifocal
  ( -- * Bifocal
    Bifocal
  , ABifocal
    -- * Combinators
  , bifocal
  , mapBifocal
  , cloneBifocal
  , withBifocal
  , chainedl1
  , chainedr1
  , chainedl
  , chainedr
    -- * Binocular
  , Binocular (..), runBinocular
    -- * Prismoid
  , Prismoid
  , somed
  , lefted
  , righted
    -- * Filtroid
  , Filtroid
  , unlefted
  , unrighted
  ) where

import Control.Applicative
import Control.Lens
import Control.Lens.Internal.Profunctor
import Control.Lens.PartialIso
import Data.Profunctor
import Data.Profunctor.Distributor
import Witherable

{- | `Bifocal`s are bidirectional parser optics.

Every one of the following is a `Bifocal`.

* `Control.Lens.Iso.Iso`
* `Control.Lens.Prism.Prism`
* `Control.Lens.Monocle.Monocle`
* `Control.Lens.Diopter.Diopter`
* `Prismoid` & `Filtroid`

`Bifocal`s are isomorphic to `Binocular`s.
-}
type Bifocal s t a b = forall p f.
  (Alternator p, Filtrator p, Alternative f, Filterable f)
    => p a (f b) -> p s (f t)

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

{- | `Prismoid`s generalize `Bifocal`s, combining
`Control.Lens.Prism.Prism`s and `Control.Lens.Diopter.Diopter`s. -}
type Prismoid s t a b = forall p f.
  (Alternator p, Alternative f)
    => p a (f b) -> p s (f t)

{- | An optic for `Filtrator`s, `Filtroid`s generalize `Bifocal`s. -}
type Filtroid s t a b = forall p f.
  (Filtrator p, Filterable f)
    => p a (f b) -> p s (f t)

{- | Build a `Bifocal` from a concrete `Binocular`. -}
bifocal :: Binocular a b s t -> Bifocal s t a b
bifocal :: forall a b s t. Binocular a b s t -> Bifocal s t a b
bifocal Binocular a b s t
bif = 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
. Binocular a b s t -> WrappedPafb f p a b -> WrappedPafb f p s t
forall (p :: * -> * -> *) a b s t.
(Alternator p, Filtrator p) =>
Binocular a b s t -> p a b -> p s t
runBinocular Binocular a b s t
bif (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

{- | Action of `ABifocal` on partial `Distributor`s. -}
mapBifocal
  :: (Alternator p, Filtrator p)
  => ABifocal s t a b -> p a b -> p s t
mapBifocal :: forall (p :: * -> * -> *) s t a b.
(Alternator p, Filtrator p) =>
ABifocal s t a b -> p a b -> p s t
mapBifocal ABifocal s t a b
bif p a b
p = ABifocal s t a b -> ((s -> Maybe a) -> p s b) -> p s t
forall (f :: * -> *) s t a b.
(Alternative f, Filterable f) =>
ABifocal s t a b -> ((s -> Maybe a) -> f b) -> f t
withBifocal ABifocal s t a b
bif (((s -> Maybe a) -> p s b) -> p s t)
-> ((s -> Maybe a) -> p s b) -> p s t
forall a b. (a -> b) -> a -> b
$ \s -> Maybe a
f -> (s -> Maybe a) -> (b -> Maybe b) -> p a b -> p 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 a
f b -> Maybe b
forall a. a -> Maybe a
Just p a b
p

{- | Clone `ABifocal` so that you can reuse the same
monomorphically typed `Bifocal` for different purposes.
-}
cloneBifocal :: ABifocal s t a b -> Bifocal s t a b
cloneBifocal :: forall s t a b. ABifocal s t a b -> Bifocal s t a b
cloneBifocal ABifocal s t a b
bif = 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
. ABifocal s t a b -> WrappedPafb f p a b -> WrappedPafb f p s t
forall (p :: * -> * -> *) s t a b.
(Alternator p, Filtrator p) =>
ABifocal s t a b -> p a b -> p s t
mapBifocal ABifocal s t a b
bif (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

{- | One or more. -}
somed :: Prismoid [a] [b] a b
somed :: forall a b (p :: * -> * -> *) (f :: * -> *).
(Alternator p, Alternative f) =>
p a (f b) -> p [a] (f [b])
somed = WrappedPafb f p [a] [b] -> p [a] (f [b])
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p [a] [b] -> p [a] (f [b]))
-> (p a (f b) -> WrappedPafb f p [a] [b])
-> p a (f b)
-> p [a] (f [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedPafb f p a b -> WrappedPafb f p [a] [b]
forall a b. WrappedPafb f p a b -> WrappedPafb f p [a] [b]
forall (p :: * -> * -> *) a b. Alternator p => p a b -> p [a] [b]
someP (WrappedPafb f p a b -> WrappedPafb f p [a] [b])
-> (p a (f b) -> WrappedPafb f p a b)
-> p a (f b)
-> WrappedPafb f p [a] [b]
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

{- | `lefted` is like `_Left`, except
with heterogeneous `Right` parameters. -}
lefted :: Prismoid (Either a c) (Either b d) a b
lefted :: forall a c b d (p :: * -> * -> *) (f :: * -> *).
(Alternator p, Alternative f) =>
p a (f b) -> p (Either a c) (f (Either b d))
lefted = WrappedPafb f p (Either a c) (Either b d)
-> p (Either a c) (f (Either b d))
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p (Either a c) (Either b d)
 -> p (Either a c) (f (Either b d)))
-> (p a (f b) -> WrappedPafb f p (Either a c) (Either b d))
-> p a (f b)
-> p (Either a c) (f (Either b d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (WrappedPafb f p a b) (WrappedPafb f p c d)
-> WrappedPafb f p (Either a c) (Either b d)
forall a b c d.
Either (WrappedPafb f p a b) (WrappedPafb f p c d)
-> WrappedPafb f p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (Either (WrappedPafb f p a b) (WrappedPafb f p c d)
 -> WrappedPafb f p (Either a c) (Either b d))
-> (p a (f b)
    -> Either (WrappedPafb f p a b) (WrappedPafb f p c d))
-> p a (f b)
-> WrappedPafb f p (Either a c) (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedPafb f p a b
-> Either (WrappedPafb f p a b) (WrappedPafb f p c d)
forall a b. a -> Either a b
Left (WrappedPafb f p a b
 -> Either (WrappedPafb f p a b) (WrappedPafb f p c d))
-> (p a (f b) -> WrappedPafb f p a b)
-> p a (f b)
-> Either (WrappedPafb f p a b) (WrappedPafb f p c d)
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


{- | `righted` is like `_Right`, except
with heterogeneous `Left` parameters. -}
righted :: Prismoid (Either c a) (Either d b) a b
righted :: forall c a d b (p :: * -> * -> *) (f :: * -> *).
(Alternator p, Alternative f) =>
p a (f b) -> p (Either c a) (f (Either d b))
righted = WrappedPafb f p (Either c a) (Either d b)
-> p (Either c a) (f (Either d b))
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p (Either c a) (Either d b)
 -> p (Either c a) (f (Either d b)))
-> (p a (f b) -> WrappedPafb f p (Either c a) (Either d b))
-> p a (f b)
-> p (Either c a) (f (Either d b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (WrappedPafb f p c d) (WrappedPafb f p a b)
-> WrappedPafb f p (Either c a) (Either d b)
forall a b c d.
Either (WrappedPafb f p a b) (WrappedPafb f p c d)
-> WrappedPafb f p (Either a c) (Either b d)
forall (p :: * -> * -> *) a b c d.
Alternator p =>
Either (p a b) (p c d) -> p (Either a c) (Either b d)
alternate (Either (WrappedPafb f p c d) (WrappedPafb f p a b)
 -> WrappedPafb f p (Either c a) (Either d b))
-> (p a (f b)
    -> Either (WrappedPafb f p c d) (WrappedPafb f p a b))
-> p a (f b)
-> WrappedPafb f p (Either c a) (Either d b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedPafb f p a b
-> Either (WrappedPafb f p c d) (WrappedPafb f p a b)
forall a b. b -> Either a b
Right (WrappedPafb f p a b
 -> Either (WrappedPafb f p c d) (WrappedPafb f p a b))
-> (p a (f b) -> WrappedPafb f p a b)
-> p a (f b)
-> Either (WrappedPafb f p c d) (WrappedPafb f p a b)
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

{- | Dual to `lefted`. -}
unlefted :: Filtroid a b (Either a c) (Either b d)
unlefted :: forall a b c d (p :: * -> * -> *) (f :: * -> *).
(Filtrator p, Filterable f) =>
p (Either a c) (f (Either b d)) -> p a (f b)
unlefted = WrappedPafb f p a b -> p a (f b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p a b -> p a (f b))
-> (p (Either a c) (f (Either b d)) -> WrappedPafb f p a b)
-> p (Either a c) (f (Either b d))
-> p a (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WrappedPafb f p a b, WrappedPafb f p c d) -> WrappedPafb f p a b
forall a b. (a, b) -> a
fst ((WrappedPafb f p a b, WrappedPafb f p c d) -> WrappedPafb f p a b)
-> (p (Either a c) (f (Either b d))
    -> (WrappedPafb f p a b, WrappedPafb f p c d))
-> p (Either a c) (f (Either b d))
-> WrappedPafb f p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedPafb f p (Either a c) (Either b d)
-> (WrappedPafb f p a b, WrappedPafb f p c d)
forall a c b d.
WrappedPafb f p (Either a c) (Either b d)
-> (WrappedPafb f p a b, WrappedPafb f 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 (WrappedPafb f p (Either a c) (Either b d)
 -> (WrappedPafb f p a b, WrappedPafb f p c d))
-> (p (Either a c) (f (Either b d))
    -> WrappedPafb f p (Either a c) (Either b d))
-> p (Either a c) (f (Either b d))
-> (WrappedPafb f p a b, WrappedPafb f p c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Either a c) (f (Either b d))
-> WrappedPafb f p (Either a c) (Either b d)
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb

{- | Dual to `righted`. -}
unrighted :: Filtroid a b (Either c a) (Either d b)
unrighted :: forall a b c d (p :: * -> * -> *) (f :: * -> *).
(Filtrator p, Filterable f) =>
p (Either c a) (f (Either d b)) -> p a (f b)
unrighted = WrappedPafb f p a b -> p a (f b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p a b -> p a (f b))
-> (p (Either c a) (f (Either d b)) -> WrappedPafb f p a b)
-> p (Either c a) (f (Either d b))
-> p a (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WrappedPafb f p c d, WrappedPafb f p a b) -> WrappedPafb f p a b
forall a b. (a, b) -> b
snd ((WrappedPafb f p c d, WrappedPafb f p a b) -> WrappedPafb f p a b)
-> (p (Either c a) (f (Either d b))
    -> (WrappedPafb f p c d, WrappedPafb f p a b))
-> p (Either c a) (f (Either d b))
-> WrappedPafb f p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedPafb f p (Either c a) (Either d b)
-> (WrappedPafb f p c d, WrappedPafb f p a b)
forall a c b d.
WrappedPafb f p (Either a c) (Either b d)
-> (WrappedPafb f p a b, WrappedPafb f 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 (WrappedPafb f p (Either c a) (Either d b)
 -> (WrappedPafb f p c d, WrappedPafb f p a b))
-> (p (Either c a) (f (Either d b))
    -> WrappedPafb f p (Either c a) (Either d b))
-> p (Either c a) (f (Either d b))
-> (WrappedPafb f p c d, WrappedPafb f p a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Either c a) (f (Either d b))
-> WrappedPafb f p (Either c a) (Either d b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb

{- |
Left associate a binary constructor pattern to sequence one or more times.
-}
chainedl1 :: APartialIso a b (a,a) (b,b) -> Bifocal a b a b
chainedl1 :: forall a b. APartialIso a b (a, a) (b, b) -> Bifocal a b a b
chainedl1 APartialIso a b (a, a) (b, b)
pat = WrappedPafb f p a b -> p a (f b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p a b -> p a (f b))
-> (p a (f b) -> WrappedPafb f p a b) -> p a (f b) -> p a (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APartialIso a b (a, a) (b, b)
-> SepBy (WrappedPafb f p)
-> WrappedPafb f p a b
-> WrappedPafb f p a b
forall (p :: * -> * -> *) a b.
(Choice p, Cochoice p, Distributor p) =>
APartialIso a b (a, a) (b, b) -> SepBy p -> p a b -> p a b
chainl1 APartialIso a b (a, a) (b, b)
pat SepBy (WrappedPafb f p)
forall (p :: * -> * -> *). Monoidal p => SepBy p
noSep (WrappedPafb f p a b -> WrappedPafb f p a b)
-> (p a (f b) -> WrappedPafb f p a b)
-> p a (f b)
-> WrappedPafb f p a b
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


{- |
Right associate a binary constructor pattern to sequence one or more times.
-}
chainedr1 :: APartialIso a b (a,a) (b,b) -> Bifocal a b a b
chainedr1 :: forall a b. APartialIso a b (a, a) (b, b) -> Bifocal a b a b
chainedr1 APartialIso a b (a, a) (b, b)
pat = WrappedPafb f p a b -> p a (f b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p a b -> p a (f b))
-> (p a (f b) -> WrappedPafb f p a b) -> p a (f b) -> p a (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APartialIso a b (a, a) (b, b)
-> SepBy (WrappedPafb f p)
-> WrappedPafb f p a b
-> WrappedPafb f p a b
forall (p :: * -> * -> *) a b.
(Choice p, Cochoice p, Distributor p) =>
APartialIso a b (a, a) (b, b) -> SepBy p -> p a b -> p a b
chainr1 APartialIso a b (a, a) (b, b)
pat SepBy (WrappedPafb f p)
forall (p :: * -> * -> *). Monoidal p => SepBy p
noSep (WrappedPafb f p a b -> WrappedPafb f p a b)
-> (p a (f b) -> WrappedPafb f p a b)
-> p a (f b)
-> WrappedPafb f p a b
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

{- |
Left associate a binary constructor pattern to sequence one or more times,
or use a nilary constructor pattern to sequence zero times.
-}
chainedl :: APartialIso a b (a,a) (b,b) -> APartialIso a b () () -> Bifocal a b a b
chainedl :: forall a b.
APartialIso a b (a, a) (b, b)
-> APartialIso a b () () -> Bifocal a b a b
chainedl APartialIso a b (a, a) (b, b)
c2 APartialIso a b () ()
c0 = WrappedPafb f p a b -> p a (f b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p a b -> p a (f b))
-> (p a (f b) -> WrappedPafb f p a b) -> p a (f b) -> p a (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APartialIso a b (a, a) (b, b)
-> APartialIso a b () ()
-> SepBy (WrappedPafb f p)
-> WrappedPafb f p a b
-> WrappedPafb f p a b
forall (p :: * -> * -> *) a b.
(Alternator p, Filtrator p) =>
APartialIso a b (a, a) (b, b)
-> APartialIso a b () () -> SepBy p -> p a b -> p a b
chainl APartialIso a b (a, a) (b, b)
c2 APartialIso a b () ()
c0 SepBy (WrappedPafb f p)
forall (p :: * -> * -> *). Monoidal p => SepBy p
noSep (WrappedPafb f p a b -> WrappedPafb f p a b)
-> (p a (f b) -> WrappedPafb f p a b)
-> p a (f b)
-> WrappedPafb f p a b
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

{- |
Right associate a binary constructor pattern to sequence one or more times,
or use a nilary constructor pattern to sequence zero times.
-}
chainedr :: APartialIso a b (a,a) (b,b) -> APartialIso a b () () -> Bifocal a b a b
chainedr :: forall a b.
APartialIso a b (a, a) (b, b)
-> APartialIso a b () () -> Bifocal a b a b
chainedr APartialIso a b (a, a) (b, b)
c2 APartialIso a b () ()
c0 = WrappedPafb f p a b -> p a (f b)
forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb (WrappedPafb f p a b -> p a (f b))
-> (p a (f b) -> WrappedPafb f p a b) -> p a (f b) -> p a (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APartialIso a b (a, a) (b, b)
-> APartialIso a b () ()
-> SepBy (WrappedPafb f p)
-> WrappedPafb f p a b
-> WrappedPafb f p a b
forall (p :: * -> * -> *) a b.
(Alternator p, Filtrator p) =>
APartialIso a b (a, a) (b, b)
-> APartialIso a b () () -> SepBy p -> p a b -> p a b
chainr APartialIso a b (a, a) (b, b)
c2 APartialIso a b () ()
c0 SepBy (WrappedPafb f p)
forall (p :: * -> * -> *). Monoidal p => SepBy p
noSep (WrappedPafb f p a b -> WrappedPafb f p a b)
-> (p a (f b) -> WrappedPafb f p a b)
-> p a (f b)
-> WrappedPafb f p a b
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

{- | Run `ABifocal` over an `Alternative` & `Filterable`. -}
withBifocal
  :: (Alternative f, Filterable f)
  => ABifocal s t a b -> ((s -> Maybe a) -> f b) -> f t
withBifocal :: forall (f :: * -> *) s t a b.
(Alternative f, Filterable f) =>
ABifocal s t a b -> ((s -> Maybe a) -> f b) -> f t
withBifocal ABifocal s t a b
bif = Binocular a b s t
-> forall (f :: * -> *).
   (Alternative f, Filterable f) =>
   ((s -> Maybe a) -> f b) -> f t
forall a b s t.
Binocular a b s t
-> forall (f :: * -> *).
   (Alternative f, Filterable f) =>
   ((s -> Maybe a) -> f b) -> f t
unBinocular (Binocular a b s (Maybe t) -> Binocular a b s t
forall a. Binocular a b s (Maybe a) -> Binocular a b s a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (ABifocal s t a b
bif (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> Binocular a b a b -> Binocular a b a (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Binocular a b a b
forall a b (p :: * -> * -> *). Tokenized a b p => p a b
anyToken)))

{- | `Binocular` provides an efficient
concrete representation of `Bifocal`s. -}
newtype Binocular a b s t = Binocular
  { forall a b s t.
Binocular a b s t
-> forall (f :: * -> *).
   (Alternative f, Filterable f) =>
   ((s -> Maybe a) -> f b) -> f t
unBinocular
      :: forall f. (Alternative f, Filterable f)
      => ((s -> Maybe a) -> f b) -> f t
  }
instance Tokenized a b (Binocular a b) where
  anyToken :: Binocular a b a b
anyToken = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((a -> Maybe a) -> f b) -> f b)
-> Binocular a b a b
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular (((a -> Maybe a) -> f b) -> (a -> Maybe a) -> f b
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just)
instance Profunctor (Binocular a b) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Binocular a b b c -> Binocular a b a d
dimap a -> b
f c -> d
g (Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((b -> Maybe a) -> f b) -> f c
k) = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((a -> Maybe a) -> f b) -> f d)
-> Binocular a b a d
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular ((forall (f :: * -> *).
  (Alternative f, Filterable f) =>
  ((a -> Maybe a) -> f b) -> f d)
 -> Binocular a b a d)
-> (forall (f :: * -> *).
    (Alternative f, Filterable f) =>
    ((a -> Maybe a) -> f b) -> f d)
-> Binocular a b a d
forall a b. (a -> b) -> a -> b
$ (c -> d) -> f c -> f d
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (f c -> f d)
-> (((a -> Maybe a) -> f b) -> f c)
-> ((a -> Maybe a) -> f b)
-> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b -> Maybe a) -> f b) -> f c
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((b -> Maybe a) -> f b) -> f c
k (((b -> Maybe a) -> f b) -> f c)
-> (((a -> Maybe a) -> f b) -> (b -> Maybe a) -> f b)
-> ((a -> Maybe a) -> f b)
-> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((a -> Maybe a) -> f b)
-> ((b -> Maybe a) -> a -> Maybe a) -> (b -> Maybe a) -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b -> Maybe a) -> (a -> b) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
instance Functor (Binocular a b s) where fmap :: forall a b. (a -> b) -> Binocular a b s a -> Binocular a b s b
fmap = (a -> b) -> Binocular a b s a -> Binocular a b s b
forall b c a. (b -> c) -> Binocular a b a b -> Binocular a b a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
instance Applicative (Binocular a b s) where
  pure :: forall a. a -> Binocular a b s a
pure a
t = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f a)
-> Binocular a b s a
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular (f a -> ((s -> Maybe a) -> f b) -> f a
forall a. a -> ((s -> Maybe a) -> f b) -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
t))
  Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f (a -> b)
x <*> :: forall a b.
Binocular a b s (a -> b) -> Binocular a b s a -> Binocular a b s b
<*> Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f a
y = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f b)
-> Binocular a b s b
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular ((f (a -> b) -> f a -> f b)
-> (((s -> Maybe a) -> f b) -> f (a -> b))
-> (((s -> Maybe a) -> f b) -> f a)
-> ((s -> Maybe a) -> f b)
-> f b
forall a b c.
(a -> b -> c)
-> (((s -> Maybe a) -> f b) -> a)
-> (((s -> Maybe a) -> f b) -> b)
-> ((s -> Maybe a) -> f b)
-> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ((s -> Maybe a) -> f b) -> f (a -> b)
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f (a -> b)
x ((s -> Maybe a) -> f b) -> f a
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f a
y)
instance Alternative (Binocular a b s) where
  empty :: forall a. Binocular a b s a
empty = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f a)
-> Binocular a b s a
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular (f a -> ((s -> Maybe a) -> f b) -> f a
forall a. a -> ((s -> Maybe a) -> f b) -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty)
  Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f a
x <|> :: forall a.
Binocular a b s a -> Binocular a b s a -> Binocular a b s a
<|> Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f a
y = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f a)
-> Binocular a b s a
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular ((f a -> f a -> f a)
-> (((s -> Maybe a) -> f b) -> f a)
-> (((s -> Maybe a) -> f b) -> f a)
-> ((s -> Maybe a) -> f b)
-> f a
forall a b c.
(a -> b -> c)
-> (((s -> Maybe a) -> f b) -> a)
-> (((s -> Maybe a) -> f b) -> b)
-> ((s -> Maybe a) -> f b)
-> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) ((s -> Maybe a) -> f b) -> f a
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f a
x ((s -> Maybe a) -> f b) -> f a
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f a
y)
instance Filterable (Binocular a b s) where
  mapMaybe :: forall a b.
(a -> Maybe b) -> Binocular a b s a -> Binocular a b s b
mapMaybe a -> Maybe b
f (Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f a
k) = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f b)
-> Binocular a b s b
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular ((a -> Maybe b) -> f a -> 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 a -> Maybe b
f (f a -> f b)
-> (((s -> Maybe a) -> f b) -> f a)
-> ((s -> Maybe a) -> f b)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s -> Maybe a) -> f b) -> f a
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f a
k)
  catMaybes :: forall a. Binocular a b s (Maybe a) -> Binocular a b s a
catMaybes (Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f (Maybe a)
k) = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f a)
-> Binocular a b s a
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular (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)
-> (((s -> Maybe a) -> f b) -> f (Maybe a))
-> ((s -> Maybe a) -> f b)
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s -> Maybe a) -> f b) -> f (Maybe a)
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f (Maybe a)
k)
instance Choice (Binocular a b) where
  left' :: forall a b c.
Binocular a b a b -> Binocular a b (Either a c) (Either b c)
left' (Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((a -> Maybe a) -> f b) -> f b
k)
    = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((Either a c -> Maybe a) -> f b) -> f (Either b c))
-> Binocular a b (Either a c) (Either b c)
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular ((forall (f :: * -> *).
  (Alternative f, Filterable f) =>
  ((Either a c -> Maybe a) -> f b) -> f (Either b c))
 -> Binocular a b (Either a c) (Either b c))
-> (forall (f :: * -> *).
    (Alternative f, Filterable f) =>
    ((Either a c -> Maybe a) -> f b) -> f (Either b c))
-> Binocular a b (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ (b -> Either b c) -> f b -> f (Either b c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b c
forall a b. a -> Either a b
Left
    (f b -> f (Either b c))
-> (((Either a c -> Maybe a) -> f b) -> f b)
-> ((Either a c -> Maybe a) -> f b)
-> f (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> Maybe a) -> f b) -> f b
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((a -> Maybe a) -> f b) -> f b
k (((a -> Maybe a) -> f b) -> f b)
-> (((Either a c -> Maybe a) -> f b) -> (a -> Maybe a) -> f b)
-> ((Either a c -> Maybe a) -> f b)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Either a c -> Maybe a) -> f b)
-> ((a -> Maybe a) -> Either a c -> Maybe a)
-> (a -> Maybe a)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a -> Maybe a
f -> (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 b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)))
  right' :: forall a b c.
Binocular a b a b -> Binocular a b (Either c a) (Either c b)
right' (Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((a -> Maybe a) -> f b) -> f b
k)
    = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((Either c a -> Maybe a) -> f b) -> f (Either c b))
-> Binocular a b (Either c a) (Either c b)
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular ((forall (f :: * -> *).
  (Alternative f, Filterable f) =>
  ((Either c a -> Maybe a) -> f b) -> f (Either c b))
 -> Binocular a b (Either c a) (Either c b))
-> (forall (f :: * -> *).
    (Alternative f, Filterable f) =>
    ((Either c a -> Maybe a) -> f b) -> f (Either c b))
-> Binocular a b (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ (b -> Either c b) -> f b -> f (Either c b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either c b
forall a b. b -> Either a b
Right
    (f b -> f (Either c b))
-> (((Either c a -> Maybe a) -> f b) -> f b)
-> ((Either c a -> Maybe a) -> f b)
-> f (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> Maybe a) -> f b) -> f b
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((a -> Maybe a) -> f b) -> f b
k (((a -> Maybe a) -> f b) -> f b)
-> (((Either c a -> Maybe a) -> f b) -> (a -> Maybe a) -> f b)
-> ((Either c a -> Maybe a) -> f b)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Either c a -> Maybe a) -> f b)
-> ((a -> Maybe a) -> Either c a -> Maybe a)
-> (a -> Maybe a)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a -> Maybe a
f -> (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 b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
f))
instance Cochoice (Binocular a b) where
  unleft :: forall a d b.
Binocular a b (Either a d) (Either b d) -> Binocular a b a b
unleft (Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((Either a d -> Maybe a) -> f b) -> f (Either b d)
k)
    = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((a -> Maybe a) -> f b) -> f b)
-> Binocular a b a b
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular ((forall (f :: * -> *).
  (Alternative f, Filterable f) =>
  ((a -> Maybe a) -> f b) -> f b)
 -> Binocular a b a b)
-> (forall (f :: * -> *).
    (Alternative f, Filterable f) =>
    ((a -> Maybe a) -> f b) -> f b)
-> Binocular a b a b
forall a b. (a -> b) -> a -> b
$ f (Maybe b) -> f b
forall a. f (Maybe a) -> f a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
    (f (Maybe b) -> f b)
-> (((a -> Maybe a) -> f b) -> f (Maybe b))
-> ((a -> Maybe a) -> f b)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either b d -> Maybe b) -> f (Either b d) -> f (Maybe b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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 (Maybe b))
-> (((a -> Maybe a) -> f b) -> f (Either b d))
-> ((a -> Maybe a) -> f b)
-> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either a d -> Maybe a) -> f b) -> f (Either b d)
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((Either a d -> Maybe a) -> f b) -> f (Either b d)
k (((Either a d -> Maybe a) -> f b) -> f (Either b d))
-> (((a -> Maybe a) -> f b) -> (Either a d -> Maybe a) -> f b)
-> ((a -> Maybe a) -> f b)
-> f (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((a -> Maybe a) -> f b)
-> ((Either a d -> Maybe a) -> a -> Maybe a)
-> (Either a d -> Maybe a)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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))
  unright :: forall d a b.
Binocular a b (Either d a) (Either d b) -> Binocular a b a b
unright (Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((Either d a -> Maybe a) -> f b) -> f (Either d b)
k)
    = (forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((a -> Maybe a) -> f b) -> f b)
-> Binocular a b a b
forall a b s t.
(forall (f :: * -> *).
 (Alternative f, Filterable f) =>
 ((s -> Maybe a) -> f b) -> f t)
-> Binocular a b s t
Binocular ((forall (f :: * -> *).
  (Alternative f, Filterable f) =>
  ((a -> Maybe a) -> f b) -> f b)
 -> Binocular a b a b)
-> (forall (f :: * -> *).
    (Alternative f, Filterable f) =>
    ((a -> Maybe a) -> f b) -> f b)
-> Binocular a b a b
forall a b. (a -> b) -> a -> b
$ f (Maybe b) -> f b
forall a. f (Maybe a) -> f a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
    (f (Maybe b) -> f b)
-> (((a -> Maybe a) -> f b) -> f (Maybe b))
-> ((a -> Maybe a) -> f b)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either d b -> Maybe b) -> f (Either d b) -> f (Maybe b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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)
    (f (Either d b) -> f (Maybe b))
-> (((a -> Maybe a) -> f b) -> f (Either d b))
-> ((a -> Maybe a) -> f b)
-> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either d a -> Maybe a) -> f b) -> f (Either d b)
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((Either d a -> Maybe a) -> f b) -> f (Either d b)
k (((Either d a -> Maybe a) -> f b) -> f (Either d b))
-> (((a -> Maybe a) -> f b) -> (Either d a -> Maybe a) -> f b)
-> ((a -> Maybe a) -> f b)
-> f (Either d b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((a -> Maybe a) -> f b)
-> ((Either d a -> Maybe a) -> a -> Maybe a)
-> (Either d a -> Maybe a)
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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))
instance Distributor (Binocular a b)
instance Alternator (Binocular a b)
instance Filtrator (Binocular a b)

{- | Run a `Binocular` on a partial `Distributor`. -}
runBinocular
  :: (Alternator p, Filtrator p)
  => Binocular a b s t
  -> p a b -> p s t
runBinocular :: forall (p :: * -> * -> *) a b s t.
(Alternator p, Filtrator p) =>
Binocular a b s t -> p a b -> p s t
runBinocular (Binocular forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f t
k) p a b
p = ((s -> Maybe a) -> p s b) -> p s t
forall (f :: * -> *).
(Alternative f, Filterable f) =>
((s -> Maybe a) -> f b) -> f t
k (((s -> Maybe a) -> p s b) -> p s t)
-> ((s -> Maybe a) -> p s b) -> p s t
forall a b. (a -> b) -> a -> b
$ \s -> Maybe a
f -> (s -> Maybe a) -> (b -> Maybe b) -> p a b -> p 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 a
f b -> Maybe b
forall a. a -> Maybe a
Just p a b
p