List 0.1 → 0.2

raw patch · 3 files changed

+88/−126 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• List.cabal +1/−1
• src/Control/Monad/ListT.hs +24/−26
• src/Data/List/Class.hs +63/−99

@@ -1,5 +1,5 @@ Name:                List-Version:             0.1+Version:             0.2 Category:            Control Synopsis:            List monad transformer and class Description:

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, UndecidableInstances #-}  -- Module is called ListT because List is taken by mtl @@ -19,10 +19,10 @@ -- >   fmap reads . -- >   joinM $ (repeat getLine :: ListT IO (IO String)) -module Control.Monad.ListT (-  ListItem(..), ListT(..), foldrListT-) where+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.Cont.Class (MonadCont(..))@@ -32,27 +32,20 @@ import Control.Monad.Trans (MonadTrans(..), MonadIO(..)) import Data.Monoid (Monoid(..)) -data ListItem l a =-  Nil |-  Cons { headL :: a, tailL :: l a }--newtype ListT m a = ListT { runListT :: m (ListItem (ListT m) a) }+newtype 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+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-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)+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 = runListT . consFunc x . ListT+    step x = return . consFunc x . joinL  -- like generic cons except using that one -- would cause an infinite loop@@ -61,14 +54,14 @@  instance Monad m => Monoid (ListT m a) where   mempty = ListT $ return Nil-  mappend = flip (foldrListT' cons)+  mappend = flip (foldrL' cons)  instance Monad m => Functor (ListT m) where-  fmap func = foldrListT' (cons . func) mempty+  fmap func = foldrL' (cons . func) mempty  instance Monad m => Monad (ListT m) where   return = ListT . return . (`Cons` mempty)-  a >>= b = foldrListT' mappend mempty $ fmap b a+  a >>= b = foldrL' mappend mempty (fmap b a)  instance Monad m => Applicative (ListT m) where   pure = return@@ -81,6 +74,11 @@ 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)+ -- YUCK: -- I can't believe I'm doing this, -- for compatability with mtl's ListT.@@ -100,11 +98,11 @@  instance MonadError e m => MonadError e (ListT m) where   throwError = lift . throwError-  catchError m = ListT . catchError (runListT m) . (runListT .)+  catchError m = ListT . catchError (runList m) . (runList .)  instance MonadReader s m => MonadReader s (ListT m) where   ask = lift ask-  local f = ListT . local f . runListT+  local f = ListT . local f . runList  instance MonadState s m => MonadState s (ListT m) where   get = lift get

@@ -4,65 +4,58 @@  module Data.List.Class (   -- | The List typeclass-  List (..),+  List (..), ListItem (..),   -- | List operations for MonadPlus   cons, fromList, filter, repeat,   -- | Standard list operations   takeWhile, genericTake, scanl,   transpose, zip, zipWith,   -- | Non standard List operations-  foldlL, toList, lengthL, lastL,+  foldrL, foldlL, toList, lengthL, lastL,   merge2On, mergeOn,   -- | Operations useful for monadic lists   execute, joinM,   -- | Convert between List types-  convList, transformListMonad, liftListMonad+  transformListMonad   ) where -import Control.Monad (MonadPlus(..), ap, join, liftM)+import Control.Monad (MonadPlus(..), liftM) import Control.Monad.Identity (Identity(..))-import Control.Monad.ListT (ListT(..), ListItem(..), foldrListT)-import Control.Monad.Trans (MonadTrans(..)) import Data.Function (fix)+import Data.Maybe (fromJust) import Prelude hiding (   filter, repeat, scanl, takeWhile, zip, zipWith) +data ListItem l a =+  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 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+  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-  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+-- | 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)  -- | Prepend an item to a 'MonadPlus' cons :: MonadPlus m => a -> m a -> m a@@ -77,13 +70,6 @@ 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)@@ -96,39 +82,33 @@       | 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+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  scanl :: List l => (a -> b -> a) -> a -> l b -> l a-scanl =-  foldlL' consJoin $ const mzero-  where-    consJoin cur = cons cur . joinL+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  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+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)  -- | Execute the monadic actions in a 'List' execute :: List l => l a -> ItemM l ()@@ -142,9 +122,8 @@ joinM =   joinL . foldrL consFunc (return mzero)   where-    consFunc action rest = do-      x <- action-      return . cons x . joinL $ rest+    consFunc action rest =+      liftM (`cons` joinL rest) action  takeWhile :: List l => (a -> Bool) -> l a -> l a takeWhile cond =@@ -152,7 +131,7 @@   where     step x       | cond x = return . cons x . joinL-      | otherwise = const $ return mzero+      | otherwise = const (return mzero)  -- | An action to transform a 'List' to a list --@@ -160,7 +139,7 @@ -- > "hello!" toList :: List l => l a -> ItemM l [a] toList =-  foldrL step $ return []+  foldrL step (return [])   where     step = liftM . (:) @@ -184,32 +163,17 @@     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+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)  -- zipWith based on zip and not vice versa, -- because the other way around hlint compains "use zip".@@ -221,17 +185,17 @@ -- > > runIdentity $ lastL "hello" -- > 'o' lastL :: List l => l a -> ItemM l a-lastL = foldlL (const id) undefined+lastL = liftM fromJust . foldlL (const Just) Nothing  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+  joinL $ toList matrix >>= r   where     r xs = do-      items <- mapM runListT xs+      items <- mapM runList xs       return $ case filter isCons items of         [] -> mzero         citems ->@@ -253,9 +217,9 @@ -- > "01235689" merge2On :: (Ord b, List l) => (a -> b) -> l a -> l a -> l a merge2On f xx yy =-  fromListT . joinL $ do-    xi <- runListT (toListT xx)-    yi <- runListT (toListT 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