Non-monadic IO in Haskell

NonMonadicIO.hs

module NonMonadicIO where

import GHC.Base (returnIO, bindIO)

-- The IO API:
--
-- returnIO :: a -> IO a
-- bindIO   :: IO a -> (a -> IO b) -> IO b

-- Here's a program which does nothing:
skip :: IO ()
skip = returnIO ()

-- Here's a program which does nothing in a more complicated way:
alsoSkip :: IO ()
alsoSkip = bindIO skip (\() -> skip)

-- To do useful things, Haskell gives us specific actions like:
--
-- getLine  :: IO String
-- putStrLn :: String -> IO ()

-- Here's hello world:
hello :: IO ()
hello = putStrLn "Hello, world!"

-- Here's a program which gets a string from the user and echoes it back:
echo :: IO ()
echo = bindIO getLine putStrLn

-- Here's a program which asks politely first:
politeEcho :: IO ()
politeEcho = bindIO (putStrLn "Please enter a string: ") (\() -> echo)

-- Here's a "combinator" which does one program then another:
semicolon :: IO () -> IO () -> IO ()
semicolon p1 p2 = bindIO p1 (\() -> p2)

rudeEcho :: IO ()
rudeEcho = putStrLn "Enter a string." `semicolon`
   (bindIO getLine (\l ->
           putStrLn "Here's your string." `semicolon`
           putStrLn l
           ))

-- We can run a whole list of programs:
runAll :: [IO ()] -> IO ()
runAll [] = returnIO ()
runAll (p:ps) = p `semicolon` runAll ps

echo3 :: IO ()
echo3 = runAll [putStrLn "Please enter a string: ", echo, putStrLn "Done!"]

-- We can run a program in a never-ending loop:
loop :: IO () -> IO ()
loop prog = prog `semicolon` loop prog

-- Here's an echo server:
echoServer :: IO ()
echoServer = loop echo3

-- We can run a program in a loop but let it say when to stop:
while :: IO Bool -> IO ()
while prog = bindIO prog (\quit -> if quit then returnIO () else while prog)

echoWithStop :: IO ()
echoWithStop = while  (bindIO (putStrLn "Enter a string (q to quit):")  (\() ->
                      (bindIO  getLine (\l ->
                               if l == "q"
                                 then return True
                                 else (bindIO (putStrLn "Here's your string:") (\() ->
                                      (bindIO (putStrLn l)                     (\() ->
                                       returnIO False
                                       ))))))))

-- A more general semicolon which passes on the result of the second program:
semicolon' :: IO a -> IO b -> IO b
semicolon' p1 p2 = bindIO p1 (\_ -> p2)

stateMachine :: (s -> IO s) -> s -> IO s
stateMachine step init = bindIO (step init) (stateMachine step)

counter :: IO Int
counter = stateMachine (\ctr -> getLine `semicolon'` print ctr `semicolon'` returnIO (ctr+1)) 0

discard :: IO a -> IO ()
discard p = p `semicolon'` skip

main :: IO ()
main = discard counter