{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingVia #-}

-- |
-- Module      : Data.Functor.Invariant.Internative
-- Copyright   : (c) Justin Le 2021
-- License     : BSD3
--
-- Maintainer  : [email protected]
-- Stability   : experimental
-- Portability : non-portable
--
-- Contains the classes 'Inalt' and 'Inplus', the invariant
-- counterparts to 'Alt'/'Plus' and 'Decide'/'Conclude' and
-- 'Alternative'/'Decidable'.
--
-- @since 0.4.0.0
module Data.Functor.Invariant.Internative (
  -- * Typeclass
  Inalt (..),
  Inplus (..),
  Internative,

  -- * Assembling Helpers
  swervedN,
  swervedNMap,
  swervedN1,
  swervedN1Map,
) where

import Control.Applicative
import Control.Applicative.Backwards (Backwards (..))
import Control.Arrow (ArrowPlus)
import Control.Monad
import Control.Monad.Trans.Identity (IdentityT (..))
import Data.Functor.Alt
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Conclude
import Data.Functor.Contravariant.Decide
import Data.Functor.Contravariant.Divise
import Data.Functor.Contravariant.Divisible
import Data.Functor.Invariant
import Data.Functor.Invariant.Inplicative
import Data.Functor.Plus
import Data.Functor.Product (Product (..))
import Data.Functor.Reverse (Reverse (..))
import qualified Data.HashMap.Lazy as HM
import Data.Hashable (Hashable)
import qualified Data.IntMap as IM
import qualified Data.IntMap.NonEmpty as NEIM
import Data.Kind
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map as M
import qualified Data.Map.NonEmpty as NEM
import qualified Data.Monoid as Monoid
import Data.SOP hiding (hmap)
import qualified Data.Semigroup as Semigroup
import Data.Sequence (Seq)
import qualified Data.Sequence.NonEmpty as NESeq
import Data.StateVar (SettableStateVar)
import Data.Void
import qualified GHC.Generics as Generics

-- | The invariant counterpart of 'Alt' and 'Decide'.
--
-- Conceptually you can think of 'Alt' as, given a way to "inject" @a@ and
-- @b@ as @c@, lets you merge @f a@ (producer of @a@) and @f b@ (producer
-- of @b@) into a @f c@ (producer of @c@), in an "either-or" fashion.
-- 'Decide' can be thought of as, given a way to "discriminate" a @c@ as
-- either a @a@ or a @b@, lets you merge @f a@ (consumer of @a@) and @f b@
-- (consumder of @b@) into a @f c@ (consumer of @c@) in an "either-or"
-- forking fashion (split the @c@ into @a@ or @b@, and use the appropriate
-- handler).
--
-- 'Inalt', for 'swerve', requires both an injecting function and
-- a choosing function in order to merge @f b@ (producer and consumer of
-- @b@) and @f c@ (producer and consumer of @c@) into a @f a@ in an
-- either-or manner.  You can think of it as, for the @f a@, it "chooses"
-- if the @a@ is actually a @b@ or a @c@ with the @a -> 'Either' b c@,
-- feeds it to either the original @f b@ or the original @f c@, and then
-- re-injects the output back into a @a@ with the @b -> a@ or the @c -> a@.
--
-- @since 0.4.0.0
class Invariant f => Inalt f where
  -- | Like '<!>', 'decide', or 'choose', but requires both
  -- an injecting and a choosing function.
  --
  -- It is used to merge @f b@ (producer and consumer of @b@) and @f c@
  -- (producer and consumer of @c@) into a @f a@ in an either-or manner.
  -- You can think of it as, for the @f a@, it "chooses" if the @a@ is
  -- actually a @b@ or a @c@ with the @a -> 'Either' b c@, feeds it to
  -- either the original @f b@ or the original @f c@, and then re-injects
  -- the output back into a @a@ with the @b -> a@ or the @c -> a@.
  --
  -- An important property is that it will only ever use exactly @one@ of
  -- the options given in order to fulfil its job.  If you swerve an @f
  -- a@ and an @f b@ into an @f c@, in order to consume/produdce the @c@,
  -- it will only use either the @f a@ or the @f b@ -- exactly one of
  -- them.
  --
  -- @since 0.4.0.0
  swerve ::
    (b -> a) ->
    (c -> a) ->
    (a -> Either b c) ->
    f b ->
    f c ->
    f a
  swerve b -> a
f c -> a
g a -> Either b c
h f b
x f c
y = (Either b c -> a) -> (a -> Either b c) -> f (Either b c) -> f a
forall a b. (a -> b) -> (b -> a) -> f a -> f b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap ((b -> a) -> (c -> a) -> Either b c -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> a
f c -> a
g) a -> Either b c
h (f b -> f c -> f (Either b c)
forall a b. f a -> f b -> f (Either a b)
forall (f :: * -> *) a b. Inalt f => f a -> f b -> f (Either a b)
swerved f b
x f c
y)

  -- | A simplified version of 'swerive' that splits to and from an
  -- 'Either'. You can then use 'invmap' to reshape it into the proper
  -- shape.
  --
  -- @since 0.4.0.0
  swerved ::
    f a ->
    f b ->
    f (Either a b)
  swerved = (a -> Either a b)
-> (b -> Either a b)
-> (Either a b -> Either a b)
-> f a
-> f b
-> f (Either a b)
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve a -> Either a b
forall a b. a -> Either a b
Left b -> Either a b
forall a b. b -> Either a b
Right Either a b -> Either a b
forall a. a -> a
id

  {-# MINIMAL swerve | swerved #-}

-- | The invariant counterpart of 'Alt' and 'Conclude'.
--
-- The main important action is described in 'Inalt', but this adds 'reject',
-- which is the counterpart to 'empty' and 'conclude' and 'conquer'.  It's the identity to
-- 'swerve'; if combine two @f a@s with 'swerve', and one of them is
-- 'reject', then that banch will never be taken.
--
-- Conceptually, if you think of 'swerve' as "choosing one path and
-- re-injecting back", then 'reject' introduces a branch that is impossible
-- to take.

-- @since 0.4.0.0
class Inalt f => Inplus f where
  reject :: (a -> Void) -> f a

-- | The invariant counterpart to 'Alternative' and 'Decidable': represents
-- a combination of both 'Applicative' and 'Alt', or 'Divisible' and
-- 'Conclude'.  There are laws?

-- @since 0.4.0.0
class (Inplus f, Inplicative f) => Internative f

-- | Ignores the contravariant part of 'swerve'
instance Alt f => Inalt (WrappedFunctor f) where
  swerved :: forall a b.
WrappedFunctor f a
-> WrappedFunctor f b -> WrappedFunctor f (Either a b)
swerved (WrapFunctor f a
x) (WrapFunctor f b
y) =
    f (Either a b) -> WrappedFunctor f (Either a b)
forall {k} (f :: k -> *) (a :: k). f a -> WrappedFunctor f a
WrapFunctor (f (Either a b) -> WrappedFunctor f (Either a b))
-> f (Either a b) -> WrappedFunctor f (Either a b)
forall a b. (a -> b) -> a -> b
$
      (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> f a -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x) f (Either a b) -> f (Either a b) -> f (Either a b)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> f b -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
y)

-- | @'reject' _ = 'zero'@
instance Plus f => Inplus (WrappedFunctor f) where
  reject :: forall a. (a -> Void) -> WrappedFunctor f a
reject a -> Void
_ = f a -> WrappedFunctor f a
forall {k} (f :: k -> *) (a :: k). f a -> WrappedFunctor f a
WrapFunctor f a
forall a. f a
forall (f :: * -> *) a. Plus f => f a
zero

instance (Alternative f, Plus f, Apply f) => Internative (WrappedFunctor f)

-- | Ignores the covariant part of 'gather'
instance Decide f => Inalt (WrappedContravariant f) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> WrappedContravariant f b
-> WrappedContravariant f c
-> WrappedContravariant f a
swerve b -> a
_ c -> a
_ a -> Either b c
h (WrapContravariant f b
x) (WrapContravariant f c
y) = f a -> WrappedContravariant f a
forall {k} (f :: k -> *) (a :: k). f a -> WrappedContravariant f a
WrapContravariant ((a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
h f b
x f c
y)

-- | @'reject' = 'conclude'@
instance Conclude f => Inplus (WrappedContravariant f) where
  reject :: forall a. (a -> Void) -> WrappedContravariant f a
reject a -> Void
f = f a -> WrappedContravariant f a
forall {k} (f :: k -> *) (a :: k). f a -> WrappedContravariant f a
WrapContravariant ((a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f)

instance (Conclude f, Divisible f, Divise f) => Internative (WrappedContravariant f)

-- | Ignores the covariant part of 'gather'
instance Decide f => Inalt (WrappedDivisible f) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> WrappedDivisible f b
-> WrappedDivisible f c
-> WrappedDivisible f a
swerve b -> a
_ c -> a
_ a -> Either b c
h (WrapDivisible f b
x) (WrapDivisible f c
y) = f a -> WrappedDivisible f a
forall {k} (f :: k -> *) (a :: k). f a -> WrappedDivisible f a
WrapDivisible ((a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide a -> Either b c
h f b
x f c
y)

-- | @'reject' = 'conclude'@
instance Conclude f => Inplus (WrappedDivisible f) where
  reject :: forall a. (a -> Void) -> WrappedDivisible f a
reject a -> Void
f = f a -> WrappedDivisible f a
forall {k} (f :: k -> *) (a :: k). f a -> WrappedDivisible f a
WrapDivisible ((a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f)

instance (Conclude f, Divisible f, Divise f) => Internative (WrappedDivisible f)

-- | Ignores the covariant part of 'gather'
instance (Decidable f, Invariant f) => Inalt (WrappedDivisibleOnly f) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> WrappedDivisibleOnly f b
-> WrappedDivisibleOnly f c
-> WrappedDivisibleOnly f a
swerve b -> a
_ c -> a
_ a -> Either b c
h (WrapDivisibleOnly f b
x) (WrapDivisibleOnly f c
y) = f a -> WrappedDivisibleOnly f a
forall {k} (f :: k -> *) (a :: k). f a -> WrappedDivisibleOnly f a
WrapDivisibleOnly ((a -> Either b c) -> f b -> f c -> f a
forall a b c. (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose a -> Either b c
h f b
x f c
y)

-- | @'reject' = 'lose'@
instance (Decidable f, Invariant f) => Inplus (WrappedDivisibleOnly f) where
  reject :: forall a. (a -> Void) -> WrappedDivisibleOnly f a
reject a -> Void
f = f a -> WrappedDivisibleOnly f a
forall {k} (f :: k -> *) (a :: k). f a -> WrappedDivisibleOnly f a
WrapDivisibleOnly ((a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f)

instance (Decidable f, Invariant f) => Internative (WrappedDivisibleOnly f)

-- | @since 0.4.1.0
deriving via WrappedFunctor (Proxy :: Type -> Type) instance Inalt Proxy

-- | @since 0.4.1.0
deriving via WrappedFunctor (Proxy :: Type -> Type) instance Inplus Proxy

-- | @since 0.4.1.0
deriving via WrappedFunctor (Proxy :: Type -> Type) instance Internative Proxy

-- | @since 0.4.1.0
deriving via WrappedFunctor [] instance Inalt []

-- | @since 0.4.1.0
deriving via WrappedFunctor [] instance Inplus []

-- | @since 0.4.1.0
deriving via WrappedFunctor [] instance Internative []

-- | @since 0.4.1.0
deriving via WrappedFunctor Maybe instance Inalt Maybe

-- | @since 0.4.1.0
deriving via WrappedFunctor Maybe instance Inplus Maybe

-- | @since 0.4.1.0
deriving via WrappedFunctor Maybe instance Internative Maybe

-- | @since 0.4.1.0
deriving via WrappedFunctor (Either e) instance Inalt (Either e)

-- | @since 0.4.1.0
deriving via WrappedFunctor IO instance Inalt IO

-- | @since 0.4.1.0
deriving via WrappedFunctor IO instance Inplus IO

-- | @since 0.4.1.0
deriving via WrappedFunctor IO instance Internative IO

-- | @since 0.4.1.0
deriving via WrappedFunctor (Generics.U1 :: Type -> Type) instance Inalt Generics.U1

-- | @since 0.4.1.0
deriving via WrappedFunctor (Generics.U1 :: Type -> Type) instance Inplus Generics.U1

-- | @since 0.4.1.0
deriving via WrappedFunctor (Generics.U1 :: Type -> Type) instance Internative Generics.U1

-- | @since 0.4.1.0
instance Inalt f => Inalt (Generics.M1 i t f) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> M1 i t f b
-> M1 i t f c
-> M1 i t f a
swerve b -> a
f c -> a
g a -> Either b c
h (Generics.M1 f b
x) (Generics.M1 f c
y) = f a -> M1 i t f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Generics.M1 ((b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve b -> a
f c -> a
g a -> Either b c
h f b
x f c
y)

-- | @since 0.4.1.0
instance Inplus f => Inplus (Generics.M1 i t f) where
  reject :: forall a. (a -> Void) -> M1 i t f a
reject = f a -> M1 i t f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Generics.M1 (f a -> M1 i t f a)
-> ((a -> Void) -> f a) -> (a -> Void) -> M1 i t f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject

-- | @since 0.4.1.0
instance Internative f => Internative (Generics.M1 i t f)

-- | @since 0.4.1.0
instance (Inalt f, Inalt g) => Inalt (f Generics.:*: g) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> (:*:) f g b
-> (:*:) f g c
-> (:*:) f g a
swerve b -> a
f c -> a
g a -> Either b c
h (f b
x1 Generics.:*: g b
y1) (f c
x2 Generics.:*: g c
y2) =
    (b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve b -> a
f c -> a
g a -> Either b c
h f b
x1 f c
x2 f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
Generics.:*: (b -> a) -> (c -> a) -> (a -> Either b c) -> g b -> g c -> g a
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> g b -> g c -> g a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve b -> a
f c -> a
g a -> Either b c
h g b
y1 g c
y2

-- | @since 0.4.1.0
instance (Inplus f, Inplus g) => Inplus (f Generics.:*: g) where
  reject :: forall a. (a -> Void) -> (:*:) f g a
reject a -> Void
f = (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject a -> Void
f f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
Generics.:*: (a -> Void) -> g a
forall a. (a -> Void) -> g a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject a -> Void
f

-- | @since 0.4.1.0
instance (Internative f, Internative g) => Internative (f Generics.:*: g)

-- | @since 0.4.1.0
instance (Inalt f, Inalt g) => Inalt (Product f g) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> Product f g b
-> Product f g c
-> Product f g a
swerve b -> a
f c -> a
g a -> Either b c
h (Pair f b
x1 g b
y1) (Pair f c
x2 g c
y2) =
    (b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve b -> a
f c -> a
g a -> Either b c
h f b
x1 f c
x2 f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
`Pair` (b -> a) -> (c -> a) -> (a -> Either b c) -> g b -> g c -> g a
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> g b -> g c -> g a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve b -> a
f c -> a
g a -> Either b c
h g b
y1 g c
y2

-- | @since 0.4.1.0
instance (Inplus f, Inplus g) => Inplus (Product f g) where
  reject :: forall a. (a -> Void) -> Product f g a
reject a -> Void
f = (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject a -> Void
f f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
`Pair` (a -> Void) -> g a
forall a. (a -> Void) -> g a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject a -> Void
f

-- | @since 0.4.1.0
instance (Internative f, Internative g) => Internative (Product f g)

-- | @since 0.4.1.0
instance Inalt f => Inalt (Generics.Rec1 f) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> Rec1 f b
-> Rec1 f c
-> Rec1 f a
swerve b -> a
f c -> a
g a -> Either b c
h (Generics.Rec1 f b
x) (Generics.Rec1 f c
y) = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Generics.Rec1 ((b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve b -> a
f c -> a
g a -> Either b c
h f b
x f c
y)

-- | @since 0.4.1.0
instance Inplus f => Inplus (Generics.Rec1 f) where
  reject :: forall a. (a -> Void) -> Rec1 f a
reject = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Generics.Rec1 (f a -> Rec1 f a)
-> ((a -> Void) -> f a) -> (a -> Void) -> Rec1 f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject

-- | @since 0.4.1.0
instance Internative f => Internative (Generics.Rec1 f)

-- | @since 0.4.1.0
instance Inalt f => Inalt (IdentityT f) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> IdentityT f b
-> IdentityT f c
-> IdentityT f a
swerve b -> a
f c -> a
g a -> Either b c
h (IdentityT f b
x) (IdentityT f c
y) = f a -> IdentityT f a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT ((b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve b -> a
f c -> a
g a -> Either b c
h f b
x f c
y)

-- | @since 0.4.1.0
instance Inplus f => Inplus (IdentityT f) where
  reject :: forall a. (a -> Void) -> IdentityT f a
reject = f a -> IdentityT f a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (f a -> IdentityT f a)
-> ((a -> Void) -> f a) -> (a -> Void) -> IdentityT f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject

-- | @since 0.4.1.0
instance Internative f => Internative (IdentityT f)

-- | @since 0.4.1.0
instance Inalt f => Inalt (Reverse f) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> Reverse f b
-> Reverse f c
-> Reverse f a
swerve b -> a
f c -> a
g a -> Either b c
h (Reverse f b
x) (Reverse f c
y) = f a -> Reverse f a
forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse ((b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve b -> a
f c -> a
g a -> Either b c
h f b
x f c
y)

-- | @since 0.4.1.0
instance Inplus f => Inplus (Reverse f) where
  reject :: forall a. (a -> Void) -> Reverse f a
reject = f a -> Reverse f a
forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f a -> Reverse f a)
-> ((a -> Void) -> f a) -> (a -> Void) -> Reverse f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject

-- | @since 0.4.1.0
instance Internative f => Internative (Reverse f)

-- | @since 0.4.1.0
instance Inalt f => Inalt (Backwards f) where
  swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> Backwards f b
-> Backwards f c
-> Backwards f a
swerve b -> a
f c -> a
g a -> Either b c
h (Backwards f b
x) (Backwards f c
y) = f a -> Backwards f a
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards ((b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve b -> a
f c -> a
g a -> Either b c
h f b
x f c
y)

-- | @since 0.4.1.0
instance Inplus f => Inplus (Backwards f) where
  reject :: forall a. (a -> Void) -> Backwards f a
reject = f a -> Backwards f a
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f a -> Backwards f a)
-> ((a -> Void) -> f a) -> (a -> Void) -> Backwards f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> f a
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject

-- | @since 0.4.1.0
instance Internative f => Internative (Backwards f)

-- | @since 0.4.1.0
deriving via WrappedFunctor Semigroup.First instance Inalt Semigroup.First

-- | @since 0.4.1.0
deriving via WrappedFunctor Semigroup.Last instance Inalt Semigroup.Last

#if !MIN_VERSION_base(4,16,0)
-- | @since 0.4.1.0
deriving via WrappedFunctor Semigroup.Option instance Inalt Semigroup.Option
-- | @since 0.4.1.0
deriving via WrappedFunctor Semigroup.Option instance Inplus Semigroup.Option
-- | @since 0.4.1.0
deriving via WrappedFunctor Semigroup.Option instance Internative Semigroup.Option
#endif

-- | @since 0.4.1.0
deriving via WrappedFunctor Monoid.First instance Inalt Monoid.First

-- | @since 0.4.1.0
deriving via WrappedFunctor Monoid.First instance Inplus Monoid.First

-- | @since 0.4.1.0
deriving via WrappedFunctor Monoid.First instance Internative Monoid.First

-- | @since 0.4.1.0
deriving via WrappedFunctor Monoid.Last instance Inalt Monoid.Last

-- | @since 0.4.1.0
deriving via WrappedFunctor Monoid.Last instance Inplus Monoid.Last

-- | @since 0.4.1.0
deriving via WrappedFunctor Monoid.Last instance Internative Monoid.Last

-- | @since 0.4.1.0
deriving via WrappedFunctor NonEmpty instance Inalt NonEmpty

-- | @since 0.4.1.0
deriving via WrappedFunctor Seq instance Inalt Seq

-- | @since 0.4.1.0
deriving via WrappedFunctor Seq instance Inplus Seq

-- | @since 0.4.1.0
deriving via WrappedFunctor Seq instance Internative Seq

-- | @since 0.4.1.0
deriving via WrappedFunctor NESeq.NESeq instance Inalt NESeq.NESeq

-- | @since 0.4.1.0
deriving via WrappedFunctor (WrappedArrow a b) instance ArrowPlus a => Inalt (WrappedArrow a b)

-- | @since 0.4.1.0
deriving via WrappedFunctor (WrappedArrow a b) instance ArrowPlus a => Inplus (WrappedArrow a b)

-- | @since 0.4.1.0
deriving via
  WrappedFunctor (WrappedArrow a b)
  instance
    ArrowPlus a => Internative (WrappedArrow a b)

-- | @since 0.4.1.0
deriving via WrappedFunctor (Generics.V1 :: Type -> Type) instance Inalt Generics.V1

-- | @since 0.4.1.0
deriving via WrappedFunctor IM.IntMap instance Inalt IM.IntMap

-- | @since 0.4.1.0
deriving via WrappedFunctor NEIM.NEIntMap instance Inalt NEIM.NEIntMap

-- | @since 0.4.1.0
deriving via WrappedFunctor (M.Map k) instance Ord k => Inalt (M.Map k)

-- | @since 0.4.1.0
deriving via WrappedFunctor (NEM.NEMap k) instance Ord k => Inalt (NEM.NEMap k)

#if MIN_VERSION_base(4,16,0)
-- | Does not require Eq k since base-4.16
--
-- @since 0.4.1.0
deriving via WrappedFunctor (HM.HashMap k) instance Hashable k => Inalt (HM.HashMap k)
#else
deriving via WrappedFunctor (HM.HashMap k) instance (Hashable k, Eq k) => Inalt (HM.HashMap k)
#endif

-- | @since 0.4.1.0
deriving via WrappedFunctor (WrappedMonad m) instance MonadPlus m => Inalt (WrappedMonad m)

-- | @since 0.4.1.0
deriving via WrappedFunctor (WrappedMonad m) instance MonadPlus m => Inplus (WrappedMonad m)

-- | @since 0.4.1.0
deriving via WrappedFunctor (WrappedMonad m) instance MonadPlus m => Internative (WrappedMonad m)

-- | @since 0.4.1.0
deriving via WrappedDivisible SettableStateVar instance Inalt SettableStateVar

-- | @since 0.4.1.0
deriving via WrappedDivisible SettableStateVar instance Inplus SettableStateVar

-- | @since 0.4.1.0
deriving via WrappedDivisible SettableStateVar instance Internative SettableStateVar

-- | @since 0.4.1.0
deriving via WrappedDivisible Predicate instance Inalt Predicate

-- | @since 0.4.1.0
deriving via WrappedDivisible Predicate instance Inplus Predicate

-- | @since 0.4.1.0
deriving via WrappedDivisible Predicate instance Internative Predicate

-- | @since 0.4.1.0
deriving via WrappedDivisible Comparison instance Inalt Comparison

-- | @since 0.4.1.0
deriving via WrappedDivisible Comparison instance Inplus Comparison

-- | @since 0.4.1.0
deriving via WrappedDivisible Comparison instance Internative Comparison

-- | @since 0.4.1.0
deriving via WrappedDivisible Equivalence instance Inalt Equivalence

-- | @since 0.4.1.0
deriving via WrappedDivisible Equivalence instance Inplus Equivalence

-- | @since 0.4.1.0
deriving via WrappedDivisible Equivalence instance Internative Equivalence

-- | @since 0.4.1.0
deriving via WrappedDivisible (Op r) instance Inalt (Op r)

-- | @since 0.4.1.0
deriving via WrappedDivisible (Op r) instance Inplus (Op r)

-- | @since 0.4.1.0
deriving via WrappedDivisible (Op r) instance Monoid r => Internative (Op r)

-- | Convenient wrapper to build up an 'Inplus' instance on by providing
-- each branch of it.  This makes it much easier to build up longer chains
-- because you would only need to write the splitting/joining functions in
-- one place.
--
-- For example, if you had a data type
--
-- @
-- data MyType = MTI Int | MTB Bool | MTS String
-- @
--
-- and an invariant functor and 'Inplus' instance @Prim@ (representing, say,
-- a bidirectional parser, where @Prim Int@ is a bidirectional parser for
-- an 'Int'@), then you could assemble a bidirectional parser for
-- a @MyType@ using:
--
-- @
-- invmap (\case MTI x -> Z (I x); MTB y -> S (Z (I y)); MTS z -> S (S (Z (I z))))
--        (\case Z (I x) -> MTI x; S (Z (I y)) -> MTB y; S (S (Z (I z))) -> MTS z) $
--   swervedN $ intPrim
--               :* boolPrim
--               :* stringPrim
--               :* Nil
-- @
--
-- Some notes on usefulness depending on how many components you have:
--
-- *    If you have 0 components, use 'reject' directly.
-- *    If you have 1 component, use 'inject' directly.
-- *    If you have 2 components, use 'swerve' directly.
-- *    If you have 3 or more components, these combinators may be useful;
--      otherwise you'd need to manually peel off eithers one-by-one.
--
-- @since 0.4.1.0
swervedN ::
  Inplus f =>
  NP f as ->
  f (NS I as)
swervedN :: forall (f :: * -> *) (as :: [*]).
Inplus f =>
NP f as -> f (NS I as)
swervedN = \case
  NP f as
Nil -> (NS I as -> Void) -> f (NS I as)
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject ((NS I as -> Void) -> f (NS I as))
-> (NS I as -> Void) -> f (NS I as)
forall a b. (a -> b) -> a -> b
$ \case {}
  f x
x :* NP f xs
xs ->
    (x -> NS I as)
-> (NS I xs -> NS I as)
-> (NS I as -> Either x (NS I xs))
-> f x
-> f (NS I xs)
-> f (NS I as)
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve
      (I x -> NS I as
I x -> NS I (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (I x -> NS I as) -> (x -> I x) -> x -> NS I as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> I x
forall a. a -> I a
I)
      NS I xs -> NS I as
NS I xs -> NS I (x : xs)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S
      (\case Z (I x
y) -> x -> Either x (NS I xs)
forall a b. a -> Either a b
Left x
x
y; S NS I xs
ys -> NS I xs -> Either x (NS I xs)
forall a b. b -> Either a b
Right NS I xs
NS I xs
ys)
      f x
x
      (NP f xs -> f (NS I xs)
forall (f :: * -> *) (as :: [*]).
Inplus f =>
NP f as -> f (NS I as)
swervedN NP f xs
xs)

-- | Given a function to "discern out" a data type into possible 'NS'
-- (multi-way Either) branches and one to re-assemble each brann, 'swerve'
-- all of the components together.
--
-- For example, if you had a data type
--
-- @
-- data MyType = MTI Int | MTB Bool | MTS String
-- @
--
-- and an invariant functor and 'Inplus' instance @Prim@ (representing, say,
-- a bidirectional parser, where @Prim Int@ is a bidirectional parser for
-- an 'Int'@), then you could assemble a bidirectional parser for
-- a @MyType@ using:
--
-- @
-- swervedNMap
--      (\case MTI x -> Z (I x); MTB y -> S (Z (I y)); MTS z -> S (S (Z (I z))))
--      (\case Z (I x) -> MTI x; S (Z (I y)) -> MTB y; S (S (Z (I z))) -> MTS z) $
--      $ intPrim
--     :* boolPrim
--     :* stringPrim
--     :* Nil
-- @
--
-- Some notes on usefulness depending on how many components you have:
--
-- *    If you have 0 components, use 'reject' directly.
-- *    If you have 1 component, you don't need anything.
-- *    If you have 2 components, use 'swerve' directly.
-- *    If you have 3 or more components, these combinators may be useful;
--      otherwise you'd need to manually peel off eithers one-by-one.
--
-- See notes on 'swervedNMap' for more details and caveats.
--
-- @since 0.4.1.0
swervedNMap ::
  Inplus f =>
  (NS I as -> b) ->
  (b -> NS I as) ->
  NP f as ->
  f b
swervedNMap :: forall (f :: * -> *) (as :: [*]) b.
Inplus f =>
(NS I as -> b) -> (b -> NS I as) -> NP f as -> f b
swervedNMap NS I as -> b
f b -> NS I as
g = (NS I as -> b) -> (b -> NS I as) -> f (NS I as) -> f b
forall a b. (a -> b) -> (b -> a) -> f a -> f b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap NS I as -> b
f b -> NS I as
g (f (NS I as) -> f b) -> (NP f as -> f (NS I as)) -> NP f as -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP f as -> f (NS I as)
forall (f :: * -> *) (as :: [*]).
Inplus f =>
NP f as -> f (NS I as)
swervedN

-- | A version of 'swervedN' for non-empty 'NP', but only
-- requiring an 'Inalt' instance.
--
-- @since 0.4.1.0
swervedN1 ::
  Inalt f =>
  NP f (a ': as) ->
  f (NS I (a ': as))
swervedN1 :: forall (f :: * -> *) a (as :: [*]).
Inalt f =>
NP f (a : as) -> f (NS I (a : as))
swervedN1 (f x
x :* NP f xs
xs) = case NP f xs
xs of
  NP f xs
Nil -> (a -> NS I (a : as))
-> (NS I (a : as) -> a) -> f a -> f (NS I (a : as))
forall a b. (a -> b) -> (b -> a) -> f a -> f b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap (I a -> NS I (a : as)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (I a -> NS I (a : as)) -> (a -> I a) -> a -> NS I (a : as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> I a
forall a. a -> I a
I) (\case Z (I x
y) -> a
x
y; S NS I xs
ys -> case NS I xs
ys of {}) f a
f x
x
  f x
_ :* NP f xs
_ ->
    (a -> NS I (a : as))
-> (NS I as -> NS I (a : as))
-> (NS I (a : as) -> Either a (NS I as))
-> f a
-> f (NS I as)
-> f (NS I (a : as))
forall b a c.
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve
      (I a -> NS I (a : as)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (I a -> NS I (a : as)) -> (a -> I a) -> a -> NS I (a : as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> I a
forall a. a -> I a
I)
      NS I as -> NS I (a : as)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S
      (\case Z (I x
y) -> a -> Either a (NS I as)
forall a b. a -> Either a b
Left a
x
y; S NS I xs
ys -> NS I as -> Either a (NS I as)
forall a b. b -> Either a b
Right NS I as
NS I xs
ys)
      f a
f x
x
      (NP f (x : xs) -> f (NS I (x : xs))
forall (f :: * -> *) a (as :: [*]).
Inalt f =>
NP f (a : as) -> f (NS I (a : as))
swervedN1 NP f xs
NP f (x : xs)
xs)

-- | A version of 'swervedNMap' for non-empty 'NS', but only
-- requiring an 'Inalt' instance.
--
-- @since 0.4.1.0
swervedN1Map ::
  Inalt f =>
  (NS I (a ': as) -> b) ->
  (b -> NS I (a ': as)) ->
  NP f (a ': as) ->
  f b
swervedN1Map :: forall (f :: * -> *) a (as :: [*]) b.
Inalt f =>
(NS I (a : as) -> b)
-> (b -> NS I (a : as)) -> NP f (a : as) -> f b
swervedN1Map NS I (a : as) -> b
f b -> NS I (a : as)
g = (NS I (a : as) -> b)
-> (b -> NS I (a : as)) -> f (NS I (a : as)) -> f b
forall a b. (a -> b) -> (b -> a) -> f a -> f b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap NS I (a : as) -> b
f b -> NS I (a : as)
g (f (NS I (a : as)) -> f b)
-> (NP f (a : as) -> f (NS I (a : as))) -> NP f (a : as) -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP f (a : as) -> f (NS I (a : as))
forall (f :: * -> *) a (as :: [*]).
Inalt f =>
NP f (a : as) -> f (NS I (a : as))
swervedN1