LazyStateT.hs

module Codec.Compression.LazyStateT where

import Control.Monad.State
import Codec.Compression.UnsafeInterleave

data LazyStateT s m a = LazyStateT { runLazyStateT :: s -> m (a, s) }

evalLazyStateT :: Monad m => LazyStateT s m a -> s -> m a
evalLazyStateT m s = do (x, _) <- runLazyStateT m s
                        return x

execLazyStateT :: Monad m => LazyStateT s m a -> s -> m s
execLazyStateT m s = do (_, s') <- runLazyStateT m s
                        return s'

instance Monad m => Monad (LazyStateT s m) where
 -- (>>=)  :: LazyStateT s m a -> (a -> LazyStateT s m b) -> LazyStateT s m b
    LazyStateT v >>= f = LazyStateT $ \s -> do ~(x, s') <- v s
                                               let LazyStateT y = f x
                                               y s'
 -- return :: a -> LazyStateT s m a
    return x = LazyStateT $ \s -> return (x, s)
 -- fail :: String -> LazyStateT s m a
    fail str = LazyStateT $ \_ -> fail str

instance MonadTrans (LazyStateT s) where
    lift m = LazyStateT $ \s -> do x <- m
                                   return (x, s)

instance Monad m => MonadState s (LazyStateT s m) where
    get = LazyStateT $ \s -> return (s, s)
    put s = LazyStateT $ \_ -> return ((), s)

instance MonadIO m => MonadIO (LazyStateT s m) where
    liftIO m = LazyStateT $ \s -> do x <- liftIO m
                                     return (x, s)

instance UnsafeInterleave m => UnsafeInterleave (LazyStateT s m) where
    unsafeInterleave (LazyStateT v)
        = LazyStateT $ \s -> unsafeInterleave (v s)