generator 0.5 → 0.5.1

raw patch · 6 files changed

+97/−70 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• generator.cabal +1/−8
• src/Control/Monad/Consumer.hs +2/−2
• src/Control/Monad/DList.hs +3/−2
• src/Control/Monad/ListT.hs +4/−6
• src/Data/List/Class.hs +41/−36
• src/Data/List/Tree.hs +46/−16

@@ -1,5 +1,5 @@ Name:                generator-Version:             0.5+Version:             0.5.1 Category:            Control Synopsis:            A list monad transformer and related functions. Description:@@ -32,10 +32,3 @@                        Data.List.Class,                        Data.List.Tree   Ghc-Options:         -O2 -Wall-  Extensions:          FlexibleContexts,-                       FlexibleInstances,-                       FunctionalDependencies,-                       MultiParamTypeClasses,-                       RankNTypes,-                       UndecidableInstances-

@@ -38,11 +38,11 @@   liftIO = lift . liftIO  -- | Consume a 'ListT'-evalConsumerT :: List l m => ConsumerT v m a -> l v -> m a+evalConsumerT :: List l => ConsumerT v (ItemM l) a -> l v -> ItemM l a evalConsumerT (ConsumerT i) = evalStateT i . Just . toListT  -- Consumer no longer has a producer left...-putNoProducer :: List l m => StateT (Maybe (l v)) m ()+putNoProducer :: List l => StateT (Maybe (l v)) (ItemM l) () putNoProducer = put Nothing  -- | Consume/get the next value

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}  -- | A difference-list monad transformer / a monadic difference-list. --@@ -41,7 +41,8 @@   mzero = mempty   mplus = mappend -instance Monad m => List (DListT m) m where+instance Monad m => List (DListT m) where+  type ItemM (DListT m) = m   joinL action =     DListT $ \rest -> joinL $     liftM (`runDListT` rest) action

@@ -8,18 +8,16 @@ --   A program which reads numbers from the user and accumulates them. -- -- > import Control.Monad.ListT (ListT)--- > import Data.List.Class (joinL, repeat, scanl, sequence, sequence_, takeWhile)--- > import Prelude hiding (repeat, scanl, sequence, sequence_, takeWhile)+-- > import Data.List.Class (execute, joinM, repeat, scanl, takeWhile)+-- > import Prelude hiding (repeat, scanl, takeWhile) -- > -- > main =--- >   sequence_ .--- >   fmap print .+-- >   execute . joinM . fmap print . -- >   scanl (+) 0 . -- >   fmap (fst . head) . -- >   takeWhile (not . null) . -- >   fmap reads .--- >   joinL . sequence $--- >   (repeat getLine :: ListT IO (IO String))+-- >   joinM $ (repeat getLine :: ListT IO (IO String))  module Control.Monad.ListT (   ListItem(..), ListT(..), foldrListT

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RankNTypes, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-}  -- | The 'List' class and actions for lists @@ -9,10 +9,9 @@   cons, fromList, filter, repeat,   -- | Standard list operations   takeWhile, genericTake, scanl,-  sequence, sequence_, transpose,-  zip, zipWith,+  transpose, zip, zipWith,   -- | Non standard List operations-  foldlL, toList, execute, lengthL, lastL,+  foldlL, toList, execute, joinM, lengthL, lastL,   -- | Convert between List types   convList, transformListMonad, liftListMonad   ) where@@ -23,37 +22,40 @@ import Control.Monad.Trans (MonadTrans(..)) import Data.Function (fix) import Prelude hiding (-  filter, repeat, scanl, sequence, sequence_, takeWhile, zip, zipWith)+  filter, repeat, scanl, takeWhile, zip, zipWith)  -- | A class for list types. -- Every list has an underlying monad.-class (MonadPlus l, Monad m) => List l m | l -> m where+class (MonadPlus l, Monad (ItemM l)) => List l where+  type ItemM l :: * -> *   -- | Transform an action returning a list to the returned list   --   -- > > joinL $ Identity "hello"   -- > "hello"-  joinL :: m (l b) -> l b+  joinL :: ItemM l (l b) -> l b   -- | foldr for 'List's.   -- the result and 'right side' values are monadic actions.-  foldrL :: (a -> m b -> m b) -> m b -> l a -> m b+  foldrL :: (a -> ItemM l b -> ItemM l b) -> ItemM l b -> l a -> ItemM l b   foldrL consFunc nilFunc = foldrL consFunc nilFunc . toListT   -- | Convert to a 'ListT'.   --   -- Can be done with a foldrL but included in type-class for efficiency.-  toListT :: l a -> ListT m a+  toListT :: l a -> ListT (ItemM l) a   toListT = convList   -- | Convert from a 'ListT'.   --   -- Can be done with a foldrL but included in type-class for efficiency.-  fromListT :: ListT m a -> l a+  fromListT :: ListT (ItemM l) a -> l a   fromListT = convList -instance List [] Identity where+instance List [] where+  type ItemM [] = Identity   joinL = runIdentity   foldrL = foldr   toListT = fromList -instance Monad m => List (ListT m) m where+instance Monad m => List (ListT m) where+  type ItemM (ListT m) = m   joinL = ListT . (>>= runListT)   foldrL = foldrListT   toListT = id@@ -73,7 +75,7 @@ fromList = foldr (mplus . return) mzero  -- | Convert between lists with the same underlying monad-convList :: (List l m, List k m) => l a -> k a+convList :: (ItemM l ~ ItemM k, List l, List k) => l a -> k a convList =   joinL . foldrL step (return mzero)   where@@ -92,8 +94,9 @@       | otherwise = mzero  -- for foldlL and scanl-foldlL' :: List l m =>-  (a -> m c -> c) -> (a -> c) -> (a -> b -> a) -> a -> l b -> c+foldlL' :: List l =>+  (a -> (ItemM l) c -> c) -> (a -> c) ->+  (a -> b -> a) -> a -> l b -> c foldlL' joinVals atEnd step startVal =   t startVal . foldrL astep (return atEnd)   where@@ -101,19 +104,19 @@     t cur = joinVals cur . (`ap` return cur)  -- | An action to do foldl for 'List's-foldlL :: List l m => (a -> b -> a) -> a -> l b -> m a+foldlL :: List l => (a -> b -> a) -> a -> l b -> ItemM l a foldlL step startVal =   foldlL' (const join) id astep (return startVal)   where     astep rest x = liftM (`step` x) rest -scanl :: List l m => (a -> b -> a) -> a -> l b -> l a+scanl :: List l => (a -> b -> a) -> a -> l b -> l a scanl =   foldlL' consJoin $ const mzero   where     consJoin cur = cons cur . joinL -genericTake :: (Integral i, List l m) => i -> l a -> l a+genericTake :: (Integral i, List l) => i -> l a -> l a genericTake count   | count <= 0 = const mzero   | otherwise = foldlL' joinStep (const mzero) next Nothing@@ -125,21 +128,22 @@     joinStep (Just (_, x)) = cons x . joinL  -- | Execute the monadic actions in a 'List'-execute :: List l m => l a -> m ()+execute :: List l => l a -> ItemM l () execute = foldlL const () -sequence :: List l m => l (m a) -> m (l a)-sequence =-  foldrL consFunc (return mzero)+-- | Transform a list of actions to a list of their results+--+-- > > joinM [Identity 4, Identity 7]+-- > [4,7]+joinM :: List l => l (ItemM l a) -> l a+joinM =+  joinL . foldrL consFunc (return mzero)   where     consFunc action rest = do       x <- action       return . cons x . joinL $ rest -sequence_ :: List l m => l (m a) -> m ()-sequence_ = execute . joinL . sequence--takeWhile :: List l m => (a -> Bool) -> l a -> l a+takeWhile :: List l => (a -> Bool) -> l a -> l a takeWhile cond =   joinL . foldrL step (return mzero)   where@@ -151,7 +155,7 @@ -- -- > > runIdentity $ toList "hello!" -- > "hello!"-toList :: List l m => l a -> m [a]+toList :: List l => l a -> ItemM l [a] toList =   foldrL step $ return []   where@@ -161,7 +165,7 @@ -- -- > > runIdentity $ lengthL [1,2,3] -- > 3-lengthL :: (Integral i, List l m) => l a -> m i+lengthL :: (Integral i, List l) => l a -> ItemM l i lengthL = foldlL (const . (+ 1)) 0  -- | Transform the underlying monad of a list given a way to transform the monad@@ -169,8 +173,8 @@ -- > > import Data.List.Tree (bfs) -- > > bfs (transformListMonad (\(Identity x) -> [x, x]) "hey" :: ListT [] Char) -- > "hheeeeyyyyyyyy"-transformListMonad :: (List l m, List k s) =>-  (forall x. m x -> s x) -> l a -> k a+transformListMonad :: (List l, List k) =>+  (forall x. ItemM l x -> ItemM k x) -> l a -> k a transformListMonad trans =   t . foldrL step (return mzero)   where@@ -182,11 +186,11 @@ -- Doing plain 'transformListMonad lift' instead doesn't give the compiler -- the same knowledge about the types. liftListMonad ::-  (MonadTrans t, Monad (t m), List l m) =>-  l a -> ListT (t m) a+  (MonadTrans t, Monad (t (ItemM l)), List l) =>+  l a -> ListT (t (ItemM l)) a liftListMonad = transformListMonad lift -zip :: List l m => l a -> l b -> l (a, b)+zip :: List l => l a -> l b -> l (a, b) zip as bs =   r0 (toListT as) (toListT bs)   where@@ -196,6 +200,7 @@         case xi of           Nil -> return mzero           Cons x xs -> r1 x xs yy+    r1 :: List l => a -> ListT (ItemM l) a -> ListT (ItemM l) b -> ItemM l (l (a, b))     r1 x xs yy = do       yi <- runListT yy       return $ case yi of@@ -205,20 +210,20 @@  -- zipWith based on zip and not vice versa, -- because the other way around hlint compains "use zip".-zipWith :: List l m => (a -> b -> c) -> l a -> l b -> l c+zipWith :: List l => (a -> b -> c) -> l a -> l b -> l c zipWith func as = liftM (uncurry func) . zip as  -- | Consume all items and return the last one -- -- > > runIdentity $ lastL "hello" -- > 'o'-lastL :: List l m => l a -> m a+lastL :: List l => l a -> ItemM l a lastL = foldlL (const id) undefined  repeat :: MonadPlus m => a -> m a repeat = fix . cons -transpose :: List l m => l (l a) -> l (l a)+transpose :: List l => l (l a) -> l (l a) transpose matrix =   joinL $ toList matrix >>= r . map toListT   where

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, ScopedTypeVariables, UndecidableInstances #-}  -- | Functions for iterating trees. -- A 'List' whose underlying monad is also a 'List' is a tree.@@ -48,42 +48,44 @@ import Control.Monad (MonadPlus(..), guard, join, liftM) import Control.Monad.ListT (ListT(..), ListItem(..)) import Data.List.Class (-  List(..), cons, foldlL, sequence,+  List(..), cons, foldlL, joinM,   transformListMonad, transpose)-import Prelude hiding (sequence)  -- | A 'type-class synonym' for Trees.-class (List l k, List k m) => Tree l k m-instance (List l k, List k m) => Tree l k m+class (List t, List (ItemM t)) => Tree t+instance (List t, List (ItemM t)) => Tree t -search :: (List l m, MonadPlus m) => (m (m a) -> m a) -> l a -> m a+search :: (List l, MonadPlus (ItemM l)) => (ItemM l (ItemM l a) -> ItemM l a) -> l a -> ItemM l a search merge =   merge . foldrL step mzero   where     step a = return . cons a . merge  -- | Iterate a tree in DFS pre-order. (Depth First Search)-dfs :: (List l m, MonadPlus m) => l a -> m a+dfs :: (List l, MonadPlus (ItemM l)) => l a -> ItemM l a dfs = search join -toListTree :: Tree l k m => l a -> ListT (ListT m) a+toListTree :: Tree t => t a -> ListT (ListT (ItemM (ItemM t))) a toListTree = transformListMonad toListT  -- | Transform a tree into lists of the items in its different layers-bfsLayers :: Tree l k m => l a -> k (k a)+bfsLayers :: Tree t => t a -> ItemM t (ItemM t a) bfsLayers =   fromListT . liftM fromListT .   search (liftM join . transpose) . liftM return .   toListTree  -- | Iterate a tree in BFS order. (Breadth First Search)-bfs :: Tree l k m => l a -> k a+bfs :: Tree t => t a -> ItemM t a bfs = join . bfsLayers -mergeOn :: (Ord b, Monad m) => (a -> b) -> ListT m (ListT m a) -> ListT m a+mergeOn ::+  forall a b m. (Ord b, Monad m) =>+  (a -> b) -> ListT m (ListT m a) -> ListT m a mergeOn f =   joinL . foldlL merge2 mzero   where+    merge2 :: ListT m a -> ListT m a -> ListT m a     merge2 xx yy =       joinL $ do         xi <- runListT xx@@ -98,12 +100,13 @@  -- | Best First Search given a scoring function. bestFirstSearchOn ::-  (Ord b, Tree l k m) => (a -> b) -> l a -> k a+  (Ord b, Tree t) => (a -> b) -> t a -> ItemM t a bestFirstSearchOn func =   fromListT . search (mergeOn func) . toListTree  mergeOnSortedHeads ::-  (Ord b, Monad m) => (a -> b) -> ListT m (ListT m a) -> ListT m a+  forall a b m. (Ord b, Monad m) =>+  (a -> b) -> ListT m (ListT m a) -> ListT m a mergeOnSortedHeads f list =   joinL $ do     item <- runListT list@@ -116,6 +119,7 @@           Cons x xs ->             cons x . mergeOnSortedHeads f $ bury xs yys   where+    bury :: ListT m a -> ListT m (ListT m a) -> ListT m (ListT m a)     bury xx yyy =       joinL $ do         xi <- runListT xx@@ -136,17 +140,43 @@  -- | Best-First-Search given that a node's children are in sorted order (best first) and given a scoring function. -- Especially useful for trees where nodes have an infinite amount of children, where 'bestFirstSearchOn' will get stuck.+--+-- Example: Find smallest Pythagorian Triplets+--+-- > import Control.Monad+-- > import Control.Monad.Generator+-- > import Control.Monad.Trans+-- > import Data.List.Tree+-- > import Data.Maybe+-- >+-- > pythagorianTriplets =+-- >   catMaybes .+-- >   fmap fst .+-- >   bestFirstSearchSortedChildrenOn snd .+-- >   generate $ do+-- >     x <- lift [1..]+-- >     yield (Nothing, x)+-- >     y <- lift [1..]+-- >     yield (Nothing, x + y)+-- >     z <- lift [1..]+-- >     yield (Nothing, x + y + z)+-- >     lift . guard $ x^2 + y^2 == z^2+-- >     yield (Just (x, y, z), 0)+-- >+-- > > print $ take 10 pythagorianTriplets+-- > [(3,4,5),(4,3,5),(6,8,10),(8,6,10),(5,12,13),(12,5,13),(9,12,15),(12,9,15),(15,8,17),(8,15,17)]+ bestFirstSearchSortedChildrenOn ::-  (Ord b, Tree l k m) => (a -> b) -> l a -> k a+  (Ord b, Tree t) => (a -> b) -> t a -> ItemM t a bestFirstSearchSortedChildrenOn func =   fromListT . search (mergeOnSortedHeads func) . toListTree  -- | Prune a tree or list given a predicate. -- Unlike 'takeWhile' which stops a branch where the condition doesn't hold, -- prune "cuts" the whole branch (the underlying MonadPlus's mzero).-prune :: (List l m, MonadPlus m) => (a -> Bool) -> l a -> l a+prune :: (List l, MonadPlus (ItemM l)) => (a -> Bool) -> l a -> l a prune cond =-  joinL . sequence . liftM r+  joinM . liftM r   where     r x = do       guard $ cond x