A simple way to test IO-using functions

FakeIO.fs

open System

module IOMonad =

    // wooh, naming conventions!
    // this is the interface for our IO implementations
    type IIO = 
        abstract member printLineImpl : string -> unit
        abstract member getLineImpl : unit -> string

    // here is the "real world" implementation:
    let defaultIO : IIO =
        { new IIO with
            member __.printLineImpl (s : string) = Console.WriteLine s
            member __.getLineImpl () = Console.ReadLine()
        }

    // abstract type for our IO monad
    type IO<'t> = private IO of (IIO -> 't)

    // we can run it with the real-world implementation
    let runIO (IO io) = io defaultIO

    // or run it with any user-defined implementation
    let runIOWith impl (IO io) = io impl


    // here are the functions you can use inside the monad:
    let printLine s = IO (fun impl -> impl.printLineImpl s)
    let getLine () = IO (fun impl -> impl.getLineImpl ())

    // the computation expression builder:
    type IOBuilder () = 
        member __.Return x = IO (fun _ -> x)
        member __.Bind (x : IO<'t>, f : 't -> IO<'u>) : IO<'u> =
            IO (fun impl -> runIOWith impl (f (runIOWith impl x)))

    // and a short name for it:
    let io = IOBuilder()


// now let's use it!
open IOMonad

// here is a function in the IO monad:
let doMyThing = io {
    do! printLine "What's your name?"
    let! name = getLine()
    do! printLine ("Hello " + name)
    }

// now we write a fake implementation of IIO:
open System.Collections.Generic
type FakeIO (fakeInputs : seq<string>) =
    // it takes a sequence of inputs (what the IO function will read):
    let inputs = new Stack<_>(fakeInputs)

    // and stores a sequence of outputs (what the IO function wrote):
    let outputs = new List<string>()
    member __.Outputs : seq<string> = upcast outputs

    // and implements the IIO interface:
    interface IIO with
        member __.getLineImpl () =
            match inputs.Count with
                | 0 -> raise <| InvalidOperationException("not enough fake inputs supplied")
                | c -> inputs.Pop()
            
        member __.printLineImpl s = outputs.Add(s)


[<EntryPoint>]
let main argv = 

    // now we can test our function
    let name = "Musashi"
    let fakeIO = new FakeIO [| name |]
    let expectedOutputs = [ "What's your name?"; "Hello " + name ]

    // run our function with our fake IO implementation:
    runIOWith fakeIO doMyThing
    // or: runIO doMyThing to run the real implementation

    // and now check the results:
    printfn "Expected: %A" expectedOutputs
    printfn "Got: %A" fakeIO.Outputs

    0

FakeIO.hs

{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

module Main where

import Control.Monad.State

-- boo, uses concrete IO monad
functionThatIsHardToTest :: IO ()
functionThatIsHardToTest = do
    putStrLn "What is your name?"
    name <- getLine
    putStrLn ("Hello " ++ name)


-- a class that represents our operations
class Monad m => IOMonad m where
    -- names chosen just so they don't clash
    readLine :: m String
    printLine :: String -> m ()

-- IO monad can implement this
instance IOMonad IO where
    readLine = getLine
    printLine = putStrLn

-- same function, just use our new operations:
functionThatIsEasierToTest :: IOMonad m => m ()
functionThatIsEasierToTest = do
    printLine "What is your name?"
    name <- readLine
    printLine ("Hello " ++ name)


-- FakeIO stores inputs and outputs (real impl should use newtypes)
type FakeIO = State ([String], [String])

instance IOMonad FakeIO where
    readLine = do
        -- NB: crashes if not enough inputs supplied
        ((input:inputs), outputs) <- get
        put (inputs, outputs)
        return input

    printLine output = do
        (inputs, outputs) <- get
        put (inputs, output:outputs)
        -- note that we use the outputs like a stack so we need to reverse them later


-- and a way to run the FakeIO (note that this is pure)
-- given a list of inputs it returns
-- the result, any unused inputs, and the outputs
runFakeIO :: [String] -> FakeIO t -> (t, [String], [String])
runFakeIO inputs f =
    let (result, (leftoverInputs, outputs)) = runState f (inputs, [])
    in (result, leftoverInputs, reverse outputs)

main :: IO ()
main = do
    -- first, old function
    functionThatIsHardToTest

    -- new function just works here since IO is an instance
    functionThatIsEasierToTest

    -- or we can run it with our fake implementation
    let (result, leftoverInputs, outputs) = runFakeIO ["Musashi", "foo"] functionThatIsEasierToTest
    putStrLn ("Got outputs: " ++ show outputs)