List-0.6.2/0000755000000000000000000000000013162765327010634 5ustar0000000000000000List-0.6.2/Setup.hs0000644000000000000000000000005713162765327012272 0ustar0000000000000000import Distribution.Simple main = defaultMain List-0.6.2/LICENSE0000644000000000000000000000275713162765327011654 0ustar0000000000000000Copyright Yair Chuchem 2009. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Yair Chuchem nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. List-0.6.2/CHANGELOG.md0000644000000000000000000000401213162765327012442 0ustar00000000000000000.6.2 ---- * `ListT`'s `Functor` instance doesn't require an underlying `Monad`. 0.6.1 ---- * Compatibility with Semigroup/Monoid proposal 0.6.0 ---- * `ListT` only available via `Control.Monad.ListT`. Resolves clash with other packages (for inclusion in Stackage). 0.5.2 ---- * `Alternative` instance 0.5.1 ---- * `splitWhenM` - a monadic variant of `break` 0.5.0 ---- * Add `mapMaybe` 0.4.4 ---- * Temporarily remove `mapMaybe` which will require bumping major version. Its previous addition in version 0.4.3 broke the `hexpat` package which used open imports causing a name clash when it was added. 0.4.3 ---- * Add `take` - a specialized version of `genericTake` * Add `splitAtM` * Add `catMaybe` * Add `mapMaybe` (temporarily removed in 0.4.4) 0.4.2 ---- * `cons` moved to List class so one could override with faster implementations * Add `enumFrom` * Add `enumFromTo` * Add `tail` * Add `filterL` 0.4.1 ---- * `Control.Monad.Trans.List.Funcs`: List functions specialized to `ListT` (to tell type inference what type is used) * Avoid using `RankNTypes` * `cons` is a right-associative operator * `ListT` also available on `Control.Monad.Trans.List` (reverted in 0.6.0) * Add `concat` (different from `join` in that inner lists are pure lists) * Add `concatMap` (different from `(=<<)` in that inner lists are pure lists) * Add `scanl1` * Add `repeatM` 0.4.0 ---- * Re-introduce `joinM` due to use-cases in `hexpat` * Add `mapL` 0.3.0 ---- * Add minor version number according to the package versioning policy. * Use `transformers` instead of `mtl` * Expose `ListT`'s data constructor * `joinM` removed. Use `(>>= lift)` instead. (re-introduced in 0.4.0) * `Functor` instance for `ListItem` * `listStateJoin` - embeds `StateT` inside the list. * Add `takeWhile` * Add `sortOn` * Add `iterateM` * Add `foldl1L` 0.2 ---- * Add instances for `Eq`, `Ord`, `Read`, `Show` * `foldrListT'` generalized to `foldrL' * `List` class independent of `ListT` - `toListT` and `fromListT` class functions removed. * Add `foldrL` 0.1 ---- * Initial version List-0.6.2/List.cabal0000644000000000000000000000147313162765327012540 0ustar0000000000000000Name: List Version: 0.6.2 Category: Control Synopsis: List monad transformer and class Description: A List monad transformer and a List class. With standard list operations for Lists License: BSD3 License-file: LICENSE Author: Yair Chuchem Maintainer: yairchu@gmail.com Homepage: http://github.com/yairchu/generator Cabal-Version: >= 1.2 Stability: experiemental Build-type: Simple Extra-source-files: CHANGELOG.md Library hs-Source-Dirs: src Extensions: Build-Depends: base >= 3 && < 5, transformers >= 0.2 Exposed-modules: Control.Monad.ListT, Control.Monad.ListT.Funcs, Data.List.Class Ghc-Options: -O2 -Wall List-0.6.2/src/0000755000000000000000000000000013162765327011423 5ustar0000000000000000List-0.6.2/src/Data/0000755000000000000000000000000013162765327012274 5ustar0000000000000000List-0.6.2/src/Data/List/0000755000000000000000000000000013162765327013207 5ustar0000000000000000List-0.6.2/src/Data/List/Class.hs0000644000000000000000000002635413162765327014622 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, TypeFamilies #-} -- | The 'List' class and actions for lists module Data.List.Class ( -- | The List typeclass List (..), ListItem (..), fromList, -- | List operations for MonadPlus filter, -- | Standard list operations repeat, take, takeWhile, genericTake, scanl, scanl1, transpose, zip, zipWith, concat, concatMap, tail, enumFrom, enumFromTo, catMaybes, mapMaybe, -- | Non standard List operations foldrL, foldlL, foldl1L, toList, lengthL, lastL, merge2On, mergeOn, -- | Operations useful for monadic lists execute, joinM, mapL, filterL, iterateM, takeWhileM, repeatM, splitAtM, splitWhenM, -- | Operations for non-monadic lists sortOn, -- | Convert between List types transformListMonad, listStateJoin ) where import Control.Monad (MonadPlus(..), join, liftM) import Control.Monad.Trans.State (StateT(..), evalStateT, get) import Data.Function (fix) import Data.Functor.Identity (Identity(..)) import Data.List (sortBy) import Data.Maybe (fromJust) import Data.Ord (comparing) import Prelude hiding ( concat, concatMap, enumFrom, enumFromTo, filter, repeat, scanl, scanl1, tail, take, takeWhile, zip, zipWith) data ListItem l a = Nil | Cons { headL :: a, tailL :: l a } deriving (Eq, Ord, Read, Show) infixr 5 `cons` -- | A class for list types. -- Every list has an underlying monad. class (MonadPlus l, Monad (ItemM l)) => List l where type ItemM l :: * -> * runList :: l a -> ItemM l (ListItem l a) -- | Transform an action returning a list to the returned list -- -- > > joinL $ Identity "hello" -- > "hello" joinL :: ItemM l (l a) -> l a -- | cons. Can be derived from MonadPlus but is part of class for performance. cons :: a -> l a -> l a cons = mplus . return instance List [] where type ItemM [] = Identity runList [] = Identity Nil runList (x:xs) = Identity $ Cons x xs joinL = runIdentity cons = (:) instance Functor m => Functor (ListItem m) where fmap _ Nil = Nil fmap func (Cons x xs) = Cons (func x) (fmap func xs) -- A "monadic-catamorphism" for lists. -- Unlike folds, this only looks at the list head. -- -- Should this be exposed? Needs a good name first.. deconstructList :: List l => ItemM l r -> (a -> l a -> ItemM l r) -> l a -> ItemM l r deconstructList onNil onCons list = do item <- runList list case item of Nil -> onNil Cons x xs -> onCons x xs deconstructList' :: List l => l r -> (a -> l a -> l r) -> l a -> l r deconstructList' onNil onCons = joinL . deconstructList (return onNil) onCons' where onCons' x = return . onCons x -- | foldr for 'List's. -- the result and 'right side' values are monadic actions. foldrL :: List l => (a -> ItemM l b -> ItemM l b) -> ItemM l b -> l a -> ItemM l b foldrL consFunc nilFunc = deconstructList nilFunc onCons where onCons x = consFunc x . foldrL consFunc nilFunc -- | Convert a list to a 'MonadPlus' -- -- > > fromList [] :: Maybe Int -- > Nothing -- > > fromList [5] :: Maybe Int -- > Just 5 fromList :: List l => [a] -> l a fromList = foldr cons mzero -- | 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 -- | An action to do foldl for 'List's foldlL :: List l => (a -> b -> a) -> a -> l b -> ItemM l a foldlL step startVal = deconstructList (return startVal) onCons where onCons x xs = let v = step startVal x in v `seq` foldlL step v xs foldl1L :: List l => (a -> a -> a) -> l a -> ItemM l a -- should use "error" or "fail"? foldl1L = deconstructList (error "foldl1L: empty list") . foldlL scanl :: List l => (a -> b -> a) -> a -> l b -> l a scanl step startVal = cons startVal . deconstructList' mzero (scanl step . step startVal) scanl1 :: List l => (a -> a -> a) -> l a -> l a scanl1 = deconstructList' mzero . scanl genericTake :: (Integral i, List l) => i -> l a -> l a genericTake count | count <= 0 = const mzero | otherwise = deconstructList' mzero onCons where onCons x = cons x . genericTake (count - 1) take :: List l => Int -> l a -> l a take = genericTake -- | 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 = liftM (`cons` joinL rest) action mapL :: List l => (a -> ItemM l b) -> l a -> l b mapL func = joinM . liftM func takeWhile :: List l => (a -> Bool) -> l a -> l a takeWhile = takeWhileM . fmap return repeatM :: List l => ItemM l a -> l a repeatM = joinM . repeat filterL :: List l => (a -> ItemM l Bool) -> l a -> l a filterL cond = joinL . foldrL step (return mzero) where step x rest = do b <- cond x if b then return . cons x . joinL $ rest else rest takeWhileM :: List l => (a -> ItemM l Bool) -> l a -> l a takeWhileM cond = joinL . foldrL step (return mzero) where step x rest = do b <- cond x if b then return . cons x . joinL $ rest else 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) => (ItemM l (k a) -> ItemM k (k a)) -> l a -> k a transformListMonad trans = t . foldrL step (return mzero) where t = joinL . trans step x = return . cons x . t zip :: List l => l a -> l b -> l (a, b) zip xx yy = deconstructList' mzero onConsX xx where onConsX x xs = deconstructList' mzero (onConsXY x xs) yy onConsXY x xs y ys = cons (x, y) $ zip 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 tail :: List l => l a -> l a tail = joinL . liftM tailL . runList -- | Consume all items and return the last one -- -- > > runIdentity $ lastL "hello" -- > 'o' lastL :: List l => l a -> ItemM l a lastL = liftM fromJust . foldlL (const Just) Nothing repeat :: List l => a -> l a repeat = fix . cons transpose :: List l => l (l a) -> l (l a) transpose matrix = joinL $ toList matrix >>= r where r xs = do items <- mapM runList xs return $ case filter isCons items of [] -> mzero citems -> cons (fromList (map headL citems)) . joinL . r $ map tailL citems isCons Nil = False isCons _ = True -- | Merge many lists sorted by a criteria given the criteria -- -- > > mergeOn length [["hi", "hey", "hello"], ["cat", "falcon"], ["banana", "cucumber"]] -- > ["hi","cat","hey","hello","banana","falcon","cucumber"] mergeOn :: (Ord b, List l) => (a -> b) -> l (l a) -> l a mergeOn f = joinL . foldlL (merge2On f) mzero -- | Merge two lists sorted by a criteria given the criteria -- -- > > merge2On id "01568" "239" -- > "01235689" merge2On :: (Ord b, List l) => (a -> b) -> l a -> l a -> l a merge2On f xx yy = joinL $ do xi <- runList xx yi <- runList yy return $ case (xi, yi) of (Cons x xs, Cons y ys) | f y > f x -> cons x . merge2On f xs $ cons y ys | otherwise -> cons y $ merge2On f (cons x xs) ys (Cons x xs, Nil) -> cons x xs (Nil, Cons y ys) -> cons y ys (Nil, Nil) -> mzero -- sorts require looking at the whole list -- even before the consumption of the first result element, -- so they make no sense for monadic lists sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn = sortBy . comparing -- | Monadic version of iterate. -- Can be used to produce trees given a children of node function. -- -- > import Data.List.Tree (bfsLayers) -- > take 3 $ bfsLayers (iterateM (\i -> [i*2, i*2+1]) [1] :: ListT [] Int) -- > [[1],[2,3],[4,5,6,7]] iterateM :: List l => (a -> ItemM l a) -> ItemM l a -> l a iterateM step startM = joinL $ do start <- startM return . cons start . iterateM step . step $ start -- | Monadic variant of splitAt. -- Consumes x items from the list and return them with the remaining monadic list. splitAtM :: List l => Int -> l a -> ItemM l ([a], l a) splitAtM at list | at <= 0 = return ([], list) | otherwise = do item <- runList list case item of Nil -> return ([], mzero) Cons x xs -> do (pre, post) <- splitAtM (at-1) xs return (x:pre, post) -- | Monadic variant of break. -- Consumes items from the list until a condition holds. splitWhenM :: List l => (a -> ItemM l Bool) -> l a -> ItemM l ([a], l a) splitWhenM cond list = do item <- runList list case item of Nil -> return ([], mzero) Cons x xs -> do isSplit <- cond x if isSplit then return ([], cons x xs) else do (pre, post) <- splitWhenM cond xs return (x:pre, post) -- | listStateJoin can transform a -- @ListT (StateT s m) a@ to a @StateT s m (ListT m a)@. -- -- When iterating a list, a state is already maintained and passed along -- in the form of the location along the list. -- This joins the inner @StateT s@ into the list. -- The list will fork the state given to it and won't share its changes. listStateJoin :: (List l, List k, ItemM l ~ StateT s (ItemM k)) => l a -> ItemM l (k a) listStateJoin list = do start <- get return . joinL . (`evalStateT` start) $ deconstructList (return mzero) onCons list where onCons x = liftM (cons x) . listStateJoin -- | Generalized 'concat' -- -- For @List l => l (l a) -> l a@ use 'join' concat :: List l => l [a] -> l a concat = join . liftM fromList -- | Genereralized 'concatMap' -- -- For @List l => (a -> l b) -> l a -> l b@ use '=<<' (monadic bind) concatMap :: List l => (a -> [b]) -> l a -> l b concatMap f = concat . liftM f catMaybes :: List l => l (Maybe a) -> l a catMaybes = concatMap f where f Nothing = mzero f (Just x) = return x mapMaybe :: List l => (a -> Maybe b) -> l a -> l b mapMaybe f = catMaybes . liftM f enumFrom :: (List l, Enum a) => a -> l a enumFrom x = cons x (enumFrom (succ x)) enumFromTo :: (List l, Enum a) => a -> a -> l a enumFromTo from to | fromEnum from > fromEnum to = mzero | otherwise = cons from (enumFromTo (succ from) to) List-0.6.2/src/Control/0000755000000000000000000000000013162765327013043 5ustar0000000000000000List-0.6.2/src/Control/Monad/0000755000000000000000000000000013162765327014101 5ustar0000000000000000List-0.6.2/src/Control/Monad/ListT.hs0000644000000000000000000000561613162765327015504 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, UndecidableInstances #-} -- | 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.Funcs (repeatM) -- > import Data.List.Class (execute, scanl, takeWhile, mapL) -- > import Prelude hiding (scanl, takeWhile) -- > -- > main = -- > execute . mapL print . -- > scanl (+) 0 . -- > fmap (fst . head) . -- > takeWhile (not . null) . -- > fmap reads $ repeatM getLine -- -- Note: -- The `transformers` package also has a `ListT` type, -- which oddly enough it is not a list monad transformer. -- This module was deliberately named differently from `transformers`'s module. module Control.Monad.ListT (ListT(..)) where import Data.List.Class (List(..), ListItem(..), foldrL) import Control.Applicative (Alternative(..), Applicative(..)) import Control.Monad (MonadPlus(..), ap, liftM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..)) #if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(..)) #endif import Data.Monoid (Monoid(..)) newtype ListT m a = ListT { runListT :: m (ListItem (ListT m) a) } deriving instance (Eq (m (ListItem (ListT m) a))) => Eq (ListT m a) deriving instance (Ord (m (ListItem (ListT m) a))) => Ord (ListT m a) deriving instance (Read (m (ListItem (ListT m) a))) => Read (ListT m a) deriving instance (Show (m (ListItem (ListT m) a))) => Show (ListT m a) -- for mappend, fmap, bind foldrL' :: List l => (a -> l b -> l b) -> l b -> l a -> l b foldrL' consFunc nilFunc = joinL . foldrL step (return nilFunc) where step x = return . consFunc x . joinL #if MIN_VERSION_base(4,9,0) instance Monad m => Semigroup (ListT m a) where (<>) = flip (foldrL' cons) #endif instance Monad m => Monoid (ListT m a) where mempty = ListT $ return Nil #if !(MIN_VERSION_base(4,11,0)) mappend = flip (foldrL' cons) #endif instance Functor m => Functor (ListT m) where fmap func (ListT action) = ListT (fmap f action) where f Nil = Nil f (Cons x xs) = Cons (func x) (fmap func xs) instance Monad m => Monad (ListT m) where return = ListT . return . (`Cons` mempty) a >>= b = foldrL' mappend mempty (fmap b a) instance Monad m => Applicative (ListT m) where pure = return (<*>) = ap instance Monad m => Alternative (ListT m) where empty = mempty (<|>) = mappend instance Monad m => MonadPlus (ListT m) where mzero = mempty mplus = mappend instance MonadTrans ListT where lift = ListT . liftM (`Cons` mempty) instance Monad m => List (ListT m) where type ItemM (ListT m) = m runList = runListT joinL = ListT . (>>= runList) cons x = ListT . return . Cons x instance MonadIO m => MonadIO (ListT m) where liftIO = lift . liftIO List-0.6.2/src/Control/Monad/ListT/0000755000000000000000000000000013162765327015140 5ustar0000000000000000List-0.6.2/src/Control/Monad/ListT/Funcs.hs0000644000000000000000000000130613162765327016552 0ustar0000000000000000-- | @List@ functions with type limited to use @ListT@. -- This might come useful for type interference. -- -- Functions where the @List@ is an input type and not only the result type do not need special limited versions. module Control.Monad.ListT.Funcs ( iterateM, repeatM, repeat, fromList ) where import Control.Monad.ListT (ListT) import qualified Data.List.Class as ListFuncs import Prelude hiding (repeat) iterateM :: Monad m => (a -> m a) -> m a -> ListT m a iterateM = ListFuncs.iterateM repeatM :: Monad m => m a -> ListT m a repeatM = ListFuncs.repeatM repeat :: Monad m => a -> ListT m a repeat = ListFuncs.repeat fromList :: Monad m => [a] -> ListT m a fromList = ListFuncs.fromList