    {-# OPTIONS_HADDOCK not-home #-}

    -- | Internal implementation details of folds.
    --
    -- This module is intended for internal use only, and may change without warning
    -- in subsequent releases.
    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

    -- | Internal implementation of 'Optics.Fold.foldVL'.
    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 = p i s v -> p i s t
    forall (p :: * -> * -> * -> *) i c a b.
    (Profunctor p, Bicontravariant p) =>
    p i c a -> p i c b
    rphantom (p i s v -> p i s t) -> (p i a b -> p i s v) -> p i a b -> p i s t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall (f :: * -> *). Applicative f => (a -> f u) -> s -> f v)
    -> p i a u -> p i s v
    forall a b s t i.
    (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
    -> p i a b -> p i s t
    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 (a -> f u) -> s -> f v
    forall (f :: * -> *). Applicative f => (a -> f u) -> s -> f v
    f (p i a u -> p i s v) -> (p i a b -> p i a u) -> p i a b -> p i s v
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p i a b -> p i a u
    forall (p :: * -> * -> * -> *) i c a b.
    (Profunctor p, Bicontravariant p) =>
    p i c a -> p i c b
    rphantom
    {-# INLINE foldVL__ #-}

    -- | Internal implementation of 'Optics.Fold.folded'.
    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 (f :: * -> *).
     Applicative f =>
     (a -> f (ZonkAny 0)) -> f a -> f ())
    -> Optic__ p i i (f a) (f b) a b
    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__ (a -> f (ZonkAny 0)) -> f a -> f ()
    forall (f :: * -> *).
    Applicative f =>
    (a -> f (ZonkAny 0)) -> f a -> f ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_
    {-# INLINE folded__ #-}

    -- | Internal implementation of 'Optics.Fold.foldring'.
    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 (f :: * -> *).
     Applicative f =>
     (a -> f (ZonkAny 1)) -> s -> f ())
    -> Optic__ p i i s t a b
    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 (ZonkAny 1)) -> s -> f ())
     -> Optic__ p i i s t a b)
    -> (forall (f :: * -> *).
        Applicative f =>
        (a -> f (ZonkAny 1)) -> s -> f ())
    -> Optic__ p i i s t a b
    forall a b. (a -> b) -> a -> b
    $ \a -> f (ZonkAny 1)
    f -> f w -> f ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (f w -> f ()) -> (s -> f w) -> s -> f ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> f u -> f u) -> f v -> s -> f w
    forall (f :: * -> *).
    Applicative f =>
    (a -> f u -> f u) -> f v -> s -> f w
    fr (\a
    a -> (a -> f (ZonkAny 1)
    f a
    a f (ZonkAny 1) -> f u -> f u
    forall a b. f a -> f b -> f b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *>)) (v -> f v
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure v
    forall {a}. a
    v)
      where
        v :: a
    v = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "foldring__: value used"
    {-# INLINE foldring__ #-}

    ------------------------------------------------------------------------------
    -- Leftmost and Rightmost
    ------------------------------------------------------------------------------

    -- | Used for 'Optics.Fold.headOf' and 'Optics.IxFold.iheadOf'.
    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 = Leftmost a -> Leftmost a
    forall a. Leftmost a -> Leftmost a
    LStep (Leftmost a -> Leftmost a) -> Leftmost a -> Leftmost a
    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
          -- The last two cases make headOf produce a Just as soon as any element is
          -- encountered, and possibly serve as a micro-optimisation; this behaviour
          -- can be disabled by replacing them with _ -> mappend x y'.  Note that
          -- this means that firstOf (backwards folded) [1..] is Just _|_.
          Leftmost a
    LPure    -> Leftmost a
    x'
          LLeaf a
    a  -> a -> Leftmost a
    forall a. a -> Leftmost a
    LLeaf (a -> Leftmost a) -> a -> Leftmost a
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    a (Leftmost a -> Maybe a
    forall a. Leftmost a -> Maybe a
    getLeftmost Leftmost a
    x')
          LStep Leftmost a
    y' -> Leftmost a
    x' Leftmost a -> Leftmost a -> Leftmost a
    forall a. Semigroup a => a -> a -> a
    SG.<> Leftmost a
    y'

    instance Monoid (Leftmost a) where
      mempty :: Leftmost a
    mempty  = Leftmost a
    forall a. Leftmost a
    LPure
      mappend :: Leftmost a -> Leftmost a -> Leftmost a
    mappend = Leftmost a -> Leftmost a -> Leftmost a
    forall a. Semigroup a => a -> a -> a
    (SG.<>)

    -- | Extract the 'Leftmost' element. This will fairly eagerly determine that it
    -- can return 'Just' the moment it sees any element at all.
    getLeftmost :: Leftmost a -> Maybe a
    getLeftmost :: forall a. Leftmost a -> Maybe a
    getLeftmost Leftmost a
    LPure     = Maybe a
    forall a. Maybe a
    Nothing
    getLeftmost (LLeaf a
    a) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a
    getLeftmost (LStep Leftmost a
    x) = Leftmost a -> Maybe a
    forall a. Leftmost a -> Maybe a
    go Leftmost a
    x
      where
        -- Make getLeftmost non-recursive so it might be inlined for LPure/LLeaf.
        go :: Leftmost a -> Maybe a
    go Leftmost a
    LPure     = Maybe a
    forall a. Maybe a
    Nothing
        go (LLeaf a
    a) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a
        go (LStep Leftmost a
    a) = Leftmost a -> Maybe a
    go Leftmost a
    a

    -- | Used for 'Optics.Fold.lastOf' and 'Optics.IxFold.ilastOf'.
    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 = Rightmost a -> Rightmost a
    forall a. Rightmost a -> Rightmost a
    RStep (Rightmost a -> Rightmost a) -> Rightmost a -> Rightmost a
    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
          -- The last two cases make lastOf produce a Just as soon as any element is
          -- encountered, and possibly serve as a micro-optimisation; this behaviour
          -- can be disabled by replacing them with _ -> mappend x y'.  Note that
          -- this means that lastOf folded [1..] is Just _|_.
          Rightmost a
    RPure    -> Rightmost a
    y'
          RLeaf a
    a  -> a -> Rightmost a
    forall a. a -> Rightmost a
    RLeaf (a -> Rightmost a) -> a -> Rightmost a
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    a (Rightmost a -> Maybe a
    forall a. Rightmost a -> Maybe a
    getRightmost Rightmost a
    y')
          RStep Rightmost a
    x' -> Rightmost a -> Rightmost a -> Rightmost a
    forall a. Monoid a => a -> a -> a
    mappend Rightmost a
    x' Rightmost a
    y'

    instance Monoid (Rightmost a) where
      mempty :: Rightmost a
    mempty  = Rightmost a
    forall a. Rightmost a
    RPure
      mappend :: Rightmost a -> Rightmost a -> Rightmost a
    mappend = Rightmost a -> Rightmost a -> Rightmost a
    forall a. Semigroup a => a -> a -> a
    (SG.<>)

    -- | Extract the 'Rightmost' element. This will fairly eagerly determine that it
    -- can return 'Just' the moment it sees any element at all.
    getRightmost :: Rightmost a -> Maybe a
    getRightmost :: forall a. Rightmost a -> Maybe a
    getRightmost Rightmost a
    RPure     = Maybe a
    forall a. Maybe a
    Nothing
    getRightmost (RLeaf a
    a) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a
    getRightmost (RStep Rightmost a
    x) = Rightmost a -> Maybe a
    forall a. Rightmost a -> Maybe a
    go Rightmost a
    x
      where
        -- Make getRightmost non-recursive so it might be inlined for RPure/RLeaf.
        go :: Rightmost a -> Maybe a
    go Rightmost a
    RPure     = Maybe a
    forall a. Maybe a
    Nothing
        go (RLeaf a
    a) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a
        go (RStep Rightmost a
    a) = Rightmost a -> Maybe a
    go Rightmost a
    a