module System.Chatty.Spawn.Overlay where
import System.Chatty.Spawn
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import System.IO
newtype SpawnOverlayT m a = SpawnOverlay { runSpawnOverlayT :: [(String,[String] -> String -> m (Int,String))] -> m (a,[(String,[String] -> String -> m (Int,String))]) }
instance Monad m => Monad (SpawnOverlayT m) where
return a = SpawnOverlay $ \o -> return (a,o)
(SpawnOverlay o) >>= f = SpawnOverlay $ \s -> do (a,s') <- o s; runSpawnOverlayT (f a) s'
instance MonadTrans SpawnOverlayT where
lift m = SpawnOverlay $ \s -> do a <- m; return (a,s)
instance MonadIO m => MonadIO (SpawnOverlayT m) where
liftIO = lift . liftIO
instance Monad m => Functor (SpawnOverlayT m) where
fmap f a = SpawnOverlay $ \s -> do (a',s') <- runSpawnOverlayT a s; return (f a',s')
instance MonadSpawn m => MonadSpawn (SpawnOverlayT m) where
mspw pn as (Right si) = SpawnOverlay $ \s ->
case pn `elem` (map fst s) of
True -> let c = snd $ head $ filter ((==pn).fst) s
in do
(r,so) <- c as si
return ((r,so,[]),s)
False -> do
r <- mspw pn as (Right si)
return (r,s)
mspw pn as (Left h) = lift $ mspw pn as (Left h)
mah pn = SpawnOverlay $ \s ->
case pn `elem` (map fst s) of
True -> return (False,s)
False -> do
ah <- mah pn
return (ah,s)