0README.md

What is inside Haskell IO?

<lambdabot> shachaf says: getLine :: IO String contains a String in the same
            way that /bin/ls contains a list of files

There are multiple ways IO could be implemented internally. Here’s a demonstration of one.

MiniIO (below) implements an ADT of arbitrarily chosen primitives that represent I/O operations and a way to combine them. One can create, evaluate and manipulate MiniIO values without causing any side effects to occur. That is what example in Main.hs does. The same applies to real IO values in Haskell: you can create a big list of print "hello"s and later pick which ones to actually execute.

You can have an IO action executed by assigning it to main. If the actual IO is implemented like MiniIO, the runtime system will run an interpreter against the value main and execute the appropriate impure effects. This is simulated by running runMiniIO against example. runMiniIO doesn’t actually contain impurity but instead simulates standard input and output as pure strings and a trivial filesystem as a pure map from filename to contents.

Another hypothetical implementation of Haskell IO might be based on:

data IO a = IO MachineCode

This one highlights how an IO String does not contain a String but a description of how to generate one. GHC uses yet another implementation (which doesn’t involve interpreting an ADT in runtime). The semantics and the API from the point of view of you the programmer are the same for all of them.

Main.hs

#!/usr/bin/env runhaskell

module Main (main, example) where

import Prelude hiding (getLine, putStr, putStrLn, print, readFile, writeFile)
import qualified Prelude

import Data.Map (Map)
import qualified Data.Map as Map

import MiniIO

main :: IO ()
main = Prelude.putStr stdout
  where ((), stdout) = runMiniIO (MiniIOState stdin files) example

example :: MiniIO ()
example = do
  putStr =<< readFile "hello"

  putStrLn "What does your mother call you?"
  name <- noisyGetLine
  putStrLn ("O hai, " ++ name ++ " (if that is your real name).")
  
  putStrLn "To what file shall I write?"
  filename <- noisyGetLine
  writeFile filename ("Name (supposedly): " ++ name ++ "\n")

  putStrLn ("Now the file " ++ show filename ++ " contains:")
  print =<< readFile filename

  where noisyGetLine = do s <- getLine; putStrLn ("> " ++ s); return s

stdin :: String
stdin = unlines ["John User", "hello"]

files :: Map String String
files = Map.fromList [("hello", "Hello world!\n")]

MiniIO.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}

module MiniIO
  ( MiniIO, MiniIOState (..)
  , getLine, putStr, putStrLn, print, readFile, writeFile
  , runMiniIO
  ) where

import Prelude hiding (getLine, putStr, putStrLn, print, readFile, writeFile)

import Control.Applicative
import Control.Lens
import Control.Monad
import Control.Monad.Trans.RWS
import Data.Map (Map)

-- | IO primitives
data MiniIO a where
  Return    :: a -> MiniIO a
  Bind      :: MiniIO a -> (a -> MiniIO b) -> MiniIO b
  GetLine   :: MiniIO String
  PutStr    :: String -> MiniIO ()
  ReadFile  :: String -> MiniIO String
  WriteFile :: String -> String -> MiniIO ()

getLine :: MiniIO String
getLine = GetLine

putStr :: String -> MiniIO ()
putStr = PutStr

putStrLn :: String -> MiniIO ()
putStrLn = putStr . (++ "\n")

print :: Show a => a -> MiniIO ()
print = putStrLn . show

readFile :: String -> MiniIO String
readFile = ReadFile

writeFile :: String -> String -> MiniIO ()
writeFile = WriteFile

instance Functor     MiniIO where fmap = liftM
instance Applicative MiniIO where pure = return; (<*>) = ap
instance Monad       MiniIO where return = Return; (>>=) = Bind

data MiniIOState =
  MiniIOState { _mioInput :: String             -- ^ Standard input
              , _mioFiles :: Map String String  -- ^ A “filesystem”
              }
  deriving (Eq, Ord, Show, Read)
makeLenses ''MiniIOState

-- | An interpreter for the MiniIO ADT
runMiniIO :: MiniIOState -> MiniIO a -> (a, String)
runMiniIO st mio =
  case runRWS (runMiniIO' mio) () st of
    ~(result, _, output) -> (result, output)

runMiniIO' :: MiniIO a -> RWS () String MiniIOState a
runMiniIO' (Return a) = return a
runMiniIO' (Bind a f) = runMiniIO' a >>= runMiniIO' . f

runMiniIO' GetLine    = mioInput %%= breakLine
runMiniIO' (PutStr s) = tell s

runMiniIO' (ReadFile name)    = use (mioFiles . ix name)
runMiniIO' (WriteFile name s) = mioFiles . at name ?= s

breakLine :: String -> (String, String)
breakLine = (_2 %~ dropNewline) . break (=='\n')
  where dropNewline ('\n':xs) = xs
        dropNewline xs        = xs