M.hs

module Control.Monad.M where
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Either
import Control.Monad.Trans.Reader
import Data.String.Util
import Pipes
import System.Exit

type M r = ReaderT Env (EitherT String IO) r

data Env = Env { indention :: Int, verbosity :: Bool }

newEnv :: Bool -> Env  
newEnv = Env 0
     
env :: M Env 
env = ask 
    
warning :: String -> M () 
warning str = do 
  i <- indention <$> env 
  liftIO $ do
    putStr $ indenting i ("warning: " ++ str)
    putStr "\n"

indent :: Int -> Env -> Env
indent amount (Env i v) = Env (i + amount) v

indentM :: Int -> M r -> M r
indentM amount = local (indent amount) 

msg :: (MonadIO m) => String -> ReaderT Env m () 
msg str = do
  e <- ask 
  when (verbosity e) . liftIO . putStr . indenting (indention e) $ str

err :: String -> M r
err = lift . left

fromE :: (Unquoted b) => Either b a -> M a
fromE (Left  er)  = err . toString $ er 
fromE (Right val) = return val 

runM :: Env -> M () -> IO () 
runM env' comp = do 
  result <- runEitherT (runReaderT comp env')
  case result of
    Left e -> do 
      liftIO . putStrLn $ "fatal error:\n" ++ e
      exitFailure
    Right ()  -> 
      exitSuccess

type ConsumerM i r = Consumer i (ReaderT Env (EitherT String IO)) r
type ProducerM i r = Producer i (ReaderT Env (EitherT String IO)) r
type PipeM a b r = Pipe a b (ReaderT Env (EitherT String IO)) r