free 4.9 → 4.10.0.1

raw patch · 10 files changed

+286/−17 lines, 10 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +13/−0
• examples/Cabbage.lhs +208/−0
• free.cabal +1/−1
• src/Control/Applicative/Free.hs +1/−1
• src/Control/Applicative/Trans/Free.hs +3/−1
• src/Control/Comonad/Cofree.hs +5/−0
• src/Control/Comonad/Trans/Cofree.hs +1/−1
• src/Control/Monad/Free/Church.hs +2/−2
• src/Control/Monad/Trans/Free/Church.hs +15/−3
• src/Control/Monad/Trans/Iter.hs +37/−8

@@ -1,3 +1,16 @@+4.10.0.1+------+* Fix for very old `cabal` versions where the `MIN_VERSION_foo` macros aren't negation friendly.++4.10+----+* Redefine `Alternative` and `MonadPlus` instances of `IterT` so that they apply to any underlying `Monad`.+  `mplus` or `<|>` is Capretta's `race` combinator; `mzero` or `empty` is a non-terminating computation.+* Redefine `fail s` for `IterT` as `mzero`, for any string `s`.+* Added `Control.Monad.Trans.Iter.untilJust`, which repeatedly retries a `m (Maybe a)` computation until+  it produces `Just` a value.+* Fix things so that we can build with GHC 7.10, which also uses the name `Alt` in `Data.Monoid`, and which exports `Monoid` from `Prelude`.+ 4.9 --- * Remove `either` support. Why? It dragged in a large number of dependencies we otherwise don't support, and so is probably best inverted.

@@ -0,0 +1,208 @@+> {-# LANGUAGE ViewPatterns #-}+> module Cabbage where+ +> import Control.Applicative+> import Control.Monad+> import Control.Monad.State+> import Control.Monad.Trans.Iter+> import Control.Monad.Writer+> import Data.Functor.Identity+> import Data.Maybe+> import Data.Tuple+> import Data.List++Consider the following problem:++A farmer must cross a river with a wolf, a sheep and a cabbage. +He owns a boat, which can only carry himself and one other item. +The sheep must not be left alone with the wolf, or with the cabbage:+if that happened, one of them would eat the other. ++> data Item = Wolf | Sheep | Cabbage | Farmer deriving (Ord, Show, Eq)+> +> eats :: Item -> Item -> Bool+> Sheep `eats` Cabbage = True+> Wolf `eats` Sheep    = True+> _ `eats` _           = False++The problem can be represented as the set of items on each side of the river. ++> type Situation = ([Item],[Item])++> initial :: Situation+> initial = ([Farmer, Wolf, Sheep, Cabbage], [])++First, some helper functions to extract single elements from lists, leaving the+rest intact:++> plusTailOf :: [a] -> [a] -> (Maybe a, [a]) +> a `plusTailOf` b = (listToMaybe b,  a ++ drop 1 b)++> singleOut1 :: (a -> Bool) -> [a] -> (Maybe a,[a])+> singleOut1 sel = uncurry plusTailOf . break sel++@+*Cabbage> singleOut1 (== Sheep) [Wolf, Sheep, Cabbage]+[(Just Wolf,[Sheep,Cabbage]),(Just Sheep,[Wolf,Cabbage]),(Just Cabbage,[Wolf,Sheep]),(Nothing,[Wolf,Sheep,Cabbage])]+@++> singleOutAll :: [a] -> [(Maybe a,[a])]+> singleOutAll = zipWith plusTailOf <$> inits <*> tails++@+*Cabbage> singleOutAll [Wolf, Sheep, Cabbage]+[(Just Wolf,[Sheep,Cabbage]),(Just Sheep,[Wolf,Cabbage]),(Just Cabbage,[Wolf,Sheep]),(Nothing,[Wolf,Sheep,Cabbage])]+@++In every move, the farmer goes from one side of the river to the other,+together with (optionally) one item.++The remaining items must not eat each other for the move to be valid.++> move :: Situation -> [Situation]+> move = move2+>   where +>   move2 (singleOut1 (== Farmer) -> (Just Farmer,as), bs)  = move1 as bs+>   move2 (bs, singleOut1 (== Farmer) -> (Just Farmer,as))  = map swap $ move1 as bs+>   move2 _                                            = []+> +>   move1 as bs = [(as', [Farmer] ++ maybeToList b ++ bs) |+>                  (b, as') <- singleOutAll as,+>                  and [not $ x `eats` y | x <- as', y <- as']]++@+*Cabbage> move initial+[([Wolf,Cabbage],[Farmer,Sheep])]+@+  +When the starting side becomes empty, the farmer succeeds.++> success :: Situation -> Bool+> success ([],_) = True+> success _      = False++A straightforward implementation to solve the problem could use the +list monad, trying all possible solutions and ++> solution1 :: Situation+> solution1 = head $ solutions' initial+>             where+>             solutions' a = if success a+>                            then return a+>                            else move a >>= solutions'++However, when it's run, it will get stuck in an infinite loop, as the sheep+is shuffled back and forth. The solution is being searched in depth.++To guarantee termination, we can use the 'Iter' monad with its MonadPlus instance.+As long as one of the possible execution paths finds a solution, the program+will terminate: the solution is looked for _in breadth_. + +> solution2 :: Iter Situation+> solution2 = solution' initial+>             where+>               solution' a =+>                 if success a+>                   then return a+>                   else delay $ msum $ map solution' (move a)++Each of the alternative sequences of movements will be evaluated+concurrently; and the shortest one will be the result. In case of ties,+the leftmost solution takes priority.++@+ *Cabbage> solution2+ IterT (Identity (Right ( …+   (IterT (Identity (Right+     (IterT (Identity (Left+       ([],[Farmer,Sheep,Cabbage,Wolf]))))))))))))))))))))))))+@++For a cleaner display, use 'retract' to escape 'Iter' monad:++@+ *Cabbage> retract solution2+ Identity ([],[Farmer,Sheep,Cabbage,Wolf])+@++'unsafeIter' will also get rid of the 'Identity' wrapper:++> unsafeIter :: Iter a -> a+> unsafeIter = runIdentity . retract++@+ *Cabbage> unsafeIter solution2+ ([],[Farmer,Sheep,Cabbage,Wolf])+@++Suppose that we not only want the solution, but also the steps that we+took to arrive there. Enter the Writer monad transformer:++> solution3 :: Iter (Situation, [Situation])+> solution3 = runWriterT $ solution' initial+>             where+>               solution' :: Situation -> WriterT [Situation] Iter Situation+>               solution' a = do+>                 tell [a]+>                 if success a+>                   then return a+>                   else mapWriterT delay $ msum $ map solution' (move a)++The second component contains the complete path to the solution:++@+ *Cabbage> snd $ unsafeIter solution3+ [([Farmer,Wolf,Sheep,Cabbage],[]),+  ([Wolf,Cabbage],[Farmer,Sheep]),+  ([Farmer,Wolf,Cabbage],[Sheep]),+  ([Cabbage],[Farmer,Wolf,Sheep]),+  ([Farmer,Sheep,Cabbage],[Wolf]),+  ([Sheep],[Farmer,Cabbage,Wolf]),+  ([Farmer,Sheep],[Cabbage,Wolf]),+  ([],[Farmer,Sheep,Cabbage,Wolf])]+@++When the transformer is applied _over_ the Iter monad, it acts locally for each solution.+If we apply the IterT transformer over another monad,+the behaviour for that monad will be shared among all threads.++For example, let's keep track of how many moves we perform. We could+do so with the writer monad again (numbers form a monoid under addition), but+we'll use the state monad this time.++> solution4 :: Iter (Situation, Integer)+> solution4 = flip runStateT 0 $ solution' initial+>             where+>               solution' :: Situation -> StateT Integer Iter Situation+>               solution' a =+>                 if success a+>                   then return a+>                   else do+>                          modify (+1)+>                          mapStateT delay $ msum $ map solution' (move a)++This gives us seven moves (one for each transition between two states).++@+ *Cabbage> unsafeIter solution4+ (([],[Farmer,Sheep,Cabbage,Wolf]),7)+@++On the other hand, if move the state inside Iter, we get a global count of+explored nodes until the solution was found.++> solution5 :: State Integer Situation+> solution5 = retract $ solution' initial+>             where+>               solution' :: Situation -> IterT (State Integer) Situation+>               solution' a =+>                 if success a+>                   then return a+>                   else do+>                          modify (+1)+>                          delay $ msum $ map solution' (move a)++@+ *Cabbage> runState solution5 0+ (([],[Farmer,Sheep,Cabbage,Wolf]),113)+@

@@ -1,6 +1,6 @@ name:          free category:      Control, Monads-version:       4.9+version:       4.10.0.1 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE

@@ -23,7 +23,7 @@   -- flexible to inspect and interpret, as the number of ways in which   -- the values can be nested is more limited.   ---  -- See <http://paolocapriotti.com/assets/applicative.pdf Free Applicative Functors>,+  -- See <http://arxiv.org/abs/1403.0749 Free Applicative Functors>,   -- by Paolo Capriotti and Ambrus Kaposi, for some applications.      Ap(..)

@@ -50,7 +50,9 @@ import Data.Functor.Apply import Data.Functor.Identity import Data.Typeable-import Data.Monoid+#if !(MIN_VERSION_base(4,8,0))+import Data.Monoid (Monoid)+#endif import qualified Data.Foldable as F  -- | The free 'Applicative' for a 'Functor' @f@.

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}@@ -25,6 +26,7 @@   , section   , coiter   , unfold+  , hoistCofree   -- * Lenses into cofree comonads   , _extract   , _unwrap@@ -111,6 +113,9 @@ 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++hoistCofree :: Functor f => (forall x . f x -> g x) -> Cofree f a -> Cofree g a+hoistCofree f (x :< y) = x :< f (hoistCofree f <$> y)  instance Functor f => ComonadCofree f (Cofree f) where   unwrap (_ :< as) = as

@@ -139,7 +139,7 @@   unwrap = tailF . extract . runCofreeT  instance Show (w (CofreeF f a (CofreeT f w a))) => Show (CofreeT f w a) where-  showsPrec d w = showParen (d > 10) $+  showsPrec d (CofreeT w) = showParen (d > 10) $     showString "CofreeT " . showsPrec 11 w  instance Read (w (CofreeF f a (CofreeT f w a))) => Read (CofreeT f w a) where

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleInstances #-}@@ -118,8 +119,7 @@     {-# INLINE foldr #-}  #if MIN_VERSION_base(4,6,0)-    foldl' f z xs = runF xs (flip f) (foldr (!>>>) id) z-      where (!>>>) h g = \r -> g $! h r+    foldl' f z xs = runF xs (\a !r -> f r a) (flip $ foldl' $ \r g -> g r) z     {-# INLINE foldl' #-} #endif 

@@ -42,9 +42,11 @@   , iterM   -- * Free Monads With Class   , MonadFree(..)+  , liftF   ) where  import Control.Applicative+import Control.Category ((<<<), (>>>)) import Control.Monad import Control.Monad.Identity import Control.Monad.Trans.Class@@ -61,7 +63,6 @@ import qualified Data.Foldable as F import Data.Traversable (Traversable) import qualified Data.Traversable as T-import Data.Monoid import Data.Functor.Bind hiding (join) import Data.Function @@ -82,7 +83,7 @@  instance Applicative (FT f m) where   pure a = FT $ \k _ -> k a-  FT fk <*> FT ak = FT $ \b fr -> ak (\d -> fk (\e -> b (e d)) fr) fr+  FT fk <*> FT ak = FT $ \b fr -> fk (\e -> ak (\d -> b (e d)) fr) fr  instance Bind (FT f m) where   (>>-) = (>>=)@@ -106,7 +107,18 @@   mplus (FT k1) (FT k2) = FT $ \a fr -> k1 a fr `mplus` k2 a fr  instance (Foldable f, Foldable m, Monad m) => Foldable (FT f m) where-  foldMap f (FT k) = F.fold $ k (return . f) (F.foldr (liftM2 mappend) (return mempty))+  foldr f r xs = F.foldr (<<<) id inner r+    where+      inner = runFT xs (return . f) (F.foldr (liftM2 (<<<)) (return id))+  {-# INLINE foldr #-}++#if MIN_VERSION_base(4,6,0)+  foldl' f z xs = F.foldl' (!>>>) id inner z+    where+      (!>>>) h g = \r -> g $! h r+      inner = runFT xs (return . flip f) (F.foldr (liftM2 (>>>)) (return id))+  {-# INLINE foldl' #-}+#endif  instance (Monad m, Traversable m, Traversable f) => Traversable (FT f m) where   traverse f (FT k) = fmap (join . lift) . T.sequenceA $ k traversePure traverseFree

@@ -40,6 +40,15 @@   -- monad encapsulates errors, the 'Iter' monad encapsulates   -- non-termination. The 'IterT' transformer generalizes non-termination to any monadic   -- computation.+  --+  -- Computations in 'IterT' (or 'Iter') can be composed in two ways:+  --+  -- * /Sequential:/ Using the 'Monad' instance, the result of a computation+  --   can be fed into the next.+  --+  -- * /Parallel:/ Using the 'MonadPlus' instance, several computations can be+  --   executed concurrently, and the first to finish will prevail.+  --   See also the <examples/Cabbage.lhs cabbage example>.    -- * The iterative monad transformer     IterT(..)@@ -51,6 +60,7 @@   , liftIter   , cutoff   , never+  , untilJust   , interleave, interleave_   -- * Consuming iterative monads   , retract@@ -158,7 +168,7 @@   {-# INLINE return #-}   IterT m >>= k = IterT $ m >>= either (runIterT . k) (return . Right . (>>= k))   {-# INLINE (>>=) #-}-  fail = IterT . fail+  fail _ = never   {-# INLINE fail #-}  instance Monad m => Apply (IterT m) where@@ -173,16 +183,19 @@   mfix f = IterT $ mfix $ runIterT . f . either id (error "mfix (IterT m): Right")   {-# INLINE mfix #-} -instance MonadPlus m => Alternative (IterT m) where-  empty = IterT mzero+instance Monad m => Alternative (IterT m) where+  empty = mzero   {-# INLINE empty #-}-  IterT a <|> IterT b = IterT (mplus a b)+  (<|>) = mplus   {-# INLINE (<|>) #-} -instance MonadPlus m => MonadPlus (IterT m) where-  mzero = IterT mzero+-- | Capretta's 'race' combinator. Satisfies left catch.+instance Monad m => MonadPlus (IterT m) where+  mzero = never   {-# INLINE mzero #-}-  IterT a `mplus` IterT b = IterT (mplus a b)+  (IterT x) `mplus` (IterT y) = IterT $ x >>= either+                                (return . Left)+                                (flip liftM y . second . mplus)   {-# INLINE mplus #-}  instance MonadTrans IterT where@@ -297,6 +310,20 @@ never :: (Monad f, MonadFree f m) => m a never = delay never +-- | Repeatedly run a computation until it produces a 'Just' value.+-- This can be useful when paired with a monad that has side effects.+--+-- For example, we may have @genId :: IO (Maybe Id)@ that uses a random+-- number generator to allocate ids, but fails if it finds a collision.+-- We can repeatedly run this with+--+-- @+-- 'retract' ('untilJust' genId) :: IO Id+-- @+untilJust :: (Monad m) => m (Maybe a) -> IterT m a+untilJust f = maybe (delay (untilJust f)) return =<< lift f+{-# INLINE untilJust #-}+ -- | Cuts off an iterative computation after a given number of -- steps. If the number of steps is 0 or less, no computation nor -- monadic effects will take place.@@ -416,6 +443,8 @@  {- $examples -<examples/MandelbrotIter.lhs Mandelbrot>+* <examples/MandelbrotIter.lhs Rendering the Mandelbrot set>++* <examples/Cabbage.lhs The wolf, the sheep and the cabbage>  -}