    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE UndecidableInstances #-}
    #include "free-common.h"
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Comonad.Cofree.Class
    -- Copyright   :  (C) 2008-2011 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  experimental
    -- Portability :  fundeps, MPTCs
    ----------------------------------------------------------------------------
    module Control.Comonad.Cofree.Class
      ( ComonadCofree(..)
      ) where

    import Control.Applicative
    import Control.Comonad
    import Control.Comonad.Trans.Env
    import Control.Comonad.Trans.Store
    import Control.Comonad.Trans.Traced
    import Control.Comonad.Trans.Identity
    import Data.List.NonEmpty
    import Data.Tree
    #if __GLASGOW_HASKELL__ < 710
    import Data.Monoid
    #endif

    -- | Allows you to peel a layer off a cofree comonad.
    class (Functor f, Comonad w) => ComonadCofree f w | w -> f where
      -- | Remove a layer.
      unwrap :: w a -> f (w a)

    instance ComonadCofree Maybe NonEmpty where
      unwrap :: NonEmpty a -> Maybe (NonEmpty a)
    unwrap (_ :| [])       = Maybe (NonEmpty a)
    forall a. Maybe a
    Nothing
      unwrap (_ :| (a :: a
    a : as :: [a]
    as)) = NonEmpty a -> Maybe (NonEmpty a)
    forall a. a -> Maybe a
    Just (a
    a a -> [a] -> NonEmpty a
    forall a. a -> [a] -> NonEmpty a
    :| [a]
    as)

    instance ComonadCofree [] Tree where
      unwrap :: Tree a -> [Tree a]
    unwrap = Tree a -> [Tree a]
    forall a. Tree a -> [Tree a]
    subForest

    instance ComonadCofree (Const b) ((,) b) where
      unwrap :: (b, a) -> Const b (b, a)
    unwrap = b -> Const b (b, a)
    forall k a (b :: k). a -> Const a b
    Const (b -> Const b (b, a)) -> ((b, a) -> b) -> (b, a) -> Const b (b, a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b, a) -> b
    forall a b. (a, b) -> a
    fst

    instance ComonadCofree f w => ComonadCofree f (IdentityT w) where
      unwrap :: IdentityT w a -> f (IdentityT w a)
    unwrap = (w a -> IdentityT w a) -> f (w a) -> f (IdentityT w a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap w a -> IdentityT w a
    forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
    IdentityT (f (w a) -> f (IdentityT w a))
    -> (IdentityT w a -> f (w a)) -> IdentityT w a -> f (IdentityT w a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . w a -> f (w a)
    forall (f :: * -> *) (w :: * -> *) a.
    ComonadCofree f w =>
    w a -> f (w a)
    unwrap (w a -> f (w a))
    -> (IdentityT w a -> w a) -> IdentityT w a -> f (w a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IdentityT w a -> w a
    forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
    runIdentityT

    instance ComonadCofree f w => ComonadCofree f (EnvT e w) where
      unwrap :: EnvT e w a -> f (EnvT e w a)
    unwrap (EnvT e :: e
    e wa :: w a
    wa) = e -> w a -> EnvT e w a
    forall e (w :: * -> *) a. e -> w a -> EnvT e w a
    EnvT e
    e (w a -> EnvT e w a) -> f (w a) -> f (EnvT e w a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> w a -> f (w a)
    forall (f :: * -> *) (w :: * -> *) a.
    ComonadCofree f w =>
    w a -> f (w a)
    unwrap w a
    wa

    instance ComonadCofree f w => ComonadCofree f (StoreT s w) where
      unwrap :: StoreT s w a -> f (StoreT s w a)
    unwrap (StoreT wsa :: w (s -> a)
    wsa s :: s
    s) = (w (s -> a) -> s -> StoreT s w a)
    -> s -> w (s -> a) -> StoreT s w a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip w (s -> a) -> s -> StoreT s w a
    forall s (w :: * -> *) a. w (s -> a) -> s -> StoreT s w a
    StoreT s
    s (w (s -> a) -> StoreT s w a) -> f (w (s -> a)) -> f (StoreT s w a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> w (s -> a) -> f (w (s -> a))
    forall (f :: * -> *) (w :: * -> *) a.
    ComonadCofree f w =>
    w a -> f (w a)
    unwrap w (s -> a)
    wsa

    instance (ComonadCofree f w, Monoid m) => ComonadCofree f (TracedT m w) where
      unwrap :: TracedT m w a -> f (TracedT m w a)
    unwrap (TracedT wma :: w (m -> a)
    wma) = w (m -> a) -> TracedT m w a
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (w (m -> a) -> TracedT m w a)
    -> f (w (m -> a)) -> f (TracedT m w a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> w (m -> a) -> f (w (m -> a))
    forall (f :: * -> *) (w :: * -> *) a.
    ComonadCofree f w =>
    w a -> f (w a)
    unwrap w (m -> a)
    wma