Input/Output

Hello, world. Finally! From the interpreter:

> putStrLn "hello!"

From a file Hello.hs:

hello :: IO ()    -- notice the strange type
hello = putStrLn "hello!"

In interpreter:

> :l Hello.hs
> :run hello
> hello

From UNIX command-line:

% ghc Hello.hs -o hello

Fails, because main function is not defined. Note that the module must be called Main. In Hello.hs:

module Main where

main :: IO ()
main = putStrLn "Hello, world!"

From UNIX command-line:

% ghc Hello.hs -o hello
./hello

IO Actions

Everything so far has been "pure" (no side-effects). To interact with world, need to "run" "actions" (effects).

A value of type IO t is "an IO action that, when run, produces a t". IO is like a scarlet letter that says "I/O inside!". There is no (acceptable) way to take off that IO label.

putStrLn :: String -> IO ()

Dummy unit value is the result of printing to the screen.

How to read a string from standard input?

getLine :: IO String

Whoa, it's not a function. It's an action that, when run, returns a String.

> getLine

main = do
  s <- getLine                   -- binds result of action
  putStrLn $ "[[" ++ s ++ "]]"

Handy functions for working with newlines:

words :: String -> [String]
unwords :: [String] -> String

Any functions that (transitively) perform I/O will have types that label it as such! So, it's good practice to factor the impure and pure code as much as possible. This will take practice.

Do-notation

The do construct takes a sequence of actions (one or more) and converts them into a single action.

> do putStrLn "hello"

> do putStrLn "hello"; putStrLn "world"

> do { putStrLn "hello"; putStrLn "world" }

> :{
do
  putStrLn "hello"
  putStrLn "world"
:}

Kind of looks like imperative code. We'll see that this syntax is, in fact, much more general!

More generally, the syntax of a do-block is as follows:

do {
  let-or-bind-1
  let-or-bind-2
  ...
  let-or-bind-n
  e                     if e :: IO T
}

Where each let-or-bind takes one of the following forms:

let-or-bind ::=
  | let p_i = e_i       if e_i :: T_i,    then p_i :: T_i
  | p_i <- e_i          if e_i :: IO T_i, then p_i :: T_i
  | e_i                 if e_i :: IO T_i

The first kind of statement is an ordinary (side-effect free) let-binding. Notice that let-bindings within a do-block do not use the keyword in. The second kind of statement runs a (potentially side-effecting) action e_i of some IO T_i type and binds the result of type T_i to the pattern p_i. The third kind of statement is just like the second, except that the pattern binding is omitted altogether if the result of the action does not need to be named. The type of each let-or-bind statement can be different. The type IO T of the final expression e is the overall type of the entire do-block.

Running an action without binding its results is particularly useful for actions of type IO ().

do
  () <- putStrLn "yo"
  _  <- putStrLn "yo"
  putStrLn "yo"

The return function wraps a pure value inside an IO value:

> :t return :: a -> IO a

To review:

let p = e  means  bind e (of some type T) to the pattern p
p <- e     means  run the action e (of some type IO T) and
                  bind the result (of type T) to the pattern p

Reading Environment Variables

> import System.Environment
> :t getEnv
> getEnv "user"
> getEnv "USER"        -- akin to: % echo $USER
> getEnv "PASSWORD"

Example: Login Loop

Expressions of type IO t can be recursive, like expressions of any other types.

login :: IO ()
login = do
  putStrLn "What's your name?"
  s <- getLine
  user <- getEnv "USER"
  if s == user
    then putStrLn $ "Well done, " ++ user ++ "!"
    else do
      putStrLn "Wrong, try again.\n"
      login

Example: Looping and Reading Numbers

main :: IO ()
main =
  do
    putStr "Tell me your favorite number: "
    s <- getLine
    let i = read s :: Int
    putStrLn $ "Yes, " ++ show i ++ " is a nice number."
    main

This is okay, but read crashes when the string cannot be parsed as an Int. Let's handle error cases nicely.

import Data.Char

main :: IO ()
main = do
  putStr "Tell me your favorite number: "
  s <- getLine
  if all isDigit s
    then let i = read s :: Int in -- tricky, not a do block
         putStrLn $ "Yes, " ++ show i ++ " is a nice number."
    else putStrLn "Hmm, that doesn't seem like a number."
  main

A bit better. Now let's factor some of the pure code outside of the IO do-block.

strToMaybeInt :: String -> Maybe Int
strToMaybeInt s
  | all isDigit s = Just $ read s
  | otherwise     = Nothing

main :: IO ()
main = do
  putStr "Tell me your favorite number: "
  s <- getLine
  case strToMaybeInt s of
    Just i  -> putStrLn $ "Yes, " ++ show i ++ " is a nice number."
    Nothing -> putStrLn "Hmm, that doesn't seem like a number."
  main

Much nicer, but can we factor even more out of the do-block?

response :: String -> String
response s =
  case strToMaybeInt s of
    Just i  -> "Yes, " ++ show i ++ " is a nice number."
    Nothing -> "Hmm, that doesn't seem like a number."

main = do
  putStr "Tell me your favorite number: "
  s <- getLine
  putStrLn $ response s
  main

Let's finish by pulling the looping behavior out as well.

loop :: String -> (String -> String) -> IO ()
loop prompt f = do
  putStr prompt
  s <- getLine
  putStrLn $ f s
  loop prompt f

main :: IO ()
main = loop "Tell me your favorite number: " response

The pure and impure code is now nicely factored and reusable.

Now let's go back to strToMaybeInt and have it handle the empty string and negative numbers.

strToMaybeInt                   :: String -> Maybe Int
strToMaybeInt ""                =  Nothing
strToMaybeInt ('-':s)           =  case strToMaybeInt s of
                                      Just i  -> Just $ -1 * i
                                      Nothing -> Nothing
strToMaybeInt s | all isDigit s =  Just $ read s
                | otherwise     =  Nothing

The pattern matching inside the '-' equation is a bit gross; we'll see a better way soon. If we were going to go further and support more features (leading and trailing whitespace, fractions, etc.) we would probably choose to use regular expressions rather than "manually" manipulating characters ourselves. And we would use other parsing techniques that we'll learn about later in the course.

Source Files

results matching ""

    No results matching ""