New monads/MonadSplit

> module Control.Monad.MonadSplit where
> import Control.Monad
> import qualified Data.Sequence as S

MonadSplit, in a sense, represents the class of monads which have both
"mplus" and a new decomposition operator: "msplit" such that

  l == (msplit l >>= \(x,xs) -> return x `mplus` xs)

> class MonadPlus m => MonadSplit m where
>       msplit  :: m a -> m (a, m a)
>       miszero :: m a -> Bool

> instance MonadSplit [] where
>       msplit []     = mzero
>       msplit (x:xs) = return (x,xs)
>       miszero = null

> instance MonadSplit Maybe where
>       msplit Nothing   = mzero
>       msplit (Just x)  = return (x, Nothing)
>       miszero Nothing  = True
>       miszero (Just _) = False

This class allows us to implement several functions which were
previously implemented over lists only.

> foldMSl :: (MonadSplit m) => (a -> b -> m a) -> a -> m b -> m a
> foldMSl m i n | miszero n = return i
>               | otherwise = do
>     (x,xs) <- msplit n
>     i'     <- m i x
>     foldMSl m i' xs

> foldMSr :: (MonadSplit m) => (a -> b -> m b) -> b -> m a -> m b
> foldMSr m i n | miszero n = return i
>               | otherwise = do
>     (x,xs) <- msplit n
>     i'     <- foldMSr m i xs
>     m x i'

> scanMSl :: (MonadSplit m) => (a -> b -> m a) -> a -> m b -> m (m a)
> scanMSl m i n | miszero n = return (return i)
>               | otherwise = do
>     (x,xs) <- msplit n
>     i'     <- m i x
>     return (return i) `mplus` scanMSl m i' xs

> scanMSr :: (MonadSplit m) => (a -> b -> m b) -> b -> m a -> m (m b)
> scanMSr m i n | miszero n = return (return i)
>               | otherwise = do
>     (x,xs) <- msplit n
>     i'     <- scanMSr m i xs
>     (return . m x =<< i') `mplus` return i'

> initsM :: (MonadSplit m) => m a -> m (m a)
> initsM m | miszero m = return mzero
>          | otherwise = return mzero `mplus` do
>                            (x,xs) <- msplit m
>                            a <- initsM xs
>                            return $ return x `mplus` a

> tailsM :: (MonadSplit m) => m a -> m (m a)
> tailsM m | miszero m = return mzero
>          | otherwise = msplit m >>= \(x,xs) -> return m `mplus` tailsM xs

With cuts l = zip (inits l) (tails l), cutsM is the equivalent for MonadSplit.

> cutsM :: (MonadSplit m) => m a -> m (m a, m a)
> cutsM m | miszero m = return (mzero, mzero)
>         | otherwise = return (mzero, m) `mplus` do
>                           (x,xs) <- msplit m
>                           (a,b)  <- cutsM xs
>                           return $ (return x `mplus` a, b)

> insertM :: (MonadSplit m) => a -> m a -> m (m a)
> insertM i m = do
>     (a,b) <- cutsM m
>     return $ a `mplus` return i `mplus` b

> permuteM :: (MonadSplit m) => m a -> m (m a)
> permuteM m | miszero m = return mzero
>            | otherwise = do
>     (x,xs) <- msplit m
>     xs'    <- permuteM xs
>     insertM x xs'

As it happens, permuteM can be expressed with foldMSr.

> permuteM2 :: (MonadSplit m) => m b -> m (m b)
> permuteM2 m = foldMSr insertM mzero m

permuteWithDel means to permute the list and all sublists.

> permuteWithDelM m | miszero m = return mzero
>                   | otherwise = do
>     (x,xs) <- msplit m
>     xs'    <- permuteWithDelM xs
>     insertM x xs' `mplus` return xs'

> permuteWithDelM2 m = foldMSr (\x xs -> insertM x xs `mplus` return xs) mzero m

An example instance for another datatype.

> instance MonadSplit S.Seq where
>       miszero  = S.null
>       msplit s = case S.viewl s of
>                        S.EmptyL  -> return (undefined, 
>                                             fail "msplit used on empty sequence")
>                        x S.:< xs -> return (x, xs)

A "generalized" searching function:

g is "generator", a function which accepts the current search space, an
element of input, and produces a new search space.

t is "tester", a function which evaluates generated solutions

and finally, i is "input".

> search :: (MonadSplit s, MonadPlus p) => 
>           (b -> p a -> s (p a)) -> (p a -> Bool) -> s b -> s (p a)
> search g t i = (foldMSr g mzero i) >>= (\x -> guard (t x) >> return x)

test1 = search insertM (all (<4))

test1 [1..2] => [[1,2],[2,1]]
test1 [1..4] => []

test2 = search (\x xs -> insertM x xs `mplus` return xs) (all (<4))

test2 [1..4] => [[1,2,3],[2,1,3],[2,3,1],[2,3],[1,3,2],[3,1,2],[3,2,1],
                 [3,2],[1,3],[3,1],[3],[1,2],[2,1],[2],[1],[]]