List 0.4.0 → 0.4.1

raw patch · 5 files changed

+260/−214 lines, 5 filesdep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• List.cabal +4/−2
• src/Control/Monad/ListT.hs +4/−79
• src/Control/Monad/Trans/List.hs +77/−0
• src/Control/Monad/Trans/List/Funcs.hs +24/−0
• src/Data/List/Class.hs +151/−133

@@ -1,5 +1,5 @@ Name:                List-Version:             0.4.0+Version:             0.4.1 Category:            Control Synopsis:            List monad transformer and class Description:@@ -17,7 +17,9 @@ Library   hs-Source-Dirs:      src   Extensions:-  Build-Depends:       base >= 3 && < 5, transformers >= 0.2.0+  Build-Depends:       base >= 3 && < 5, transformers >= 0.2   Exposed-modules:     Control.Monad.ListT,+                       Control.Monad.Trans.List,+                       Control.Monad.Trans.List.Funcs,                        Data.List.Class   Ghc-Options:         -O2 -Wall

@@ -1,83 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, 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.+-- Alternative module name to "List"'s @Control.Monad.Trans.List@.+-- The name @Control.Monad.Trans.List@ conflicts with "transformers"'s broken ListT. ----- > import Control.Monad (join)--- > import Control.Monad.ListT (ListT)--- > import Control.Monad.Trans (lift)--- > import Data.List.Class (execute, repeat, scanl, takeWhile, mapL)--- > import Prelude hiding (repeat, scanl, takeWhile)--- > --- > main =--- >     execute . mapL print .--- >     scanl (+) 0 .--- >     fmap (fst . head) .--- >     takeWhile (not . null) .--- >     fmap reads $ do--- >       repeat ()--- >       lift getLine :: ListT IO String+-- Import this module and not @Control.Monad.Trans.List@ if using both packages.  module Control.Monad.ListT (ListT(..)) where -import Data.List.Class (List(..), ListItem(..), foldrL)--import Control.Applicative (Applicative(..))-import Control.Monad (MonadPlus(..), ap, liftM)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Trans.Class (MonadTrans(..))-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---- 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 (foldrL' cons)--instance Monad m => Functor (ListT m) where-  fmap func = foldrL' (cons . func) mempty--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 => 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)--instance MonadIO m => MonadIO (ListT m) where-  liftIO = lift . liftIO+import Control.Monad.Trans.List (ListT(..))

@@ -0,0 +1,77 @@+{-# LANGUAGE 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.Trans.List.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++module Control.Monad.Trans.List (ListT(..)) where++import Data.List.Class (List(..), ListItem(..), foldrL)++import Control.Applicative (Applicative(..))+import Control.Monad (MonadPlus(..), ap, liftM)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Trans.Class (MonadTrans(..))+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++-- 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 (foldrL' cons)++instance Monad m => Functor (ListT m) where+    fmap func = foldrL' (cons . func) mempty++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 => 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)++instance MonadIO m => MonadIO (ListT m) where+    liftIO = lift . liftIO

@@ -0,0 +1,24 @@+-- | @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.Trans.List.Funcs+    ( iterateM, repeatM, repeat, fromList+    ) where++import Control.Monad.Trans.List (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

@@ -1,28 +1,29 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, TypeFamilies #-}+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}  -- | The 'List' class and actions for lists  module Data.List.Class (-  -- | The List typeclass-  List (..), ListItem (..),-  -- | List operations for MonadPlus-  cons, fromList, filter, repeat,-  -- | Standard list operations-  takeWhile, genericTake, scanl,-  transpose, zip, zipWith,-  -- | Non standard List operations-  foldrL, foldlL, foldl1L, toList, lengthL, lastL,-  merge2On, mergeOn,-  -- | Operations useful for monadic lists-  execute, joinM, mapL, iterateM, takeWhileM,-  -- | Operations for non-monadic lists-  sortOn,-  -- | Convert between List types-  transformListMonad,-  listStateJoin-  ) where+    -- | The List typeclass+    List (..), ListItem (..),+    -- | List operations for MonadPlus+    cons, fromList, filter, repeat,+    -- | Standard list operations+    takeWhile, genericTake, scanl, scanl1,+    transpose, zip, zipWith,+    concat, concatMap,+    -- | Non standard List operations+    foldrL, foldlL, foldl1L, toList, lengthL, lastL,+    merge2On, mergeOn,+    -- | Operations useful for monadic lists+    execute, joinM, mapL, iterateM, takeWhileM, repeatM,+    -- | Operations for non-monadic lists+    sortOn,+    -- | Convert between List types+    transformListMonad,+    listStateJoin+    ) where -import Control.Monad (MonadPlus(..), liftM)+import Control.Monad (MonadPlus(..), join, liftM) import Control.Monad.Trans.State (StateT(..), evalStateT, get) import Data.Function (fix) import Data.Functor.Identity (Identity(..))@@ -30,43 +31,60 @@ import Data.Maybe (fromJust) import Data.Ord (comparing) import Prelude hiding (-  filter, repeat, scanl, takeWhile, zip, zipWith)+    concat, concatMap, filter, repeat, scanl, scanl1, takeWhile, zip, zipWith)  data ListItem l a =-  Nil |-  Cons { headL :: a, tailL :: l a }-  deriving (Eq, Ord, Read, Show)+    Nil |+    Cons { headL :: a, tailL :: l a }+    deriving (Eq, Ord, Read, Show)  -- | 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+    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  instance List [] where-  type ItemM [] = Identity-  runList [] = Identity Nil-  runList (x:xs) = Identity $ Cons x xs-  joinL = runIdentity+    type ItemM [] = Identity+    runList [] = Identity Nil+    runList (x:xs) = Identity $ Cons x xs+    joinL = runIdentity  instance Functor m => Functor (ListItem m) where-  fmap _ Nil = Nil-  fmap func (Cons x xs) = Cons (func x) (fmap func xs)+    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 list = do-  item <- runList list-  case item of-    Nil -> nilFunc-    Cons x xs -> consFunc x (foldrL consFunc nilFunc xs)+foldrL consFunc nilFunc =+    deconstructList nilFunc onCons+    where+        onCons x = consFunc x . foldrL consFunc nilFunc +infixr 5 `cons` -- | Prepend an item to a 'MonadPlus' cons :: MonadPlus m => a -> m a -> m a cons = mplus . return@@ -86,45 +104,38 @@ -- > Nothing filter :: MonadPlus m => (a -> Bool) -> m a -> m a filter cond =-  (>>= f)-  where-    f x-      | cond x = return x-      | otherwise = mzero+    (>>= 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 list = do-  item <- runList list-  case item of-    Nil -> return startVal-    Cons x xs ->-      let v = step startVal x-      in v `seq` foldlL step v xs+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-foldl1L step list = do-  item <- runList list-  let Cons x xs = item-  foldlL step x xs+-- 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 list =-  cons startVal . joinL $ do-    item <- runList list-    return $ case item of-      Nil -> mzero-      Cons x xs -> scanl step (step startVal x) xs+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 list-  | count <= 0 = mzero-  | otherwise =-    joinL $ do-      item <- runList list-      return $ case item of-        Nil -> mzero-        Cons x xs -> cons x (genericTake (count-1) xs)+genericTake count+    | count <= 0 = const mzero+    | otherwise = deconstructList' mzero onCons+    where+        onCons x = cons x . genericTake (count - 1)  -- | Execute the monadic actions in a 'List' execute :: List l => l a -> ItemM l ()@@ -136,10 +147,10 @@ -- > [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+    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@@ -147,15 +158,18 @@ takeWhile :: List l => (a -> Bool) -> l a -> l a takeWhile = takeWhileM . fmap return +repeatM :: List l => ItemM l a -> l a+repeatM = joinM . repeat+ 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+    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 --@@ -163,9 +177,9 @@ -- > "hello!" toList :: List l => l a -> ItemM l [a] toList =-  foldrL step (return [])-  where-    step = liftM . (:)+    foldrL step (return [])+    where+        step = liftM . (:)  -- | Consume a list (execute its actions) and return its length --@@ -180,24 +194,19 @@ -- > > 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+    (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+    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 =-  joinL $ do-    xi <- runList xx-    case xi of-      Nil -> return mzero-      Cons x xs -> do-        yi <- runList yy-        return $ case yi of-          Nil -> mzero-          Cons y ys -> cons (x, y) (zip xs ys)+    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".@@ -216,17 +225,17 @@  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+    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 --@@ -241,16 +250,16 @@ -- > "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+    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,@@ -266,11 +275,11 @@ -- > [[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+    joinL $ do+        start <- startM+        return . cons start+            . iterateM step+            . step $ start  -- | listStateJoin can transform a -- @ListT (StateT s m) a@ to a @StateT s m (ListT m a)@.@@ -280,12 +289,21 @@ -- 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)+    => l a -> ItemM l (k a) listStateJoin list = do-  start <- get-  return . joinL . (`evalStateT` start) $ do-    item <- runList list-    case item of-      Nil -> return mzero-      Cons x xs -> liftM (cons x) (listStateJoin xs)+    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