generator 0.5.1 → 0.5.2

raw patch · 4 files changed

+6/−549 lines, 4 filesdep +ListPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: List

API changes (from Hackage documentation)

Files

• generator.cabal +6/−14
• src/Control/Monad/ListT.hs +0/−112
• src/Data/List/Class.hs +0/−239
• src/Data/List/Tree.hs +0/−184

@@ -1,17 +1,11 @@ Name:                generator-Version:             0.5.1+Version:             0.5.2 Category:            Control-Synopsis:            A list monad transformer and related functions.+Synopsis:            Python-generators notation for creation of monadic lists Description:-    A list monad transformer and a generic List class.-     Consumer and Generator monad transformers to create     and iterate 'ListT's in a manner similar to     Python generators.--    A Tree module for searching and pruning-    trees expressed as 'List's whose underlying monad-    is also a List. License:             BSD3 License-file:        LICENSE Author:              Yair Chuchem@@ -24,11 +18,9 @@ Library   hs-Source-Dirs:      src   Extensions:-  Build-Depends:       base >= 3 && < 5, mtl, MaybeT-  Exposed-modules:     Control.Monad.ListT,-                       Control.Monad.DList,+  Build-Depends:       base >= 3 && < 5, mtl, MaybeT, List+  Exposed-modules:     Control.Monad.DList,                        Control.Monad.Consumer,-                       Control.Monad.Generator,-                       Data.List.Class,-                       Data.List.Tree+                       Control.Monad.Generator   Ghc-Options:         -O2 -Wall+

@@ -1,112 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}---- Module is called ListT because List is taken by mtl---- | A list monad transformer / a monadic list.------ Monadic list example:---   A program which reads numbers from the user and accumulates them.------ > import Control.Monad.ListT (ListT)--- > import Data.List.Class (execute, joinM, repeat, scanl, takeWhile)--- > import Prelude hiding (repeat, scanl, takeWhile)--- >--- > main =--- >   execute . joinM . fmap print .--- >   scanl (+) 0 .--- >   fmap (fst . head) .--- >   takeWhile (not . null) .--- >   fmap reads .--- >   joinM $ (repeat getLine :: ListT IO (IO String))--module Control.Monad.ListT (-  ListItem(..), ListT(..), foldrListT-) where--import Control.Applicative (Applicative(..))-import Control.Monad (MonadPlus(..), ap, liftM)--- import Control.Monad.Cont.Class (MonadCont(..))-import Control.Monad.Error.Class (MonadError(..))-import Control.Monad.Reader.Class (MonadReader(..))-import Control.Monad.State.Class (MonadState(..))-import Control.Monad.Trans (MonadTrans(..), MonadIO(..))-import Data.Monoid (Monoid(..))--data ListItem l a =-  Nil |-  Cons { headL :: a, tailL :: l a }--data ListT m a = ListT { runListT :: m (ListItem (ListT m) a) }---- | foldr for ListT-foldrListT :: Monad m => (a -> m b -> m b) -> m b -> ListT m a -> m b-foldrListT consFunc nilFunc list = do-  item <- runListT list-  case item of-    Nil -> nilFunc-    Cons x xs -> consFunc x $ foldrListT consFunc nilFunc xs---- for mappend, fmap, bind-foldrListT' :: Monad m =>-  (a -> ListT m b -> ListT m b) -> ListT m b -> ListT m a -> ListT m b-foldrListT' consFunc nilFunc =-  ListT . foldrListT step (runListT nilFunc)-  where-    step x = runListT . consFunc x . ListT---- like generic cons except using that one--- would cause an infinite loop-cons :: Monad m => a -> ListT m a -> ListT m a-cons x = ListT . return . Cons x--instance Monad m => Monoid (ListT m a) where-  mempty = ListT $ return Nil-  mappend = flip (foldrListT' cons)--instance Monad m => Functor (ListT m) where-  fmap func = foldrListT' (cons . func) mempty--instance Monad m => Monad (ListT m) where-  return = ListT . return . (`Cons` mempty)-  a >>= b = foldrListT' mappend mempty $ fmap b a--instance Monad m => Applicative (ListT m) where-  pure = return-  (<*>) = ap--instance Monad m => MonadPlus (ListT m) where-  mzero = mempty-  mplus = mappend--instance MonadTrans ListT where-  lift = ListT . liftM (`Cons` mempty)---- YUCK:--- I can't believe I'm doing this,--- for compatability with mtl's ListT.--- I hate the O(N^2) code length auto-lifts. DRY!!--instance MonadIO m => MonadIO (ListT m) where-  liftIO = lift . liftIO--{---- TODO: understand and verify this instance :)-instance MonadCont m => MonadCont (ListT m) where-  callCC f =-    ListT $ callCC thing-    where-      thing c = runListT . f $ ListT . c . (`Cons` mempty)--}--instance MonadError e m => MonadError e (ListT m) where-  throwError = lift . throwError-  catchError m = ListT . catchError (runListT m) . (runListT .)--instance MonadReader s m => MonadReader s (ListT m) where-  ask = lift ask-  local f = ListT . local f . runListT--instance MonadState s m => MonadState s (ListT m) where-  get = lift get-  put = lift . put-

@@ -1,239 +0,0 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-}---- | The 'List' class and actions for lists--module Data.List.Class (-  -- | The List typeclass-  List (..),-  -- | List operations for MonadPlus-  cons, fromList, filter, repeat,-  -- | Standard list operations-  takeWhile, genericTake, scanl,-  transpose, zip, zipWith,-  -- | Non standard List operations-  foldlL, toList, execute, joinM, lengthL, lastL,-  -- | Convert between List types-  convList, transformListMonad, liftListMonad-  ) where--import Control.Monad (MonadPlus(..), ap, join, liftM)-import Control.Monad.Identity (Identity(..))-import Control.Monad.ListT (ListT(..), ListItem(..), foldrListT)-import Control.Monad.Trans (MonadTrans(..))-import Data.Function (fix)-import Prelude hiding (-  filter, repeat, scanl, takeWhile, zip, zipWith)---- | A class for list types.--- Every list has an underlying monad.-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 :: ItemM l (l b) -> l b-  -- | foldr for 'List's.-  -- the result and 'right side' values are monadic actions.-  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 (ItemM l) a-  toListT = convList-  -- | Convert from a 'ListT'.-  ---  -- Can be done with a foldrL but included in type-class for efficiency.-  fromListT :: ListT (ItemM l) a -> l a-  fromListT = convList--instance List [] where-  type ItemM [] = Identity-  joinL = runIdentity-  foldrL = foldr-  toListT = fromList--instance Monad m => List (ListT m) where-  type ItemM (ListT m) = m-  joinL = ListT . (>>= runListT)-  foldrL = foldrListT-  toListT = id-  fromListT = id---- | Prepend an item to a 'MonadPlus'-cons :: MonadPlus m => a -> m a -> m a-cons = mplus . return---- | Convert a list to a 'MonadPlus'------ > > fromList [] :: Maybe Int--- > Nothing--- > > fromList [5] :: Maybe Int--- > Just 5-fromList :: MonadPlus m => [a] -> m a-fromList = foldr (mplus . return) mzero---- | Convert between lists with the same underlying monad-convList :: (ItemM l ~ ItemM k, List l, List k) => l a -> k a-convList =-  joinL . foldrL step (return mzero)-  where-    step x = return . cons x . joinL---- | filter for any MonadPlus------ > > filter (> 5) (Just 3)--- > Nothing-filter :: MonadPlus m => (a -> Bool) -> m a -> m a-filter cond =-  (>>= f)-  where-    f x-      | cond x = return x-      | otherwise = mzero---- for foldlL and scanl-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-    astep x rest = return $ (`t` rest) . (`step` x)-    t cur = joinVals cur . (`ap` return cur)---- | An action to do foldl for 'List's-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 => (a -> b -> a) -> a -> l b -> l a-scanl =-  foldlL' consJoin $ const mzero-  where-    consJoin cur = cons cur . joinL--genericTake :: (Integral i, List l) => i -> l a -> l a-genericTake count-  | count <= 0 = const mzero-  | otherwise = foldlL' joinStep (const mzero) next Nothing-  where-    next Nothing x = Just (count, x)-    next (Just (i, _)) y = Just (i - 1, y)-    joinStep Nothing = joinL-    joinStep (Just (1, x)) = const $ return x-    joinStep (Just (_, x)) = cons x . joinL---- | Execute the monadic actions in a 'List'-execute :: List l => l a -> ItemM l ()-execute = foldlL const ()---- | 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--takeWhile :: List l => (a -> Bool) -> l a -> l a-takeWhile cond =-  joinL . foldrL step (return mzero)-  where-    step x-      | cond x = return . cons x . joinL-      | otherwise = const $ return mzero---- | An action to transform a 'List' to a list------ > > runIdentity $ toList "hello!"--- > "hello!"-toList :: List l => l a -> ItemM l [a]-toList =-  foldrL step $ return []-  where-    step = liftM . (:)---- | Consume a list (execute its actions) and return its length------ > > runIdentity $ lengthL [1,2,3]--- > 3-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------ > > import Data.List.Tree (bfs)--- > > bfs (transformListMonad (\(Identity x) -> [x, x]) "hey" :: ListT [] Char)--- > "hheeeeyyyyyyyy"-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-    t = joinL . trans-    step x = return . cons x . t---- | Lift the underlying monad of a list and transform it to a ListT.------ Doing plain 'transformListMonad lift' instead doesn't give the compiler--- the same knowledge about the types.-liftListMonad ::-  (MonadTrans t, Monad (t (ItemM l)), List l) =>-  l a -> ListT (t (ItemM l)) a-liftListMonad = transformListMonad lift--zip :: List l => l a -> l b -> l (a, b)-zip as bs =-  r0 (toListT as) (toListT bs)-  where-    r0 xx yy =-      joinL $ do-        xi <- runListT xx-        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-        Nil -> mzero-        Cons y ys ->-          cons (x, y) $ r0 xs ys---- zipWith based on zip and not vice versa,--- because the other way around hlint compains "use zip".-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 => l a -> ItemM l a-lastL = foldlL (const id) undefined--repeat :: MonadPlus m => a -> m a-repeat = fix . cons--transpose :: List l => l (l a) -> l (l a)-transpose matrix =-  joinL $ toList matrix >>= r . map toListT-  where-    r xs = do-      items <- mapM runListT xs-      return $ case filter isCons items of-        [] -> mzero-        citems ->-          cons (fromList (map headL citems)) .-          joinL . r $ map tailL citems-    isCons Nil = False-    isCons _ = True-

@@ -1,184 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, ScopedTypeVariables, UndecidableInstances #-}---- | Functions for iterating trees.--- A 'List' whose underlying monad is also a 'List' is a tree.------ It's nodes are accessible, in contrast to the list monad,--- which can also be seen as a tree, except only its leafs--- are accessible and only in "dfs order".------ > import Control.Monad.Generator--- > import Data.List.Class (genericTake, takeWhile, toList, lastL)--- >--- > bits = t ""--- > t prev =--- >   generate $ do--- >     yield prev--- >     x <- lift "01"--- >     yields $ t (prev ++ [x])--- >--- > > take 3 (bfsLayers bits)--- > [[""],["0","1"],["00","01","10","11"]]--- >--- > > take 10 (bfs bits)--- > ["","0","1","00","01","10","11","000","001","010"]--- >--- > > dfs (genericTake 4 bits)--- > ["","0","00","000","001","01","010","011","1","10","100","101","11","110","111"]--- >--- > > toList $ genericTake 3 bits--- > [["","0","00"],["","0","01"],["","1","10"],["","1","11"]]------ Examples of pruning with 'prune' and 'takeWhile':------ > > dfs . takeWhile (not . isSuffixOf "11") $ genericTake 4 bits--- > ["","0","00","000","001","01","010","1","10","100","101"]--- >--- > > lastL . takeWhile (not . isSuffixOf "11") $ genericTake 4 bits--- > ["000","001","010","01","100","101","1"]--- >--- > > lastL . prune (not . isSuffixOf "11") $ genericTake 4 bits--- > ["000","001","010","100","101"]----module Data.List.Tree (-  Tree, dfs, bfs, bfsLayers, bestFirstSearchOn,-  prune, bestFirstSearchSortedChildrenOn-  ) where--import Control.Monad (MonadPlus(..), guard, join, liftM)-import Control.Monad.ListT (ListT(..), ListItem(..))-import Data.List.Class (-  List(..), cons, foldlL, joinM,-  transformListMonad, transpose)---- | A 'type-class synonym' for Trees.-class (List t, List (ItemM t)) => Tree t-instance (List t, List (ItemM t)) => Tree t--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, MonadPlus (ItemM l)) => l a -> ItemM l a-dfs = search join--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 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 t => t a -> ItemM t a-bfs = join . bfsLayers--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-        yi <- runListT yy-        return $ case (xi, yi) of-          (Cons x xs, Cons y ys)-            | f y > f x -> cons x . merge2 xs $ cons y ys-            | otherwise -> cons y $ merge2 (cons x xs) ys-          (x, y) -> mplus (t x) (t y)-    t Nil = mzero-    t (Cons x xs) = cons x xs---- | Best First Search given a scoring function.-bestFirstSearchOn ::-  (Ord b, Tree t) => (a -> b) -> t a -> ItemM t a-bestFirstSearchOn func =-  fromListT . search (mergeOn func) . toListTree--mergeOnSortedHeads ::-  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-    case item of-      Nil -> return mzero-      Cons xx yys -> do-        xi <- runListT xx-        return $ case xi of-          Nil -> mergeOnSortedHeads f yys-          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-        case xi of-          Nil -> return yyy-          Cons x xs -> bury' x xs yyy-    bury' x xs yyy = do-      yyi <- runListT yyy-      case yyi of-        Nil -> return . return $ cons x xs-        Cons yy yys -> do-          yi <- runListT yy-          case yi of-            Nil -> bury' x xs yys-            Cons y ys-              | f x <= f y -> return . cons (cons x xs) $ cons (cons y ys) yys-              | otherwise -> return . cons (cons y ys) =<< bury' x xs yys---- | 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 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, MonadPlus (ItemM l)) => (a -> Bool) -> l a -> l a-prune cond =-  joinM . liftM r-  where-    r x = do-      guard $ cond x-      return x-