module Optics.Extra.Internal.Zoom
  (
  -- * Zoom
    Focusing(..)
  , stateZoom
  , stateZoomMaybe
  , stateZoomMany
  , FocusingWith(..)
  , rwsZoom
  , rwsZoomMaybe
  , rwsZoomMany
  , May(..)
  , shuffleMay
  , Err(..)
  , shuffleErr
  -- * Magnify
  , Effect(..)
  , EffectRWS(..)
  , rwsMagnify
  , rwsMagnifyMaybe
  , rwsMagnifyMany
  -- * Misc
  , shuffleS
  , shuffleW
  ) where

import Data.Coerce
import Data.Monoid
import qualified Data.Semigroup as SG

import Optics.Core
import Optics.Internal.Utils

-- | Used by 'Optics.Zoom.Zoom' to 'Optics.Zoom.zoom' into
-- 'Control.Monad.State.StateT'.
newtype Focusing m c s = Focusing { Focusing m c s -> m (c, s)
unfocusing :: m (c, s) }

instance Monad m => Functor (Focusing m c) where
  fmap :: (a -> b) -> Focusing m c a -> Focusing m c b
fmap a -> b
f (Focusing m (c, a)
m) = m (c, b) -> Focusing m c b
forall (m :: * -> *) c s. m (c, s) -> Focusing m c s
Focusing (m (c, b) -> Focusing m c b) -> m (c, b) -> Focusing m c b
forall a b. (a -> b) -> a -> b
$ do
     (c
c, a
s) <- m (c, a)
m
     (c, b) -> m (c, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c
c, a -> b
f a
s)
  {-# INLINE fmap #-}

instance (Monad m, Monoid s) => Applicative (Focusing m s) where
  pure :: a -> Focusing m s a
pure a
s = m (s, a) -> Focusing m s a
forall (m :: * -> *) c s. m (c, s) -> Focusing m c s
Focusing (m (s, a) -> Focusing m s a) -> m (s, a) -> Focusing m s a
forall a b. (a -> b) -> a -> b
$ (s, a) -> m (s, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
forall a. Monoid a => a
mempty, a
s)
  Focusing m (s, a -> b)
mf <*> :: Focusing m s (a -> b) -> Focusing m s a -> Focusing m s b
<*> Focusing m (s, a)
ms = m (s, b) -> Focusing m s b
forall (m :: * -> *) c s. m (c, s) -> Focusing m c s
Focusing (m (s, b) -> Focusing m s b) -> m (s, b) -> Focusing m s b
forall a b. (a -> b) -> a -> b
$ do
    (s
c, a -> b
f) <- m (s, a -> b)
mf
    (s
c', a
s) <- m (s, a)
ms
    (s, b) -> m (s, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
c s -> s -> s
forall a. Monoid a => a -> a -> a
`mappend` s
c', a -> b
f a
s)
  {-# INLINE pure #-}
  {-# INLINE (<*>) #-}

stateZoom
  :: (Is k A_Lens, Monad m)
  => Optic' k is t s
  -> (s -> m (c, s))
  -> (t -> m (c, t))
stateZoom :: Optic' k is t s -> (s -> m (c, s)) -> t -> m (c, t)
stateZoom Optic' k is t s
o s -> m (c, s)
m = Focusing m c t -> m (c, t)
forall (m :: * -> *) c s. Focusing m c s -> m (c, s)
unfocusing (Focusing m c t -> m (c, t))
-> (t -> Focusing m c t) -> t -> m (c, t)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Optic' k is t s -> (s -> Focusing m c s) -> t -> Focusing m c t
forall k (is :: IxList) s t a b.
Is k A_Lens =>
Optic k is s t a b -> LensVL s t a b
toLensVL Optic' k is t s
o (m (c, s) -> Focusing m c s
forall (m :: * -> *) c s. m (c, s) -> Focusing m c s
Focusing (m (c, s) -> Focusing m c s)
-> (s -> m (c, s)) -> s -> Focusing m c s
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. s -> m (c, s)
m)
{-# INLINE stateZoom #-}

stateZoomMaybe
  :: (Is k An_AffineTraversal, Monad m)
  => Optic' k is t s
  -> (s -> m (c, s))
  -> (t -> m (Maybe c, t))
stateZoomMaybe :: Optic' k is t s -> (s -> m (c, s)) -> t -> m (Maybe c, t)
stateZoomMaybe Optic' k is t s
o s -> m (c, s)
m =
     ((First c, t) -> (Maybe c, t)) -> m (First c, t) -> m (Maybe c, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c t. (First c, t) -> (Maybe c, t)
coerce :: (First c, t) -> (Maybe c, t))
  (m (First c, t) -> m (Maybe c, t))
-> (t -> m (First c, t)) -> t -> m (Maybe c, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Focusing m (First c) t -> m (First c, t)
forall (m :: * -> *) c s. Focusing m c s -> m (c, s)
unfocusing
  #. traverseOf (castOptic @An_AffineTraversal o)
                (Focusing #. over (mapped % _1) (First #. Just) . m)
{-# INLINE stateZoomMaybe #-}

stateZoomMany
  :: (Is k A_Traversal, Monad m, Monoid c)
  => Optic' k is t s
  -> (s -> m (c, s))
  -> (t -> m (c, t))
stateZoomMany :: Optic' k is t s -> (s -> m (c, s)) -> t -> m (c, t)
stateZoomMany Optic' k is t s
o s -> m (c, s)
m = Focusing m c t -> m (c, t)
forall (m :: * -> *) c s. Focusing m c s -> m (c, s)
unfocusing (Focusing m c t -> m (c, t))
-> (t -> Focusing m c t) -> t -> m (c, t)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Optic' k is t s -> (s -> Focusing m c s) -> t -> Focusing m c t
forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k is t s
o (m (c, s) -> Focusing m c s
forall (m :: * -> *) c s. m (c, s) -> Focusing m c s
Focusing (m (c, s) -> Focusing m c s)
-> (s -> m (c, s)) -> s -> Focusing m c s
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. s -> m (c, s)
m)
{-# INLINE stateZoomMany #-}

----------------------------------------

-- | Used by 'Optics.Zoom.Zoom' to 'Optics.Zoom.zoom' into
-- 'Control.Monad.RWS.RWST'.
newtype FocusingWith w m c s = FocusingWith { FocusingWith w m c s -> m (c, s, w)
unfocusingWith :: m (c, s, w) }

instance Monad m => Functor (FocusingWith w m s) where
  fmap :: (a -> b) -> FocusingWith w m s a -> FocusingWith w m s b
fmap a -> b
f (FocusingWith m (s, a, w)
m) = m (s, b, w) -> FocusingWith w m s b
forall w (m :: * -> *) c s. m (c, s, w) -> FocusingWith w m c s
FocusingWith (m (s, b, w) -> FocusingWith w m s b)
-> m (s, b, w) -> FocusingWith w m s b
forall a b. (a -> b) -> a -> b
$ do
     (s
c, a
s, w
w) <- m (s, a, w)
m
     (s, b, w) -> m (s, b, w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
c, a -> b
f a
s, w
w)
  {-# INLINE fmap #-}

instance (Monad m, Monoid s, Monoid w) => Applicative (FocusingWith w m s) where
  pure :: a -> FocusingWith w m s a
pure a
s = m (s, a, w) -> FocusingWith w m s a
forall w (m :: * -> *) c s. m (c, s, w) -> FocusingWith w m c s
FocusingWith (m (s, a, w) -> FocusingWith w m s a)
-> m (s, a, w) -> FocusingWith w m s a
forall a b. (a -> b) -> a -> b
$ (s, a, w) -> m (s, a, w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
forall a. Monoid a => a
mempty, a
s, w
forall a. Monoid a => a
mempty)
  FocusingWith m (s, a -> b, w)
mf <*> :: FocusingWith w m s (a -> b)
-> FocusingWith w m s a -> FocusingWith w m s b
<*> FocusingWith m (s, a, w)
ms = m (s, b, w) -> FocusingWith w m s b
forall w (m :: * -> *) c s. m (c, s, w) -> FocusingWith w m c s
FocusingWith (m (s, b, w) -> FocusingWith w m s b)
-> m (s, b, w) -> FocusingWith w m s b
forall a b. (a -> b) -> a -> b
$ do
    (s
c, a -> b
f, w
w) <- m (s, a -> b, w)
mf
    (s
c', a
s, w
w') <- m (s, a, w)
ms
    (s, b, w) -> m (s, b, w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
c s -> s -> s
forall a. Monoid a => a -> a -> a
`mappend` s
c', a -> b
f a
s, w
w w -> w -> w
forall a. Monoid a => a -> a -> a
`mappend` w
w')
  {-# INLINE pure #-}
  {-# INLINE (<*>) #-}

rwsZoom
  :: (Is k A_Lens, Monad m)
  => Optic' k is t s
  -> (r -> s -> m (c, s, w))
  -> (r -> t -> m (c, t, w))
rwsZoom :: Optic' k is t s -> (r -> s -> m (c, s, w)) -> r -> t -> m (c, t, w)
rwsZoom Optic' k is t s
o r -> s -> m (c, s, w)
m = \r
r -> FocusingWith w m c t -> m (c, t, w)
forall w (m :: * -> *) c s. FocusingWith w m c s -> m (c, s, w)
unfocusingWith (FocusingWith w m c t -> m (c, t, w))
-> (t -> FocusingWith w m c t) -> t -> m (c, t, w)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Optic' k is t s
-> (s -> FocusingWith w m c s) -> t -> FocusingWith w m c t
forall k (is :: IxList) s t a b.
Is k A_Lens =>
Optic k is s t a b -> LensVL s t a b
toLensVL Optic' k is t s
o (m (c, s, w) -> FocusingWith w m c s
forall w (m :: * -> *) c s. m (c, s, w) -> FocusingWith w m c s
FocusingWith (m (c, s, w) -> FocusingWith w m c s)
-> (s -> m (c, s, w)) -> s -> FocusingWith w m c s
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. r -> s -> m (c, s, w)
m r
r)
{-# INLINE rwsZoom #-}

rwsZoomMaybe
  :: (Is k An_AffineTraversal, Monad m, Monoid w)
  => Optic' k is t s
  -> (r -> s -> m (c, s, w))
  -> (r -> t -> m (Maybe c, t, w))
rwsZoomMaybe :: Optic' k is t s
-> (r -> s -> m (c, s, w)) -> r -> t -> m (Maybe c, t, w)
rwsZoomMaybe Optic' k is t s
o r -> s -> m (c, s, w)
m = \r
r ->
     ((First c, t, w) -> (Maybe c, t, w))
-> m (First c, t, w) -> m (Maybe c, t, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c t w. (First c, t, w) -> (Maybe c, t, w)
coerce :: (First c, t, w) -> (Maybe c, t, w))
  (m (First c, t, w) -> m (Maybe c, t, w))
-> (t -> m (First c, t, w)) -> t -> m (Maybe c, t, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  FocusingWith w m (First c) t -> m (First c, t, w)
forall w (m :: * -> *) c s. FocusingWith w m c s -> m (c, s, w)
unfocusingWith
  #. traverseOf (castOptic @An_AffineTraversal o)
                (FocusingWith #. over (mapped % _1) (First #. Just) . m r)
{-# INLINE rwsZoomMaybe #-}

rwsZoomMany
  :: (Is k A_Traversal, Monad m, Monoid w, Monoid c)
  => Optic' k is t s
  -> (r -> s -> m (c, s, w))
  -> (r -> t -> m (c, t, w))
rwsZoomMany :: Optic' k is t s -> (r -> s -> m (c, s, w)) -> r -> t -> m (c, t, w)
rwsZoomMany Optic' k is t s
o r -> s -> m (c, s, w)
m = \r
r -> FocusingWith w m c t -> m (c, t, w)
forall w (m :: * -> *) c s. FocusingWith w m c s -> m (c, s, w)
unfocusingWith (FocusingWith w m c t -> m (c, t, w))
-> (t -> FocusingWith w m c t) -> t -> m (c, t, w)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Optic' k is t s
-> (s -> FocusingWith w m c s) -> t -> FocusingWith w m c t
forall k (f :: * -> *) (is :: IxList) s t a b.
(Is k A_Traversal, Applicative f) =>
Optic k is s t a b -> (a -> f b) -> s -> f t
traverseOf Optic' k is t s
o (m (c, s, w) -> FocusingWith w m c s
forall w (m :: * -> *) c s. m (c, s, w) -> FocusingWith w m c s
FocusingWith (m (c, s, w) -> FocusingWith w m c s)
-> (s -> m (c, s, w)) -> s -> FocusingWith w m c s
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. r -> s -> m (c, s, w)
m r
r)
{-# INLINE rwsZoomMany #-}

----------------------------------------

-- | Make a 'Monoid' out of 'Maybe' for error handling.
newtype May a = May { May a -> Maybe a
getMay :: Maybe a }

instance SG.Semigroup a => SG.Semigroup (May a) where
  May (Just a
a) <> :: May a -> May a -> May a
<> May (Just a
b) = Maybe a -> May a
forall a. Maybe a -> May a
May (Maybe a -> May a) -> Maybe a -> May a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
SG.<> a
b)
  May a
_            <> May a
_            = Maybe a -> May a
forall a. Maybe a -> May a
May Maybe a
forall a. Maybe a
Nothing
  {-# INLINE (<>) #-}

instance Monoid a => Monoid (May a) where
  mempty :: May a
mempty = Maybe a -> May a
forall a. Maybe a -> May a
May (Maybe a -> May a) -> Maybe a -> May a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. Monoid a => a
mempty
  mappend :: May a -> May a -> May a
mappend = May a -> May a -> May a
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mempty #-}
  {-# INLINE mappend #-}

shuffleMay :: Maybe (May c) -> May (Maybe c)
shuffleMay :: Maybe (May c) -> May (Maybe c)
shuffleMay = \case
  Maybe (May c)
Nothing      -> Maybe (Maybe c) -> May (Maybe c)
forall a. Maybe a -> May a
May (Maybe c -> Maybe (Maybe c)
forall a. a -> Maybe a
Just Maybe c
forall a. Maybe a
Nothing)
  Just (May Maybe c
c) -> Maybe (Maybe c) -> May (Maybe c)
forall a. Maybe a -> May a
May (c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> Maybe c -> Maybe (Maybe c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe c
c)
{-# INLINE shuffleMay #-}

----------------------------------------

-- | Make a 'Monoid' out of 'Either' for error handling.
newtype Err e a = Err { Err e a -> Either e a
getErr :: Either e a }

instance SG.Semigroup a => SG.Semigroup (Err e a) where
  Err (Right a
a) <> :: Err e a -> Err e a -> Err e a
<> Err (Right a
b) = Either e a -> Err e a
forall e a. Either e a -> Err e a
Err (Either e a -> Err e a) -> Either e a -> Err e a
forall a b. (a -> b) -> a -> b
$ a -> Either e a
forall a b. b -> Either a b
Right (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
SG.<> a
b)
  Err (Left e
e)  <> Err e a
_             = Either e a -> Err e a
forall e a. Either e a -> Err e a
Err (Either e a -> Err e a) -> Either e a -> Err e a
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left e
e
  Err e a
_             <> Err (Left e
e)  = Either e a -> Err e a
forall e a. Either e a -> Err e a
Err (Either e a -> Err e a) -> Either e a -> Err e a
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left e
e
  {-# INLINE (<>) #-}

instance Monoid a => Monoid (Err e a) where
  mempty :: Err e a
mempty = Either e a -> Err e a
forall e a. Either e a -> Err e a
Err (Either e a -> Err e a) -> Either e a -> Err e a
forall a b. (a -> b) -> a -> b
$ a -> Either e a
forall a b. b -> Either a b
Right a
forall a. Monoid a => a
mempty
  mappend :: Err e a -> Err e a -> Err e a
mappend = Err e a -> Err e a -> Err e a
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mempty #-}
  {-# INLINE mappend #-}

shuffleErr :: Maybe (Err e c) -> Err e (Maybe c)
shuffleErr :: Maybe (Err e c) -> Err e (Maybe c)
shuffleErr = \case
  Maybe (Err e c)
Nothing       -> Either e (Maybe c) -> Err e (Maybe c)
forall e a. Either e a -> Err e a
Err (Maybe c -> Either e (Maybe c)
forall a b. b -> Either a b
Right Maybe c
forall a. Maybe a
Nothing)
  Just (Err Either e c
ec) -> Either e (Maybe c) -> Err e (Maybe c)
forall e a. Either e a -> Err e a
Err (c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> Either e c -> Either e (Maybe c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either e c
ec)
{-# INLINE shuffleErr #-}

----------------------------------------

-- | Wrap a monadic effect.
newtype Effect m r = Effect { Effect m r -> m r
getEffect :: m r }

instance (Monad m, SG.Semigroup r) => SG.Semigroup (Effect m r) where
  Effect m r
ma <> :: Effect m r -> Effect m r -> Effect m r
<> Effect m r
mb = m r -> Effect m r
forall (m :: * -> *) r. m r -> Effect m r
Effect (m r -> Effect m r) -> m r -> Effect m r
forall a b. (a -> b) -> a -> b
$ r -> r -> r
forall a. Semigroup a => a -> a -> a
(SG.<>) (r -> r -> r) -> m r -> m (r -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
ma m (r -> r) -> m r -> m r
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m r
mb
  {-# INLINE (<>) #-}

instance (Monad m, Monoid r) => Monoid (Effect m r) where
  mempty :: Effect m r
mempty = m r -> Effect m r
forall (m :: * -> *) r. m r -> Effect m r
Effect (m r -> Effect m r) -> m r -> Effect m r
forall a b. (a -> b) -> a -> b
$ r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
forall a. Monoid a => a
mempty
  mappend :: Effect m r -> Effect m r -> Effect m r
mappend = Effect m r -> Effect m r -> Effect m r
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mempty #-}
  {-# INLINE mappend #-}

----------------------------------------

-- | Wrap a monadic effect. Used when magnifying 'Control.Monad.RWS.RWST'.
newtype EffectRWS w s m c = EffectRWS { EffectRWS w s m c -> s -> m (c, s, w)
getEffectRWS :: s -> m (c, s, w) }

instance
  (SG.Semigroup c, SG.Semigroup w, Monad m
  ) => SG.Semigroup (EffectRWS w s m c) where
  EffectRWS s -> m (c, s, w)
ma <> :: EffectRWS w s m c -> EffectRWS w s m c -> EffectRWS w s m c
<> EffectRWS s -> m (c, s, w)
mb = (s -> m (c, s, w)) -> EffectRWS w s m c
forall w s (m :: * -> *) c. (s -> m (c, s, w)) -> EffectRWS w s m c
EffectRWS ((s -> m (c, s, w)) -> EffectRWS w s m c)
-> (s -> m (c, s, w)) -> EffectRWS w s m c
forall a b. (a -> b) -> a -> b
$ \s
s -> do
    (c
c, s
s', w
w)    <- s -> m (c, s, w)
ma s
s
    (c
c', s
s'', w
w') <- s -> m (c, s, w)
mb s
s'
    (c, s, w) -> m (c, s, w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c
c c -> c -> c
forall a. Semigroup a => a -> a -> a
SG.<> c
c', s
s'', w
w w -> w -> w
forall a. Semigroup a => a -> a -> a
SG.<> w
w')
  {-# INLINE (<>) #-}

instance (Monoid c, Monoid w, Monad m) => Monoid (EffectRWS w s m c) where
  mempty :: EffectRWS w s m c
mempty  = (s -> m (c, s, w)) -> EffectRWS w s m c
forall w s (m :: * -> *) c. (s -> m (c, s, w)) -> EffectRWS w s m c
EffectRWS ((s -> m (c, s, w)) -> EffectRWS w s m c)
-> (s -> m (c, s, w)) -> EffectRWS w s m c
forall a b. (a -> b) -> a -> b
$ \s
s -> (c, s, w) -> m (c, s, w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c
forall a. Monoid a => a
mempty, s
s, w
forall a. Monoid a => a
mempty)
  mappend :: EffectRWS w s m c -> EffectRWS w s m c -> EffectRWS w s m c
mappend = EffectRWS w s m c -> EffectRWS w s m c -> EffectRWS w s m c
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mempty #-}
  {-# INLINE mappend #-}

rwsMagnify
  :: Is k A_Getter
  => Optic' k is a b
  -> (b -> s -> f (c, s, w))
  -> (a -> s -> f (c, s, w))
rwsMagnify :: Optic' k is a b -> (b -> s -> f (c, s, w)) -> a -> s -> f (c, s, w)
rwsMagnify Optic' k is a b
o b -> s -> f (c, s, w)
m = EffectRWS w s f c -> s -> f (c, s, w)
forall w s (m :: * -> *) c. EffectRWS w s m c -> s -> m (c, s, w)
getEffectRWS (EffectRWS w s f c -> s -> f (c, s, w))
-> (a -> EffectRWS w s f c) -> a -> s -> f (c, s, w)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Optic' k is a b
-> (b -> EffectRWS w s f c) -> a -> EffectRWS w s f c
forall k (is :: IxList) s a r.
Is k A_Getter =>
Optic' k is s a -> (a -> r) -> s -> r
views Optic' k is a b
o ((s -> f (c, s, w)) -> EffectRWS w s f c
forall w s (m :: * -> *) c. (s -> m (c, s, w)) -> EffectRWS w s m c
EffectRWS ((s -> f (c, s, w)) -> EffectRWS w s f c)
-> (b -> s -> f (c, s, w)) -> b -> EffectRWS w s f c
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. b -> s -> f (c, s, w)
m)
{-# INLINE rwsMagnify #-}

rwsMagnifyMaybe
  :: (Is k An_AffineFold, Applicative m, Monoid w)
  => Optic' k is a b
  -> (b -> s -> m (c, s, w))
  -> (a -> s -> m (Maybe c, s, w))
rwsMagnifyMaybe :: Optic' k is a b
-> (b -> s -> m (c, s, w)) -> a -> s -> m (Maybe c, s, w)
rwsMagnifyMaybe Optic' k is a b
o b -> s -> m (c, s, w)
m = \a
r s
s -> m (Maybe c, s, w)
-> (EffectRWS w s m c -> m (Maybe c, s, w))
-> Maybe (EffectRWS w s m c)
-> m (Maybe c, s, w)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
  ((Maybe c, s, w) -> m (Maybe c, s, w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe c
forall a. Maybe a
Nothing, s
s, w
forall a. Monoid a => a
mempty))
  (\EffectRWS w s m c
e -> Optic A_Setter '[] (m (c, s, w)) (m (Maybe c, s, w)) c (Maybe c)
-> (c -> Maybe c) -> m (c, s, w) -> m (Maybe c, s, w)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Setter (m (c, s, w)) (m (Maybe c, s, w)) (c, s, w) (Maybe c, s, w)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped Setter (m (c, s, w)) (m (Maybe c, s, w)) (c, s, w) (Maybe c, s, w)
-> Optic A_Lens '[] (c, s, w) (Maybe c, s, w) c (Maybe c)
-> Optic A_Setter '[] (m (c, s, w)) (m (Maybe c, s, w)) c (Maybe c)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (c, s, w) (Maybe c, s, w) c (Maybe c)
forall s t a b. Field1 s t a b => Lens s t a b
_1) c -> Maybe c
forall a. a -> Maybe a
Just (m (c, s, w) -> m (Maybe c, s, w))
-> m (c, s, w) -> m (Maybe c, s, w)
forall a b. (a -> b) -> a -> b
$ EffectRWS w s m c -> s -> m (c, s, w)
forall w s (m :: * -> *) c. EffectRWS w s m c -> s -> m (c, s, w)
getEffectRWS EffectRWS w s m c
e s
s)
  (Optic' k is a b
-> (b -> EffectRWS w s m c) -> a -> Maybe (EffectRWS w s m c)
forall k (is :: IxList) s a r.
Is k An_AffineFold =>
Optic' k is s a -> (a -> r) -> s -> Maybe r
previews Optic' k is a b
o ((s -> m (c, s, w)) -> EffectRWS w s m c
forall w s (m :: * -> *) c. (s -> m (c, s, w)) -> EffectRWS w s m c
EffectRWS ((s -> m (c, s, w)) -> EffectRWS w s m c)
-> (b -> s -> m (c, s, w)) -> b -> EffectRWS w s m c
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. b -> s -> m (c, s, w)
m) a
r)
{-# INLINE rwsMagnifyMaybe #-}

rwsMagnifyMany
  :: (Is k A_Fold, Monad m, Monoid w, Monoid c)
  => Optic' k is a b
  -> (b -> s -> m (c, s, w))
  -> (a -> s -> m (c, s, w))
rwsMagnifyMany :: Optic' k is a b -> (b -> s -> m (c, s, w)) -> a -> s -> m (c, s, w)
rwsMagnifyMany Optic' k is a b
o b -> s -> m (c, s, w)
m = EffectRWS w s m c -> s -> m (c, s, w)
forall w s (m :: * -> *) c. EffectRWS w s m c -> s -> m (c, s, w)
getEffectRWS (EffectRWS w s m c -> s -> m (c, s, w))
-> (a -> EffectRWS w s m c) -> a -> s -> m (c, s, w)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Optic' k is a b
-> (b -> EffectRWS w s m c) -> a -> EffectRWS w s m c
forall k m (is :: IxList) s a.
(Is k A_Fold, Monoid m) =>
Optic' k is s a -> (a -> m) -> s -> m
foldMapOf Optic' k is a b
o ((s -> m (c, s, w)) -> EffectRWS w s m c
forall w s (m :: * -> *) c. (s -> m (c, s, w)) -> EffectRWS w s m c
EffectRWS ((s -> m (c, s, w)) -> EffectRWS w s m c)
-> (b -> s -> m (c, s, w)) -> b -> EffectRWS w s m c
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. b -> s -> m (c, s, w)
m)
{-# INLINE rwsMagnifyMany #-}

----------------------------------------
-- Misc

shuffleS :: s -> Maybe (c, s) -> (Maybe c, s)
shuffleS :: s -> Maybe (c, s) -> (Maybe c, s)
shuffleS s
s = (Maybe c, s)
-> ((c, s) -> (Maybe c, s)) -> Maybe (c, s) -> (Maybe c, s)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe c
forall a. Maybe a
Nothing, s
s) (Optic A_Lens '[] (c, s) (Maybe c, s) c (Maybe c)
-> (c -> Maybe c) -> (c, s) -> (Maybe c, s)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens '[] (c, s) (Maybe c, s) c (Maybe c)
forall s t a b. Field1 s t a b => Lens s t a b
_1 c -> Maybe c
forall a. a -> Maybe a
Just)
{-# INLINE shuffleS #-}

shuffleW :: Monoid w => Maybe (c, w) -> (Maybe c, w)
shuffleW :: Maybe (c, w) -> (Maybe c, w)
shuffleW = (Maybe c, w)
-> ((c, w) -> (Maybe c, w)) -> Maybe (c, w) -> (Maybe c, w)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe c
forall a. Maybe a
Nothing, w
forall a. Monoid a => a
mempty) (Optic A_Lens '[] (c, w) (Maybe c, w) c (Maybe c)
-> (c -> Maybe c) -> (c, w) -> (Maybe c, w)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens '[] (c, w) (Maybe c, w) c (Maybe c)
forall s t a b. Field1 s t a b => Lens s t a b
_1 c -> Maybe c
forall a. a -> Maybe a
Just)
{-# INLINE shuffleW #-}