io.hs

{-# LANGUAGE RankNTypes #-}

import Prelude hiding (IO, getLine)
import qualified Prelude as P
import System.IO.Unsafe

-- * The Foreign Function Interface

-- | FFI values permit interfacing with foreign functions, such as low-level IO
-- operations, memory management operations, or bindings to other user-level
-- libraries written in, eg, C. FFI is opaque to the programmer.
newtype FFI a = FFI a

-- | The primitive operation that we will treat as the only blessed means of
-- evaluating FFI values. This would also be a magic builtin in a real language
-- implementation.
eval :: (FFI a) -> (a -> r) -> r
eval (FFI x) f = f x

-- * IO

-- | An IO value is either a finished computation or an unfinished FFI
-- computation.
newtype IO a = IO {
    unIO :: forall r.
            (a -> r)
         -> (forall t. (FFI t) -> (t -> r) -> r)
         -> r
}

instance Functor IO where
    fmap f (IO m) = IO $ \u k ->
        m (\x -> u (x `seq` f x)) k -- Note the strictness requirement here.

instance Applicative IO where
    pure x = IO (\u _ ->  u x)
    (<*>) mf ma = mf >>= \f -> fmap f ma

-- | Implementation of monad multiplication to define the bind operation
-- because I am a hipster.
joinIO :: IO (IO a) -> IO a
joinIO io = IO $ \u k ->
    unIO io (\x -> unIO x u k) k

instance Monad IO where
    return = pure
    (>>=) m f = joinIO $ fmap f m

-- | Lift an FFI value into the IO monad (the only way to actually use it).
runFFI :: FFI a -> IO a
runFFI ffi = IO $ \u k -> k ffi u

-- | Run an IO computation, which in general is not safe because it may not
-- terminate.
unsafeRunIO :: IO a -> a
unsafeRunIO io = unIO io id eval

-- * Builtins
-- The language standard library will provide a number of primitive builtin
-- functions via the FFI. Here we use @unsafePerformIO@ to simulate said
-- builtins.

-- | Primitive builtin operation to read a line from stdin.
_primGetLine :: FFI (() -> String)
_primGetLine = FFI $ \_ -> unsafePerformIO P.getLine

-- | Primitive builtin operation to write a line to stdout.
_primPutLine :: FFI (String -> ())
_primPutLine = FFI $ \str -> (unsafePerformIO (putStrLn str))

-- * Wrapped IO actions
-- The next two functions demonstrate how FFI functions can be wrapped and used
-- in the IO monad.

getLine :: IO String
getLine = (runFFI _primGetLine) <*> (return ())

putLine :: String -> IO ()
putLine str = (runFFI _primPutLine) <*> (return str)

-- * Demo

-- | Use our primitives!
testIO :: IO Int
testIO = do
    putLine "Hello. What is your name?"
    name <- getLine
    putLine $ "Hello, " ++ name ++ ". How old are you?"
    age <- getLine
    putLine $ concat ["I just wanted to make sure that IO actions are " ++
                      "threaded correctly. Bye!" ]
    return $ length name