Yet Another Haskell Tutorial の続き2

今日も、Yet Another Haskell Tutorial のExerciseの続きです。ついでに YAHTタグを追加しました。

Exercise 4.12 Write map and filter using continuation passing style.

my_map' :: (a -> b) -> ([b] -> c) -> [a] -> c
my_map' f cont [] = cont []
my_map' f cont (x:xs) = my_map' f (\ys -> cont(f x : ys)) xs

my_map :: (a -> b) -> [a] -> [b]
my_map f l = my_map' f id l


my_filter' :: (a -> Bool) -> ([a] -> c) -> [a] -> c
my_filter' f cont [] = cont []
my_filter' f cont (x:xs) = my_filter' f (\ys -> cont(if f x then x : ys else ys)) xs

my_filter :: (a -> Bool) -> [a] -> [a]
my_filter f l = my_filter' f id l

Exercise 5.1 Write a program that asks the user for his or her name. If the name is
one of Simon, John or Phil, tell the user that you think Haskell is a great programming
language. If the name is Koen, tell them that you think debugging Haskell is fun (Koen
Classen is one of the people who works on Haskell debugging); otherwise, tell the user
that you don’t know who he or she is.
Write two different versions of this program, one using if statements, the other using a
case statement.

module Main where

import IO

main = do
    hSetBuffering stdin LineBuffering
    askName2

askName = do
    putStrLn "Who are you?: "
    name <- getLine
    if (name == "Simon" || name == "John" || name == "Phil")
      then putStrLn "I think Haskell is a great programming language."
      else if name == "Koen"
        then putStrLn "I think debugging Haskell is fun!"
        else putStrLn "I don't know who he or she is."

askName2 = do
    putStrLn "Who are you?: "
    name <- getLine
    case name of
      s | (s == "Simon" || s == "John" || s == "Phil") -> putStrLn "I think Haskell is a great programming language."
        | s == "Koen" -> putStrLn "I think debugging Haskell is fun!"
      _ -> putStrLn "I don't know who he or she is."

Exercise 5.2 Write a program that first asks whether the user wants to read from a file,
write to a file or quit. If the user responds quit, the program should exit. If he responds
read, the program should ask him for a file name and print that file to the screen (if the
file doesn’t exist, the program may crash). If he responds write, it should ask him for a
file name and then ask him for text to write to the file, with “. ” signaling completion.
All but the “. ” should be written to the file.
For example, running this program might produce:

Do you want to [read] a file, [write] a file or [quit]?
read
Enter a file name to read:
foo
...contents of foo...
Do you want to [read] a file, [write] a file or [quit]?
write
Enter a file name to write:
foo
Enter text (dot on a line by itself to end):
this is some
text for
foo
.
Do you want to [read] a file, [write] a file or [quit]?
read
Enter a file name to read:
foo
this is some
text for
foo
Do you want to [read] a file, [write] a file or [quit]?
read
Enter a file name to read:
foof
Sorry, that file does not exist.
Do you want to [read] a file, [write] a file or [quit]?
blech
I don’t understand the command blech.
Do you want to [read] a file, [write] a file or [quit]?
quit
Goodbye!

module Main where

import IO

main = do
  hSetBuffering stdin LineBuffering
  doLoop

doLoop = do
  putStrLn "Do you want to [read] a file, [write] a file or [quit]?"
  command <- getLine
  case command of
    "quit" -> do putStrLn "Goodbye!"
                 return ()
    "read" -> do putStrLn "Enter a file name to read:"
                 filename <- getLine
                 doRead filename
                 doLoop
    "write" -> do putStrLn "Enter a file name to write:"
                  filename <- getLine
                  doWrite filename
                  doLoop
    _      -> do putStrLn ("I don't understand the command " ++ command ++ ".")
                 doLoop

doRead filename =
    bracket (openFile filename ReadMode) hClose
            (\h -> do putStrLn "...contents of foo..."
                      contents <- hGetContents h
                      putStrLn contents)

doWrite filename =
    bracket (openFile filename WriteMode) hClose
            doWriteLoop

doWriteLoop handle = do
    putStrLn "Enter text (dot on line by itself to end):"
    doWriteLoop' handle

doWriteLoop' handle = do
    line <- getLine
    case line of
      "." -> return()
      _   -> do hPutStrLn handle line
                doWriteLoop' handle