{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
{-# LANGUAGE TypeOperators #-}
module Data.Functor.Contravariant.Conclude (
Conclude(..)
, concluded
) where
import Control.Applicative.Backwards
import Control.Monad.Trans.Identity
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_transformers(0,6,0))
import Control.Monad.Trans.List
#endif
#if MIN_VERSION_base(4,8,0)
import Data.Monoid (Alt(..))
#else
import Control.Applicative
#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
class Decide f => Conclude f where
conclude :: (a -> Void) -> f a
concluded :: Conclude f => f Void
concluded :: f Void
concluded = (Void -> Void) -> f Void
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude Void -> Void
forall a. a -> a
id
instance Decidable f => Conclude (WrappedDivisible f) where
conclude :: (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 (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose a -> Void
f)
instance Conclude Comparison where conclude :: (a -> Void) -> Comparison a
conclude = (a -> Void) -> Comparison a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
instance Conclude Equivalence where conclude :: (a -> Void) -> Equivalence a
conclude = (a -> Void) -> Equivalence a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
instance Conclude Predicate where conclude :: (a -> Void) -> Predicate a
conclude = (a -> Void) -> Predicate a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
instance Conclude (Op r) where
conclude :: (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
#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged)
instance Conclude Proxy where conclude :: (a -> Void) -> Proxy a
conclude = (a -> Void) -> Proxy a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
#endif
#ifdef MIN_VERSION_StateVar
instance Conclude SettableStateVar where conclude = lose
#endif
#if MIN_VERSION_base(4,8,0)
instance Conclude f => Conclude (Alt f) where
conclude :: (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude
#endif
#ifdef GHC_GENERICS
instance Conclude U1 where conclude :: (a -> Void) -> U1 a
conclude = (a -> Void) -> U1 a
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose
instance Conclude f => Conclude (Rec1 f) where
conclude :: (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude
instance Conclude f => Conclude (M1 i c f) where
conclude :: (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude
instance (Conclude f, Conclude g) => Conclude (f :*: g) where
conclude :: (a -> Void) -> (:*:) f g a
conclude a -> Void
f = (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f
instance (Apply f, Applicative f, Conclude g) => Conclude (f :.: g) where
conclude :: (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 (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude
#endif
instance Conclude f => Conclude (Backwards f) where
conclude :: (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude
instance Conclude f => Conclude (IdentityT f) where
conclude :: (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude
instance Conclude m => Conclude (ReaderT r m) where
conclude :: (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f
instance Conclude m => Conclude (Lazy.RWST r w s m) where
conclude :: (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 (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\ ~(a
a, s
_, w
_) -> a
a) ((a -> Void) -> m 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 :: (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 (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\(a
a, s
_, w
_) -> a
a) ((a -> Void) -> m a
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f)
#if !(MIN_VERSION_transformers(0,6,0))
instance (Divisible m, Divise m) => Conclude (ListT m) where
conclude :: (a -> Void) -> ListT m a
conclude a -> Void
_ = m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT m [a]
forall (f :: * -> *) a. Divisible f => f a
conquer
#endif
instance (Divisible m, Divise m) => Conclude (MaybeT m) where
conclude :: (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 (f :: * -> *) a. Divisible f => f a
conquer
instance Conclude m => Conclude (Lazy.StateT s m) where
conclude :: (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 (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (a, s) -> a
forall a b. (a, b) -> a
lazyFst ((a -> Void) -> m a
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f)
instance Conclude m => Conclude (Strict.StateT s m) where
conclude :: (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 (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (a, s) -> a
forall a b. (a, b) -> a
fst ((a -> Void) -> m a
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f)
instance Conclude m => Conclude (Lazy.WriterT w m) where
conclude :: (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 (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (a, w) -> a
forall a b. (a, b) -> a
lazyFst ((a -> Void) -> m a
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f)
instance Conclude m => Conclude (Strict.WriterT w m) where
conclude :: (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 (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (a, w) -> a
forall a b. (a, b) -> a
fst ((a -> Void) -> m a
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 :: (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 (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude
instance (Conclude f, Conclude g) => Conclude (Product f g) where
conclude :: (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f) ((a -> Void) -> g a
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude a -> Void
f)
instance Conclude f => Conclude (Reverse f) where
conclude :: (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 (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude
lazyFst :: (a, b) -> a
lazyFst :: (a, b) -> a
lazyFst ~(a
a, b
_) = a
a