    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}

    module Data.Copointed where

    import Control.Applicative
    import Data.Default.Class
    import GHC.Generics

    #ifdef MIN_VERSION_comonad
    import Control.Comonad.Trans.Env
    import Control.Comonad.Trans.Store
    import Control.Comonad.Trans.Traced

    #if !(MIN_VERSION_comonad(4,3,0))
    import Data.Functor.Coproduct
    #endif
    #endif

    #ifdef MIN_VERSION_containers
    import Data.Tree
    #endif

    #ifdef MIN_VERSION_semigroupoids
    import Data.Functor.Bind
    #endif

    import Data.Semigroup as Semigroup
    import Data.List.NonEmpty (NonEmpty(..))

    import qualified Data.Monoid as Monoid

    #ifdef MIN_VERSION_tagged
    import Data.Tagged
    #endif

    import Data.Functor.Identity
    import Data.Functor.Sum as F
    import Data.Functor.Compose

    #ifdef MIN_VERSION_transformers
    import Data.Functor.Reverse
    import Control.Applicative.Backwards
    import Control.Applicative.Lift as Applicative
    import Control.Monad.Trans.Identity
    import qualified Control.Monad.Trans.Writer.Lazy as Lazy
    import qualified Control.Monad.Trans.Writer.Strict as Strict
    #endif

    -- | 'Copointed' does not require a 'Functor', as the only relationship
    -- between 'copoint' and 'fmap' is given by a free theorem.

    class Copointed p where
      copoint :: p a -> a

    instance Copointed ((,) a) where
      copoint :: forall a. (a, a) -> a
    copoint = (a, a) -> a
    forall a a. (a, a) -> a
    snd

    instance Copointed ((,,) a b) where
      copoint :: forall a. (a, b, a) -> a
    copoint (a
    _,b
    _,a
    a) = a
    a

    instance Copointed ((,,,) a b c) where
      copoint :: forall a. (a, b, c, a) -> a
    copoint (a
    _,b
    _,c
    _,a
    a) = a
    a

    instance Default m => Copointed ((->)m) where
      copoint :: forall a. (m -> a) -> a
    copoint m -> a
    f = m -> a
    f m
    forall a. Default a => a
    def

    instance Copointed m => Copointed (WrappedMonad m) where
      copoint :: forall a. WrappedMonad m a -> a
    copoint = m a -> a
    forall a. m a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (m a -> a) -> (WrappedMonad m a -> m a) -> WrappedMonad m a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WrappedMonad m a -> m a
    forall (m :: * -> *) a. WrappedMonad m a -> m a
    unwrapMonad

    #ifdef MIN_VERSION_comonad
    instance (Default m, Copointed w) => Copointed (TracedT m w) where
      copoint :: forall a. TracedT m w a -> a
    copoint (TracedT w (m -> a)
    w) = w (m -> a) -> m -> a
    forall a. w a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint w (m -> a)
    w m
    forall a. Default a => a
    def

    instance Copointed w => Copointed (EnvT e w) where
      copoint :: forall a. EnvT e w a -> a
    copoint = w a -> a
    forall a. w a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (w a -> a) -> (EnvT e w a -> w a) -> EnvT e w a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EnvT e w a -> w a
    forall e (w :: * -> *) a. EnvT e w a -> w a
    lowerEnvT

    instance Copointed w => Copointed (StoreT s w) where
      copoint :: forall a. StoreT s w a -> a
    copoint (StoreT w (s -> a)
    wf s
    s) = w (s -> a) -> s -> a
    forall a. w a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint w (s -> a)
    wf s
    s
    #endif

    #ifdef MIN_VERSION_comonad
    #if !(MIN_VERSION_comonad(4,3,0))
    instance (Copointed p, Copointed q) => Copointed (Coproduct p q) where
      copoint = coproduct copoint copoint
    #endif
    #endif

    #ifdef MIN_VERSION_containers
    instance Copointed Tree where
      copoint :: forall a. Tree a -> a
    copoint = Tree a -> a
    forall a. Tree a -> a
    rootLabel
    #endif

    #ifdef MIN_VERSION_tagged
    instance Copointed (Tagged a) where
      copoint :: forall a. Tagged a a -> a
    copoint = Tagged a a -> a
    forall {k} (s :: k) b. Tagged s b -> b
    unTagged
    #endif

    instance Copointed Identity where
      copoint :: forall a. Identity a -> a
    copoint = Identity a -> a
    forall a. Identity a -> a
    runIdentity

    instance (Copointed p, Copointed q) => Copointed (Compose p q) where
      copoint :: forall a. Compose p q a -> a
    copoint = q a -> a
    forall a. q a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (q a -> a) -> (Compose p q a -> q a) -> Compose p q a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p (q a) -> q a
    forall a. p a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (p (q a) -> q a)
    -> (Compose p q a -> p (q a)) -> Compose p q a -> q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Compose p q a -> p (q a)
    forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
    Compose f g a -> f (g a)
    getCompose

    instance (Copointed f, Copointed g) => Copointed (F.Sum f g) where
      copoint :: forall a. Sum f g a -> a
    copoint (F.InL f a
    m) = f a -> a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint f a
    m
      copoint (F.InR g a
    m) = g a -> a
    forall a. g a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint g a
    m

    #ifdef MIN_VERSION_transformers
    instance Copointed f => Copointed (Backwards f) where
      copoint :: forall a. Backwards f a -> a
    copoint = f a -> a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (f a -> a) -> (Backwards f a -> f a) -> Backwards f a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Backwards f a -> f a
    forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
    forwards

    instance Copointed f => Copointed (Applicative.Lift f) where
      copoint :: forall a. Lift f a -> a
    copoint (Pure a
    a)   = a
    a
      copoint (Other f a
    fa) = f a -> a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint f a
    fa

    instance Copointed f => Copointed (Reverse f) where
      copoint :: forall a. Reverse f a -> a
    copoint = f a -> a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (f a -> a) -> (Reverse f a -> f a) -> Reverse f a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Reverse f a -> f a
    forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
    getReverse

    instance Copointed m => Copointed (IdentityT m) where
      copoint :: forall a. IdentityT m a -> a
    copoint = m a -> a
    forall a. m a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (m a -> a) -> (IdentityT m a -> m a) -> IdentityT m a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IdentityT m a -> m a
    forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
    runIdentityT

    instance Copointed m => Copointed (Lazy.WriterT w m) where
      copoint :: forall a. WriterT w m a -> a
    copoint = (a, w) -> a
    forall a b. (a, b) -> a
    fst ((a, w) -> a) -> (WriterT w m a -> (a, w)) -> WriterT w m a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m (a, w) -> (a, w)
    forall a. m a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (m (a, w) -> (a, w))
    -> (WriterT w m a -> m (a, w)) -> WriterT w m a -> (a, w)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WriterT w m a -> m (a, w)
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    Lazy.runWriterT

    instance Copointed m => Copointed (Strict.WriterT w m) where
      copoint :: forall a. WriterT w m a -> a
    copoint = (a, w) -> a
    forall a b. (a, b) -> a
    fst ((a, w) -> a) -> (WriterT w m a -> (a, w)) -> WriterT w m a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m (a, w) -> (a, w)
    forall a. m a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (m (a, w) -> (a, w))
    -> (WriterT w m a -> m (a, w)) -> WriterT w m a -> (a, w)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WriterT w m a -> m (a, w)
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    Strict.runWriterT
    #endif

    instance Copointed Monoid.Dual where
      copoint :: forall a. Dual a -> a
    copoint = Dual a -> a
    forall a. Dual a -> a
    Monoid.getDual

    instance Copointed Monoid.Sum where
      copoint :: forall a. Sum a -> a
    copoint = Sum a -> a
    forall a. Sum a -> a
    Monoid.getSum

    instance Copointed Monoid.Product where
      copoint :: forall a. Product a -> a
    copoint = Product a -> a
    forall a. Product a -> a
    Monoid.getProduct

    instance Copointed NonEmpty where
      copoint :: forall a. NonEmpty a -> a
    copoint ~(a
    a :| [a]
    _) = a
    a

    instance Copointed Semigroup.First where
      copoint :: forall a. First a -> a
    copoint = First a -> a
    forall a. First a -> a
    Semigroup.getFirst

    instance Copointed Semigroup.Last where
      copoint :: forall a. Last a -> a
    copoint = Last a -> a
    forall a. Last a -> a
    Semigroup.getLast

    instance Copointed Semigroup.Max where
      copoint :: forall a. Max a -> a
    copoint = Max a -> a
    forall a. Max a -> a
    Semigroup.getMax

    instance Copointed Semigroup.Min where
      copoint :: forall a. Min a -> a
    copoint = Min a -> a
    forall a. Min a -> a
    Semigroup.getMin

    instance Copointed WrappedMonoid where
      copoint :: forall a. WrappedMonoid a -> a
    copoint = WrappedMonoid a -> a
    forall a. WrappedMonoid a -> a
    unwrapMonoid

    instance Copointed (Arg a) where
      copoint :: forall a. Arg a a -> a
    copoint (Arg a
    _ a
    b) = a
    b

    #ifdef MIN_VERSION_semigroupoids
    instance Copointed f => Copointed (WrappedApplicative f) where
      copoint :: forall a. WrappedApplicative f a -> a
    copoint = f a -> a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (f a -> a)
    -> (WrappedApplicative f a -> f a) -> WrappedApplicative f a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WrappedApplicative f a -> f a
    forall (f :: * -> *) a. WrappedApplicative f a -> f a
    unwrapApplicative

    instance Copointed f => Copointed (MaybeApply f) where
      copoint :: forall a. MaybeApply f a -> a
    copoint (MaybeApply (Left f a
    fa)) = f a -> a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint f a
    fa
      copoint (MaybeApply (Right a
    a)) = a
    a
    #endif

    instance Copointed Par1 where
      copoint :: forall a. Par1 a -> a
    copoint = Par1 a -> a
    forall a. Par1 a -> a
    unPar1

    instance Copointed f => Copointed (M1 i c f) where
      copoint :: forall a. M1 i c f a -> a
    copoint = f a -> a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (f a -> a) -> (M1 i c f a -> f a) -> M1 i c f a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . M1 i c f a -> f a
    forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
    unM1

    instance Copointed f => Copointed (Rec1 f) where
      copoint :: forall a. Rec1 f a -> a
    copoint = f a -> a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (f a -> a) -> (Rec1 f a -> f a) -> Rec1 f a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rec1 f a -> f a
    forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
    unRec1

    instance (Copointed f, Copointed g) => Copointed (f :+: g) where
      copoint :: forall a. (:+:) f g a -> a
    copoint (L1 f a
    a) = f a -> a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint f a
    a
      copoint (R1 g a
    a) = g a -> a
    forall a. g a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint g a
    a

    instance (Copointed f, Copointed g) => Copointed (f :.: g) where
      copoint :: forall a. (:.:) f g a -> a
    copoint = g a -> a
    forall a. g a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (g a -> a) -> ((:.:) f g a -> g a) -> (:.:) f g a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f (g a) -> g a
    forall a. f a -> a
    forall (p :: * -> *) a. Copointed p => p a -> a
    copoint (f (g a) -> g a) -> ((:.:) f g a -> f (g a)) -> (:.:) f g a -> g a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (:.:) f g a -> f (g a)
    forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
    (:.:) f g p -> f (g p)
    unComp1