Chatty

Chatty

Some text about Chatty.

The Problem

In large monad stacks it’s often clumsy to make use of a monad deep inside. Consider the following piece of code:

foo :: StateT Int (WriterT String (ReaderT Config (ErrorT Error IO))) Bool
foo = do
  st <- get
  lift $ lift $ lift $ lift $ putStr ("Do you like the number "++show st++"? ")
  b <- lift $ lift $ lift $ lift readLine
  unless b $ do
    lift $ lift $ lift $ lift $ putStr "Enter the new number: "
    st' <- lift $ lift $ lift $ lift readLine
    min <- lift $ lift $ asks minimumNumber
    when (st' < min) $ lift $ lift $ lift $ throwError TooSmallError
    put st'
    lift $ tell ("Chose "++show st'++". ")
  return b

Yuck! So much lift... Classical monad transformer libraries have a way to handle this: They have typeclasses for that!

foo' :: (MonadState Int m, MonadWriter String m, MonadReader Config m, MonadError Error m, MonadIO m) => m Bool
foo' = do
  st <- get
  liftIO $ putStr ("Do you like the number "++show st++"? ")
  b <- liftIO readLine
  unless b $ do
    liftIO $ putStr "Enter the new number: "
    st' <- liftIO readLine
    min <- asks minimumNumber
    when (st' < min) $ throwError TooSmallError
    put st'
    tell ("Chose "++show st'++". ")
  return b

Suddenly, not only the lifts disappear, but there is also another change: The signature doesn’t prescribe the order of the transformers. It just doesn’t matter any more. This enables you to put more than one StateT (ReaderT/WriterT/ErrorT) into the stack. The topmost one will be used and the deeper ones are ignored:

bar :: (MonadState Int m, MonadWriter String m, MonadReader Config m, MonadError Error m, MonadIO m) => m ()
bar = do
  foo'
  runStateT foo' 0
  runReaderT foo' defConfig{minimumNumber=10}
  runWriterT foo'
  return ()

That way we can construct an arbitrary environment for foo’, kind of sandboxing. If we don’t want foo’ to touch our state, we present him another one.

But: What about the IO? We can hijack the state handling, the reader, the writer, even the error handling, but we cannot hijack putStr and readLine. That sucks :(

What are the main reasons to use IO? What do people usually do there? In most cases a full-featured IO environment is not required.

Simple printers

Let’s start with text output. We might be unable to hijack putStr, but we can introduce a replacement:

class Monad m => ChPrinter m where
  mprint :: String -> m ()

instance ChPrinter IO where
  mprint = putStr

instance ChPrinter m => ChPrinter (StateT s m) where ...
instance ChPrinter m => ChPrinter (WriterT s m) where ...
instance ChPrinter m => ChPrinter (ReaderT s m) where ...
instance ChPrinter m => ChPrinter (ErrorT s m) where ...

We still need to rewrite foo’:

foo'' :: (MonadState Int m, MonadWriter String m, MonadReader Config m, MonadError Error m, ChPrinter m, MonadIO m) => m Bool
foo'' = do
  st <- get
  mprint ("Do you like the number "++show st++"? ")
  b <- liftIO readLine
  unless b $ do
    mprint "Enter the new number: "
    st' <- liftIO readLine
    min <- asks minimumNumber
    when (st' < min) $ throwError TooSmallError
    put st'
    tell ("Chose "++show st'++". ")
  return b

This should do exactly the same as foo’. For hijacking output we still need some additional instances.

newtype DeafT m a = Deaf { runDeafT :: m a }
newtype OutRedirT m a = OutRedir { runOutRedirT' :: Handle -> m a }
newtype RecorderT m a = Recorder { runRecorderT' :: m (a,[String]) }

instance Monad m => ChPrinter (DeafT m) where ...
instance MonadIO m => ChPrinter (OutRedirT m) where ...
instance Monad m => ChPrinter (RecorderT m) where ...

Now look what we can do with these guys:

bar' :: (MonadState Int m, MonadWriter String m, MonadReader Config m, MonadError Error m, MonadIO m) => m String
bar' = do
  foo'' .>. "bar.log"       -- file redirection using OutRedirT!
  foo'' .>>. "bar.log"      -- appending supported as well
  foo'' .>. DiscardO        -- discard the entire output
  _,r <- foo'' .>. RecordO  -- record the entire output to a Replayable
  return $ replay r         -- convert the Replayable to a string

More about printers in the haddocks. For using simple printers, you’ll need to import Text.Chatty.Printer. Also importing Text.Chatty.Interactor is always a good idea as a ton of instances is declared there.

Scanners

Hijacking output is nice, but foo” still needs IO for reading input. Let’s change that!

class Monad m => ChScanner m where
  mscan1 :: m Char      -- Read one single character
  mscanL :: m String    -- Lazily read all the input.
  mscannable :: m Bool  -- Input readable? (not EOF)

instance ChScanner IO where
  mscan1 = getChar
  mscanL = getContents
  mscannable = fmap not isEOF

newtype HereStringT m a = HereString { runHereStringT :: String -> m (a,String) }
newtype QuietT m a = Quiet { runQuietT :: m a }
newtype InRedirT m a = InRedir { runInRedirT' :: Handle -> m a }

instance Monad m => ChScanner (HereStringT m) where ...
instance Monad m => ChScanner (QuietT m) where ...
instance MonadIO m => ChScanner (InRedirT m) where ...

Our fourth version of foo doesn’t even require MonadIO any more:

foo''' :: (MonadState Int m, MonadWriter String m, MonadReader Config m, MonadError Error m, ChPrinter m, ChScanner m) => m Bool
foo''' = do
  st <- get
  mprint ("Do you like the number "++show st++"? ")
  b <- read <$> mscanLn
  unless b $ do
    mprint "Enter the new number: "
    st' <- read <$> mscanLn
    min <- asks minimumNumber
    when (st' < min) $ throwError TooSmallError
    put st'
    tell ("Chose "++show st'++". ")
  return b

bar'' :: (MonadState Int m, MonadWriter String m, MonadReader Config m, MonadError Error m, ChPrinter m, ChFinalizer m, MonadIO m) => m ()
bar'' = do
  foo''' .<. "bar.input"     -- file redirection using InRedirT
  foo''' .<. EmptyI          -- empty input using QuietT
  foo''' .<<. "False\n30\n"  -- here strings using HereStringT
  return ()

What’s a Finalizer?

You might have noticed that bar” requires a ChFinalizer environment. Now what’s that? The problem is that input from file is read lazily. If we close the file too soon, some strings in the running program will get in trouble. A ChFinalizer is a little helper whom you can tell a handle at any time and later give signal to close all known ones.

There is only one instance for ChFinalizer: HandleCloserT. The usual way of using it is wrapping the block in withLazyIO paranthenses.

For instance, the following is possible:

bar'' :: (MonadState Int m, MonadWriter String m, MonadReader Config m, MonadError Error m, ChPrinter m, MonadIO m) => m ()
bar'' = withLazyIO $ do
  foo''' .<. "bar.input"     -- file redirection using InRedirT
  foo''' .<. EmptyI          -- empty input using QuietT
  foo''' .<<. "False\n30\n"  -- here strings using HereStringT
  return ()

Another possibility is wrapping the entire program in a single finalizer, like this:

main = withLazyIO $ do
  ...

In that case, you should make sure not to open too many files (they will be closed right before program exits).

I can haz pipes!

Do we have pipes? Of course we have!

blaa :: ChPrinter m => m ()
blaa = mprintLn "Blaaa!"

output :: (ChPrinter m, ChScanner m) => String -> m ()
output str = do
  mprintLn ("Argument: "++str)
  inp <- mscanL
  mprintLn ("Input: "++inp)

fuu :: ChPrinter m => m ()
fuu = do
  blaa .|. output "lawl"       -- Argument: lawl    Input: Blaaa!
  output .<$. blaa .<<. "lawl" -- Argument: Blaaa!  Input: lawl

Please do never forget that pipes are only a minor side feature of Chatty. If your application heavily relies on pipes, the Conduit or Pipes package might be a better choice.

Older versions Editor Timestamp
Chatty m@doomanddarkness.eu 2015-07-25 09:25:01 UTC
Chatty m@doomanddarkness.eu 2015-07-25 09:24:43 UTC
Chatty m@doomanddarkness.eu 2015-07-24 23:09:25 UTC
Chatty m@doomanddarkness.eu 2015-07-24 23:08:51 UTC
Chatty m@doomanddarkness.eu 2015-07-24 23:08:19 UTC
Chatty m@doomanddarkness.eu 2015-07-24 23:07:17 UTC
Chatty m@doomanddarkness.eu 2015-07-24 23:06:04 UTC
Chatty m@doomanddarkness.eu 2015-07-24 23:05:12 UTC
Chatty m@doomanddarkness.eu 2015-07-24 23:04:32 UTC
Chatty m@doomanddarkness.eu 2015-07-24 23:03:38 UTC