comonad-transformers 1.6.3 → 1.7

raw patch · 4 files changed

+281/−210 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Comonad/Trans/Cofree.hs +151/−0
• Control/Comonad/Trans/Stream.hs +0/−208
• Control/Monad/Trans/Free.hs +126/−0
• comonad-transformers.cabal +4/−2

@@ -0,0 +1,151 @@+{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Trans.Cofree+-- Copyright   :  (C) 2008-2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- Haskell 98 cofree comonads+--+----------------------------------------------------------------------------+module Control.Comonad.Trans.Cofree+  ( Cofree(..)+  , section+  , unwrap+  , coiter+  , unfold+  ) where++import Control.Applicative+import Control.Comonad+import Control.Comonad.Trans.Class+import Data.Functor.Bind+import Data.Distributive+import Data.Foldable+import Data.Semigroup+import Data.Monoid+import Data.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable++#ifdef GHC_TYPEABLE+import Data.Data+#endif++infixr 5 :<++data Cofree f a = a :< f (Cofree f a)++unwrap :: Cofree f a -> f (Cofree f a)+unwrap (_ :< as) = as++coiter :: Functor f => (a -> f a) -> a -> Cofree f a+coiter psi a = a :< (coiter psi <$> psi a)++unfold :: Functor f => (b -> (a, f b)) -> b -> Cofree f a+unfold f c = case f c of +  (x, d) -> x :< fmap (unfold f) d++instance Distributive f => Distributive (Cofree f) where+  distribute w = fmap extract w :< fmap distribute (collect unwrap w)++instance Functor f => Functor (Cofree f) where+  fmap f (a :< as) = f a :< fmap (fmap f) as+  b <$ (_ :< as) = b :< fmap (b <$) as++instance Functor f => Extend (Cofree f) where+  extend f w = f w :< fmap (extend f) (unwrap w)+  duplicate w = w :< fmap duplicate (unwrap w)++instance Functor f => Comonad (Cofree f) where+  extract (a :< _) = a++instance ComonadTrans Cofree where+  lower (_ :< as) = fmap extract as++-- | lower . section = id+section :: Comonad f => f a -> Cofree f a +section as = extract as :< extend section as++instance Apply f => Apply (Cofree f) where+  (f :< fs) <.> (a :< as) = f a :< ((<.>) <$> fs <.> as)+  (f :< fs) <.  (_ :< as) = f :< ((<. ) <$> fs <.> as)+  (_ :< fs)  .> (a :< as) = a :< (( .>) <$> fs <.> as)++instance Applicative f => Applicative (Cofree f) where+  pure a = as where as = a :< pure as+  (f :< fs) <*> (a :< as) = f a :< ((<*>) <$> fs <*> as)+  (f :< fs) <*  (_ :< as) = f :< ((<* ) <$> fs <*> as)+  (_ :< fs)  *> (a :< as) = a :< (( *>) <$> fs <*> as)++instance (Show (f (Cofree f a)), Show a) => Show (Cofree f a) where+  showsPrec d (a :< as) = showParen (d > 5) $ +    showsPrec 6 a . showString " :< " . showsPrec 5 as++instance (Read (f (Cofree f a)), Read a) => Read (Cofree f a) where+  readsPrec d r = readParen (d > 5)+                          (\r' -> [(u :< v,w) |+                                  (u, s) <- readsPrec 6 r',+                                  (":<", t) <- lex s,+                                  (v, w) <- readsPrec 5 t]) r++instance (Eq (f (Cofree f a)), Eq a) => Eq (Cofree f a) where+  a :< as == b :< bs = a == b && as == bs++instance (Ord (f (Cofree f a)), Ord a) => Ord (Cofree f a) where+  compare (a :< as) (b :< bs) = case compare a b of+    LT -> LT+    EQ -> compare as bs+    GT -> GT++instance Foldable f => Foldable (Cofree f) where+  foldMap f (a :< as) = f a `mappend` foldMap (foldMap f) as++instance Foldable1 f => Foldable1 (Cofree f) where+  foldMap1 f (a :< as) = f a <> foldMap1 (foldMap1 f) as++instance Traversable f => Traversable (Cofree f) where+  traverse f (a :< as) = (:<) <$> f a <*> traverse (traverse f) as++instance Traversable1 f => Traversable1 (Cofree f) where+  traverse1 f (a :< as) = (:<) <$> f a <.> traverse1 (traverse1 f) as++#ifdef GHC_TYPEABLE+instance (Typeable1 f) => Typeable1 (Cofree f) where+  typeOf1 dfa = mkTyConApp cofreeTyCon [typeOf1 (f dfa)]+    where+      f :: Cofree f a -> f a+      f = undefined++instance (Typeable1 f, Typeable a) => Typeable (Cofree f a) where+  typeOf = typeOfDefault++cofreeTyCon :: TyCon+cofreeTyCon = mkTyCon "Control.Comonad.Cofree.Cofree"+{-# NOINLINE cofreeTyCon #-}++instance+  ( Typeable1 f+  , Data (f (Cofree f a))+  , Data a+  ) => Data (Cofree f a) where+    gfoldl f z (a :< as) = z (:<) `f` a `f` as+    toConstr _ = cofreeConstr+    gunfold k z c = case constrIndex c of+        1 -> k (k (z (:<)))+        _ -> error "gunfold"+    dataTypeOf _ = cofreeDataType+    dataCast1 f = gcast1 f++cofreeConstr :: Constr+cofreeConstr = mkConstr cofreeDataType ":<" [] Infix+{-# NOINLINE cofreeConstr #-}++cofreeDataType :: DataType+cofreeDataType = mkDataType "Control.Comonad.Cofree.Cofree" [cofreeConstr]+{-# NOINLINE cofreeDataType #-}+#endif

@@ -1,208 +0,0 @@-{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module      :  Control.Comonad.Trans.Stream--- Copyright   :  (C) 2008-2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable------ The f-branching stream comonad, aka the cofree comonad for a Functor f.--- --- Provided here as a comonad-transformer version of the 'ListT done right' --- monad transformer.------------------------------------------------------------------------------module Control.Comonad.Trans.Stream -  ( -  -- * The Stream comonad-    Stream-  , stream-  , runStream-  , unfolds-  -- * The Stream comonad transformer-  , StreamT(..)-  -- * Operations-  , tails-  , unfoldsW-  -- * StreamT nodes-  , Node(..)-  ) where--import Control.Applicative-import Control.Comonad-import Control.Comonad.Hoist.Class-import Data.Functor.Apply-import Control.Comonad.Trans.Class-import Data.Functor.Identity-import Data.Foldable-import Data.Traversable-import Data.Monoid--#ifdef __GLASGOW_HASKELL__-import Data.Data-#endif---- | Isomorphic to the definition:------ > data Stream f a = a :< f (Stream f a)-type Stream f = StreamT f Identity---- | cons onto an f-branching stream-stream :: a -> f (Stream f a) -> Stream f a -stream a as = StreamT (Identity (a :< as))---- | uncons from an f-branching stream-runStream :: Stream f a -> (a, f (Stream f a))-runStream (StreamT (Identity (a :< as))) = (a, as)---- | unfold a stream from a seed.-unfolds :: Functor f => (a -> (b, f a)) -> a -> Stream f b-unfolds f a = let (h, t) = f a in stream h (unfolds f <$> t)--data Node f w a = a :< f (StreamT f w a)---infixr 5 :<--fstN :: Node f w a -> a-fstN (a :< _) = a--sndN :: Node f w a -> f (StreamT f w a)-sndN (_ :< as) = as--instance (Functor w, Functor f)  => Functor (Node f w) where-  fmap f (a :< as) = f a :< fmap (fmap f) as--  --- | The f-branching stream comonad transformer is a comonadic version of--- the \"ListT done Right\" monad transformer. You can extract the underlying comonadic --- value by using 'lower' or runStream-data StreamT f w a = StreamT { runStreamT :: w (Node f w a) }--instance (Show a, Show (StreamT f w a), Show (f (StreamT f w a)), Show (w (Node f w a))) => Show (Node f w a) where-  showsPrec d (a :< as) = showParen (d > 5) $-    showsPrec 6 a . showString " :< " . showsPrec 5 as--instance (Show (w (Node f w a)), Show (Node f w a), Show a, Show (f (StreamT f w a))) => Show (StreamT f w a) where-  showsPrec d (StreamT wa) = showParen (d > 10) $ -    showsPrec 11 wa--instance (Functor w, Functor f) => Functor (StreamT f w) where-  fmap f = StreamT . fmap (fmap f) . runStreamT---- TODO: relax requirement to just Extend-instance (Comonad w, Functor f) => Extend (StreamT f w) where-  duplicate = StreamT . extend (\w -> StreamT w :< (duplicate <$> sndN (extract w))) . runStreamT-  extend f = StreamT . extend (\w -> f (StreamT w) :< (extend f <$> sndN (extract w))) . runStreamT--instance (Comonad w, Functor f) => Comonad (StreamT f w) where-  extract = fstN . extract . runStreamT--instance (Comonad w, Apply w, Apply f) => Apply (StreamT f w) where-  StreamT ffs <.> StreamT aas = StreamT (liftF2 wfa ffs aas) where-    wfa (f :< fs) (a :< as) = f a :< ((<.>) <$> fs <.> as)--instance Functor f => ComonadTrans (StreamT f) where-  lower = fmap fstN . runStreamT --instance Functor f => ComonadHoist (StreamT f) where-  cohoist (StreamT wa) = stream a (cohoist <$> as) where-    a :< as = extract wa --instance (Foldable w, Foldable f) => Foldable (StreamT f w) where-  foldMap f = foldMap (\(a :< as) -> f a `mappend` foldMap (foldMap f) as) . runStreamT--instance (Traversable w, Traversable f) => Traversable (StreamT f w) where-  traverse f (StreamT w) = StreamT <$> traverse (\(a :< as) -> (:<) <$> f a <*> traverse (traverse f) as) w---- TODO--- instance (Distributive w, Distributive f) => Distributive (StreamT f w) where--{--instance Show a => Show (Identity a) where-  showsPrec d (Identity a) = showParen (d > 10) $-      showString "Identity " . showsPrec 11 a--instance (Show (w (a, f (StreamT f w a)))) => Show (StreamT f w a) where-  showsPrec d (StreamT w) = showParen (d > 10) $ -      showString "StreamT " . showsPrec 11 w--}--tails :: Comonad w => StreamT f w a -> f (StreamT f w a)-tails = sndN . extract . runStreamT--unfoldsW :: (Comonad w, Functor f) => (w a -> (b, f a)) -> w a -> StreamT f w b-unfoldsW f = StreamT . extend (\s -> let (h, t) = f s in h :< fmap (\a -> unfoldsW f (a <$ s)) t)--#ifdef __GLASGOW_HASKELL__--typeF :: t f w a -> w a -> f a -typeF = undefined-typeW :: t f w a -> f a -> w a-typeW = undefined--instance (Typeable1 f, Typeable1 w) => Typeable1 (Node f w) where-  typeOf1 d = mkTyConApp nodeTyCon [typeOf1 (typeF d undefined), typeOf1 (typeW d undefined)]--instance (Typeable1 f, Typeable1 w, Typeable a) => Typeable (Node f w a) where-  typeOf = typeOfDefault--instance (Typeable1 f, Typeable1 w) => Typeable1 (StreamT f w) where-  typeOf1 d = mkTyConApp streamTTyCon [typeOf1 (typeF d undefined), typeOf1 (typeW d undefined)]--instance (Typeable1 f, Typeable1 w, Typeable a) => Typeable (StreamT f w a) where-  typeOf = typeOfDefault--nodeTyCon :: TyCon-nodeTyCon = mkTyCon "Control.Comonad.Trans.Stream.Node"-{-# NOINLINE nodeTyCon #-}--streamTTyCon :: TyCon-streamTTyCon = mkTyCon "Control.Comonad.Trans.Stream.StreamT"-{-# NOINLINE streamTTyCon #-}--instance (Typeable1 f, Typeable1 w, Data a, Data (f (StreamT f w a)), Data (StreamT f w a)) => Data (Node f w a) where-  gfoldl k z (a :< as) = z (:<) `k` a `k` as-  toConstr _ = nodeConstr-  gunfold f z c = case constrIndex c of-    1 -> f (f (z (:<)))-    _ -> error "gunfold"-  dataTypeOf _ = nodeDataType-  dataCast1 f = gcast1 f---- if any structure ever cried out for generic programming, this is it-instance -  ( Typeable1 f-  , Typeable1 w-  , Data (w (Node f w a))-  , Data (Node f w a)-  , Data (f (StreamT f w a))-  , Data a-  ) => Data (StreamT f w a) where-    gfoldl f z (StreamT a) = z StreamT `f` a-    toConstr _ = streamTConstr-    gunfold k z c = case constrIndex c of-        1 -> k (z StreamT)-        _ -> error "gunfold"-    dataTypeOf _ = streamTDataType-    dataCast1 f = gcast1 f--streamTConstr :: Constr-streamTConstr = mkConstr streamTDataType "StreamT" [] Prefix-{-# NOINLINE streamTConstr #-}--streamTDataType :: DataType-streamTDataType = mkDataType "Control.Comonad.Trans.Stream.StreamT" [streamTConstr]-{-# NOINLINE streamTDataType #-}--nodeConstr :: Constr-nodeConstr = mkConstr streamTDataType ":<" [] Infix-{-# NOINLINE nodeConstr #-}--nodeDataType :: DataType-nodeDataType = mkDataType "Control.Comonad.Trans.Stream.Node" [nodeConstr]-{-# NOINLINE nodeDataType #-}--#endif

@@ -0,0 +1,126 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.Free+-- Copyright   :  (C) 2008-2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- Haskell 98 free monads+--+----------------------------------------------------------------------------+module Control.Monad.Trans.Free+  ( Free(..)+  , retract+  , liftF+  , iter+  , wrap+  ) where++import Control.Applicative+import Control.Monad (liftM, MonadPlus(..))+import Control.Monad.Trans.Class+import Data.Functor.Bind+import Data.Foldable+import Data.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable++data Free f a = Pure a | Free (f (Free f a))++instance (Eq (f (Free f a)), Eq a) => Eq (Free f a) where+  Pure a == Pure b = a == b+  Free fa == Free fb = fa == fb+  _ == _ = False++instance (Ord (f (Free f a)), Ord a) => Ord (Free f a) where+  Pure a `compare` Pure b = a `compare` b+  Pure _ `compare` Free _ = LT+  Free _ `compare` Pure _ = GT+  Free fa `compare` Free fb = fa `compare` fb++instance (Show (f (Free f a)), Show a) => Show (Free f a) where+  showsPrec d (Pure a) = showParen (d > 10) $+    showString "Pure " . showsPrec 11 a+  showsPrec d (Free m) = showParen (d > 10) $+    showString "Free " . showsPrec 11 m++instance (Read (f (Free f a)), Read a) => Read (Free f a) where+  readsPrec d r = readParen (d > 10)+      (\r' -> [ (Pure m, t) +             | ("Pure", s) <- lex r'+             , (m, t) <- readsPrec 11 s]) r+    ++ readParen (d > 10)+      (\r' -> [ (Free m, t)+             | ("Free", s) <- lex r'+             , (m, t) <- readsPrec 11 s]) r++instance Functor f => Functor (Free f) where+  fmap f (Pure a)  = Pure (f a)+  fmap f (Free fa) = Free (fmap f <$> fa)++instance Functor f => Apply (Free f) where+  Pure a  <.> Pure b = Pure (a b)+  Pure a  <.> Free fb = Free $ fmap a <$> fb+  Free fa <.> b = Free $ (<.> b) <$> fa+  +instance Functor f => Applicative (Free f) where+  pure = Pure+  Pure a <*> Pure b = Pure $ a b+  Pure a <*> Free mb = Free $ fmap a <$> mb+  Free ma <*> b = Free $ (<*> b) <$> ma++instance Functor f => Bind (Free f) where+  Pure a >>- f = f a+  Free m >>- f = Free ((>>- f) <$> m)+  +instance Functor f => Monad (Free f) where+  return = Pure+  Pure a >>= f = f a+  Free m >>= f = Free ((>>= f) <$> m)++instance Alternative v => Alternative (Free v) where+  empty = Free empty+  a <|> b = Free (pure a <|> pure b)++instance (Functor v, MonadPlus v) => MonadPlus (Free v) where+  mzero = Free mzero+  a `mplus` b = Free (return a `mplus` return b)++instance MonadTrans Free where+  lift = Free . liftM Pure++instance Foldable f => Foldable (Free f) where+  foldMap f (Pure a) = f a+  foldMap f (Free fa) = foldMap (foldMap f) fa++instance Foldable1 f => Foldable1 (Free f) where+  foldMap1 f (Pure a) = f a+  foldMap1 f (Free fa) = foldMap1 (foldMap1 f) fa++instance Traversable f => Traversable (Free f) where+  traverse f (Pure a) = Pure <$> f a +  traverse f (Free fa) = Free <$> traverse (traverse f) fa++instance Traversable1 f => Traversable1 (Free f) where+  traverse1 f (Pure a) = Pure <$> f a+  traverse1 f (Free fa) = Free <$> traverse1 (traverse1 f) fa++liftF :: Functor f => f a -> Free f a+liftF = Free . fmap Pure++wrap :: f (Free f a) -> Free f a +wrap = Free++-- | retract . lift = id+-- | retract . liftF = id+retract :: Monad f => Free f a -> f a+retract (Pure a) = return a+retract (Free as) = as >>= retract++iter :: Functor f => (f a -> a) -> Free f a -> a+iter _ (Pure a) = a+iter phi (Free m) = phi (iter phi <$> m)

@@ -1,6 +1,6 @@ name:          comonad-transformers category:      Control, Comonads-version:       1.6.3+version:       1.7 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -42,6 +42,7 @@   exposed-modules:     Control.Comonad.Hoist.Class     Control.Comonad.Trans.Class+    Control.Comonad.Trans.Cofree     Control.Comonad.Trans.Discont     Control.Comonad.Trans.Discont.Lazy     Control.Comonad.Trans.Discont.Strict@@ -56,7 +57,8 @@     Control.Comonad.Trans.Store.Memo     Control.Comonad.Trans.Traced     Control.Comonad.Trans.Traced.Memo-    Control.Comonad.Trans.Stream++    Control.Monad.Trans.Free      Data.Functor.Coproduct     Data.Functor.Composition