{-
 Examples of similar types:

 Co (Env x) = Reader x
 Co Initialize = Finalize
 Co (Store x) = State x
 Co (Traced x) = Writer x
 Codensity (Const x) = Cont x
 Codensity Endo = []
 CodensityAsk ((->) x) = Either x
 CodensityAsk (Const x) = ((->) x)
 CodensityAsk Endo = Writer (Sum Natural)
 CodensityAsk Finalize = Identity
 CodensityAsk Identity = Maybe
 CodensityAsk Predicate = Data.Searchable.Set (infinite-search)
 Cofree (Const x) = Env x
 Cofree Finalize = Identity
 Free (Const x) = Either x
 Free Finalize = Maybe
 Free Initialize = Identity
-}

{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- {-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

module Control.ForFree (
  -- * Plus
    Plus(..), OpT(..),
  -- * Yoneda
    Yoneda(..), unreduceYoneda,
  -- * CoYoneda
    CoYoneda(..), reduceCoYoneda,
  -- * Free monad
    Free(..), reduceFree, affectFree, FreeT(..), reduceFreeT,
  -- * Free comonad
    Cofree(..), unreduceCofree, affectCofree, CofreeT(..),
    unreduceCofreeT,
  -- * Codensity monad
    Codensity(..), lowerCodensity,
  -- * Density comonad
    Density(..), liftDensity,
  -- * Monads from comonads
    CoT(..), Co, runCo, liftCoT0, lowerCoT0, lowerCo0, liftCoT1,
    lowerCoT1, lowerCo1,
  -- * Codensity ask monad
    CodensityAsk(..), peekCodensityAsk, CodensityAskT(..),
    peekCodensityAskT, lowerCodensityAskT, catchCodensityAsk,
    catchCodensityAskT,
  -- * Density ask comonad
    DensityAskT(..), DensityAsk, liftDensityAsk,
  -- * Miscellaneous
    Finalize(..), Initialize(..), Decompose(..), Recompose(..),
  -- * Instances of types from other modules
    Op(..), Endo(..), Const(..)
) where {

  import Control.Applicative;
  import Control.Arrow;
  import Control.Category;
  import Control.Comonad;
  import Control.Comonad.Hoist.Class;
  import Control.Comonad.Trans.Class;
  import Control.Monad;
  import Control.Monad.Trans.Class;
  import Control.Monad.Trans.Maybe (MaybeT);
  import Control.Monad.Trans.Reader (ReaderT(..));
  import Control.Monad.Trans.RWS (RWST);
  import Control.Monad.Trans.State (StateT);
  import Control.Monad.Trans.Writer (WriterT(..));
  import Data.Functor.Contravariant;
  import Data.Functor.Identity;
  import Data.IntMap (IntMap);
  import Data.Map (Map);
  import Data.Monoid;
  import Data.Sequence (Seq);
  import Prelude hiding (id, (.));

  instance Monoid x => Alternative (Const x) where {
    empty = Const mempty;
    Const x <|> Const y = Const (mappend x y);
  };

  instance Monoid x => Plus (Const x) where {
    zero = Const mempty;
    plus (Const x) (Const y) = Const (mappend x y);
  };

--  instance Category Op where {
--    id = Op id;
--    Op x . Op y = Op (y . x);
--  };

-- | Like 'Op' but apply another type.
;
  newtype OpT f a b = OpT { getOpT :: f b -> a };

  instance Functor f => Contravariant (OpT f x) where {
    contramap f (OpT x) = OpT (x . fmap f);
  };

  instance Comonad f => Category (OpT f) where {
    id = OpT extract;
    OpT x . OpT y = OpT (y =<= x);
  };

-- | 'zero' and 'plus' should form a monoid.
;
  class Plus f where {
    zero :: f x;
    plus :: f x -> f x -> f x;
  };

--  instance Alternative f => Plus f where {
--    zero = empty;
--    plus = (<|>);
--  };

  instance Plus Endo where {
    zero = mempty;
    plus = mappend;
  };

  instance Monoid x => Plus (Op x) where {
    zero = Op (const mempty);
    plus (Op x) (Op y) = Op (liftA2 mappend x y);
  };

  instance Monoid x => Plus (OpT f x) where {
    zero = OpT (const mempty);
    plus (OpT x) (OpT y) = OpT (liftA2 mappend x y);
  };

  instance Plus Comparison where {
    zero = Comparison (\_ _ -> EQ);
    plus (Comparison x) (Comparison y) = Comparison (\a b -> mappend (x a b) (y a b));
  };

-- | Right Yoneda lemma
;
  newtype Yoneda f x = Yoneda { runYoneda :: forall z. (x -> z) -> f z };

  instance Functor (Yoneda f) where {
    fmap f (Yoneda x) = Yoneda (\k -> x (k . f));
  };

  instance Plus f => Plus (Yoneda f) where {
    zero = Yoneda (const zero);
    plus (Yoneda x) (Yoneda y) = Yoneda (liftA2 plus x y);
  };

-- | Build the right Yoneda by specifying the translation from a functor to anything.
;
  unreduceYoneda :: Functor w => (forall z. w z -> f z) -> w x -> Yoneda f x;
  unreduceYoneda f x = Yoneda (\z -> f (z <$> x));

-- | Left Yoneda lemma
;
  data CoYoneda f x = forall z. CoYoneda (z -> x) (f z);

  instance Functor (CoYoneda f) where {
    fmap f (CoYoneda x y) = CoYoneda (f . x) y;
  };

-- | Lower the left Yoneda by specifying the translation from the inner type to any functor.
;
  reduceCoYoneda :: Functor m => (forall z. f z -> m z) -> CoYoneda f x -> m x;
  reduceCoYoneda f (CoYoneda x y) = x <$> f y;

-- | Free monad from a functor
;
  data Free f x = Pure x | Free (f (Free f x));

  deriving instance (Eq (f (Free f a)), Eq a) => Eq (Free f a);
  deriving instance (Ord (f (Free f a)), Ord a) => Ord (Free f a);
  deriving instance (Read (f (Free f a)), Read a) => Read (Free f a);
  deriving instance (Show (f (Free f a)), Show a) => Show (Free f a);

  instance Functor f => Functor (Free f) where {
    fmap f (Pure x) = Pure (f x);
    fmap f (Free x) = Free (fmap f <$> x);
  };

  instance Functor f => Applicative (Free f) where {
    pure = Pure;
    Pure a <*> Pure b = Pure (a b);
    Pure a <*> Free b = Free (fmap a <$> b);
    Free a <*> b = Free ((<*> b) <$> a);
  };

  instance Functor f => Monad (Free f) where {
    return = Pure;
    Pure a >>= f = f a;
    Free m >>= f = Free ((>>= f) <$> m);
  };

  joinFree :: Functor f => Free f (Free f x) -> Free f x;
  joinFree (Pure x) = x;
  joinFree (Free x) = Free (join <$> x);
  -- {-# RULES "join=joinFree" join = joinFree #-};

  instance (Functor f, Plus f) => Alternative (Free f) where {
    empty = Free zero;
    Pure x <|> _ = Pure x;
    _ <|> Pure x = Pure x;
    Free x <|> Free y = Free (plus x y);
  };

  instance (Functor f, Plus f) => MonadPlus (Free f) where {
    mzero = empty;
    mplus = (<|>);
  };

  instance Plus f => Plus (Free f) where {
    zero = Free zero;
    plus (Pure x) _ = Pure x;
    plus _ (Pure x) = Pure x;
    plus (Free x) (Free y) = Free (plus x y);
  };

  instance ComonadHoist Free where {
    cohoist (Pure x) = Pure x;
    cohoist (Free x) = Free (pure . cohoist $ extract x);
  };

-- | Lowers the free monad to another monad by giving the translation from the functor to the monad.
;
  reduceFree :: Monad m => (forall z. f z -> m z) -> Free f x -> m x;
  reduceFree f (Pure x) = return x;
  reduceFree f (Free x) = f x >>= reduceFree f;

-- | Affect each level of the structure and pass a result of reading them to the leaf nodes.
;
  affectFree :: Functor g => (forall z. (s, f z) -> g (s, z)) -> (s, Free f x) -> Free g (s, x);
  affectFree _ (s, Pure x) = Pure (s, x);
  affectFree f (s, Free x) = Free (w f $ f (s, x)) where {
    w :: Functor g => (forall z. (s, f z) -> g (s, z)) -> g (s, Free f x) -> g (Free g (s, x));
    w f' x' = affectFree f' <$> x';
  };

-- | Free comonad from a functor
;
  data Cofree f x = x :< f (Cofree f x);
  infixr 5 :<;

  deriving instance (Eq (f (Cofree f a)), Eq a) => Eq (Cofree f a);
  deriving instance (Ord (f (Cofree f a)), Ord a) => Ord (Cofree f a);
  deriving instance (Read (f (Cofree f a)), Read a) => Read (Cofree f a);
  deriving instance (Show (f (Cofree f a)), Show a) => Show (Cofree f a);

  instance Functor f => Functor (Cofree f) where {
    fmap f (x :< y) = f x :< (fmap f <$> y);
  };

  instance Functor f => Extend (Cofree f) where {
    duplicate z@(x :< y) = z :< (duplicate <$> y);
  };

  instance Functor f => Comonad (Cofree f) where {
    extract (x :< _) = x;
  };

  instance Applicative f => Applicative (Cofree f) where {
    pure x = x :< pure (pure x);
    (f :< fs) <*> (a :< as) = f a :< ((<*>) <$> fs <*> as);
    (f :< fs) <* (_ :< as) = f :< ((<*) <$> fs <*> as);
    (_ :< fs) *> (a :< as) = a :< ((*>) <$> fs <*> as);
  };

  instance ComonadHoist Cofree where {
    cohoist (x :< y) = x :< (pure . cohoist $ extract y);
  };

-- | Make up the 'Cofree' structure by unfolding it.
;
  unfold :: Functor f => (b -> (a, f b)) -> b -> Cofree f a;
  unfold f = uncurry (:<) . second (fmap $ unfold f) . f;

-- | Build the free comonad from a comonad by giving the translation from the comonad to a functor.
;
  unreduceCofree :: Comonad w => (forall z. w z -> f z) -> w x -> Cofree f x;
  unreduceCofree f x = extract x :< f (x =>> unreduceCofree f);

-- | Affect each level of the structure and pass a result of reading them to each node.
;
  affectCofree :: Functor g => (forall z. (s, f z) -> g (s, z)) -> (s, Cofree f x) -> Cofree g (s, x);
  affectCofree f (s, x :< y) = (s, x) :< w f (f (s, y)) where {
    w :: Functor g => (forall z. (s, f z) -> g (s, z)) -> g (s, Cofree f x) -> g (Cofree g (s, x));
    w f' x' = affectCofree f' <$> x';
  };

-- | Transformer of free monad.
;
  newtype FreeT f m r = FreeT { runFreeT :: m (Either r (f (FreeT f m r))) };

  instance (Functor f, Functor m) => Functor (FreeT f m) where {
    fmap f (FreeT x) = FreeT ((f +++ fmap (fmap f)) <$> x);
  };

  instance (Functor f, Monad m) => Monad (FreeT f m) where {
    return = FreeT . return . Left;
    FreeT m >>= f = FreeT (m >>= either (runFreeT . f) (return . Right . fmap (>>= f)));
  };

  joinFreeT :: (Functor f, Monad m) => FreeT f m (FreeT f m x) -> FreeT f m x;
  joinFreeT (FreeT x) = FreeT (x >>= either runFreeT (return . Right . fmap join));
  -- {-# RULES "join=joinFreeT" join = joinFreeT #-};

  instance (Functor f, Applicative m, Monad m) => Applicative (FreeT f m) where {
    pure = return;
    (<*>) = ap;
  };

  instance (Functor f, MonadPlus m) => MonadPlus (FreeT f m) where {
    mzero = FreeT mzero;
    mplus (FreeT x) (FreeT y) = FreeT (mplus x y);
  };

  instance (Functor f, Monad m, Alternative m) => Alternative (FreeT f m) where {
    empty = FreeT empty;
    FreeT x <|> FreeT y = FreeT (x <|> y);
  };

  instance Plus m => Plus (FreeT f m) where {
    zero = FreeT zero;
    plus (FreeT x) (FreeT y) = FreeT (plus x y);
  };

  instance MonadTrans (FreeT f) where {
    lift = FreeT . liftM Left;
  };

-- | As 'reduceFree' for transformers (you must reduce to the monad being transformed).
;
  reduceFreeT :: Monad m => (forall z. f z -> m z) -> FreeT f m x -> m x;
  reduceFreeT f (FreeT x) = x >>= either return (f >=> reduceFreeT f);

  data CofreeT f w x = CofreeT (w x) (f (CofreeT f w x));
--  data CofreeT f w x = CofreeT (w (x, f (CofreeT f w x)));

  instance (Functor f, Functor w) => Functor (CofreeT f w) where {
    fmap f (CofreeT x y) = CofreeT (f <$> x) (fmap f <$> y);
  };

  instance (Functor f, Extend w) => Extend (CofreeT f w) where {
    duplicate (CofreeT x y) = CofreeT (x =>> flip CofreeT y) (duplicate <$> y);
  };

  instance (Functor f, Comonad w) => Comonad (CofreeT f w) where {
    extract (CofreeT x _) = extract x;
  };

  instance ComonadTrans (CofreeT f) where {
    lower (CofreeT x _) = x;
  };

-- | As 'unreduceCofree' for transformers (you must unreduce from the comonad being transformed).
;
  unreduceCofreeT :: Comonad w => (forall z. w z -> f z) -> w x -> CofreeT f w x;
  unreduceCofreeT f x = CofreeT x (f (x =>> unreduceCofreeT f));

-- | Codensity monad from anything (it doesn't have to be a functor)
;
  newtype Codensity f x = Codensity { runCodensity :: forall z. (x -> f z) -> f z };

  instance Functor (Codensity f) where {
    fmap f (Codensity x) = Codensity (\k -> x (k . f));
  };

  instance Monad (Codensity f) where {
    return x = Codensity ($ x);
    m >>= k = Codensity (\c -> runCodensity m (\a -> runCodensity (k a) c));
  };

  instance Applicative (Codensity f) where {
    pure x = Codensity ($ x);
    (<*>) = ap;
  };

  instance Plus f => Alternative (Codensity f) where {
    empty = Codensity (const zero);
    Codensity x <|> Codensity y = Codensity (liftA2 plus x y);
  };

  instance Plus f => MonadPlus (Codensity f) where {
    mzero = Codensity (const zero);
    mplus (Codensity x) (Codensity y) = Codensity (liftA2 plus x y);
  };

  instance Plus f => Plus (Codensity f) where {
    zero = mzero;
    plus = mplus;
  };

  instance MonadTrans Codensity where {
    lift x = Codensity (x >>=);
  };

-- | You can reduce the codensity monad of any applicative functor to that applicative functor.
;
  lowerCodensity :: Applicative f => Codensity f x -> f x;
  lowerCodensity (Codensity x) = x pure;

-- | Density comonad from anything (it doesn't have to be a functor)
;
  data Density f x = forall z. Density (f z -> x) (f z);

  instance Functor (Density f) where {
    fmap f (Density x y) = Density (f . x) y;
  };

  instance Extend (Density f) where {
    duplicate (Density f x) = Density (Density f) x;
  };

  instance Comonad (Density f) where {
    extract (Density f x) = f x;
  };

  instance Applicative f => Applicative (Density f) where {
    pure x = Density (const x) (pure ());
    Density f x <*> Density a y = Density (\k -> f (fst <$> k) (a (snd <$> k))) (liftA2 (,) x y);
  };

  instance ComonadTrans Density where {
    lower (Density f x) = x =>> f;
  };

-- | You can make the density comonad from any copointed functor.
;
  liftDensity :: Comonad w => w a -> Density w a;
  liftDensity = Density extract;

  newtype CodensityAskT w m x = CodensityAskT { runCodensityAskT :: forall z. w (m z) -> (x -> m z) -> m z };

-- | Codensity monad taking a parameter holding something related to the output type. If this parameter is a comonad, you get a 'MonadPlus'.
;
  newtype CodensityAsk w x = CodensityAsk { runCodensityAsk :: forall z. w z -> (x -> z) -> z };

  instance Functor (CodensityAskT w m) where {
    fmap f (CodensityAskT x) = CodensityAskT (\q k -> x q (k . f));
  };

  instance Monad (CodensityAskT w m) where {
    return x = CodensityAskT (\_ f -> f x);
    CodensityAskT m >>= f = CodensityAskT (\q k -> m q (\a -> runCodensityAskT (f a) q k));
  };

  instance Comonad w => MonadPlus (CodensityAskT w m) where {
    mzero = CodensityAskT (\q _ -> extract q);
    mplus (CodensityAskT f) (CodensityAskT g) = CodensityAskT $ flip (\y -> flip f y =<= flip g y);
  };

  instance Applicative (CodensityAskT w f) where {
    pure = return;
    (<*>) = ap;
  };

  instance Comonad w => Alternative (CodensityAskT w f) where {
    empty = CodensityAskT (\q _ -> extract q);
    CodensityAskT f <|> CodensityAskT g = CodensityAskT $ flip (\y -> flip f y =<= flip g y);
  };

  instance Comonad w => Plus (CodensityAskT w f) where {
    zero = empty;
    plus = (<|>);
  };

  instance MonadTrans (CodensityAskT w) where {
    lift x = CodensityAskT (\_ f -> x >>= f);
  };

  instance Functor (CodensityAsk w) where {
    fmap f (CodensityAsk x) = CodensityAsk (\q k -> x q (k . f));
  };

  instance Monad (CodensityAsk w) where {
    return x = CodensityAsk (\_ f -> f x);
    CodensityAsk m >>= f = CodensityAsk (\q k -> m q (\a -> runCodensityAsk (f a) q k));
  };

  instance Comonad w => MonadPlus (CodensityAsk w) where {
    mzero = CodensityAsk (\q _ -> extract q);
    mplus (CodensityAsk f) (CodensityAsk g) = CodensityAsk $ flip (\y -> flip f y =<= flip g y);
  };

  instance Applicative (CodensityAsk w) where {
    pure = return;
    (<*>) = ap;
  };

  instance Comonad w => Alternative (CodensityAsk w) where {
    empty = CodensityAsk (\q _ -> extract q);
    CodensityAsk f <|> CodensityAsk g = CodensityAsk $ flip (\y -> flip f y =<= flip g y);
  };

  instance Comonad w => Plus (CodensityAsk w) where {
    zero = empty;
    plus = (<|>);
  };

-- | Access the result of some 'CodensityAsk' by specifying an input which corresponds to the result.
;
  peekCodensityAsk :: w x -> CodensityAsk w x -> x;
  peekCodensityAsk x (CodensityAsk f) = f x id;

  peekCodensityAskT :: Applicative m => w (m x) -> CodensityAskT w m x -> m x;
  peekCodensityAskT x (CodensityAskT f) = f x pure;

  lowerCodensityAskT :: (Plus w, Applicative m) => CodensityAskT w m x -> m x;
  lowerCodensityAskT (CodensityAskT f) = f zero pure;

  catchCodensityAsk :: w (CodensityAsk w x) -> CodensityAsk w x -> CodensityAsk w x;
  catchCodensityAsk w (CodensityAsk f) = f w return;

  catchCodensityAskT :: (Functor w, Monad m) => w (CodensityAskT w m x) -> CodensityAskT w m x -> CodensityAskT w m x;
  catchCodensityAskT w (CodensityAskT f) = join . lift $ f (return <$> w) (return . return);

  data DensityAskT p f x = forall z. DensityAskT (p z -> f z -> x) (f z);

-- | Density comonad taking a parameter holding something related to the output type. If this parameter is a 'Plus', you get a comonad.
;
  type DensityAsk p = DensityAskT p Identity;

  instance Functor (DensityAskT p f) where {
    fmap f (DensityAskT x y) = DensityAskT (\q -> f . x q) y;
  };

  instance Plus p => Extend (DensityAskT p f) where {
    duplicate (DensityAskT x y) = DensityAskT (\q z -> DensityAskT (\q' z' -> x (plus q q') z') z) y;
  };

  instance Plus p => Comonad (DensityAskT p f) where {
    extract (DensityAskT x y) = x zero y;
  };

  instance Plus p => ComonadTrans (DensityAskT p) where {
    lower (DensityAskT x y) = y =>> x zero;
  };

  liftDensityAsk :: Comonad w => w x -> DensityAskT p w x;
  liftDensityAsk = DensityAskT $ const extract;

-- | Make a monad transformer from any comonad as Edward Kmett described.
;
  newtype CoT w m a = CoT { runCoT :: forall r. w (a -> m r) -> m r };

  type Co w = CoT w Identity;

  runCo :: Functor w => Co w a -> w (a -> r) -> r;
  runCo m = runIdentity . runCoT m . fmap (fmap Identity);

  instance Functor w => Functor (CoT w m) where {
    fmap f (CoT w) = CoT (w . fmap (. f));
  };

  instance Comonad w => Applicative (CoT w m) where {
    pure x = CoT (flip extract x);
    f <*> x = f >>= flip fmap x;
  };

  instance Comonad w => Monad (CoT w m) where {
    return x = CoT (flip extract x);
    CoT k >>= f = CoT (k . extend (\w a -> runCoT (f a) w))
  };

  instance (Comonad w, Plus m) => Alternative (CoT w m) where {
    empty = CoT (const zero);
    CoT x <|> CoT y = CoT (liftA2 plus x y);
  };

  instance (Comonad w, Plus m) => MonadPlus (CoT w m) where {
    mzero = CoT (const zero);
    mplus (CoT x) (CoT y) = CoT (liftA2 plus x y);
  };

  instance Comonad w => MonadTrans (CoT w) where {
    lift x = CoT (\z -> x >>= extract z);
  };

  liftCoT0 :: Comonad w => (forall a. w a -> s) -> CoT w m s;
  liftCoT0 f = CoT (extract <*> f);

  lowerCoT0 :: (Functor w, Applicative m) => CoT w m s -> w a -> m s;
  lowerCoT0 (CoT m) = m . (pure <$);

  lowerCo0 :: Functor w => Co w s -> w a -> s;
  lowerCo0 (CoT m) = runIdentity . m . (return <$);

  liftCoT1 :: (forall a. w a -> a) -> CoT w m ();
  liftCoT1 f = CoT $ flip f ();

  lowerCoT1 :: (Functor w, Applicative m) => CoT w m z -> w a -> m a;
  lowerCoT1 (CoT m) = m . fmap (const . pure);

  lowerCo1 :: Functor w => Co w z -> w a -> a;
  lowerCo1 (CoT m) = runIdentity . m . fmap (const . return);

-- | Finalize monad on '(->)' category. (The Finalize monad is the only possible monad of a endofunctor taking all objects to one final object of the category.)
;
  data Finalize x = Finalize;

-- | Initialize comonad on '(->)' category. (The Initialize comonad is dual to the Finalize monad.)
;
  data Initialize x;

  instance Functor Finalize where {
    fmap _ Finalize = Finalize;
  };

  instance Contravariant Finalize where {
    contramap _ Finalize = Finalize;
  };

  instance Applicative Finalize where {
    pure _ = Finalize;
    Finalize <*> Finalize = Finalize;
  };

  instance Monad Finalize where {
    return _ = Finalize;
    Finalize >>= _ = Finalize;
  };

  instance Alternative Finalize where {
    empty = Finalize;
    Finalize <|> Finalize = Finalize;
  };

  instance MonadPlus Finalize where {
    mzero = Finalize;
    mplus Finalize Finalize = Finalize;
  };

  instance Monoid (Finalize x) where {
    mempty = Finalize;
    mappend Finalize Finalize = Finalize;
    mconcat _ = Finalize;
  };

  instance Functor Initialize where {
    fmap _ _ = undefined;
  };

  instance Contravariant Initialize where {
    contramap _ _ = undefined;
  };

  instance Extend Initialize where {
    duplicate _ = undefined;
  };

  instance Comonad Initialize where {
    extract _ = undefined;
  };

  data Decompose :: (* -> *) -> (* -> *) -> * -> * where {
    Decompose :: y z -> Decompose x y (x z);
  };

  instance ComonadHoist (Decompose f) where {
    cohoist (Decompose a) = Decompose (pure $ extract a);
  };

  data Recompose :: ((* -> *) -> (* -> *) -> * -> *) -> (* -> *) -> * -> * where {
    Recompose :: forall (w :: (* -> *) -> (* -> *) -> * -> *) (x :: * -> *) y z. w x y (x z) -> Recompose w y z;
  };

-- instance Plus for other modules which Alternative

  instance Plus [] where {
    zero = [];
    plus = (++);
  };

  instance Plus Maybe where {
    zero = empty;
    plus = (<|>);
  };

  instance Plus Seq where {
    zero = mempty;
    plus = mappend;
  };

  instance Ord k => Plus (Map k) where {
    zero = mempty;
    plus = mappend;
  };

  instance Plus IntMap where {
    zero = mempty;
    plus = mappend;
  };

  instance (Functor m, Monad m) => Plus (MaybeT m) where {
    zero = empty;
    plus = (<|>);
  };

  instance (ArrowZero a, ArrowPlus a) => Plus (WrappedArrow a b) where {
    zero = empty;
    plus = (<|>);
  };

  instance (Monoid w, Functor m, MonadPlus m) => Plus (RWST r w s m) where {
    zero = mzero;
    plus = mplus;
  };

  instance Plus f => Plus (ReaderT x f) where {
    zero = ReaderT (const zero);
    plus (ReaderT x) (ReaderT y) = ReaderT (liftA2 plus x y);
  };

  instance Plus f => Plus (WriterT x f) where {
    zero = WriterT zero;
    plus (WriterT x) (WriterT y) = WriterT (plus x y);
  };

  instance MonadPlus m => Plus (StateT s m) where {
    zero = mzero;
    plus = mplus;
  };

}

-- Please notify me in case any of this is wrong. (I am not a mathematician.)