control-monad-free 0.5.3 → 0.6

raw patch · 3 files changed

+74/−21 lines, 3 filesdep +prelude-extrasdep −deepseqdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: prelude-extras

Dependencies removed: deepseq

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Control/Monad/Free.hs +50/−12
• Control/Monad/Free/Improve.hs +14/−3
• control-monad-free.cabal +10/−6

@@ -1,6 +1,8 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}  module Control.Monad.Free (@@ -16,18 +18,20 @@ -- * Free Monad Transformers    FreeT(..),    foldFreeT, foldFreeT', mapFreeT,+   foldFreeA, mapFreeA, -- * Translate between Free monad and Free monad transformer computations    trans, trans', untrans,liftFree   ) where  import Control.Applicative-import Control.DeepSeq import Control.Monad import Control.Monad.Trans.Class+import Control.Monad.IO.Class import Data.Foldable-import Data.Monoid import Data.Traversable as T-import Prelude hiding (abs)+import Data.Typeable (Typeable)+import GHC.Generics (Generic)+import Prelude.Extras  -- | This type class generalizes over encodings of Free Monads. class (Functor f, Monad m) => MonadFree f m where@@ -38,11 +42,25 @@     free = evalFree (Pure . Left) (Pure . Right)     wrap = Impure -data Free f a = Impure (f (Free f a)) | Pure a-deriving instance (Eq a, Eq (f(Free f a))) => Eq (Free f a)-deriving instance (Ord a, Ord (f(Free f a))) => Ord (Free f a)-deriving instance (Show a, Show (f(Free f a))) => Show (Free f a)+data Free f a = Impure (f (Free f a)) | Pure a deriving (Generic, Typeable) +instance (Eq1 f) => Eq1 (Free f) where (==#) = (==)+instance (Eq a, Eq1 f) => Eq (Free f a) where+ Pure a == Pure b = a == b+ Impure a == Impure b = a ==# b+ _ == _ = False++instance Ord1 f => Ord1 (Free f) where compare1 = compare+instance (Ord a, Ord1 f) => Ord (Free f a) where+  compare Impure{} Pure{} = LT+  compare Pure{} Impure{} = GT+  compare (Pure   a) (Pure   b) = compare a b+  compare (Impure a) (Impure b) = compare1 a b++instance (Show a, Show1 f) => Show (Free f a) where+  showsPrec p (Pure   a) = showParen (p > 0) $ ("Pure "   ++) . showsPrec  11 a+  showsPrec p (Impure a) = showParen (p > 0) $ ("Impure " ++) . showsPrec1 11 a+ instance Functor f => Functor (Free f) where     fmap f (Pure a)    = Pure   (f a)     fmap f (Impure fa) = Impure (fmap (fmap f) fa)@@ -60,9 +78,10 @@     Pure a    >>= f = f a     Impure fa >>= f = Impure (fmap (>>= f) fa) -instance (NFData a, NFData (f(Free f a))) => NFData (Free f a) where-  rnf (Pure a) = rnf a `seq` ()-  rnf (Impure fa) = rnf fa `seq` ()+instance Functor f => Applicative (Free f) where+  pure = Pure+  Pure   f <*> x = fmap f x+  Impure f <*> x = Impure (fmap (<*> x) f)  isPure Pure{} = True; isPure _ = False isImpure = not . isPure@@ -75,6 +94,10 @@ foldFreeM pure _    (Pure   x) = pure x foldFreeM pure imp  (Impure x) = imp =<< T.mapM (foldFreeM pure imp) x +foldFreeA :: (Traversable f, Applicative m) => (a -> m b) -> m (f b -> b) -> Free f a -> m b+foldFreeA pure _    (Pure   x) = pure x+foldFreeA pure imp  (Impure x) = imp <*> traverse (foldFreeA pure imp) x+ induce :: (Functor f, Monad m) => (forall a. f a -> m a) -> Free f a -> m a induce f = foldFree return (join . f) @@ -88,6 +111,10 @@ mapFreeM  :: (Traversable f, Functor g, Monad m) => (f (Free g a) -> m(g (Free g a))) -> Free f a -> m(Free g a) mapFreeM eta = foldFreeM (return . Pure) (liftM Impure . eta) +mapFreeA  :: (Traversable f, Functor g, Applicative m) =>+             m (f (Free g a) -> g (Free g a)) -> Free f a -> m(Free g a)+mapFreeA eta = foldFreeA (pure . Pure) (liftA (Impure .) eta)+ mapFreeM' :: (Functor f, Traversable g, Monad m) => (forall a. f a -> m(g a)) -> Free f a -> m(Free g a) mapFreeM' eta = foldFree (return . Pure)                          (liftM Impure . join . liftM T.sequence . eta)@@ -108,6 +135,10 @@ instance (Functor f, Functor m) => Functor (FreeT f m) where     fmap f = conj $ fmap (editEither f ((fmap.fmap) f)) +instance (Functor f, Functor a, Monad a) => Applicative (FreeT f a) where+    pure = FreeT . return . Left+    (<*>) = ap+ instance (Functor f, Monad m) => Monad (FreeT f m) where     return = FreeT . return . Left     m >>= f = FreeT $ unFreeT m >>= \r ->@@ -122,6 +153,13 @@ instance (Functor f) => MonadTrans (FreeT f) where     lift = FreeT . liftM Left +instance (Functor f, Monad m, MonadIO m) => MonadIO (FreeT f m) where+    liftIO = lift . liftIO++instance (Functor f, Monad m, MonadPlus m) => MonadPlus (FreeT f m) where+    mzero = lift mzero+    mplus a b = FreeT (mplus (unFreeT a) (unFreeT b))+ foldFreeT :: (Traversable f, Monad m) => (a -> m b) -> (f b -> m b) -> FreeT f m a -> m b foldFreeT p i m = unFreeT m >>= \r ->               case r of@@ -142,8 +180,8 @@ untrans :: (Traversable f, Monad m) => FreeT f m a -> m(Free f a) untrans = foldFreeT (return . Pure) (return . Impure) -trans :: (Functor f, Monad m) => Free f a -> FreeT f m a-trans  = FreeT . foldFree (return . Left) (return . Right . fmap FreeT)+trans :: MonadFree f m => Free f a -> m a+trans  = foldFree return wrap  trans' :: (Functor f, Monad m) => m(Free f a) -> FreeT f m a trans' = FreeT . join . liftM unFreeT . liftM trans

@@ -17,9 +17,10 @@    C(..), rep, improve   ) where +import Control.Applicative import Control.Monad import Control.Monad.Free-+import Control.Monad.Trans.Class  newtype C mu a = C (forall b. (a -> mu b) -> mu b) @@ -37,10 +38,20 @@   return a = C (\h -> h a)   C p >>= k = C (\h -> p (\a -> case k a of C q -> q h)) +instance Applicative (C mu) where+  pure = return+  (<*>) = ap+ instance Functor f => MonadFree f (C (Free f)) where   wrap t = C (\h -> wrap (fmap (\(C p) -> p h) t))   free   = rep . (fmap.fmap.fmap) rep . free . improve +instance (Monad m, Functor f) => MonadFree f (C (FreeT f m)) where+  wrap t = C (\h -> wrap (fmap (\(C p) -> p h) t))+  free   = rep . (liftM.fmap.fmap) rep . free . improve+ instance MonadPlus mu => MonadPlus (C mu) where-    mzero       = rep mzero-    mplus p1 p2 = rep (mplus (improve p1) (improve p2))+  mzero       = rep mzero+  mplus p1 p2 = rep (mplus (improve p1) (improve p2))++instance MonadTrans C where lift m = C (m >>=)

@@ -1,16 +1,16 @@ name: control-monad-free-version: 0.5.3+version: 0.6 Cabal-Version:  >= 1.6 build-type: Simple license: PublicDomain author: Luke Palmer, Pepe Iborra maintainer: pepeiborra@gmail.com homepage: http://github.com/pepeiborra/control-monad-free-description: +description:           This package provides datatypes to construct Free monads, -	  Free monad transformers, and useful instances. In addition it-	  provides the constructs to avoid quadratic complexity of left -	  associative bind, as explained in:+          Free monad transformers, and useful instances. In addition it+          provides the constructs to avoid quadratic complexity of left +          associative bind, as explained in:           .           * Janis Voigtlander, /Asymptotic Improvement of Computations over Free Monads, MPC'08/  @@ -18,9 +18,13 @@ category: Control, Monads stability: experimental +source-repository head+  type:     git+  location: git://github.com/pepeiborra/control-monad-free+ Library   buildable: True-  build-depends: base >= 2 && < 5, deepseq, transformers+  build-depends: base >= 2 && < 5, transformers, prelude-extras   extensions:  StandaloneDeriving, Rank2Types, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, OverlappingInstances   exposed-modules:      Control.Monad.Free