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.

About peeking

Some scanners have support for peeking the first char without removing it from the input queue. One of them is HereStringT. As this lookahead feature might be useful sometimes, I decided to write a typeclass for it.

class ChScanner m => ChBufferedScanner m where 
  mpeek1 :: m Char           -- Scan the next character without removing it.
  mprepend :: String -> m () -- Prepend the given character to the scannable input.

instance Monad m => ChBufferedScanner (HereStringT m) where
  mpeek1 = HereString $ \ss -> return (head ss, ss)
  mprepend s = HereString $ \ss -> return ((), s++ss)

However, HereStringT is not always handy to use. Sometimes you’ll want to have these features on arbitrary scanners. So, let’s construct a buffer layer for them!

newtype ScannerBufferT m a = ScannerBuffer { runScannerBufferT :: [String] -> m (a,[String]) }

instance ChScanner m => ChScanner (ScannerBufferT m) where
  mscan1 = ScannerBuffer $ \(ss:sx) -> (if null ss then do s <- mscan1; return (s,[]:map (s:) sx) else return (head ss,tail ss:map (head ss:) sx))
  mscanL = ScannerBuffer $ \(ss:sx) -> do l <- mscanL; return (ss++l, []:map (++l) sx)
  mscannable = ScannerBuffer $ \(ss:sx) -> (if null ss then do b <- mscannable; return (b,[]:sx) else return (True,ss:sx))
  mscanh = return Nothing
  mready = ScannerBuffer $ \(ss:sx) -> (if null ss then do b <- mready; return (b,[]:sx) else return (True,ss:sx))

instance ChScanner m => ChBufferedScanner (ScannerBufferT m) where
  mpeek1 = ScannerBuffer $ \(ss:sx) -> (if null ss then do s <- mscan1; return (s,[s]:sx) else return (head ss,ss:sx))
  mprepend s = ScannerBuffer $ \(ss:sx) -> return ((),(s++ss):sx)

This looks rather overcomplicated. You’re right, it is. There is an easier way to construct a ChBufferedScanner layer on a ChScanner. But this one brings a significant advantage as it is able to also implement the following (even cooler!) typeclass:

class ChBufferedScanner m => ChStackBufferedScanner m where
  mpush :: m () -- Push the current input state to the stack.
  mpop :: m ()  -- Pop the previous input state from the stack.

instance ChScanner m => ChStackBufferedScanner (ScannerBufferT m) where
  mpush = ScannerBuffer $ \(ss:sx) -> return ((),ss:[]:sx)
  mpop = ScannerBuffer $ \(_:sx) -> return ((),sx)

More about scanners in the haddocks. For using simple scanners, you’ll need to import Text.Chatty.Scanner. Also importing Text.Chatty.Interactor is always a good idea as a ton of instances is declared there (and the piping). For withLazyIO you’ll need Text.Chatty.Finalizer. For buffered scanners Text.Chatty.Scanner.Buffered is required.

Channel printers

Simple printers assume that there is only one way of printing things. In reality there are lots of situations in which you have more than one output channel. Consider, for instance, an IRC bot. There are many ways the bot may emit messages: Users, Channels, standard output, the log file, raw server commands... We could define an algebraic type for channel selection like this:

data MsgTarget = TargetUser String | TargetChannel String | LogFile LogLevel | Stdout | RawIRC deriving (Ord, Eq, Show)

Usually, you will need a specialized ChChannelPrinter instance for your application. There are general ones, but they aren’t that useful. Here’s the typeclass:

class (ChPrinter m,Eq c) => ChChannelPrinter c m where
  cbracket :: c -> m a -> m a   -- Run the function with the given channel.
  cbracket c m = cstart c >> m >>= \a -> cfin c >> return a
  cstart :: c -> m ()           -- Switch to the given channel
  cfin :: c -> m ()             -- Return to the previous channel. The argument is bogus (just for type inference).
  cprint :: c -> String -> m () -- Print the string to the given channel.
  cprint c s = cbracket c $ mprint s
  cthis :: m c                  -- Return the current channel.

-- Captures all output on all channels
newtype ArchiverT c m a = Archiver { runArchiverT' :: ([(c,[String])],[c]) -> m (a,([(c,[String])],[c])) }
instance (Eq c, Monad m) => ChChannelPrinter c (ArchiverT c m) where ...
runArchiverT :: (Eq c,Monad m) => c -> ArchiverT c m a -> m (a,[(c,Replayable)])

-- Forwards output on a specific channel only
newtype FilterT c m a = Filter { runFilterT :: (c,[c]) -> m (a,[c]) }
instance (Eq c,ChPrinter m) => ChChannelPrinter c (FilterT c m) where ...

-- Joins all output regardless of its channel
newtype JoinerT m a = Joiner { runJoinerT :: m a }
instance (Eq c,ChPrinter m) => ChChannelPrinter c (JoinerT m) where ...

Sample instance

To get some feeling about how to handle channel printers, consider the following code from Anticiv. ChClock is explained later.

-- channel selector
data Target = Log           -- write to log file
            | Target String -- privmsg to a channel or user name
            | Notice String -- notice to a channel or user name
            | Address User  -- address a user in the channel
            | Raw           -- raw server command
            deriving Eq

newtype OutPlexT m a = OutPlex { runOutPlex :: Handle -> [Target] -> m (a,[Target]) }

instance (MonadIO m,ChPrinter m,MonadBot m,ChClock m,ChAtoms m) => ChPrinter (OutPlexT m) where
  mprint s = OutPlex $ \h ts -> do
    -- Throttle emissions
    unless (head ts == Log) $ do
      t <- bgets lastMsg
      tw <- bkInt "Throttle"
      let wait = do
            t' <- mgetstamp
            unless (t' > t+(fromRational (fromIntegral tw / 1000))) wait
      wait
      t' <- mgetstamp
      bmodify $ \b -> b{lastMsg=t'}
    case head ts of
      Log -> do
        -- Pass-through to underlying ChPrinter
        m <- bmodule
        mprint ("["++m++"] "++s)
      -- Dispatch over the handle
      Raw -> liftIO $ hPutStr h s
      Target ch -> liftIO $ hPrintf h "PRIVMSG %s :%s" ch s
      Address de -> do
        ch <- bkStr "Connection/Channel"
        liftIO $ hPrintf h "PRIVMSG %s :%s: %s" ch (userNick de) s
      Notice ch -> liftIO $ hPrintf h "NOTICE %s :%s" ch s
    return ((),ts)
  mflush = OutPlex $ \h ts -> (case head ts of
    Log -> mflush
    _ -> liftIO $ hFlush h ) >> return ((),ts)

instance (MonadIO m,ChPrinter m,MonadBot m,ChClock m,ChAtoms m) => ChChannelPrinter Target (OutPlexT m) where
  cstart c = OutPlex $ \_ ts -> return ((),c:ts)
  cfin _ = OutPlex $ \_ ts -> return ((),tail ts)
  cthis = OutPlex $ \_ ts -> return (head ts,ts)

Miscellaneous

Besides classical text in- and output there are other typical IO operations. Chatty tries to un-IO as many of these as possible.

Time

One example is time retrieval:

class (Functor m,Monad m) => ChClock m where
  mutctime :: m UTCTime          -- Get UTC time
  mgetstamp :: m NominalDiffTime -- Get a timestamp, guaranteed to grow

instance ChClock IO where
  mutctime = getCurrentTime
  mgetstamp = fmap (flip diffUTCTime (UTCTime (fromGregorian 1970 1 1) (secondsToDiffTime 0))) mutctime

TODO: Implement more instances, e.g. a ReaderT UTCTime.

Random

One other example is random number retrieval:

class Monad m => ChRandom m where
  mrandom :: Random r => m r           -- Get a single random number
  mrandomR :: Random r => (r,r) -> m r -- Get a single random number in the given range

instance ChRandom IO where
  mrandom = randomIO
  mrandomR rs = randomRIO rs

TODO: Implement more instances, e.g. a StateT RandomGen.

Shell-like convenience

Carefully inspect the following listing and you’ll get a clue what System.Chatty.Commands and System.Chatty.Spawn are about ;)

main = withBuiltins $ withLazyIO $ do
  echo "------ This file: "
  cat ["example.hs"]
  echo "------ Stats for this file: "
  (do
    mprint "Chars: "; wc CountChars .<. "example.hs"
    mprint "Lines: "; wc CountLines .<. "example.hs"
    mprint "Words: "; wc CountWords .<. "example.hs"
    ) .|. tee "example.stats"
  cat [] .<<. "------ Reversed dir contents:\n"
  ls [] .|. tac []
  echo "------ Disk space: ($USER)"
  spawn "df" ["-h"]
  echo "abc$USER" .|. spawn "cat" []
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