    -- |
    -- Module: Optics.Arrow
    -- Description: Turn optics into arrow transformers.
    module Optics.Arrow
      ( ArrowOptic(..)
      , assignA
      ) where

    import Control.Arrow
    import Data.Coerce
    import qualified Control.Category as C

    import Data.Profunctor.Indexed

    import Optics.AffineTraversal
    import Optics.Prism
    import Optics.Setter
    import Optics.Internal.Optic
    import Optics.Internal.Utils

    newtype WrappedArrow p i a b = WrapArrow { forall (p :: * -> * -> *) i a b. WrappedArrow p i a b -> p a b
    unwrapArrow :: p a b }

    instance C.Category p => C.Category (WrappedArrow p i) where
      WrapArrow p b c
    f . :: forall b c a.
    WrappedArrow p i b c
    -> WrappedArrow p i a b -> WrappedArrow p i a c
    . WrapArrow p a b
    g = p a c -> WrappedArrow p i a c
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p b c
    f p b c -> p a b -> p a c
    forall b c a. p b c -> p a b -> p a c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    C.. p a b
    g)
      id :: forall a. WrappedArrow p i a a
    id                        = p a a -> WrappedArrow p i a a
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow p a a
    forall a. p a a
    forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    C.id
      {-# INLINE (.) #-}
      {-# INLINE id #-}

    instance Arrow p => Arrow (WrappedArrow p i) where
      arr :: forall b c. (b -> c) -> WrappedArrow p i b c
    arr                         = p b c -> WrappedArrow p i b c
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p b c -> WrappedArrow p i b c)
    -> ((b -> c) -> p b c) -> (b -> c) -> WrappedArrow p i b c
    forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
    #. (b -> c) -> p b c
    forall b c. (b -> c) -> p b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr
      first :: forall b c d.
    WrappedArrow p i b c -> WrappedArrow p i (b, d) (c, d)
    first                       = p (b, d) (c, d) -> WrappedArrow p i (b, d) (c, d)
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p (b, d) (c, d) -> WrappedArrow p i (b, d) (c, d))
    -> (p b c -> p (b, d) (c, d))
    -> p b c
    -> WrappedArrow p i (b, d) (c, d)
    forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
    #. p b c -> p (b, d) (c, d)
    forall b c d. p b c -> p (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first  (p b c -> WrappedArrow p i (b, d) (c, d))
    -> (WrappedArrow p i b c -> p b c)
    -> WrappedArrow p i b c
    -> WrappedArrow p i (b, d) (c, d)
    forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
    .# WrappedArrow p i b c -> p b c
    forall (p :: * -> * -> *) i a b. WrappedArrow p i a b -> p a b
    unwrapArrow
      second :: forall b c d.
    WrappedArrow p i b c -> WrappedArrow p i (d, b) (d, c)
    second                      = p (d, b) (d, c) -> WrappedArrow p i (d, b) (d, c)
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p (d, b) (d, c) -> WrappedArrow p i (d, b) (d, c))
    -> (p b c -> p (d, b) (d, c))
    -> p b c
    -> WrappedArrow p i (d, b) (d, c)
    forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
    #. p b c -> p (d, b) (d, c)
    forall b c d. p b c -> p (d, b) (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (p b c -> WrappedArrow p i (d, b) (d, c))
    -> (WrappedArrow p i b c -> p b c)
    -> WrappedArrow p i b c
    -> WrappedArrow p i (d, b) (d, c)
    forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
    .# WrappedArrow p i b c -> p b c
    forall (p :: * -> * -> *) i a b. WrappedArrow p i a b -> p a b
    unwrapArrow
      WrapArrow p b c
    a *** :: forall b c b' c'.
    WrappedArrow p i b c
    -> WrappedArrow p i b' c' -> WrappedArrow p i (b, b') (c, c')
    *** WrapArrow p b' c'
    b = p (b, b') (c, c') -> WrappedArrow p i (b, b') (c, c')
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p b c
    a p b c -> p b' c' -> p (b, b') (c, c')
    forall b c b' c'. p b c -> p b' c' -> p (b, b') (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** p b' c'
    b)
      WrapArrow p b c
    a &&& :: forall b c c'.
    WrappedArrow p i b c
    -> WrappedArrow p i b c' -> WrappedArrow p i b (c, c')
    &&& WrapArrow p b c'
    b = p b (c, c') -> WrappedArrow p i b (c, c')
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p b c
    a p b c -> p b c' -> p b (c, c')
    forall b c c'. p b c -> p b c' -> p b (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& p b c'
    b)
      {-# INLINE arr #-}
      {-# INLINE first #-}
      {-# INLINE second #-}
      {-# INLINE (***) #-}
      {-# INLINE (&&&) #-}

    instance Arrow p => Profunctor (WrappedArrow p) where
      dimap :: forall a b c d i.
    (a -> b)
    -> (c -> d) -> WrappedArrow p i b c -> WrappedArrow p i a d
    dimap a -> b
    f c -> d
    g WrappedArrow p i b c
    k = (a -> b) -> WrappedArrow p i a b
    forall b c. (b -> c) -> WrappedArrow p i b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr a -> b
    f WrappedArrow p i a b
    -> WrappedArrow p i b d -> WrappedArrow p i a d
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> WrappedArrow p i b c
    k WrappedArrow p i b c
    -> WrappedArrow p i c d -> WrappedArrow p i b d
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (c -> d) -> WrappedArrow p i c d
    forall b c. (b -> c) -> WrappedArrow p i b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr c -> d
    g
      lmap :: forall a b i c.
    (a -> b) -> WrappedArrow p i b c -> WrappedArrow p i a c
    lmap  a -> b
    f   WrappedArrow p i b c
    k = (a -> b) -> WrappedArrow p i a b
    forall b c. (b -> c) -> WrappedArrow p i b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr a -> b
    f WrappedArrow p i a b
    -> WrappedArrow p i b c -> WrappedArrow p i a c
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> WrappedArrow p i b c
    k
      rmap :: forall c d i b.
    (c -> d) -> WrappedArrow p i b c -> WrappedArrow p i b d
    rmap    c -> d
    g WrappedArrow p i b c
    k =           WrappedArrow p i b c
    k WrappedArrow p i b c
    -> WrappedArrow p i c d -> WrappedArrow p i b d
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (c -> d) -> WrappedArrow p i c d
    forall b c. (b -> c) -> WrappedArrow p i b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr c -> d
    g
      {-# INLINE dimap #-}
      {-# INLINE lmap #-}
      {-# INLINE rmap #-}

      lcoerce' :: forall a b i c.
    Coercible a b =>
    WrappedArrow p i a c -> WrappedArrow p i b c
    lcoerce' = (b -> a) -> WrappedArrow p i a c -> WrappedArrow p i b c
    forall a b i c.
    (a -> b) -> WrappedArrow p i b c -> WrappedArrow p i a c
    forall (p :: * -> * -> * -> *) a b i c.
    Profunctor p =>
    (a -> b) -> p i b c -> p i a c
    lmap b -> a
    forall a b. Coercible a b => a -> b
    coerce
      rcoerce' :: forall a b i c.
    Coercible a b =>
    WrappedArrow p i c a -> WrappedArrow p i c b
    rcoerce' = (a -> b) -> WrappedArrow p i c a -> WrappedArrow p i c b
    forall c d i b.
    (c -> d) -> WrappedArrow p i b c -> WrappedArrow p i b d
    forall (p :: * -> * -> * -> *) c d i b.
    Profunctor p =>
    (c -> d) -> p i b c -> p i b d
    rmap a -> b
    forall a b. Coercible a b => a -> b
    coerce
      {-# INLINE lcoerce' #-}
      {-# INLINE rcoerce' #-}

    instance Arrow p => Strong (WrappedArrow p) where
      first' :: forall i a b c.
    WrappedArrow p i a b -> WrappedArrow p i (a, c) (b, c)
    first'  (WrapArrow p a b
    k) = p (a, c) (b, c) -> WrappedArrow p i (a, c) (b, c)
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p a b -> p (a, c) (b, c)
    forall b c d. p b c -> p (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first p a b
    k)
      second' :: forall i a b c.
    WrappedArrow p i a b -> WrappedArrow p i (c, a) (c, b)
    second' (WrapArrow p a b
    k) = p (c, a) (c, b) -> WrappedArrow p i (c, a) (c, b)
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p a b -> p (c, a) (c, b)
    forall b c d. p b c -> p (d, b) (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second p a b
    k)
      {-# INLINE first' #-}
      {-# INLINE second' #-}

    instance ArrowChoice p => Choice (WrappedArrow p) where
      left' :: forall i a b c.
    WrappedArrow p i a b -> WrappedArrow p i (Either a c) (Either b c)
    left'  (WrapArrow p a b
    k) = p (Either a c) (Either b c)
    -> WrappedArrow p i (Either a c) (Either b c)
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p a b -> p (Either a c) (Either b c)
    forall b c d. p b c -> p (Either b d) (Either c d)
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either b d) (Either c d)
    left p a b
    k)
      right' :: forall i a b c.
    WrappedArrow p i a b -> WrappedArrow p i (Either c a) (Either c b)
    right' (WrapArrow p a b
    k) = p (Either c a) (Either c b)
    -> WrappedArrow p i (Either c a) (Either c b)
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow (p a b -> p (Either c a) (Either c b)
    forall b c d. p b c -> p (Either d b) (Either d c)
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either d b) (Either d c)
    right p a b
    k)
      {-# INLINE left' #-}
      {-# INLINE right' #-}

    instance ArrowChoice p => Visiting (WrappedArrow p)

    class Arrow arr => ArrowOptic k arr where
      -- | Turn an optic into an arrow transformer.
      overA :: Optic k is s t a b -> arr a b -> arr s t

    instance Arrow arr => ArrowOptic An_Iso arr where
      overA :: forall (is :: IxList) s t a b.
    Optic An_Iso is s t a b -> arr a b -> arr s t
    overA = Optic An_Iso is s t a b -> arr a b -> arr s t
    forall (p :: * -> * -> * -> *) (arr :: * -> * -> *) k
           (is :: IxList) s t a b.
    (p ~ WrappedArrow arr, Profunctor p, Constraints k p) =>
    Optic k is s t a b -> arr a b -> arr s t
    overA__
      {-# INLINE overA #-}

    instance Arrow arr => ArrowOptic A_Lens arr where
      overA :: forall (is :: IxList) s t a b.
    Optic A_Lens is s t a b -> arr a b -> arr s t
    overA = Optic A_Lens is s t a b -> arr a b -> arr s t
    forall (p :: * -> * -> * -> *) (arr :: * -> * -> *) k
           (is :: IxList) s t a b.
    (p ~ WrappedArrow arr, Profunctor p, Constraints k p) =>
    Optic k is s t a b -> arr a b -> arr s t
    overA__
      {-# INLINE overA #-}

    instance ArrowChoice arr => ArrowOptic A_Prism arr where
      overA :: forall (is :: IxList) s t a b.
    Optic A_Prism is s t a b -> arr a b -> arr s t
    overA = Optic A_Prism is s t a b -> arr a b -> arr s t
    forall (p :: * -> * -> * -> *) (arr :: * -> * -> *) k
           (is :: IxList) s t a b.
    (p ~ WrappedArrow arr, Profunctor p, Constraints k p) =>
    Optic k is s t a b -> arr a b -> arr s t
    overA__
      {-# INLINE overA #-}

    instance ArrowChoice arr => ArrowOptic An_AffineTraversal arr where
      overA :: forall (is :: IxList) s t a b.
    Optic An_AffineTraversal is s t a b -> arr a b -> arr s t
    overA = Optic An_AffineTraversal is s t a b -> arr a b -> arr s t
    forall (p :: * -> * -> * -> *) (arr :: * -> * -> *) k
           (is :: IxList) s t a b.
    (p ~ WrappedArrow arr, Profunctor p, Constraints k p) =>
    Optic k is s t a b -> arr a b -> arr s t
    overA__
      {-# INLINE overA #-}

    -- | Run an arrow command and use the output to set all the targets of an optic
    -- to the result.
    --
    -- @
    -- runKleisli action ((), (), ()) where
    --   action =      assignA _1 (Kleisli (const getVal1))
    --            \>>> assignA _2 (Kleisli (const getVal2))
    --            \>>> assignA _3 (Kleisli (const getVal3))
    --   getVal1 :: Either String Int
    --   getVal1 = ...
    --   getVal2 :: Either String Bool
    --   getVal2 = ...
    --   getVal3 :: Either String Char
    --   getVal3 = ...
    -- @
    --
    -- has the type @'Either' 'String' ('Int', 'Bool', 'Char')@
    assignA
      :: (Is k A_Setter, Arrow arr)
      => Optic k is s t a b
      -> arr s b -> arr s t
    assignA :: forall k (arr :: * -> * -> *) (is :: IxList) s t a b.
    (Is k A_Setter, Arrow arr) =>
    Optic k is s t a b -> arr s b -> arr s t
    assignA Optic k is s t a b
    o arr s b
    p = (s -> b -> t) -> arr s (b -> t)
    forall b c. (b -> c) -> arr b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ((b -> s -> t) -> s -> b -> t
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((b -> s -> t) -> s -> b -> t) -> (b -> s -> t) -> s -> b -> t
    forall a b. (a -> b) -> a -> b
    $ Optic k is s t a b -> b -> s -> t
    forall k (is :: IxList) s t a b.
    Is k A_Setter =>
    Optic k is s t a b -> b -> s -> t
    set Optic k is s t a b
    o) arr s (b -> t) -> arr s b -> arr s (b -> t, b)
    forall b c c'. arr b c -> arr b c' -> arr b (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& arr s b
    p arr s (b -> t, b) -> arr (b -> t, b) t -> arr s t
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ((b -> t, b) -> t) -> arr (b -> t, b) t
    forall b c. (b -> c) -> arr b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (((b -> t) -> b -> t) -> (b -> t, b) -> t
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry' (b -> t) -> b -> t
    forall a. a -> a
    id)
    {-# INLINE assignA #-}

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

    -- | Internal implementation of overA.
    overA__
      :: (p ~ WrappedArrow arr, Profunctor p, Constraints k p)
      => Optic k is s t a b
      -> arr a b -> arr s t
    overA__ :: forall (p :: * -> * -> * -> *) (arr :: * -> * -> *) k
           (is :: IxList) s t a b.
    (p ~ WrappedArrow arr, Profunctor p, Constraints k p) =>
    Optic k is s t a b -> arr a b -> arr s t
    overA__ Optic k is s t a b
    o = WrappedArrow arr (Curry is (ZonkAny 0)) s t -> arr s t
    forall (p :: * -> * -> *) i a b. WrappedArrow p i a b -> p a b
    unwrapArrow (WrappedArrow arr (Curry is (ZonkAny 0)) s t -> arr s t)
    -> (WrappedArrow arr (ZonkAny 0) a b
        -> WrappedArrow arr (Curry is (ZonkAny 0)) s t)
    -> WrappedArrow arr (ZonkAny 0) a b
    -> arr s t
    forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
    #. Optic k is s t a b
    -> Optic_
         k (WrappedArrow arr) (ZonkAny 0) (Curry is (ZonkAny 0)) s t a b
    forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i.
    Profunctor p =>
    Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b
    getOptic Optic k is s t a b
    o (WrappedArrow arr (ZonkAny 0) a b -> arr s t)
    -> (arr a b -> WrappedArrow arr (ZonkAny 0) a b)
    -> arr a b
    -> arr s t
    forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
    .# arr a b -> WrappedArrow arr (ZonkAny 0) a b
    forall (p :: * -> * -> *) i a b. p a b -> WrappedArrow p i a b
    WrapArrow
    {-# INLINE overA__ #-}