module Optics.Passthrough where

import Optics.Internal.Optic
import Optics.AffineTraversal
import Optics.Lens
import Optics.Prism
import Optics.Traversal
import Optics.View

class (Is k A_Traversal, ViewableOptic k r) => PermeableOptic k r where
  -- | Modify the target of an 'Optic' returning extra information of type 'r'.
  passthrough
    :: Optic k is s t a b
    -> (a -> (r, b))
    -> s
    -> (ViewResult k r, t)

instance PermeableOptic An_Iso r where
  passthrough :: Optic An_Iso is s t a b
-> (a -> (r, b)) -> s -> (ViewResult An_Iso r, t)
passthrough Optic An_Iso is s t a b
o = Optic An_Iso is s t a b -> LensVL s t a b
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 An_Iso is s t a b
o
  {-# INLINE passthrough #-}

instance PermeableOptic A_Lens r where
  passthrough :: Optic A_Lens is s t a b
-> (a -> (r, b)) -> s -> (ViewResult A_Lens r, t)
passthrough Optic A_Lens is s t a b
o = Optic A_Lens is s t a b -> LensVL s t a b
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 A_Lens is s t a b
o
  {-# INLINE passthrough #-}

instance PermeableOptic A_Prism r where
  passthrough :: Optic A_Prism is s t a b
-> (a -> (r, b)) -> s -> (ViewResult A_Prism r, t)
passthrough Optic A_Prism is s t a b
o a -> (r, b)
f s
s = Optic A_Prism is s t a b
-> ((b -> t) -> (s -> Either t a) -> (Maybe r, t)) -> (Maybe r, t)
forall k (is :: IxList) s t a b r.
Is k A_Prism =>
Optic k is s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism Optic A_Prism is s t a b
o (((b -> t) -> (s -> Either t a) -> (Maybe r, t)) -> (Maybe r, t))
-> ((b -> t) -> (s -> Either t a) -> (Maybe r, t)) -> (Maybe r, t)
forall a b. (a -> b) -> a -> b
$ \b -> t
bt s -> Either t a
sta -> case s -> Either t a
sta s
s of
    Left t
t -> (Maybe r
forall a. Maybe a
Nothing, t
t)
    Right a
a -> case a -> (r, b)
f a
a of
      (r
r, b
b) -> (r -> Maybe r
forall a. a -> Maybe a
Just r
r, b -> t
bt b
b)
  {-# INLINE passthrough #-}

instance PermeableOptic An_AffineTraversal r where
  passthrough :: Optic An_AffineTraversal is s t a b
-> (a -> (r, b)) -> s -> (ViewResult An_AffineTraversal r, t)
passthrough Optic An_AffineTraversal is s t a b
o a -> (r, b)
f s
s = Optic An_AffineTraversal is s t a b
-> ((s -> Either t a) -> (s -> b -> t) -> (Maybe r, t))
-> (Maybe r, t)
forall k (is :: IxList) s t a b r.
Is k An_AffineTraversal =>
Optic k is s t a b
-> ((s -> Either t a) -> (s -> b -> t) -> r) -> r
withAffineTraversal Optic An_AffineTraversal is s t a b
o (((s -> Either t a) -> (s -> b -> t) -> (Maybe r, t))
 -> (Maybe r, t))
-> ((s -> Either t a) -> (s -> b -> t) -> (Maybe r, t))
-> (Maybe r, t)
forall a b. (a -> b) -> a -> b
$ \s -> Either t a
sta s -> b -> t
sbt -> case s -> Either t a
sta s
s of
    Left t
t -> (Maybe r
forall a. Maybe a
Nothing, t
t)
    Right a
a -> case a -> (r, b)
f a
a of
      (r
r, b
b) -> (r -> Maybe r
forall a. a -> Maybe a
Just r
r, s -> b -> t
sbt s
s b
b)
  {-# INLINE passthrough #-}

instance Monoid r => PermeableOptic A_Traversal r where
  passthrough :: Optic A_Traversal is s t a b
-> (a -> (r, b)) -> s -> (ViewResult A_Traversal r, t)
passthrough = Optic A_Traversal is s t a b
-> (a -> (r, b)) -> s -> (ViewResult A_Traversal r, 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
  {-# INLINE passthrough #-}