free 3.1.1 → 3.2

raw patch · 5 files changed

+258/−5 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• free.cabal +9/−4
• src/Control/Applicative/Free.hs +79/−0
• src/Control/Monad/Free.hs +8/−1
• src/Control/Monad/Free/Church.hs +134/−0
• src/Control/Monad/Trans/Free.hs +28/−0

@@ -1,8 +1,8 @@ name:          free category:      Control, Monads-version:       3.1.1+version:       3.2 license:       BSD3-cabal-version: >= 1.6+cabal-version: >= 1.10 license-file:  LICENSE author:        Edward A. Kmett maintainer:    Edward A. Kmett <ekmett@gmail.com>@@ -35,11 +35,16 @@ library   hs-source-dirs: src +  default-language: Haskell2010+  default-extensions:+    CPP   other-extensions:     MultiParamTypeClasses     FunctionalDependencies     FlexibleInstances     UndecidableInstances+    Rank2Types+    GADTs    build-depends:     base                 >= 4       && < 5,@@ -56,10 +61,10 @@   if impl(ghc)     cpp-options: -DGHC_TYPEABLE -  extensions: CPP-   exposed-modules:+    Control.Applicative.Free     Control.Monad.Free+    Control.Monad.Free.Church     Control.Monad.Free.Class     Control.Monad.Trans.Free     Control.Comonad.Cofree

@@ -0,0 +1,79 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE GADTs #-}+{-# OPTIONS_GHC -Wall #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Applicative.Free+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs, Rank2Types+--+-- 'Applicative' functors for free+----------------------------------------------------------------------------+module Control.Applicative.Free+  ( Ap(..)+  , runAp+  , liftAp+  , hoistAp+  ) where++import Control.Applicative+import Data.Functor.Apply++#ifdef GHC_TYPEABLE+import Data.Typeable+#endif++-- | The free 'Applicative' for a 'Functor' @f@.+data Ap f a where+  Pure :: a -> Ap f a+  Ap   :: f a -> Ap f (a -> b) -> Ap f b++-- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.+runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a+runAp _ (Pure x) = pure x+runAp u (Ap f x) = flip id <$> u f <*> runAp u x++instance Functor (Ap f) where+  fmap f (Pure a)   = Pure (f a)+  fmap f (Ap x y)   = Ap x ((f .) <$> y)++instance Apply (Ap f) where+  Pure f <.> y = fmap f y+  Ap x y <.> z = Ap x (flip <$> y <.> z)++instance Applicative (Ap f) where+  pure = Pure+  Pure f <*> y = fmap f y+  Ap x y <*> z = Ap x (flip <$> y <*> z)++-- | A version of 'lift' that can be used with just a 'Functor' for @f@.+liftAp :: f a -> Ap f a+liftAp x = Ap x (Pure id)+{-# INLINE liftAp #-}++-- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Ap f@ to @Ap g@.+hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b+hoistAp _ (Pure a) = Pure a+hoistAp f (Ap x y) = Ap (f x) (hoistAp f y)+{-# INLINE hoistAp #-}++#ifdef GHC_TYPEABLE+instance Typeable1 f => Typeable1 (Ap f) where+  typeOf1 t = mkTyConApp apTyCon [typeOf1 (f t)] where+    f :: Ap f a -> f a+    f = undefined++apTyCon :: TyCon+#if __GLASGOW_HASKELL__ < 704+apTyCon = mkTyCon "Control.Applicative.Free.Ap"+#else+apTyCon = mkTyCon3 "free" "Control.Applicative.Free" "Ap"+#endif+{-# NOINLINE apTyCon #-}++#endif

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.Free@@ -14,7 +15,6 @@ -- Portability :  MPTCs, fundeps -- -- Monads for free--- ---------------------------------------------------------------------------- module Control.Monad.Free   ( MonadFree(..)@@ -22,6 +22,7 @@   , retract   , liftF   , iter+  , hoistFree   ) where  import Control.Applicative@@ -212,6 +213,12 @@ iter :: Functor f => (f a -> a) -> Free f a -> a iter _ (Pure a) = a iter phi (Free m) = phi (iter phi <$> m)++-- | Lift a natural transformation from @f@ to @g@ into a natural transformation from @'FreeT' f@ to @'FreeT' g@.+hoistFree :: Functor g => (forall a. f a -> g a) -> Free f b -> Free g b+hoistFree _ (Pure a) = Pure a+hoistFree f (Free as) = Free (hoistFree f <$> f as)+{-# INLINE hoistFree #-}  #ifdef GHC_TYPEABLE instance Typeable1 f => Typeable1 (Free f) where

@@ -0,0 +1,134 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Free.Church+-- Copyright   :  (C) 2011-2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  non-portable (rank-2 polymorphism)+--+-- \"Free Monads for Less\"+--+-- This is based on the \"Free Monads for Less\" series of articles:+--+-- <http://comonad.com/reader/2011/free-monads-for-less/>+-- <http://comonad.com/reader/2011/free-monads-for-less-2/>+----------------------------------------------------------------------------+module Control.Monad.Free.Church+  ( F(..)+  , improve+  , fromF+  , toF+  , liftF+  , retract+  ) where++import Control.Applicative+import Control.Monad as Monad+import Control.Monad.Free hiding (liftF, retract)+import Control.Monad.Reader.Class+import Control.Monad.Writer.Class+import Control.Monad.Cont.Class+import Control.Monad.Trans.Class+import Control.Monad.State.Class+import Data.Functor.Bind++-- | The Church-encoded free monad for a functor @f@.+--+-- It is /asymptotically/ more efficient to use ('>>=') for 'F' than it is to ('>>=') with 'Free'.+--+-- <http://comonad.com/reader/2011/free-monads-for-less-2/>+newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r }++instance Functor (F f) where+  fmap f (F g) = F (\kp -> g (kp . f))++instance Apply (F f) where+  (<.>) = (<*>)++instance Applicative (F f) where+  pure a = F (\kp _ -> kp a)+  F f <*> F g = F (\kp kf -> f (\a -> g (\b -> kp (a b)) kf) kf)++instance Alternative f => Alternative (F f) where+  empty = F (\_ kf -> kf empty)+  F f <|> F g = F (\kp kf -> kf (pure (f kp kf) <|> pure (g kp kf)))++instance Bind (F f) where+  (>>-) = (>>=)++instance Monad (F f) where+  return a = F (\kp _ -> kp a)+  F m >>= f = F (\kp kf -> m (\a -> runF (f a) kp kf) kf)++instance MonadPlus f => MonadPlus (F f) where+  mzero = F (\_ kf -> kf mzero)+  F f `mplus` F g = F (\kp kf -> kf (return (f kp kf) `mplus` return (g kp kf)))++instance MonadTrans F where+  lift f = F (\kp kf -> kf (liftM kp f))++instance Functor f => MonadFree f (F f) where+  wrap f = F (\kp kf -> kf (fmap (\ (F m) -> m kp kf) f))++instance MonadState s m => MonadState s (F m) where+  get = lift get+  put = lift . put++instance MonadReader e m => MonadReader e (F m) where+  ask = lift ask+  local f = lift . local f . retract++instance MonadWriter w m => MonadWriter w (F m) where+  tell = lift . tell+  pass = lift . pass . retract+  listen = lift . listen . retract++instance MonadCont m => MonadCont (F m) where+  callCC f = lift $ callCC (retract . f . fmap lift)++-- | A version of 'lift' that can be used with just a 'Functor' for @f@.+liftF :: Functor f => f a -> F f a+liftF f = F (\kp kf -> kf (fmap kp f))+{-# INLINE liftF #-}++-- |+-- 'retract' is the left inverse of 'lift' and 'liftF'+--+-- @+-- 'retract' . 'lift' = 'id'+-- 'retract' . 'liftF' = 'id'+-- @+retract :: Monad m => F m a -> m a+retract (F m) = m return Monad.join+{-# INLINE retract #-}++-- | Convert to another free monad representation.+fromF :: MonadFree f m => F f a -> m a+fromF (F m) = m return wrap+{-# INLINE fromF #-}++-- | Generate a Church-encoded free monad from a 'Free' monad.+toF :: Functor f => Free f a -> F f a+toF xs = F (\kp kf -> go kp kf xs) where+  go kp _  (Pure a) = kp a+  go kp kf (Free fma) = kf (fmap (go kp kf) fma)++-- | Improve the asymptotic performance of code that builds a free monad with only binds and returns by using 'F' behind the scenes.+--+-- This is based on the \"Free Monads for Less\" series of articles by Edward Kmett:+--+-- <http://comonad.com/reader/2011/free-monads-for-less/>+-- <http://comonad.com/reader/2011/free-monads-for-less-2/>+--+-- and \"Asymptotic Improvement of Computations over Free Monads\" by Janis Voightländer:+--+-- <http://www.iai.uni-bonn.de/~jv/mpc08.pdf>+improve :: Functor f => (forall m. MonadFree f m => m a) -> Free f a+improve m = fromF m+{-# INLINE improve #-}

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.Trans.Free@@ -21,6 +22,8 @@   , FreeT(..)   , MonadFree(..)   , liftF+  , hoistFreeT+  , transFreeT   ) where  import Control.Applicative@@ -66,6 +69,11 @@   bitraverse f _ (Pure a)  = Pure <$> f a   bitraverse _ g (Free as) = Free <$> traverse g as +transFreeF :: (forall x. f x -> g x) -> FreeF f a b -> FreeF g a b+transFreeF _ (Pure a) = Pure a+transFreeF t (Free as) = Free (t as)+{-# INLINE transFreeF #-}+ -- | The \"free monad transformer\" for a functor @f@. newtype FreeT f m a = FreeT { runFreeT :: m (FreeF f a (FreeT f m a)) } @@ -90,42 +98,62 @@  instance (Functor f, Monad m) => Applicative (FreeT f m) where   pure a = FreeT (return (Pure a))+  {-# INLINE pure #-}   (<*>) = ap+  {-# INLINE (<*>) #-}  instance (Functor f, Monad m) => Monad (FreeT f m) where   return a = FreeT (return (Pure a))+  {-# INLINE return #-}   FreeT m >>= f = FreeT $ m >>= \v -> case v of     Pure a -> runFreeT (f a)     Free w -> return (Free (fmap (>>= f) w))  instance MonadTrans (FreeT f) where   lift = FreeT . liftM Pure+  {-# INLINE lift #-}  instance (Functor f, MonadIO m) => MonadIO (FreeT f m) where   liftIO = lift . liftIO+  {-# INLINE liftIO #-}  instance (Functor f, MonadPlus m) => Alternative (FreeT f m) where   empty = FreeT mzero   FreeT ma <|> FreeT mb = FreeT (mplus ma mb)+  {-# INLINE (<|>) #-}  instance (Functor f, MonadPlus m) => MonadPlus (FreeT f m) where   mzero = FreeT mzero+  {-# INLINE mzero #-}   mplus (FreeT ma) (FreeT mb) = FreeT (mplus ma mb)+  {-# INLINE mplus #-}  instance (Functor f, Monad m) => MonadFree f (FreeT f m) where   wrap = FreeT . return . Free+  {-# INLINE wrap #-}  -- | FreeT is a functor from the category of functors to the category of monads. -- -- This provides the mapping. liftF :: (Functor f, Monad m) => f a -> FreeT f m a liftF = wrap . fmap return+{-# INLINE liftF #-}  instance (Foldable m, Foldable f) => Foldable (FreeT f m) where   foldMap f (FreeT m) = foldMap (bifoldMap f (foldMap f)) m  instance (Monad m, Traversable m, Traversable f) => Traversable (FreeT f m) where   traverse f (FreeT m) = FreeT <$> traverse (bitraverse f (traverse f)) m++-- | Lift a monad homomorphism from @m@ to @n@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' f n@+--+-- @'hoistFreeT' :: ('Monad' m, 'Functor' f) => (m ~> n) -> 'FreeT' f m ~> 'FreeT' f n@+hoistFreeT :: (Monad m, Functor f) => (forall a. m a -> n a) -> FreeT f m b -> FreeT f n b+hoistFreeT mh = FreeT . mh . liftM (fmap (hoistFreeT mh)) . runFreeT++-- | Lift a natural transformation from @f@ to @g@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' g n@+transFreeT :: (Monad m, Functor g) => (forall a. f a -> g a) -> FreeT f m b -> FreeT g m b+transFreeT nt = FreeT . liftM (fmap (transFreeT nt) . transFreeF nt) . runFreeT  #ifdef GHC_TYPEABLE