List (empty) → 0.1

raw patch · 5 files changed

+437/−0 lines, 5 filesdep +basedep +mtlsetup-changed

Dependencies added: base, mtl

Files

LICENSE +32/−0
List.cabal +24/−0
Setup.hs +3/−0
src/Control/Monad/ListT.hs +112/−0
src/Data/List/Class.hs +266/−0

+ LICENSE view

@@ -0,0 +1,32 @@+Copyright 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.cabal view

@@ -0,0 +1,24 @@+Name:                List+Version:             0.1+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/tree+Cabal-Version:       >= 1.2+Stability:           experiemental+Build-type:          Simple++Library+  hs-Source-Dirs:      src+  Extensions:+  Build-Depends:       base >= 3 && < 5, mtl+  Exposed-modules:     Control.Monad.ListT,+                       Data.List.Class+  Ghc-Options:         -O2 -Wall+

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+

+ src/Control/Monad/ListT.hs view

@@ -0,0 +1,112 @@+{-# 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 }++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++-- 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+

+ src/Data/List/Class.hs view

@@ -0,0 +1,266 @@+{-# 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, lengthL, lastL,+  merge2On, mergeOn,+  -- | Operations useful for monadic lists+  execute, joinM,+  -- | 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++-- | 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 =+  fromListT . joinL $ do+    xi <- runListT (toListT xx)+    yi <- runListT (toListT 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+