{-# OPTIONS_HADDOCK not-home #-}
module Optics.Internal.Fold where
import Data.Functor
import Data.Foldable
import Data.Maybe
import qualified Data.Semigroup as SG
import Data.Profunctor.Indexed
import Optics.Internal.Bi
import Optics.Internal.Optic
foldVL__
:: (Bicontravariant p, Traversing p)
=> (forall f. Applicative f => (a -> f u) -> s -> f v)
-> Optic__ p i i s t a b
foldVL__ :: forall (p :: * -> * -> * -> *) a u s v i t b.
(Bicontravariant p, Traversing p) =>
(forall (f :: * -> *). Applicative f => (a -> f u) -> s -> f v)
-> Optic__ p i i s t a b
foldVL__ forall (f :: * -> *). Applicative f => (a -> f u) -> s -> f v
f = forall (p :: * -> * -> * -> *) i c a b.
(Profunctor p, Bicontravariant p) =>
p i c a -> p i c b
rphantom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) a b s t i.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p i a b -> p i s t
wander forall (f :: * -> *). Applicative f => (a -> f u) -> s -> f v
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i c a b.
(Profunctor p, Bicontravariant p) =>
p i c a -> p i c b
rphantom
{-# INLINE foldVL__ #-}
folded__
:: (Bicontravariant p, Traversing p, Foldable f)
=> Optic__ p i i (f a) (f b) a b
folded__ :: forall (p :: * -> * -> * -> *) (f :: * -> *) i a b.
(Bicontravariant p, Traversing p, Foldable f) =>
Optic__ p i i (f a) (f b) a b
folded__ = forall (p :: * -> * -> * -> *) a u s v i t b.
(Bicontravariant p, Traversing p) =>
(forall (f :: * -> *). Applicative f => (a -> f u) -> s -> f v)
-> Optic__ p i i s t a b
foldVL__ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
{-# INLINE folded__ #-}
foldring__
:: (Bicontravariant p, Traversing p)
=> (forall f. Applicative f => (a -> f u -> f u) -> f v -> s -> f w)
-> Optic__ p i i s t a b
foldring__ :: forall (p :: * -> * -> * -> *) a u v s w i t b.
(Bicontravariant p, Traversing p) =>
(forall (f :: * -> *).
Applicative f =>
(a -> f u -> f u) -> f v -> s -> f w)
-> Optic__ p i i s t a b
foldring__ forall (f :: * -> *).
Applicative f =>
(a -> f u -> f u) -> f v -> s -> f w
fr = forall (p :: * -> * -> * -> *) a u s v i t b.
(Bicontravariant p, Traversing p) =>
(forall (f :: * -> *). Applicative f => (a -> f u) -> s -> f v)
-> Optic__ p i i s t a b
foldVL__ forall a b. (a -> b) -> a -> b
$ \a -> f Any
f -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Applicative f =>
(a -> f u -> f u) -> f v -> s -> f w
fr (\a
a -> (a -> f Any
f a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {a}. a
v)
where
v :: a
v = forall a. HasCallStack => [Char] -> a
error [Char]
"foldring__: value used"
{-# INLINE foldring__ #-}
data Leftmost a = LPure | LLeaf a | LStep (Leftmost a)
instance SG.Semigroup (Leftmost a) where
Leftmost a
x <> :: Leftmost a -> Leftmost a -> Leftmost a
<> Leftmost a
y = forall a. Leftmost a -> Leftmost a
LStep forall a b. (a -> b) -> a -> b
$ case Leftmost a
x of
Leftmost a
LPure -> Leftmost a
y
LLeaf a
_ -> Leftmost a
x
LStep Leftmost a
x' -> case Leftmost a
y of
Leftmost a
LPure -> Leftmost a
x'
LLeaf a
a -> forall a. a -> Leftmost a
LLeaf forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe a
a (forall a. Leftmost a -> Maybe a
getLeftmost Leftmost a
x')
LStep Leftmost a
y' -> Leftmost a
x' forall a. Semigroup a => a -> a -> a
SG.<> Leftmost a
y'
instance Monoid (Leftmost a) where
mempty :: Leftmost a
mempty = forall a. Leftmost a
LPure
mappend :: Leftmost a -> Leftmost a -> Leftmost a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)
getLeftmost :: Leftmost a -> Maybe a
getLeftmost :: forall a. Leftmost a -> Maybe a
getLeftmost Leftmost a
LPure = forall a. Maybe a
Nothing
getLeftmost (LLeaf a
a) = forall a. a -> Maybe a
Just a
a
getLeftmost (LStep Leftmost a
x) = forall a. Leftmost a -> Maybe a
go Leftmost a
x
where
go :: Leftmost a -> Maybe a
go Leftmost a
LPure = forall a. Maybe a
Nothing
go (LLeaf a
a) = forall a. a -> Maybe a
Just a
a
go (LStep Leftmost a
a) = Leftmost a -> Maybe a
go Leftmost a
a
data Rightmost a = RPure | RLeaf a | RStep (Rightmost a)
instance SG.Semigroup (Rightmost a) where
Rightmost a
x <> :: Rightmost a -> Rightmost a -> Rightmost a
<> Rightmost a
y = forall a. Rightmost a -> Rightmost a
RStep forall a b. (a -> b) -> a -> b
$ case Rightmost a
y of
Rightmost a
RPure -> Rightmost a
x
RLeaf a
_ -> Rightmost a
y
RStep Rightmost a
y' -> case Rightmost a
x of
Rightmost a
RPure -> Rightmost a
y'
RLeaf a
a -> forall a. a -> Rightmost a
RLeaf forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe a
a (forall a. Rightmost a -> Maybe a
getRightmost Rightmost a
y')
RStep Rightmost a
x' -> forall a. Monoid a => a -> a -> a
mappend Rightmost a
x' Rightmost a
y'
instance Monoid (Rightmost a) where
mempty :: Rightmost a
mempty = forall a. Rightmost a
RPure
mappend :: Rightmost a -> Rightmost a -> Rightmost a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)
getRightmost :: Rightmost a -> Maybe a
getRightmost :: forall a. Rightmost a -> Maybe a
getRightmost Rightmost a
RPure = forall a. Maybe a
Nothing
getRightmost (RLeaf a
a) = forall a. a -> Maybe a
Just a
a
getRightmost (RStep Rightmost a
x) = forall a. Rightmost a -> Maybe a
go Rightmost a
x
where
go :: Rightmost a -> Maybe a
go Rightmost a
RPure = forall a. Maybe a
Nothing
go (RLeaf a
a) = forall a. a -> Maybe a
Just a
a
go (RStep Rightmost a
a) = Rightmost a -> Maybe a
go Rightmost a
a