New monads/MonadSplit

< New monads

Categories: Code

> 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],[]]

Recent content is available under a simple permissive license.