Lecture 8
Input/Output
F12
, then click ConsoleF12
, then click ConsoleCtrl+Shift+k
↓ , PgDn , n , j |
next slide |
↑ , PgUp , p , k |
prev slide |
Esc |
enables ctrl+f globally |
-- Designed by Anish S. Tondwalkar
import Graphics.Gloss.Data.Point
import Graphics.Gloss.Geometry.Line
-- A line is specified by two points (a point is a pair of Floats)
data Line = L Point Point
-- takes two lines instead of two points
intersectLines (L a b) (L c d) = intersectLineLine a b c d
-- Designed by Jonathan E Hills
import Roots
import Data.Complex
-- Find the intersection of the lines
-- y = m1 * x + b1 and y = m2 * x + b2 by getting the roots
-- of the difference of the polynomials
-- b1 + m1 * x and b2 + m2 * x
-- findIntersection (m1, b1) (m2, b2) gives (x, y)
findIntersection :: (Double, Double) -> (Double, Double) -> (Double, Double)
findIntersection (m1, b1) (m2, b2)
| m1 == m2 = error ""Lines are parallel!""
| otherwise = (x, m1 * x + b1) where
x = Data.Complex.realPart (r !! 0) where
r = roots 0.00001 10000 [(b1 - b2) :+ 0, (m1 - m2) :+ 0]
Remember, Haskell is pure.
(no modification of global variables)
Let's print out some output!
Create a file Main.hs
and write the following code
module Main where
main = do
putStrLn "Hello world!"
putStrLn "main is a function"
putStrLn "of type IO ()"
Run the code
Use GHCi
|
Or just use
|
Or compile the code!
|
main
main
is the "entry point of a Haskell program" *
It must be an IO type.
$ ghci Main.hs
*Main> :t main
main :: IO ()
It's like the main
from Java or C++. When you compile Haskell code, the main
function runs.
do
glues together multiple IO actions
do
is a keyword in Haskell, like let
or where
.
main = do
putStrLn "this line is the first IO action"
putStrLn "putStrLn has type String -> IO ()"
putStrLn "we are glueing together multiple IO ()"
Input is just as straight forward.
The getLine
function binds input to a variable.
module Main where
main = do
putStrLn "Why did the banker leave his job?"
answer <- getLine
putStrLn (if answer == "he lost interest"
then "Correct!"
else "Wrong!")
<-
We have seen the <-
symbol before
[ x | x<-[1..10], even x ]
The symbol is pronounced "drawn from"
main = do
input <- getLine
putStrLn ("you wrote: " ++ input)
"input is drawn from getLine"
If you see IO, think side effects.
putStrLn
displays something to your monitor. That's a side effect!
putStrLn gives back nothing, ()
Prelude> :t putStrLn
putStrLn :: String -> IO ()
getLine gives back a String to use
Prelude> :t getLine
getLine :: IO String
Side-effects are isolated into I/O actions.
Pure code is separated from impure operations.
I/O actions only exist within other I/O actions.
return
return
is a function that "makes an I/O action out of a pure value" *
Prelude> :t return
return :: Monad m => a -> m a
return "hello" :: IO String
It's pretty much the opposite of the <-
syntax.
main = do
input <- return "hello"
putStrLn input
return
packs up a value into an IO box. <-
extracts the value out of an IO box.
return
In this program, we exit when the input is "y"
module Main where
main = do
putStrLn "quit the program? y/n"
ans <- getLine
if ans /= "y" then do
putStrLn "not quitting"
main
else return ()
return () has the type IO ()
We create an IO that doesn't do anything so that the program could exit.
when
The when function from Control.Monad module looks nicer
when :: Monad m => Bool -> m () -> m ()
|
|
sequence
sequence evaluates each IO action from a list of actions and returns a list of IO outputs
sequence :: Monad m => [m a] -> m [a]
Prelude> sequence [getLine, getLine]
hello
world
["hello","world"]
Prelude> sequence (map print [1,2])
1
2
[(),()]
print is equivalent to putStrLn.show
mapM
mapM takes care of the sequencing stuff
Prelude> mapM print [1,2,3]
1
2
3
[(),(),()]
and mapM_ is the same but doesn't output anything afterwards
Prelude> mapM_ print [1,2,3]
1
2
3
interact
interact makes I/O really easy.
Just call interact
on a String -> String function and you're done!
module Main where
main = interact countChars
countChars :: String -> String
countChars str =
let allLines = lines str
lengths = map (show.length) allLines
in unlines lengths
module Main where
import System.IO
main = do
theInput <- readFile "input.txt"
putStrLn (countLines theInput)
countLines :: String -> String
countLines str = (show (length (lines str)))
module Main where
import System.IO
main = readFile "input.txt" >>= print.length.lines
Writing to file is done with writeFile
module Main where
import System.IO
main = do
putStrLn "writing to file..."
writeFile "output.txt" ['A'..'Z']
writeFile will overwrite the file. Use appendFile if you'd like to append instead
Write an IO program that reverses text
given a file containing some text, create an output file with everything in reverseinput.txt | output.txt |
|
|