Monday, February 5, 2018

The wizard monoid

Recent versions of GHC 8.0 provides a Monoid instance for IO and this post gives a motivating example for why this instance is useful by building combinable "wizard"s.

Wizards

I'll define a "wizard" as a program that prompts a user "up front" for multiple inputs and then performs several actions after all input has been collected.

Here is an example of a simple wizard:

main :: IO ()
main = do
    -- First, we request all inputs:
    putStrLn "What is your name?"
    name <- getLine

    putStrLn "What is your age?"
    age <- getLine

    -- Then, we perform all actions:
    putStrLn ("Your name is: " ++ name)
    putStrLn ("Your age is: " ++ age)

... which produces the following interaction:

What is your name?
Gabriel<Enter>
What is your age?
31<Enter>
Your name is: Gabriel
Your age is: 31

... and here is an example of a slightly more complex wizard:

import qualified System.Directory

main :: IO ()
main = do
    -- First, we request all inputs:
    files <- System.Directory.listDirectory "."
    let askFile file = do
            putStrLn ("Would you like to delete " ++ file ++ "?")
            response <- getLine
            case response of
                "y" -> return [file]
                _   -> return []

    listOfListOfFilesToRemove <- mapM askFile files
    let listOfFilesToRemove = concat listOfListOfFilesToRemove

    -- Then, we perform all actions:
    let removeFile file = do
            putStrLn ("Removing " ++ file)
            System.Directory.removeFile file
    mapM_ removeFile listOfFilesToRemove

... which produces the following interaction:

Would you like to delete file1.txt?
y<Enter>
Would you like to delete file2.txt?
n<Enter>
Would you like to delete file3.txt?
y<Enter>
Removing file1.txt
Removing file3.txt

In each example, we want to avoid performing any irreversible action before the user has completed entering all requested input.

Modularity

Let's revisit our first example:

main :: IO ()
main = do
    -- First, we request all inputs:
    putStrLn "What is your name?"
    name <- getLine

    putStrLn "What is your age?"
    age <- getLine

    -- Then, we perform all actions:
    putStrLn ("Your name is: " ++ name)
    putStrLn ("Your age is: " ++ age)

This example is really combining two separate wizards:

  • The first wizard requests and displays the user's name
  • The second wizard requests and displays the user's age

However, we had to interleave the logic for these two wizards because we needed to request all inputs before performing any action.

What if there were a way to define these two wizards separately and then combine them into a larger wizard? We can do so by taking advantage of the Monoid instance for IO, like this:

import Data.Monoid ((<>))

name :: IO (IO ())
name = do
    putStrLn "What is your name?"
    x <- getLine
    return (putStrLn ("Your name is: " ++ x))

age :: IO (IO ())
age = do
    putStrLn "What is your age?"
    x <- getLine
    return (putStrLn ("Your age is: " ++ x))

runWizard :: IO (IO a) -> IO a
runWizard request = do
    respond <- request
    respond

main :: IO ()
main = runWizard (name <> age)

This program produces the exact same behavior as before, but now all the logic for dealing with the user's name is totally separate from the logic for dealing with the user's age.

The way this works is that we split each wizard into two parts:

  • the "request" (i.e. prompting the user for input)
  • the "response" (i.e. performing an action based on that input)

... and we do so at the type-level by giving each wizard the type IO (IO ()):

name :: IO (IO ())

age :: IO (IO ())

The outer IO action is the "request". When the request is done the outer IO action returns an inner IO action which is the "response". For example:

--      ↓ The request
name :: IO (IO ())
--          ↑ The response
name = do
    putStrLn "What is your name?"
    x <- getLine
    -- ↑ Everything above is part of the outer `IO` action (i.e. the "request")

    --      ↓ This return value is the inner `IO` action (i.e. the "response")
    return (putStrLn ("Your name is: " ++ x))

We combine wizards using the (<>) operator, which has the following behavior when specialized to IO actions:

ioLeft <> ioRight

= do resultLeft  <- ioLeft
     resultRight <- ioRight
     return (resultLeft <> resultRight)

In other words, if you combine two IO actions you just run each IO action and then combine their results. This in turn implies that if we nest two IO actions then we repeat this process twice:

requestLeft <> requestRight

= do respondLeft  <- requestLeft
     respondRight <- requestRight
     return (respondLeft <> respondRight)

= do respondLeft  <- requestLeft
     respondRight <- requestRight
     return (do
         unitLeft  <- respondLeft
         unitRight <- respondRight
         return (unitLeft <> unitRight) )

-- Both `unitLeft` and `unitRight` are `()` and `() <> () = ()`, so we can
-- simplify this further to:
= do respondLeft  <- requestLeft
     respondRight <- requestRight
     return (do
         respondLeft
         respondRight )

In other words, when we combine two wizards we combine their requests and then combine their responses.

This works for more than two wizards. For example:

request0 <> request1 <> request2 <> request3

= do respond0 <- request0
     respond1 <- request1
     respond2 <- request2
     respond3 <- request3
     return (do
         respond0
         respond1
         respond2
         respond3 )

To show this in action, let's revisit our original example once again:

import Data.Monoid ((<>))

name :: IO (IO ())
name = do
    putStrLn "What is your name?"
    x <- getLine
    return (putStrLn ("Your name is: " ++ x))

age :: IO (IO ())
age = do
    putStrLn "What is your age?"
    x <- getLine
    return (putStrLn ("Your age is: " ++ x))

runWizard :: IO (IO a) -> IO a
runWizard request = do
    respond <- request
    respond

main :: IO ()
main = runWizard (name <> age)

... and this time note that name and age are awfully similar, so we can factor them out into a shared function:

import Data.Monoid ((<>))

prompt :: String -> IO (IO ())
prompt attribute = do
    putStrLn ("What is your " ++ attribute ++ "?")
    x <- getLine
    return (putStrLn ("Your " ++ attribute ++ " is: " ++ x))

runWizard :: IO (IO a) -> IO a
runWizard request = do
    respond <- request
    respond

main :: IO ()
main = runWizard (prompt "name" <> prompt "age")

We were not able to factor out this shared logic back when the logic for the two wizards were manually interleaved. Once we split them into separate logical wizards then we can begin to exploit shared structure to compress our program.

This program compression lets us easily add new wizards:

import Data.Monoid ((<>))

prompt :: String -> IO (IO ())
prompt attribute = do
    putStrLn ("What is your " ++ attribute ++ "?")
    x <- getLine
    return (putStrLn ("Your " ++ attribute ++ " is: " ++ x))

runWizard :: IO (IO a) -> IO a
runWizard request = do
    respond <- request
    respond

main :: IO ()
main = runWizard (prompt "name" <> prompt "age" <> prompt "favorite color")

... and take advantage of standard library functions that work on Monoids, like foldMap so that we can mass-produce wizards:

import Data.Monoid ((<>))

prompt :: String -> IO (IO ())
prompt attribute = do
    putStrLn ("What is your " ++ attribute ++ "?")
    x <- getLine
    return (putStrLn ("Your " ++ attribute ++ " is: " ++ x))

runWizard :: IO (IO a) -> IO a
runWizard request = do
    respond <- request
    respond

main :: IO ()
main = runWizard (foldMap prompt [ "name", "age", "favorite color", "sign" ])

More importantly, we can now easily see at a glance what our program does and ease of reading is a greater virtue than ease of writing.

Final example

Now let's revisit the file removal example through the same lens:

import qualified System.Directory

main :: IO ()
main = do
    -- First, we request all inputs:
    files <- System.Directory.listDirectory "."
    let askFile file = do
            putStrLn ("Would you like to delete " ++ file ++ "?")
            response <- getLine
            case response of
                "y" -> return [file]
                _   -> return []

    listOfListOfFilesToRemove <- mapM askFile files
    let listOfFilesToRemove = concat listOfListOfFilesToRemove

    -- Then, we perform all actions:
    let removeFile file = do
            putStrLn ("Removing " ++ file)
            System.Directory.removeFile file
    mapM_ removeFile listOfFilesToRemove

We can simplify this using the same pattern:

import qualified System.Directory

main :: IO ()
main = do
    files <- System.Directory.listDirectory "."
    runWizard (foldMap prompt files)

prompt :: FilePath -> IO (IO ())
prompt file = do
    putStrLn ("Would you like to delete " ++ file ++ "?")
    response <- getLine
    case response of
        "y" -> return (do
            putStrLn ("Removing " ++ file)
            System.Directory.removeFile file )
        _   -> return (return ())

runWizard :: IO (IO a) -> IO a
runWizard request = do
    respond <- request
    respond

All we have to do is define a wizard for processing a single file, mass-produce the wizard using foldMap and the Monoid instance for IO takes care of bundling all the requests up front and threading the selected files to be removed afterwards.

Conclusion

This pattern does not subsume all possible wizards that users might want to write. For example, if the wizards depend on one another then this pattern breaks down pretty quickly. However, hopefully this provides an example of you can chain the Monoid instance for IO with other Monoid instance (even itself!) to generate emergent behavior.