    {-# LANGUAGE CPP           #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE Safe #-}

    -----------------------------------------------------------------------------
    -- |
    -- Copyright   :  (C) 2021 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- This module is only available if building with GHC 8.6 or later, or if the
    -- @+contravariant@ @cabal@ build flag is available.
    ----------------------------------------------------------------------------
    module Data.Functor.Contravariant.Conclude (
        Conclude(..)
      , gconclude
      , concluded
      , gconcluded
      ) where

    import Control.Applicative.Backwards
    import Control.Monad.Trans.Identity
    import qualified Control.Monad.Trans.RWS.Lazy as Lazy
    import qualified Control.Monad.Trans.RWS.Strict as Strict
    import Control.Monad.Trans.Reader
    import qualified Control.Monad.Trans.State.Lazy as Lazy
    import qualified Control.Monad.Trans.State.Strict as Strict
    import qualified Control.Monad.Trans.Writer.Lazy as Lazy
    import qualified Control.Monad.Trans.Writer.Strict as Strict

    import Data.Functor.Apply
    import Data.Functor.Compose
    import Data.Functor.Contravariant
    import Data.Functor.Contravariant.Decide
    import Data.Functor.Product
    import Data.Functor.Reverse
    import Data.Monoid (Alt(..))
    import Data.Proxy
    import Data.Void
    import GHC.Generics

    #if defined(MIN_VERSION_contravariant)
    # if !(MIN_VERSION_transformers(0,6,0))
    import Control.Monad.Trans.List
    # endif
    import Control.Monad.Trans.Maybe
    import Data.Functor.Contravariant.Divise
    import Data.Functor.Contravariant.Divisible
    #endif

    #ifdef MIN_VERSION_StateVar
    import Data.StateVar
    #endif

    -- | The contravariant analogue of 'Plus'.  Adds on to 'Decide' the ability
    -- to express a combinator that rejects all input, to act as the dead-end.
    -- Essentially 'Decidable' without a superclass constraint on 'Divisible'.
    --
    -- If one thinks of @f a@ as a consumer of @a@s, then 'conclude' defines
    -- a consumer that cannot ever receive /any/ input.
    --
    -- Conclude acts as an identity with 'decide', because any decision that
    -- involves 'conclude' must necessarily /always/ pick the other option.
    --
    -- That is, for, say,
    --
    -- @
    -- 'decide' f x 'concluded'
    -- @
    --
    -- @f@ is the deciding function that picks which of the inputs of @decide@
    -- to direct input to; in the situation above, @f@ must /always/ direct all
    -- input to @x@, and never 'concluded'.
    --
    -- Mathematically, a functor being an instance of 'Decide' means that it is
    -- \"monoidal\" with respect to the contravariant "either-based" Day
    -- convolution described in the documentation of 'Decide'.  On top of
    -- 'Decide', it adds a way to construct an \"identity\" @conclude@ where
    -- @decide f x (conclude q) == x@, and @decide g (conclude r) y == y@.
    --
    -- @since 5.3.6
    class Decide f => Conclude f where
        -- | The consumer that cannot ever receive /any/ input.
        conclude :: (a -> Void) -> f a

    -- | Generic 'conclude'. Caveats:
    --
    --   1. Will not compile if @f@ is a sum type.
    --   2. Will not compile if @f@ contains fields that do not mention its type variable.
    --
    -- @since 5.3.8
    gconclude :: (Generic1 f, Conclude (Rep1 f)) => (a -> Void) -> f a
    gconclude :: forall (f :: * -> *) a.
    (Generic1 f, Conclude (Rep1 f)) =>
    (a -> Void) -> f a
    gconclude a -> Void
    f = Rep1 f a -> f a
    forall a. Rep1 f a -> f a
    forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
    to1 (Rep1 f a -> f a) -> Rep1 f a -> f a
    forall a b. (a -> b) -> a -> b
    $ (a -> Void) -> Rep1 f a
    forall a. (a -> Void) -> Rep1 f a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f

    -- | A potentially more meaningful form of 'conclude', the consumer that cannot
    -- ever receive /any/ input.  That is because it expects only input of type
    -- 'Void', but such a type has no values.
    --
    -- @
    -- 'concluded' = 'conclude' 'id'
    -- @
    --
    -- @since 5.3.6
    concluded :: Conclude f => f Void
    concluded :: forall (f :: * -> *). Conclude f => f Void
    concluded = (Void -> Void) -> f Void
    forall a. (a -> Void) -> f a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude Void -> Void
    forall a. a -> a
    id

    -- | Generic 'concluded'. Caveats are the same as for 'gconclude'.
    --
    -- @since 5.3.8
    gconcluded :: (Generic1 f, Conclude (Rep1 f)) => f Void
    gconcluded :: forall (f :: * -> *). (Generic1 f, Conclude (Rep1 f)) => f Void
    gconcluded = Rep1 f Void -> f Void
    forall a. Rep1 f a -> f a
    forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
    to1 Rep1 f Void
    forall (f :: * -> *). Conclude f => f Void
    concluded

    #if defined(MIN_VERSION_contravariant)
    -- | This instance is only available if the @+contravariant@ @cabal@ flag is
    -- enabled.
    --
    -- @since 5.3.6
    instance Decidable f => Conclude (WrappedDivisible f) where
        conclude :: forall a. (a -> Void) -> WrappedDivisible f a
    conclude a -> Void
    f = f a -> WrappedDivisible f a
    forall (f :: * -> *) a. f a -> WrappedDivisible f a
    WrapDivisible ((a -> Void) -> f a
    forall a. (a -> Void) -> f a
    forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
    lose a -> Void
    f)
    #endif

    -- | @since 5.3.6
    instance Conclude Comparison where
      conclude :: forall a. (a -> Void) -> Comparison a
    conclude a -> Void
    f = (a -> a -> Ordering) -> Comparison a
    forall a. (a -> a -> Ordering) -> Comparison a
    Comparison ((a -> a -> Ordering) -> Comparison a)
    -> (a -> a -> Ordering) -> Comparison a
    forall a b. (a -> b) -> a -> b
    $ \a
    a a
    _ -> Void -> Ordering
    forall a. Void -> a
    absurd (a -> Void
    f a
    a)

    -- | @since 5.3.6
    instance Conclude Equivalence where
      conclude :: forall a. (a -> Void) -> Equivalence a
    conclude a -> Void
    f = (a -> a -> Bool) -> Equivalence a
    forall a. (a -> a -> Bool) -> Equivalence a
    Equivalence ((a -> a -> Bool) -> Equivalence a)
    -> (a -> a -> Bool) -> Equivalence a
    forall a b. (a -> b) -> a -> b
    $ Void -> a -> Bool
    forall a. Void -> a
    absurd (Void -> a -> Bool) -> (a -> Void) -> a -> a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Void
    f

    -- | @since 5.3.6
    instance Conclude Predicate where
      conclude :: forall a. (a -> Void) -> Predicate a
    conclude a -> Void
    f = (a -> Bool) -> Predicate a
    forall a. (a -> Bool) -> Predicate a
    Predicate ((a -> Bool) -> Predicate a) -> (a -> Bool) -> Predicate a
    forall a b. (a -> b) -> a -> b
    $ Void -> Bool
    forall a. Void -> a
    absurd (Void -> Bool) -> (a -> Void) -> a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Void
    f

    -- | @since 5.3.6
    instance Conclude (Op r) where
      conclude :: forall a. (a -> Void) -> Op r a
    conclude a -> Void
    f = (a -> r) -> Op r a
    forall a b. (b -> a) -> Op a b
    Op ((a -> r) -> Op r a) -> (a -> r) -> Op r a
    forall a b. (a -> b) -> a -> b
    $ Void -> r
    forall a. Void -> a
    absurd (Void -> r) -> (a -> Void) -> a -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Void
    f

    -- | @since 5.3.6
    instance Conclude Proxy where
      conclude :: forall a. (a -> Void) -> Proxy a
    conclude a -> Void
    _ = Proxy a
    forall {k} (t :: k). Proxy t
    Proxy

    #ifdef MIN_VERSION_StateVar
    -- | @since 5.3.6
    instance Conclude SettableStateVar where
      conclude k = SettableStateVar (absurd . k)
    #endif

    -- | @since 5.3.6
    instance Conclude f => Conclude (Alt f) where
      conclude :: forall a. (a -> Void) -> Alt f a
    conclude = f a -> Alt f a
    forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
    Alt (f a -> Alt f a) -> ((a -> Void) -> f a) -> (a -> Void) -> Alt 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. Conclude f => (a -> Void) -> f a
    conclude

    -- | @since 5.3.6
    instance Conclude U1 where
      conclude :: forall a. (a -> Void) -> U1 a
    conclude a -> Void
    _ = U1 a
    forall k (p :: k). U1 p
    U1

    -- | @since 5.3.6
    instance Conclude f => Conclude (Rec1 f) where
      conclude :: forall a. (a -> Void) -> Rec1 f a
    conclude = f a -> Rec1 f a
    forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
    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. Conclude f => (a -> Void) -> f a
    conclude

    -- | @since 5.3.6
    instance Conclude f => Conclude (M1 i c f) where
      conclude :: forall a. (a -> Void) -> M1 i c f a
    conclude = f a -> M1 i c f a
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
    M1 (f a -> M1 i c f a)
    -> ((a -> Void) -> f a) -> (a -> Void) -> M1 i c 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. Conclude f => (a -> Void) -> f a
    conclude

    -- | @since 5.3.6
    instance (Conclude f, Conclude g) => Conclude (f :*: g) where
      conclude :: forall a. (a -> Void) -> (:*:) f g a
    conclude a -> Void
    f = (a -> Void) -> f a
    forall a. (a -> Void) -> f a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude 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
    :*: (a -> Void) -> g a
    forall a. (a -> Void) -> g a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f

    -- | @since 5.3.6
    instance (Apply f, Applicative f, Conclude g) => Conclude (f :.: g) where
      conclude :: forall a. (a -> Void) -> (:.:) f g a
    conclude = f (g a) -> (:.:) f g a
    forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
    f (g p) -> (:.:) f g p
    Comp1 (f (g a) -> (:.:) f g a)
    -> ((a -> Void) -> f (g a)) -> (a -> Void) -> (:.:) f g a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . g a -> f (g a)
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (g a -> f (g a)) -> ((a -> Void) -> g a) -> (a -> Void) -> f (g a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Void) -> g a
    forall a. (a -> Void) -> g a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude

    -- | @since 5.3.6
    instance Conclude f => Conclude (Backwards f) where
      conclude :: forall a. (a -> Void) -> Backwards f a
    conclude = 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. Conclude f => (a -> Void) -> f a
    conclude

    -- | @since 5.3.6
    instance Conclude f => Conclude (IdentityT f) where
      conclude :: forall a. (a -> Void) -> IdentityT f a
    conclude = 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. Conclude f => (a -> Void) -> f a
    conclude

    -- | @since 5.3.6
    instance Conclude m => Conclude (ReaderT r m) where
      conclude :: forall a. (a -> Void) -> ReaderT r m a
    conclude a -> Void
    f = (r -> m a) -> ReaderT r m a
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
    ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
    forall a b. (a -> b) -> a -> b
    $ \r
    _ -> (a -> Void) -> m a
    forall a. (a -> Void) -> m a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f

    -- | @since 5.3.6
    instance Conclude m => Conclude (Lazy.RWST r w s m) where
      conclude :: forall a. (a -> Void) -> RWST r w s m a
    conclude a -> Void
    f = (r -> s -> m (a, s, w)) -> RWST r w s m a
    forall r w s (m :: * -> *) a.
    (r -> s -> m (a, s, w)) -> RWST r w s m a
    Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
    -> (r -> s -> m (a, s, w)) -> RWST r w s m a
    forall a b. (a -> b) -> a -> b
    $ \r
    _ s
    _ -> ((a, s, w) -> a) -> m a -> m (a, s, w)
    forall a' a. (a' -> a) -> m a -> m a'
    forall (f :: * -> *) a' a.
    Contravariant f =>
    (a' -> a) -> f a -> f a'
    contramap (\ ~(a
    a, s
    _, w
    _) -> a
    a) ((a -> Void) -> m a
    forall a. (a -> Void) -> m a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f)

    -- | @since 5.3.6
    instance Conclude m => Conclude (Strict.RWST r w s m) where
      conclude :: forall a. (a -> Void) -> RWST r w s m a
    conclude a -> Void
    f = (r -> s -> m (a, s, w)) -> RWST r w s m a
    forall r w s (m :: * -> *) a.
    (r -> s -> m (a, s, w)) -> RWST r w s m a
    Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
    -> (r -> s -> m (a, s, w)) -> RWST r w s m a
    forall a b. (a -> b) -> a -> b
    $ \r
    _ s
    _ -> ((a, s, w) -> a) -> m a -> m (a, s, w)
    forall a' a. (a' -> a) -> m a -> m a'
    forall (f :: * -> *) a' a.
    Contravariant f =>
    (a' -> a) -> f a -> f a'
    contramap (\(a
    a, s
    _, w
    _) -> a
    a) ((a -> Void) -> m a
    forall a. (a -> Void) -> m a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f)

    #if defined(MIN_VERSION_contravariant)
    # if !(MIN_VERSION_transformers(0,6,0))
    -- | This instance is only available if the @+contravariant@ @cabal@ flag is
    -- enabled.
    --
    -- @since 5.3.6
    instance (Divisible m, Divise m) => Conclude (ListT m) where
      conclude _ = ListT conquer
    # endif

    -- | This instance is only available if the @+contravariant@ @cabal@ flag is
    -- enabled.
    --
    -- @since 5.3.6
    instance (Divisible m, Divise m) => Conclude (MaybeT m) where
      conclude :: forall a. (a -> Void) -> MaybeT m a
    conclude a -> Void
    _ = m (Maybe a) -> MaybeT m a
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT m (Maybe a)
    forall a. m a
    forall (f :: * -> *) a. Divisible f => f a
    conquer
    #endif

    -- | @since 5.3.6
    instance Conclude m => Conclude (Lazy.StateT s m) where
      conclude :: forall a. (a -> Void) -> StateT s m a
    conclude a -> Void
    f = (s -> m (a, s)) -> StateT s m a
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
    Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
    -> (s -> m (a, s)) -> StateT s m a
    forall a b. (a -> b) -> a -> b
    $ \s
    _ -> ((a, s) -> a) -> m a -> m (a, s)
    forall a' a. (a' -> a) -> m a -> m a'
    forall (f :: * -> *) a' a.
    Contravariant f =>
    (a' -> a) -> f a -> f a'
    contramap (a, s) -> a
    forall a b. (a, b) -> a
    lazyFst ((a -> Void) -> m a
    forall a. (a -> Void) -> m a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f)

    -- | @since 5.3.6
    instance Conclude m => Conclude (Strict.StateT s m) where
      conclude :: forall a. (a -> Void) -> StateT s m a
    conclude a -> Void
    f = (s -> m (a, s)) -> StateT s m a
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
    Strict.StateT ((s -> m (a, s)) -> StateT s m a)
    -> (s -> m (a, s)) -> StateT s m a
    forall a b. (a -> b) -> a -> b
    $ \s
    _ -> ((a, s) -> a) -> m a -> m (a, s)
    forall a' a. (a' -> a) -> m a -> m a'
    forall (f :: * -> *) a' a.
    Contravariant f =>
    (a' -> a) -> f a -> f a'
    contramap (a, s) -> a
    forall a b. (a, b) -> a
    fst ((a -> Void) -> m a
    forall a. (a -> Void) -> m a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f)

    -- | @since 5.3.6
    instance Conclude m => Conclude (Lazy.WriterT w m) where
      conclude :: forall a. (a -> Void) -> WriterT w m a
    conclude a -> Void
    f = m (a, w) -> WriterT w m a
    forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
    Lazy.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
    forall a b. (a -> b) -> a -> b
    $ ((a, w) -> a) -> m a -> m (a, w)
    forall a' a. (a' -> a) -> m a -> m a'
    forall (f :: * -> *) a' a.
    Contravariant f =>
    (a' -> a) -> f a -> f a'
    contramap (a, w) -> a
    forall a b. (a, b) -> a
    lazyFst ((a -> Void) -> m a
    forall a. (a -> Void) -> m a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f)

    -- | @since 5.3.6
    instance Conclude m => Conclude (Strict.WriterT w m) where
      conclude :: forall a. (a -> Void) -> WriterT w m a
    conclude a -> Void
    f = m (a, w) -> WriterT w m a
    forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
    Strict.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
    forall a b. (a -> b) -> a -> b
    $ ((a, w) -> a) -> m a -> m (a, w)
    forall a' a. (a' -> a) -> m a -> m a'
    forall (f :: * -> *) a' a.
    Contravariant f =>
    (a' -> a) -> f a -> f a'
    contramap (a, w) -> a
    forall a b. (a, b) -> a
    fst ((a -> Void) -> m a
    forall a. (a -> Void) -> m a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f)

    -- | @since 5.3.6
    instance (Apply f, Applicative f, Conclude g) => Conclude (Compose f g) where
      conclude :: forall a. (a -> Void) -> Compose f g a
    conclude = f (g a) -> Compose f g a
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Compose (f (g a) -> Compose f g a)
    -> ((a -> Void) -> f (g a)) -> (a -> Void) -> Compose f g a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . g a -> f (g a)
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (g a -> f (g a)) -> ((a -> Void) -> g a) -> (a -> Void) -> f (g a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Void) -> g a
    forall a. (a -> Void) -> g a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude

    -- | @since 5.3.6
    instance (Conclude f, Conclude g) => Conclude (Product f g) where
      conclude :: forall a. (a -> Void) -> Product f g a
    conclude 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) -> f a
    forall a. (a -> Void) -> f a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f) ((a -> Void) -> g a
    forall a. (a -> Void) -> g a
    forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
    conclude a -> Void
    f)

    -- | @since 5.3.6
    instance Conclude f => Conclude (Reverse f) where
      conclude :: forall a. (a -> Void) -> Reverse f a
    conclude = 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. Conclude f => (a -> Void) -> f a
    conclude

    -- Helpers

    lazyFst :: (a, b) -> a
    lazyFst :: forall a b. (a, b) -> a
    lazyFst ~(a
    a, b
    _) = a
    a