jameshfisher · January 6, 2015 01:51 · Jan 6, 2015
diff --git a/NonMonadicIO.hs b/NonMonadicIO.hs
@@ -0,0 +1,90 @@
+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