comonad-transformers 0.6.2 → 0.6.5

raw patch · 10 files changed

+233/−49 lines, 10 filesdep +prelude-extrasdep +syb-extrasPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: prelude-extras, syb-extras

API changes (from Hackage documentation)

Files

• Control/Comonad/Trans/Discont/Lazy.hs +1/−1
• Control/Comonad/Trans/Discont/Strict.hs +1/−1
• Control/Comonad/Trans/Env/Lazy.hs +32/−6
• Control/Comonad/Trans/Env/Strict.hs +32/−7
• Control/Comonad/Trans/Store/Lazy.hs +4/−1
• Control/Comonad/Trans/Store/Strict.hs +4/−1
• Control/Comonad/Trans/Stream.hs +107/−23
• Control/Comonad/Trans/Traced.hs +1/−3
• Control/Monad/Trans/Cont/Comonadic.hs +37/−0
• comonad-transformers.cabal +14/−6

@@ -34,7 +34,7 @@ import Control.Comonad import Control.Comonad.Trans.Class -#ifdef GHC_TYPEABLE+#ifdef __GLASGOW_HASKELL__ import Data.Typeable  instance (Typeable s, Typeable1 w) => Typeable1 (DiscontT s w) where

@@ -34,7 +34,7 @@ import Control.Comonad import Control.Comonad.Trans.Class -#ifdef GHC_TYPEABLE+#ifdef __GLASGOW_HASKELL__ import Data.Typeable  instance (Typeable s, Typeable1 w) => Typeable1 (DiscontT s w) where

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Comonad.Trans.Context@@ -28,16 +29,19 @@   , local   ) where +import Control.Applicative import Control.Comonad import Control.Comonad.Trans.Class import Control.Comonad.Hoist.Class import Control.Comonad.Apply import Data.Functor.Apply import Data.Functor.Identity+import Data.Foldable+import Data.Traversable import Data.Monoid -#ifdef GHC_TYPEABLE-import Data.Data+#ifdef __GLASGOW_HASKELL__+import Data.Data.Extras  instance (Typeable s, Typeable1 w) => Typeable1 (EnvT s w) where   typeOf1 dswa = mkTyConApp envTTyCon [typeOf (s dswa), typeOf1 (w dswa)]@@ -54,11 +58,27 @@ instance (Typeable s, Typeable1 w, Typeable a) => Typeable (EnvT s w a) where   typeOf = typeOfDefault +{-+instance (Data e, Data1 w) => Data1 (EnvT e w) where+    gfoldl1 f z (EnvT e wa) = liftK f wa (z EnvT `f` e)+    toConstr1 _ = envTConstr+    gunfold1 k z c = case constrIndex c of+        1 -> liftF k (k (z EnvT))+        _ -> error "gunfold"+    dataTypeOf1 _ = envTDataType+    dataCast1_1 f = gcast1 f++instance (Data e, Data1 w, Data a) => Data (EnvT e w a) where+    gfoldl = gfoldl1+    toConstr = toConstr1+    gunfold = gunfold1+    dataTypeOf = dataTypeOf1+    dataCast1 = dataCast1_1+-}+ instance-  ( Typeable e-  , Typeable1 w-  , Data e-  , Data (w a)+  ( Data e+  , Typeable1 w, Data (w a)   , Data a   ) => Data (EnvT e w a) where     gfoldl f z (EnvT e wa) = z EnvT `f` e `f` wa@@ -108,6 +128,12 @@  instance ComonadHoist (EnvT e) where   cohoist ~(EnvT e wa) = EnvT e (Identity (extract wa))++instance Foldable w => Foldable (EnvT e w) where+  foldMap f (EnvT _ w) = foldMap f w++instance Traversable w => Traversable (EnvT e w) where+  traverse f (EnvT e w) = EnvT e <$> traverse f w  ask :: EnvT e w a -> e ask ~(EnvT e _) = e

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Comonad.Trans.Env.Strict@@ -32,12 +33,14 @@ import Control.Comonad.Apply import Control.Comonad.Trans.Class import Control.Comonad.Hoist.Class+import Data.Foldable+import Data.Traversable import Data.Functor.Apply import Data.Functor.Identity import Data.Monoid -#ifdef GHC_TYPEABLE-import Data.Data+#ifdef __GLASGOW_HASKELL__+import Data.Data.Extras  instance (Typeable s, Typeable1 w) => Typeable1 (EnvT s w) where   typeOf1 dswa = mkTyConApp envTTyCon [typeOf (s dswa), typeOf1 (w dswa)]@@ -54,11 +57,27 @@ instance (Typeable s, Typeable1 w, Typeable a) => Typeable (EnvT s w a) where   typeOf = typeOfDefault -instance -  ( Typeable e-  , Typeable1 w-  , Data e-  , Data (w a)+{-+instance (Data e, Data1 w) => Data1 (EnvT e w) where+    gfoldl1 f z (EnvT e wa) = liftK f wa (z EnvT `f` e)+    toConstr1 _ = envTConstr+    gunfold1 k z c = case constrIndex c of+        1 -> liftF k (k (z EnvT))+        _ -> error "gunfold"+    dataTypeOf1 _ = envTDataType+    dataCast1_1 f = gcast1 f++instance (Data e, Data1 w, Data a) => Data (EnvT e w a) where+    gfoldl = gfoldl1+    toConstr = toConstr1+    gunfold = gunfold1+    dataTypeOf = dataTypeOf1+    dataCast1 = dataCast1_1+-}++instance+  ( Data e+  , Typeable1 w, Data (w a)   , Data a   ) => Data (EnvT e w a) where     gfoldl f z (EnvT e wa) = z EnvT `f` e `f` wa@@ -108,6 +127,12 @@   EnvT ef wf <.> EnvT ea wa = EnvT (ef `mappend` ea) (wf <.> wa)  instance (Monoid e, ComonadApply w) => ComonadApply (EnvT e w)++instance Foldable w => Foldable (EnvT e w) where+  foldMap f (EnvT _ w) = foldMap f w++instance Traversable w => Traversable (EnvT e w) where+  traverse f (EnvT e w) = EnvT e <$> traverse f w  ask :: EnvT e w a -> e ask (EnvT e _) = e

@@ -35,7 +35,7 @@ import Control.Comonad.Trans.Class import Data.Functor.Identity -#ifdef GHC_TYPEABLE+#ifdef __GLASGOW_HASKELL__ import Data.Typeable instance (Typeable s, Typeable1 w) => Typeable1 (StoreT s w) where   typeOf1 dswa = mkTyConApp storeTTyCon [typeOf (s dswa), typeOf1 (w dswa)]@@ -44,6 +44,9 @@       s = undefined       w :: StoreT s w a -> w a       w = undefined++instance (Typeable s, Typeable1 w, Typeable a) => Typeable (StoreT s w a) where+  typeOf = typeOfDefault  storeTTyCon :: TyCon storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.Lazy.StoreT"

@@ -35,7 +35,7 @@ import Control.Comonad.Trans.Class import Data.Functor.Identity -#ifdef GHC_TYPEABLE+#ifdef __GLASGOW_HASKELL__ import Data.Typeable instance (Typeable s, Typeable1 w) => Typeable1 (StoreT s w) where   typeOf1 dswa = mkTyConApp storeTTyCon [typeOf (s dswa), typeOf1 (w dswa)]@@ -44,6 +44,9 @@       s = undefined       w :: StoreT s w a -> w a       w = undefined++instance (Typeable s, Typeable1 w, Typeable a) => Typeable (StoreT s w a) where+  typeOf = typeOfDefault  storeTTyCon :: TyCon storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.Lazy.StoreT"

@@ -26,6 +26,8 @@   -- * Operations   , tails   , unfoldsW+  -- * StreamT nodes+  , Node(..)   ) where  import Control.Applicative@@ -39,8 +41,10 @@ import Data.Traversable import Data.Monoid -#ifdef GHC_TYPEABLE-import Data.Data+import Text.Show.Extras++#ifdef __GLASGOW_HASKELL__+import Data.Data.Extras #endif  -- | Isomorphic to the definition:@@ -50,47 +54,76 @@  -- | cons onto an f-branching stream stream :: a -> f (Stream f a) -> Stream f a -stream a as = StreamT (Identity (a, as))+stream a as = StreamT (Identity (a :< as))  -- | uncons from an f-branching stream runStream :: Stream f a -> (a, f (Stream f a))-runStream = runIdentity . runStreamT+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)++instance (Show1 f, Show1 w) => Show1 (Node f w) where+  showsPrec1 d (a :< as) = showParen (d > 5) $+    showsPrec 6 a . showString " :< " . showsPrec1 5 as++instance (Show1 f, Show1 w, Show a) => Show (Node f w a) where+  showsPrec = showsPrec1+++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 (a, f (StreamT f w a)) }+data StreamT f w a = StreamT { runStreamT :: w (Node f w a) } +instance (Show1 f, Show1 w) => Show1 (StreamT f w) where+  showsPrec1 d (StreamT wa) = showParen (d > 10) $ +    showsPrec1 11 wa++instance (Show1 f, Show1 w, Show a) => Show (StreamT f w a) where+  showsPrec = showsPrec1+ instance (Functor w, Functor f) => Functor (StreamT f w) where-  fmap f = StreamT . fmap (\(a, as) -> (f a, fmap f <$> as)) . runStreamT+  fmap f = StreamT . fmap (fmap f) . runStreamT  instance (Comonad w, Functor f) => Comonad (StreamT f w) where-  extract = fst . extract . runStreamT-  duplicate = StreamT . extend (\w -> (StreamT w, duplicate <$> snd (extract w))) . runStreamT-  extend f = StreamT . extend (\w -> (f (StreamT w), extend f <$> snd (extract w))) . runStreamT+  extract = fstN . extract . runStreamT+  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 (ComonadApply w, FunctorApply f) => FunctorApply (StreamT f w) where   StreamT ffs <.> StreamT aas = StreamT (liftW2 wfa ffs aas) where-    wfa (f,fs) (a,as) = (f a, (<.>) <$> fs <.> as)+    wfa (f :< fs) (a :< as) = f a :< ((<.>) <$> fs <.> as)  instance (ComonadApply w, FunctorApply f) => ComonadApply (StreamT f w)  instance Functor f => ComonadTrans (StreamT f) where-  lower = fmap fst . runStreamT+  lower = fmap fstN . runStreamT  instance Functor f => ComonadHoist (StreamT f) where   cohoist (StreamT wa) = stream a (cohoist <$> as) where-    (a,as) = extract wa +    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+  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+  traverse f (StreamT w) = StreamT <$> traverse (\(a :< as) -> (:<) <$> f a <*> traverse (traverse f) as) w  {- instance Show a => Show (Identity a) where@@ -103,28 +136,70 @@ -}  tails :: Comonad w => StreamT f w a -> f (StreamT f w a)-tails = snd . extract . runStreamT+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))+unfoldsW f = StreamT . extend (\s -> let (h, t) = f s in h :< fmap (\a -> unfoldsW f (a <$ s)) t) -#ifdef GHC_TYPEABLE+#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 dfwa = mkTyConApp streamTTyCon [typeOf1 (f dfwa), typeOf1 (w dfwa)]-    where-      f :: StreamT f w a -> f a -      f = undefined-      w :: StreamT f w a -> w a-      w = undefined+  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 (Data1 f, Data1 w) => Data1 (Node f w) where+  gfoldl1 k z (a :< as) = liftK k (z (:<) `k` a) as+  toConstr1 _ = nodeConstr+  gunfold1 f z c = case constrIndex c of+    1 -> liftF f (f (z (:<)))+    _ -> error "gunfold"+  dataTypeOf1 _ = nodeDataType+  dataCast1_1 f = gcast1 f++instance (Data1 f, Data1 w, Data a) => Data (Node f w a) where+  gfoldl = gfoldl1+  toConstr = toConstr1+  gunfold = gunfold1+  dataTypeOf = dataTypeOf1+  dataCast1 = dataCast1_1++instance (Data1 f, Data1 w) => Data1 (StreamT f w) where+  gfoldl1 k z (StreamT a) = liftK k (z StreamT) (undefined a)+  toConstr1 _ = streamTConstr+  gunfold1 k z c = case constrIndex c of+    1 -> liftF k (z StreamT)+    _ -> error "gunfold"+  dataTypeOf1 _ = streamTDataType+  dataCast1_1 f = gcast1 f++instance (Data1 f, Data1 w, Data a) => Data (StreamT f w a) where+  gfoldl = gfoldl1+  toConstr = toConstr1+  gunfold = gunfold1+  dataTypeOf = dataTypeOf1+  dataCast1 = dataCast1_1+{- -- if any structure ever cried out for generic programming, this is it instance    ( Typeable1 f@@ -141,6 +216,7 @@         _ -> error "gunfold"     dataTypeOf _ = streamTDataType     dataCast1 f = gcast1 f+-}  streamTConstr :: Constr streamTConstr = mkConstr streamTDataType "StreamT" [] Prefix@@ -149,5 +225,13 @@ 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

@@ -35,9 +35,7 @@ import Data.Functor.Identity import Data.Monoid -#ifdef GHC_TYPEABLE import Data.Typeable-#endif  type Traced m = TracedT m Identity @@ -79,7 +77,7 @@ censor :: Functor w => (m -> m) -> TracedT m w a -> TracedT m w a censor g = TracedT . fmap (. g) . runTracedT -#ifdef GHC_TYPEABLE+#ifdef __GLASGOW_HASKELL__  instance (Typeable s, Typeable1 w) => Typeable1 (TracedT s w) where   typeOf1 dswa = mkTyConApp tracedTTyCon [typeOf (s dswa), typeOf1 (w dswa)]

@@ -0,0 +1,37 @@+module Control.Monad.Trans.Cont.Comonadic where++import Control.Comonad+import Control.Applicative+import Control.Monad (ap)+import Data.Functor.Apply+import Data.Functor.Identity++type Cont r = ContW r Identity++cont :: ((a -> r) -> r) -> Cont r a +cont f = ContW (f . runIdentity) ++runCont :: Cont r a -> (a -> r) -> r+runCont (ContW k) = k . Identity++newtype ContW r w a = ContW { runContW :: w (a -> r) -> r }++instance Functor w => Functor (ContW r w) where+  fmap f (ContW k) = ContW $ k . fmap (. f)++instance Comonad w => FunctorApply (ContW r w) where+  (<.>) = ap++instance Comonad w => Applicative (ContW r w) where+  pure x = ContW $ \wk -> extract wk x+  (<*>) = ap -- TODO: expand++instance Comonad w => Monad (ContW r w) where+  return = pure+  ContW k >>= f = ContW $ k . extend (\wa a -> runContW (f a) wa)++-- callCC :: Comonad w => ((forall b. a -> ContW r w b) -> ContW r w a) -> ContW r w a+callCC :: Comonad w => ((a -> ContW r w b) -> ContW r w a) -> ContW r w a+callCC f = ContW $ \wc -> runContW (f (\a -> ContW $ \_ -> extract wc a)) wc++{- instance Comonad w => MonadCont (ContT r w) where callCC = callCC #-}

@@ -1,32 +1,39 @@ name:          comonad-transformers category:      Control, Comonads-version:       0.6.2+version:       0.6.5 license:       BSD3-cabal-version: >= 1.2+cabal-version: >= 1.6 license-file:  LICENSE author:        Edward A. Kmett maintainer:    Edward A. Kmett <ekmett@gmail.com> stability:     provisional-homepage:      http://comonad.com/reader/+homepage:      git://github.com/ekmett/comonad-transformers/ copyright:     Copyright (C) 2008-2011 Edward A. Kmett synopsis:      Haskell 98 comonad transformers description:   Haskell 98 comonad transformers build-type:    Simple extra-source-files: coq/Store.v +source-repository head+  type: git+  location: git://github.com/ekmett/comonad-transformers.git+ library   build-depends:      base >= 4 && < 4.4,     array >= 0.3.0.1 && < 0.4,     comonad >= 0.6 && < 0.7,     functor-apply >= 0.6 && < 0.8,+    prelude-extras >= 0.1 && < 0.3,+    syb-extras >= 0.1 && < 0.3,     transformers >= 0.2.0 && <= 0.3 -  extensions: CPP   if impl(ghc)-    cpp-options: -DGHC_TYPEABLE-    extensions: FlexibleContexts+    build-depends: syb-extras >= 0.1 && <= 0.3+    extensions: DeriveDataTypeable +  extensions: CPP+   exposed-modules:     Control.Comonad.Hoist.Class     Control.Comonad.Trans.Class@@ -42,5 +49,6 @@     Control.Comonad.Trans.Store.Strict     Control.Comonad.Trans.Traced     Control.Comonad.Trans.Stream+    Control.Monad.Trans.Cont.Comonadic    ghc-options:      -Wall