{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module : Data.Functor.Contravariant.Conclude -- Copyright : (c) Justin Le 2019 -- License : BSD3 -- -- Maintainer : justin@jle.im -- Stability : experimental -- Portability : non-portable -- -- The contravariant counterpart of 'Data.Functor.Plus': like 'Decidable', -- but without needing a 'Divisible' constraint. This is only a part of -- this library currently for compatibility, until it is (hopefully) merged -- into /semigroupoids/. -- -- @since 0.3.0.0 module Data.Functor.Contravariant.Conclude ( Conclude(..) , concluded ) where import Control.Applicative.Backwards import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe 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.Contravariant.Divise import Data.Functor.Contravariant.Divisible import Data.Functor.Product import Data.Functor.Reverse import Data.Void #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif #if MIN_VERSION_base(4,8,0) import Data.Monoid (Alt(..)) #else import Data.Monoid (Monoid(..)) #endif #if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged) import Data.Proxy #endif #ifdef MIN_VERSION_StateVar import Data.StateVar #endif #if __GLASGOW_HASKELL__ >= 702 #define GHC_GENERICS import GHC.Generics #endif -- | The contravariant analogue of 'Data.Functor.Plus.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@. class Decide f => Conclude f where -- | The consumer that cannot ever receive /any/ input. conclude :: (a -> Void) -> f a -- | 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' -- @ concluded :: Conclude f => f Void concluded :: forall (f :: * -> *). Conclude f => f Void concluded = forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude forall a. a -> a id instance Decidable f => Conclude (WrappedDivisible f) where conclude :: forall a. (a -> Void) -> WrappedDivisible f a conclude a -> Void f = forall {k} (f :: k -> *) (a :: k). f a -> WrappedDivisible f a WrapDivisible (forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a lose a -> Void f) instance Conclude Comparison where conclude :: forall a. (a -> Void) -> Comparison a conclude = forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a lose instance Conclude Equivalence where conclude :: forall a. (a -> Void) -> Equivalence a conclude = forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a lose instance Conclude Predicate where conclude :: forall a. (a -> Void) -> Predicate a conclude = forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a lose instance Conclude (Op r) where conclude :: forall a. (a -> Void) -> Op r a conclude a -> Void f = forall a b. (b -> a) -> Op a b Op forall a b. (a -> b) -> a -> b $ forall a. Void -> a absurd forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Void f #if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged) instance Conclude Proxy where conclude :: forall a. (a -> Void) -> Proxy a conclude = forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a lose #endif #ifdef MIN_VERSION_StateVar instance Conclude SettableStateVar where conclude :: forall a. (a -> Void) -> SettableStateVar a conclude = forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a lose #endif #if MIN_VERSION_base(4,8,0) instance Conclude f => Conclude (Alt f) where conclude :: forall a. (a -> Void) -> Alt f a conclude = forall {k} (f :: k -> *) (a :: k). f a -> Alt f a Alt forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude #endif #ifdef GHC_GENERICS instance Conclude U1 where conclude :: forall a. (a -> Void) -> U1 a conclude = forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a lose instance Conclude f => Conclude (Rec1 f) where conclude :: forall a. (a -> Void) -> Rec1 f a conclude = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p Rec1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude instance Conclude f => Conclude (M1 i c f) where conclude :: forall a. (a -> Void) -> M1 i c f a conclude = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude instance (Conclude f, Conclude g) => Conclude (f :*: g) where conclude :: forall a. (a -> Void) -> (:*:) f g a conclude a -> Void f = forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> g p -> (:*:) f g p :*: forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f instance (Apply f, Applicative f, Conclude g) => Conclude (f :.: g) where conclude :: forall a. (a -> Void) -> (:.:) f g a conclude = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). f (g p) -> (:.:) f g p Comp1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude #endif instance Conclude f => Conclude (Backwards f) where conclude :: forall a. (a -> Void) -> Backwards f a conclude = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a Backwards forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude instance Conclude f => Conclude (IdentityT f) where conclude :: forall a. (a -> Void) -> IdentityT f a conclude = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a IdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude instance Conclude m => Conclude (ReaderT r m) where conclude :: forall a. (a -> Void) -> ReaderT r m a conclude a -> Void f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \r _ -> forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f 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 = forall r w s (m :: * -> *) a. (r -> s -> m (a, s, w)) -> RWST r w s m a Lazy.RWST forall a b. (a -> b) -> a -> b $ \r _ s _ -> forall (f :: * -> *) a' a. Contravariant f => (a' -> a) -> f a -> f a' contramap (\ ~(a a, s _, w _) -> a a) (forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f) 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 = forall r w s (m :: * -> *) a. (r -> s -> m (a, s, w)) -> RWST r w s m a Strict.RWST forall a b. (a -> b) -> a -> b $ \r _ s _ -> forall (f :: * -> *) a' a. Contravariant f => (a' -> a) -> f a -> f a' contramap (\(a a, s _, w _) -> a a) (forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f) instance (Divisible m, Divise m) => Conclude (ListT m) where conclude :: forall a. (a -> Void) -> ListT m a conclude a -> Void _ = forall (m :: * -> *) a. m [a] -> ListT m a ListT forall (f :: * -> *) a. Divisible f => f a conquer instance (Divisible m, Divise m) => Conclude (MaybeT m) where conclude :: forall a. (a -> Void) -> MaybeT m a conclude a -> Void _ = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a MaybeT forall (f :: * -> *) a. Divisible f => f a conquer instance Conclude m => Conclude (Lazy.StateT s m) where conclude :: forall a. (a -> Void) -> StateT s m a conclude a -> Void f = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a Lazy.StateT forall a b. (a -> b) -> a -> b $ \s _ -> forall (f :: * -> *) a' a. Contravariant f => (a' -> a) -> f a -> f a' contramap forall a b. (a, b) -> a lazyFst (forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f) instance Conclude m => Conclude (Strict.StateT s m) where conclude :: forall a. (a -> Void) -> StateT s m a conclude a -> Void f = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a Strict.StateT forall a b. (a -> b) -> a -> b $ \s _ -> forall (f :: * -> *) a' a. Contravariant f => (a' -> a) -> f a -> f a' contramap forall a b. (a, b) -> a fst (forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f) instance Conclude m => Conclude (Lazy.WriterT w m) where conclude :: forall a. (a -> Void) -> WriterT w m a conclude a -> Void f = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a Lazy.WriterT forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a' a. Contravariant f => (a' -> a) -> f a -> f a' contramap forall a b. (a, b) -> a lazyFst (forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f) instance Conclude m => Conclude (Strict.WriterT w m) where conclude :: forall a. (a -> Void) -> WriterT w m a conclude a -> Void f = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a Strict.WriterT forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a' a. Contravariant f => (a' -> a) -> f a -> f a' contramap forall a b. (a, b) -> a fst (forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f) instance (Apply f, Applicative f, Conclude g) => Conclude (Compose f g) where conclude :: forall a. (a -> Void) -> Compose f g a conclude = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1). f (g a) -> Compose f g a Compose forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude instance (Conclude f, Conclude g) => Conclude (Product f g) where conclude :: forall a. (a -> Void) -> Product f g a conclude a -> Void f = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> g a -> Product f g a Pair (forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f) (forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude a -> Void f) instance Conclude f => Conclude (Reverse f) where conclude :: forall a. (a -> Void) -> Reverse f a conclude = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a Reverse forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a conclude lazyFst :: (a, b) -> a lazyFst :: forall a b. (a, b) -> a lazyFst ~(a a, b _) = a a