packages feed

free 4.2 → 4.4

raw patch · 9 files changed

+119/−106 lines, 9 files

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright 2008-2012 Edward Kmett+Copyright 2008-2013 Edward Kmett  All rights reserved.
free.cabal view
@@ -1,6 +1,6 @@ name:          free category:      Control, Monads-version:       4.2+version:       4.4 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE@@ -9,7 +9,7 @@ stability:     provisional homepage:      http://github.com/ekmett/free/ bug-reports:   http://github.com/ekmett/free/issues-copyright:     Copyright (C) 2008-2012 Edward A. Kmett+copyright:     Copyright (C) 2008-2013 Edward A. Kmett synopsis:      Monads for free description:   Free monads are useful for many tree-like structures and domain specific languages.
src/Control/Applicative/Free.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Applicative.Free--- Copyright   :  (C) 2012 Edward Kmett+-- Copyright   :  (C) 2012-2013 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
src/Control/Comonad/Cofree.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Comonad.Cofree--- Copyright   :  (C) 2008-2012 Edward Kmett+-- Copyright   :  (C) 2008-2013 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
src/Control/Comonad/Trans/Cofree.hs view
@@ -10,7 +10,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Comonad.Trans.Cofree--- Copyright   :  (C) 2008-2012 Edward Kmett+-- Copyright   :  (C) 2008-2013 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -21,6 +21,7 @@ ---------------------------------------------------------------------------- module Control.Comonad.Trans.Cofree   ( CofreeT(..)+  , cofree, runCofree   , CofreeF(..)   , ComonadCofree(..)   , headF@@ -37,6 +38,7 @@ import Data.Bifoldable import Data.Bitraversable import Data.Foldable+import Data.Functor.Identity import Data.Semigroup import Data.Traversable import Prelude hiding (id,(.))@@ -83,6 +85,16 @@  -- | This is a cofree comonad of some functor @f@, with a comonad @w@ threaded through it at each level. newtype CofreeT f w a = CofreeT { runCofreeT :: w (CofreeF f a (CofreeT f w a)) }++type Cofree f = CofreeT f Identity++cofree :: CofreeF f a (Cofree f a) -> Cofree f a+cofree = CofreeT . Identity+{-# INLINE cofree #-}++runCofree :: Cofree f a -> CofreeF f a (Cofree f a)+runCofree = runIdentity . runCofreeT+{-# INLINE runCofree #-}  instance (Functor f, Functor w) => Functor (CofreeT f w) where   fmap f = CofreeT . fmap (bimap f (fmap f)) . runCofreeT
src/Control/Comonad/Trans/Coiter.hs view
@@ -10,19 +10,25 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Comonad.Trans.Coiter--- Copyright   :  (C) 2008-2012 Edward Kmett+-- Copyright   :  (C) 2008-2013 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com> -- Stability   :  provisional -- Portability :  MPTCs, fundeps ----- The iterative comonad generated by a comonad+-- The coiterative comonad generated by a comonad ---------------------------------------------------------------------------- module Control.Comonad.Trans.Coiter-  ( CoiterT(..)+  (+  -- * The coiterative comonad transformer+    CoiterT(..)+  -- * The coiterative comonad+  , Coiter, coiter, runCoiter+  -- * Generating coiterative comonads+  , unfold+  -- * Cofree comonads   , ComonadCofree(..)-  , coiterT   ) where  import Control.Arrow@@ -42,14 +48,26 @@ import Data.Data #endif --- | This is the (co?)iterative comonad generated by a comonad+-- | This is the coiterative comonad generated by a comonad newtype CoiterT w a = CoiterT { runCoiterT :: w (a, CoiterT w a) } +-- | The coiterative comonad+type Coiter = CoiterT Identity++coiter :: a -> Coiter a -> Coiter a+coiter a as = CoiterT $ Identity (a,as)+{-# INLINE coiter #-}++runCoiter :: Coiter a -> (a, Coiter a)+runCoiter = runIdentity . runCoiterT+{-# INLINE runCoiter #-}+ 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+  {-# INLINE extract #-}   extend f = CoiterT . extend (\w -> (f (CoiterT w), extend f $ snd $ extract w)) . runCoiterT  instance Foldable w => Foldable (CoiterT w) where@@ -63,6 +81,7 @@  instance Comonad w => ComonadCofree Identity (CoiterT w) where   unwrap = Identity . snd . extract . runCoiterT+  {-# INLINE unwrap #-}  instance Show (w (a, CoiterT w a)) => Show (CoiterT w a) where   showsPrec d w = showParen (d > 10) $@@ -74,13 +93,15 @@  instance Eq (w (a, CoiterT w a)) => Eq (CoiterT w a) where   CoiterT a == CoiterT b = a == b+  {-# INLINE (==) #-}  instance Ord (w (a, CoiterT w a)) => Ord (CoiterT w a) where   compare (CoiterT a) (CoiterT b) = compare a b+  {-# INLINE compare #-}  -- | Unfold a @CoiterT@ comonad transformer from a cokleisli arrow and an initial comonadic seed.-coiterT :: Comonad w => (w a -> a) -> w a -> CoiterT w a-coiterT psi = CoiterT . extend (extract &&& coiterT psi . extend psi)+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
src/Control/Monad/Free.hs view
@@ -10,7 +10,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.Free--- Copyright   :  (C) 2008-2012 Edward Kmett+-- Copyright   :  (C) 2008-2013 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
src/Control/Monad/Trans/Free.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Rank2Types #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable #-}@@ -10,7 +11,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.Trans.Free--- Copyright   :  (C) 2008-2012 Edward Kmett+-- Copyright   :  (C) 2008-2013 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -21,13 +22,20 @@ -- ---------------------------------------------------------------------------- module Control.Monad.Trans.Free-  ( FreeF(..)+  (+  -- * The base functor+    FreeF(..)+  -- * The free monad transformer   , FreeT(..)-  , MonadFree(..)+  -- * The free monad+  , Free, free, runFree+  -- * Operations   , liftF   , iterT   , hoistFreeT   , transFreeT+  -- * Free Monads With Class+  , MonadFree(..)   ) where  import Control.Applicative@@ -37,6 +45,7 @@ import Control.Monad.IO.Class import Data.Monoid import Data.Foldable+import Data.Functor.Identity import Data.Traversable import Data.Bifunctor import Data.Bifoldable@@ -56,40 +65,54 @@ instance Functor f => Functor (FreeF f a) where   fmap _ (Pure a)  = Pure a   fmap f (Free as) = Free (fmap f as)+  {-# INLINE fmap #-}  instance Foldable f => Foldable (FreeF f a) where   foldMap f (Free as) = foldMap f as   foldMap _ _         = mempty+  {-# INLINE foldMap #-}  instance Traversable f => Traversable (FreeF f a) where   traverse _ (Pure a)  = pure (Pure a)   traverse f (Free as) = Free <$> traverse f as+  {-# INLINE traverse #-}  instance Functor f => Bifunctor (FreeF f) where   bimap f _ (Pure a)  = Pure (f a)   bimap _ g (Free as) = Free (fmap g as)+  {-# INLINE bimap #-}  instance Foldable f => Bifoldable (FreeF f) where   bifoldMap f _ (Pure a)  = f a   bifoldMap _ g (Free as) = foldMap g as+  {-# INLINE bifoldMap #-}  instance Traversable f => Bitraversable (FreeF f) where   bitraverse f _ (Pure a)  = Pure <$> f a   bitraverse _ g (Free as) = Free <$> traverse g as+  {-# INLINE bitraverse #-}  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@.+-- | The \"free monad transformer\" for a functor @f@ newtype FreeT f m a = FreeT { runFreeT :: m (FreeF f a (FreeT f m a)) } -instance Eq (m (FreeF f a (FreeT f m a))) => Eq (FreeT f m a) where-  FreeT m == FreeT n = m == n+-- | The \"free monad\" for a functor @f@.+type Free f = FreeT f Identity -instance Ord (m (FreeF f a (FreeT f m a))) => Ord (FreeT f m a) where-  compare (FreeT m) (FreeT n) = compare m n+runFree :: Free f a -> FreeF f a (Free f a)+runFree = runIdentity . runFreeT+{-# INLINE runFree #-}++free :: FreeF f a (Free f a) -> Free f a+free = FreeT . Identity+{-# INLINE free #-}++deriving instance Eq (m (FreeF f a (FreeT f m a))) => Eq (FreeT f m a)+deriving instance Ord (m (FreeF f a (FreeT f m a))) => Ord (FreeT f m a)  instance Show (m (FreeF f a (FreeT f m a))) => Show (FreeT f m a) where   showsPrec d (FreeT m) = showParen (d > 10) $
src/Control/Monad/Trans/Iter.hs view
@@ -26,13 +26,19 @@ -- Unlike 'Free', this is a true monad transformer. ---------------------------------------------------------------------------- module Control.Monad.Trans.Iter-  ( MonadFree(..)-  , IterF(..)-  , IterT(..)+  (+  -- * The iterative monad transformer+    IterT(..)+  -- * Capretta's iterative monad+  , Iter, iter, runIter+  -- * Operations   , delay-  , retract-  , iter   , hoistIterT+  -- * Consuming iterative monads+  , retract+  , fold+  -- * IterT ~ FreeT Identity+  , MonadFree(..)   ) where  import Control.Applicative@@ -42,13 +48,11 @@ import Control.Monad.Free.Class import Control.Monad.State.Class import Control.Monad.Reader.Class-import Data.Bifoldable import Data.Bifunctor import Data.Bitraversable import Data.Functor.Bind import Data.Functor.Identity-import Data.Foldable-import Data.Monoid+import Data.Foldable hiding (fold) import Data.Traversable import Data.Semigroup.Foldable import Data.Semigroup.Traversable@@ -58,59 +62,37 @@ import Data.Data #endif -data IterF a b = Pure a | Iter b-  deriving (Eq,Ord,Show,Read,Typeable)--instance Functor (IterF a) where-  fmap _ (Pure a) = Pure a-  fmap f (Iter b) = Iter (f b)--instance Foldable (IterF a) where-  foldMap f (Iter b) = f b-  foldMap _ _         = mempty--instance Traversable (IterF a) where-  traverse _ (Pure a) = pure (Pure a)-  traverse f (Iter b) = Iter <$> f b--instance Bifunctor IterF where-  bimap f _ (Pure a) = Pure (f a)-  bimap _ g (Iter b) = Iter (g b)--instance Bifoldable IterF where-  bifoldMap f _ (Pure a) = f a-  bifoldMap _ g (Iter b) = g b--instance Bitraversable IterF where-  bitraverse f _ (Pure a) = Pure <$> f a-  bitraverse _ g (Iter b) = Iter <$> g b--iterF :: (a -> r) -> (b -> r) -> IterF a b -> r-iterF f _ (Pure a) = f a-iterF _ g (Iter b) = g b-{-# INLINE iterF #-}- -- | The monad supporting iteration based over a base monad @m@. -- -- @ -- 'IterT' ~ 'FreeT' 'Identity' -- @-data IterT m a = IterT { runIterT :: m (IterF a (IterT m a)) }+newtype IterT m a = IterT { runIterT :: m (Either a (IterT m a)) } #if __GLASGOW_HASKELL__ >= 707   deriving (Typeable) #endif -instance Eq (m (IterF a (IterT m a))) => Eq (IterT m a) where+type Iter = IterT Identity++iter :: Either a (Iter a) -> Iter a+iter = IterT . Identity+{-# INLINE iter #-}++runIter :: Iter a -> Either a (Iter a)+runIter = runIdentity . runIterT+{-# INLINE runIter #-}++instance Eq (m (Either a (IterT m a))) => Eq (IterT m a) where   IterT m == IterT n = m == n -instance Ord (m (IterF a (IterT m a))) => Ord (IterT m a) where+instance Ord (m (Either a (IterT m a))) => Ord (IterT m a) where   compare (IterT m) (IterT n) = compare m n -instance Show (m (IterF a (IterT m a))) => Show (IterT m a) where+instance Show (m (Either a (IterT m a))) => Show (IterT m a) where   showsPrec d (IterT m) = showParen (d > 10) $     showString "IterT " . showsPrec 11 m -instance Read (m (IterF a (IterT m a))) => Read (IterT m a) where+instance Read (m (Either a (IterT m a))) => Read (IterT m a) where   readsPrec d =  readParen (d > 10) $ \r ->     [ (IterT m,t) | ("IterT",s) <- lex r, (m,t) <- readsPrec 11 s] @@ -119,15 +101,15 @@   {-# INLINE fmap #-}  instance Monad m => Applicative (IterT m) where-  pure = IterT . return . Pure+  pure = IterT . return . Left   {-# INLINE pure #-}   (<*>) = ap   {-# INLINE (<*>) #-}  instance Monad m => Monad (IterT m) where-  return = IterT . return . Pure+  return = IterT . return . Left   {-# INLINE return #-}-  IterT m >>= k = IterT $ m >>= iterF (runIterT . k) (return . Iter . (>>= k))+  IterT m >>= k = IterT $ m >>= either (runIterT . k) (return . Right . (>>= k))   {-# INLINE (>>=) #-}   fail = IterT . fail   {-# INLINE fail #-}@@ -141,9 +123,7 @@   {-# INLINE (>>-) #-}  instance MonadFix m => MonadFix (IterT m) where-  mfix f = IterT $ mfix (runIterT . f . unPure) where-    unPure (Pure x)  = x-    unPure (Iter _) = error "mfix (IterT m): Iter"+  mfix f = IterT $ mfix $ runIterT . f . either id (error "mfix (IterT m): Right")   {-# INLINE mfix #-}  instance MonadPlus m => Alternative (IterT m) where@@ -158,17 +138,16 @@   IterT a `mplus` IterT b = IterT (mplus a b)   {-# INLINE mplus #-} --- | This is not a true monad transformer. It is only a monad transformer \"up to 'retract'\". instance MonadTrans IterT where-  lift = IterT . liftM Pure+  lift = IterT . liftM Left   {-# INLINE lift #-}  instance Foldable m => Foldable (IterT m) where-  foldMap f = foldMap (iterF f (foldMap f)) . runIterT+  foldMap f = foldMap (either f (foldMap f)) . runIterT   {-# INLINE foldMap #-}  instance Foldable1 m => Foldable1 (IterT m) where-  foldMap1 f = foldMap1 (iterF f (foldMap1 f)) . runIterT+  foldMap1 f = foldMap1 (either f (foldMap1 f)) . runIterT   {-# INLINE foldMap1 #-}  instance (Monad m, Traversable m) => Traversable (IterT m) where@@ -177,20 +156,10 @@  instance (Monad m, Traversable1 m) => Traversable1 (IterT m) where   traverse1 f (IterT m) = IterT <$> traverse1 go m where-    go (Pure a) = Pure <$> f a-    go (Iter a) = Iter <$> traverse1 f a+    go (Left a) = Left <$> f a+    go (Right a) = Right <$> traverse1 f a   {-# INLINE traverse1 #-} -{--instance MonadWriter e m => MonadWriter e (IterT m) where-  tell = lift . tell-  {-# INLINE tell #-}-  listen = lift . listen . retract-  {-# INLINE listen #-}-  pass = lift . pass . retract-  {-# INLINE pass #-}--}- instance (Functor m, MonadReader e m) => MonadReader e (IterT m) where   ask = lift ask   {-# INLINE ask #-}@@ -207,20 +176,8 @@   {-# INLINE state #-} #endif -{--instance (Functor m, MonadError e m) => MonadError e (Free m) where-  throwError = lift . throwError-  {-# INLINE throwError #-}-  catchError as f = lift (catchError (retract as) (retract . f))-  {-# INLINE catchError #-}--instance (Functor m, MonadCont m) => MonadCont (Free m) where-  callCC f = lift (callCC (retract . f . liftM lift))-  {-# INLINE callCC #-}--}- instance Monad m => MonadFree Identity (IterT m) where-  wrap = IterT . return . Iter . runIdentity+  wrap = IterT . return . Right . runIdentity   {-# INLINE wrap #-}  delay :: (Monad f, MonadFree f m) => m a -> m a@@ -234,11 +191,11 @@ -- 'retract' . 'lift' = 'id' -- @ retract :: Monad m => IterT m a -> m a-retract m = runIterT m >>= iterF return retract+retract m = runIterT m >>= either return retract  -- | Tear down a 'Free' 'Monad' using iteration.-iter :: Monad m => (m a -> a) -> IterT m a -> a-iter phi (IterT m) = phi (iterF id (iter phi) `liftM` m)+fold :: Monad m => (m a -> a) -> IterT m a -> a+fold phi (IterT m) = phi (either id (fold phi) `liftM` m)  -- | Lift a monad homomorphism from @m@ to @n@ into a Monad homomorphism from @'IterT' m@ to @'IterT' n@. hoistIterT :: Monad n => (forall a. m a -> n a) -> IterT m b -> IterT n b@@ -260,7 +217,7 @@  instance   ( Typeable1 m, Typeable a-  , Data (m (IterF a (IterT m a)))+  , Data (m (Either a (IterT m a)))   , Data a   ) => Data (IterT m a) where     gfoldl f z (IterT as) = z IterT `f` as