module Data.List.Class (
List (..), ListItem (..),
cons, fromList, filter, repeat,
takeWhile, genericTake, scanl,
transpose, zip, zipWith,
foldrL, foldlL, toList, lengthL, lastL,
merge2On, mergeOn,
execute, joinM,
transformListMonad
) where
import Control.Monad (MonadPlus(..), liftM)
import Control.Monad.Identity (Identity(..))
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)
class (MonadPlus l, Monad (ItemM l)) => List l where
type ItemM l :: * -> *
runList :: l a -> ItemM l (ListItem l a)
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 :: 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)
cons :: MonadPlus m => a -> m a -> m a
cons = mplus . return
fromList :: MonadPlus m => [a] -> m a
fromList = foldr (mplus . return) mzero
filter :: MonadPlus m => (a -> Bool) -> m a -> m a
filter cond =
(>>= f)
where
f x
| cond x = return x
| otherwise = mzero
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
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
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 (count1) xs)
execute :: List l => l a -> ItemM l ()
execute = foldlL const ()
joinM :: List l => l (ItemM l a) -> l a
joinM =
joinL . foldrL consFunc (return mzero)
where
consFunc action rest =
liftM (`cons` joinL rest) action
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)
toList :: List l => l a -> ItemM l [a]
toList =
foldrL step (return [])
where
step = liftM . (:)
lengthL :: (Integral i, List l) => l a -> ItemM l i
lengthL = foldlL (const . (+ 1)) 0
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
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)
zipWith :: List l => (a -> b -> c) -> l a -> l b -> l c
zipWith func as = liftM (uncurry func) . zip as
lastL :: List l => l a -> ItemM l a
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
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
mergeOn :: (Ord b, List l) => (a -> b) -> l (l a) -> l a
mergeOn f = joinL . foldlL (merge2On f) mzero
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