#if __GLASGOW_HASKELL__ >= 707
#endif
module Control.Comonad.Trans.Coiter
(
CoiterT(..)
, Coiter, coiter, runCoiter
, unfold
, ComonadCofree(..)
) where
import Control.Arrow
import Control.Comonad
import Control.Comonad.Trans.Class
import Control.Comonad.Cofree.Class
import Control.Category
import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable
import Data.Foldable
import Data.Functor.Identity
import Data.Traversable
import Prelude hiding (id,(.))
#if defined(GHC_TYPEABLE) || __GLASGOW_HASKELL__ >= 707
import Data.Data
#endif
newtype CoiterT w a = CoiterT { runCoiterT :: w (a, CoiterT w a) }
type Coiter = CoiterT Identity
coiter :: a -> Coiter a -> Coiter a
coiter a as = CoiterT $ Identity (a,as)
runCoiter :: Coiter a -> (a, Coiter a)
runCoiter = runIdentity . runCoiterT
instance Functor w => Functor (CoiterT w) where
fmap f = CoiterT . fmap (bimap f (fmap f)) . runCoiterT
instance Comonad w => Comonad (CoiterT w) where
extract = fst . extract . runCoiterT
extend f = CoiterT . extend (\w -> (f (CoiterT w), extend f $ snd $ extract w)) . runCoiterT
instance Foldable w => Foldable (CoiterT w) where
foldMap f = foldMap (bifoldMap f (foldMap f)) . runCoiterT
instance Traversable w => Traversable (CoiterT w) where
traverse f = fmap CoiterT . traverse (bitraverse f (traverse f)) . runCoiterT
instance ComonadTrans CoiterT where
lower = fmap fst . runCoiterT
instance Comonad w => ComonadCofree Identity (CoiterT w) where
unwrap = Identity . snd . extract . runCoiterT
instance Show (w (a, CoiterT w a)) => Show (CoiterT w a) where
showsPrec d w = showParen (d > 10) $
showString "CoiterT " . showsPrec 11 w
instance Read (w (a, CoiterT w a)) => Read (CoiterT w a) where
readsPrec d = readParen (d > 10) $ \r ->
[(CoiterT w, t) | ("CoiterT", s) <- lex r, (w, t) <- readsPrec 11 s]
instance Eq (w (a, CoiterT w a)) => Eq (CoiterT w a) where
CoiterT a == CoiterT b = a == b
instance Ord (w (a, CoiterT w a)) => Ord (CoiterT w a) where
compare (CoiterT a) (CoiterT b) = compare a b
unfold :: Comonad w => (w a -> a) -> w a -> CoiterT w a
unfold psi = CoiterT . extend (extract &&& unfold psi . extend psi)
#if defined(GHC_TYPEABLE) && __GLASGOW_HASKELL__ < 707
instance Typeable1 w => Typeable1 (CoiterT w) where
typeOf1 t = mkTyConApp coiterTTyCon [typeOf1 (w t)] where
w :: CoiterT w a -> w a
w = undefined
coiterTTyCon :: TyCon
#if __GLASGOW_HASKELL__ < 704
coiterTTyCon = mkTyCon "Control.Comonad.Trans.Coiter.CoiterT"
#else
coiterTTyCon = mkTyCon3 "free" "Control.Comonad.Trans.Coiter" "CoiterT"
#endif
instance
( Typeable1 w, Typeable a
, Data (w (a, CoiterT w a))
, Data a
) => Data (CoiterT w a) where
gfoldl f z (CoiterT w) = z CoiterT `f` w
toConstr _ = coiterTConstr
gunfold k z c = case constrIndex c of
1 -> k (z CoiterT)
_ -> error "gunfold"
dataTypeOf _ = coiterTDataType
dataCast1 f = gcast1 f
coiterTConstr :: Constr
coiterTConstr = mkConstr coiterTDataType "CoiterT" [] Prefix
coiterTDataType :: DataType
coiterTDataType = mkDataType "Control.Comonad.Trans.Coiter.CoiterT" [coiterTConstr]
#endif