ch02.hs

-- Starting Out

-- Ready, set, go!

-- Baby's first functions
doubleMe x = x + x
doubleUs x y = x*2 + y*2
doubleUs' x y = doubleMe x + doubleMe y
doubleSmallNumber x = if x > 100
                        then x
                        else x*2
doubleSmallNumber' x = (if x > 100 then x else x*2) + 1

-- An intro to lists

a = 'A': "SMALL CAT"

b = 5:[1,2,3,4,5]

c = "Steve Buscemi" !! 6

d = [3,2,1] > [2,1,0]

e = [3,2,1] > [2,10,100]

f = [3,4,2] > [3,4]

g = [3,4,2] > [2,4]

h = [3,4,2] == [3,4,2]

i = head [5,4,3,2,1]

j = tail [5,4,3,2,1]

k = last [5,4,3,2,1]

l = init [5,4,3,2,1]

m = length [5,4,3,2,1]

n = null [1,2,3]

o = null []

p = reverse [5,4,3,2,1]

q = take 3 [5,4,3,2,1]

r = take 1 [3,9,3]

s = take 5 [1,2]

t = take 0 [6,6,6]

u = drop 3 [8,4,2,1,5,6]

v = drop 0 [1,2,3,4]

w = drop 100 [1,2,3,4]

y = minimum [8,4,2,1,5,6]

z = maximum [1,9,2,3,4]

a' = sum [5,2,1,6,3,2,5,7]  

b' = product [6,2,1,2]  

c' = product [1,2,5,6,7,9,2,0]  

d' = 4 `elem` [3,4,5,6]

e' = 10 `elem` [3,4,5,6]

-- Texas ranges
f' = [1..20]

g' = ['a' .. 'z']

h' = [2,4..20]

i' = [3,6..20]

j' = take 10 (cycle [1,2,3])

k' = take 12 (cycle "LOL ")

l' = take 10 (repeat 5)

m' = take 10 (repeat  5)

-- I'm a list comprehension
n' = [x*2 | x <- [1..10]]

o' = [x*2 | x <- [1..10], x*2 >= 12]

p' = [ x | x <- [50 .. 100], x `mod` 7 == 3]

boomBangs xs = [ if x < 10 then "BOOM!" else "BANG" | x <- xs, odd x]

q' = boomBangs [7 .. 13]

r' = [x | x <- [10..20], x /= 13, x /=15, x /= 19]

s' = [ x*y | x <- [2,5,10], y <- [8,10,11]]

t' = [ x*y | x <- [2,5,10], y <- [8,10,11], x*y > 50]

nouns = ["hobo", "frog", "pope"]
adjectives = ["lazy", "grouchy", "scheming"]
u' = [adjective ++ " " ++ noun | adjective <- adjectives, noun <- nouns]

length' xs = sum [1 | _ <- xs]

removeNonUppercase st = [c | c <- st, c `elem` ['A'..'Z']]
v' = removeNonUppercase "Hahaha! Ahahaha!"
w' = removeNonUppercase "IdontLIKEFROGS"

xxs = [
    [1,3,5,2,3,1,2,4,5],
    [1,2,3,4,5,6,7,8,9],
    [1,2,4,2,1,6,3,1,3,2,3,6]
    ]
y' = [ [x | x <- xs, even x] | xs <- xxs]

-- Tuples
z' = fst (8, 11)
a1 = fst ("Wow", False)
b1 = snd (8, 11)
c1 = snd ("Wow", False)

d1 = zip [1,2,3,4,5] [5,5,5,5,5] 
e1 = zip [1..5] ["one", "two", "three", "four", "five"]

f1 = zip [5,3,2,6,2,7,2,5,4,6,6] ["im", "a", "turtle"]

g1 = zip [1..] ["apple", "orange", "cherry", "mango"]

triangles = [ (a, b, c) | c <- [1..10], b <- [1..10], a <- [1..10] ]
rightTriangles = [
     (a, b, c) |
        c <- [1..10],
        b <- [1..c],
        a <- [1..b],
        a^2 + b^2 == c^2
   ]
rightTriangles' = [
     (a, b, c) |
        c <- [1..10],
        b <- [1..c],
        a <- [1..b],
        a^2 + b^2 == c^2,
        a + b + c == 24
     ]

ch03.hs

-- Starting Out

-- Ready, set, go!

-- Baby's first functions
doubleMe x = x + x
doubleUs x y = x*2 + y*2
doubleUs' x y = doubleMe x + doubleMe y
doubleSmallNumber x = if x > 100
                        then x
                        else x*2
doubleSmallNumber' x = (if x > 100 then x else x*2) + 1

-- An intro to lists

a = 'A': "SMALL CAT"

b = 5:[1,2,3,4,5]

c = "Steve Buscemi" !! 6

d = [3,2,1] > [2,1,0]

e = [3,2,1] > [2,10,100]

f = [3,4,2] > [3,4]

g = [3,4,2] > [2,4]

h = [3,4,2] == [3,4,2]

i = head [5,4,3,2,1]

j = tail [5,4,3,2,1]

k = last [5,4,3,2,1]

l = init [5,4,3,2,1]

m = length [5,4,3,2,1]

n = null [1,2,3]

o = null []

p = reverse [5,4,3,2,1]

q = take 3 [5,4,3,2,1]

r = take 1 [3,9,3]

s = take 5 [1,2]

t = take 0 [6,6,6]

u = drop 3 [8,4,2,1,5,6]

v = drop 0 [1,2,3,4]

w = drop 100 [1,2,3,4]

y = minimum [8,4,2,1,5,6]

z = maximum [1,9,2,3,4]

a' = sum [5,2,1,6,3,2,5,7]  

b' = product [6,2,1,2]  

c' = product [1,2,5,6,7,9,2,0]  

d' = 4 `elem` [3,4,5,6]

e' = 10 `elem` [3,4,5,6]

-- Texas ranges
f' = [1..20]

g' = ['a' .. 'z']

h' = [2,4..20]

i' = [3,6..20]

j' = take 10 (cycle [1,2,3])

k' = take 12 (cycle "LOL ")

l' = take 10 (repeat 5)

m' = take 10 (repeat  5)

-- I'm a list comprehension
n' = [x*2 | x <- [1..10]]

o' = [x*2 | x <- [1..10], x*2 >= 12]

p' = [ x | x <- [50 .. 100], x `mod` 7 == 3]

boomBangs xs = [ if x < 10 then "BOOM!" else "BANG" | x <- xs, odd x]

q' = boomBangs [7 .. 13]

r' = [x | x <- [10..20], x /= 13, x /=15, x /= 19]

s' = [ x*y | x <- [2,5,10], y <- [8,10,11]]

t' = [ x*y | x <- [2,5,10], y <- [8,10,11], x*y > 50]

nouns = ["hobo", "frog", "pope"]
adjectives = ["lazy", "grouchy", "scheming"]
u' = [adjective ++ " " ++ noun | adjective <- adjectives, noun <- nouns]

length' xs = sum [1 | _ <- xs]

removeNonUppercase st = [c | c <- st, c `elem` ['A'..'Z']]
v' = removeNonUppercase "Hahaha! Ahahaha!"
w' = removeNonUppercase "IdontLIKEFROGS"

xxs = [
    [1,3,5,2,3,1,2,4,5],
    [1,2,3,4,5,6,7,8,9],
    [1,2,4,2,1,6,3,1,3,2,3,6]
    ]
y' = [ [x | x <- xs, even x] | xs <- xxs]

-- Tuples
z' = fst (8, 11)
a1 = fst ("Wow", False)
b1 = snd (8, 11)
c1 = snd ("Wow", False)

d1 = zip [1,2,3,4,5] [5,5,5,5,5] 
e1 = zip [1..5] ["one", "two", "three", "four", "five"]

f1 = zip [5,3,2,6,2,7,2,5,4,6,6] ["im", "a", "turtle"]

g1 = zip [1..] ["apple", "orange", "cherry", "mango"]

triangles = [ (a, b, c) | c <- [1..10], b <- [1..10], a <- [1..10] ]
rightTriangles = [
     (a, b, c) |
        c <- [1..10],
        b <- [1..c],
        a <- [1..b],
        a^2 + b^2 == c^2
   ]
rightTriangles' = [
     (a, b, c) |
        c <- [1..10],
        b <- [1..c],
        a <- [1..b],
        a^2 + b^2 == c^2,
        a + b + c == 24
     ]

ch08.hs

data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show, Read, Eq)

singleton :: a -> Tree a
singleton x = Node x EmptyTree EmptyTree

treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node a left right)
    | x == a = Node x left right
    | x < a  = Node a (treeInsert x left) right
    | x > a  = Node a left (treeInsert x right)

treeElem :: (Ord a) => a -> Tree a -> Bool
treeElem x EmptyTree = False
treeElem x (Node a left right)
    | x == a = True
    | x < a  = treeElem x left
    | x > a  = treeElem x right

-- *Main> let nums = [8, 6, 4, 1, 7, 3, 5]
-- *Main> let numTree = foldr treeInsert EmptyTree nums
-- *Main> numTree
-- Node 5 (Node 3 (Node 1 EmptyTree EmptyTree) (Node 4 EmptyTree EmptyTree)) (Node 7 (Node 6 EmptyTree EmptyTree) (Node 8 EmptyTree EmptyTree))
-- *Main> 8 `treeElem` numTree
-- True
-- *Main> 100 `treeElem` numTree
-- False
-- *Main> 1 `treeElem` numTree
-- True
-- *Main> 10 `treeElem` numTree
-- False
-- *Main>     

ch09-01.hs

main = putStrLn "hello, world"

-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ ghc --make helloworld
-- [1 of 1] Compiling Main             ( helloworld.hs, helloworld.o )
-- Linking helloworld ...
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ ./helloworld 
-- hello, world
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ ^C
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ 

ch09-02.hs

main = do
    putStrLn "Hello, what's your name?"
    name <- getLine
    putStrLn ("Hey " ++ name ++ ", you rock!")

-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ runhaskell nameguess.hs 
-- Hello, what's your name?
-- asfd asdf
-- Hey asfd asdf, you rock!
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$     

ch09-03.hs

import Data.Char

main = do
    putStrLn "What's your first name?"
    firstName <- getLine
    putStrLn "What's your last name?"
    lastName <- getLine
    let bigFirstName = map toUpper firstName
        bigLastName  = map toUpper lastName
    putStrLn $ "hey " ++ bigFirstName ++ " " ++ bigLastName ++ ", how are you?"    

ch09-04.hs

main = do
    line <- getLine
    if null line
        then return ()
        else do
            putStrLn $ reverseWords line
            main

reverseWords :: String -> String
reverseWords = unwords . map reverse . words

ch09-05.hs

-- Using return doesn't cause the I/O
-- do block to end in execution or 
-- anything like that.
-- For instance, this program will
-- quite happily carry out all the
-- way to the last line:

main = do  
    return ()  
    return "HAHAHA"  
    line <- getLine  
    return "BLAH BLAH BLAH"  
    return 4  
    putStrLn line

ch09-06.hs

import Control.Monad
import Data.Char

main = forever $ do
    putStr "Give me some input: "
    l <- getLine
    putStrLn $ map toUpper l

-- $ ghc --make 06-capslocker.hs 
-- [1 of 1] Compiling Main             ( 06-capslocker.hs, 06-capslocker.o )
-- Linking 06-capslocker ...
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ cat haiku.txt | ./06-capslocker 
-- Give me some input: I'M A LIL' TEAPOT  
-- Give me some input: WHAT'S WITH THAT AIRPLANE FOOD, HUH?  
-- Give me some input: IT'S SO SMALL, TASTELESS 
-- Give me some input: 06-capslocker: <stdin>: hGetLine: end of file

ch09-07.hs

import Data.Char

main = do
    contents <- getContents
    putStrLn (map toUpper contents)

-- $ ghc --make 07-get-contents.hs 
-- [1 of 1] Compiling Main             ( 07-get-contents.hs, 07-get-contents.o )
-- Linking 07-get-contents ...
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ cat haiku.txt | ./07-get-contents 
-- I'M A LIL' TEAPOT  
-- WHAT'S WITH THAT AIRPLANE FOOD, HUH?  
-- IT'S SO SMALL, TASTELESS 
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ ./07-get-contents 
-- hi
-- HI
-- how are you
-- HOW ARE YOU    

ch09-08.hs

import Data.Char

-- Let's make program that takes some input and prints out only those lines that are shorter than 10 characters. Observe:
main = do
    contents <- getContents
    putStr (shortLinesOnly contents)

shortLinesOnly :: String -> String
shortLinesOnly input =
    let allLines   = lines input
        shortLines = filter (\line -> length line < 10) allLines
        result     = unlines shortLines
    in result

-- $ ghc --make 08-shortlinesonly.hs 
-- [1 of 1] Compiling Main             ( 08-shortlinesonly.hs, 08-shortlinesonly.o )
-- Linking 08-shortlinesonly ...
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ cat shortlines.txt | ./08-shortlinesonly 
-- so am i  
-- short 
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ cat haiku.txt | ./08-shortlinesonly 
-- gustavo@yasiyatere:~/workspace/haskel-stuff/src/Ch09$ ^C    

ch09-09.hs

import Data.Char

-- -- first version
-- main = do
--     contents <- getContents
--     putStr (shortLinesOnly contents)

--  interact takes a function of type String -> String as a parameter
--  and returns an I/O action that will take some input,
--  run that function on it and then print out the function's result.
main = interact shortLinesOnly
-- main = interact $ unlines . filter ((<10) . length) . lines  

shortLinesOnly :: String -> String
shortLinesOnly input =
    let allLines   = lines input
        shortLines = filter (\line -> length line < 10) allLines
        result     = unlines shortLines
    in result

ch09-10.hs

main = interact respondPalindromes'

respondPalindromes contents =
    unlines (map (\xs -> if isPalindrome xs then "palindrome" else "not a palindrome") (lines contents))
    where isPalindrome xs = xs == reverse xs

respondPalindromes' =
    unlines . map (\xs -> if isPalindrome xs then "palindrome" else "not a palindrome") . lines
    where isPalindrome xs = xs == reverse xs    

-- $ runhaskell 10-palindrome.hs 
-- ABCBA
-- palindrome
-- anitalavalatina
-- palindrome
-- hallo how are you
-- not a palindrome    

ch09-11.hs

import System.IO
import Data.Char

main0 = do
    handle <- openFile "girlfriend.txt" ReadMode
    contents <- hGetContents handle
    putStr contents
    hClose handle

main1 = do
    withFile "girlfriend.txt" ReadMode (\handle -> do
        contents <- hGetContents handle
        putStr contents)   
        
withFile' :: FilePath -> IOMode -> (Handle -> IO a) -> IO a
withFile' path mode f = do
    handle <- openFile path mode
    result <- f handle
    hClose handle
    return result 

main2 = do
    contents <- readFile "girlfriend.txt"
    putStr contents

main = do
    contents <- readFile "girlfriend.txt"
    writeFile "girlfriendcaps.txt" (map toUpper contents)

ch09-12.hs

import System.IO
import System.Directory
import Data.List

main0 = do
    todoItem <- getLine
    appendFile "todo.txt" (todoItem ++ "\n")

main = do 
    handle                 <- openFile "todo.txt" ReadMode
    (tempName, tempHandle) <- openTempFile "." "temp"
    contents               <- hGetContents handle
    let todoTasks = lines contents
        numberedTasks = zipWith (\n line -> show n ++ " - " ++ line) [0..] todoTasks
    putStrLn "These are your TO-DO items:"
    putStr $ unlines numberedTasks
    putStrLn "Which one do you want to delete?"
    numberString <- getLine
    let number = read numberString
        newTodoItems = delete (todoTasks !! number) todoTasks
    hPutStr tempHandle $ unlines newTodoItems
    hClose handle
    hClose tempHandle
    removeFile "todo.txt"
    renameFile tempName "todo.txt"

ch09-13.hs

import System.Environment
import Data.List

main = do
    args <- getArgs
    progName <- getProgName
    putStrLn "The arguments are:"
    mapM putStrLn args
    putStrLn "the program name is:"
    putStrLn progName

-- $ ./arg-test first second w00t "multi word arg"  
-- The arguments are:  
-- first  
-- second  
-- w00t  
-- multi word arg  
-- The program name is:  
-- arg-test 

ch09-14.hs

-- import System.Environment
-- import System.Directory
-- import System.IO
-- import Data.List

-- add :: [String] -> IO ()
-- add [fileName, todoItem] = appendFile fileName (todoItem ++ "\n")

-- view :: [String] -> IO ()
-- view [fileName] = do
--     contents <- readFile fileName
--     let todoTasks = lines contents
--         numberedTasks = zipWith (\n line -> show n ++ " - " ++ line) [0..] todoTasks
--     putStr $ unlines numberedTasks

-- remove :: [String] -> IO ()
-- remove [fileName, numberString] = do
--     handle <- openFile fileName ReadMode
--     (tempName, tempHandle) <- openTempFile "." "temp"
--     contents <- hGetContents handle
--     let number = read numberString
--         todoTasks = lines contents
--         newTodoItems = delete (todoTasks !! number) todoTasks
--     hPutStr tempHandle $ unlines newTodoItems
--     hClose handle
--     hClose tempHandle
--     removeFile fileName
--     renameFile tempName fileName


-- dispatch :: [(String, [String] -> IO ())]
-- dispatch = [ ("add", add)
--            , ("view", view)
--            , ("remove", remove)
--            ]

-- main = do
--     (command:args) <- getArgs
--     let (Just action) = lookup command dispatch
--     action args

import System.Environment   
import System.Directory  
import System.IO  
import Data.List  
  
dispatch :: [(String, [String] -> IO ())]  
dispatch =  [ ("add", add)  
            , ("view", view)  
            , ("remove", remove)  
            ]  
   
main = do  
    (command:args) <- getArgs  
    let (Just action) = lookup command dispatch  
    action args  
  
add :: [String] -> IO ()  
add [fileName, todoItem] = appendFile fileName (todoItem ++ "\n")  
  
view :: [String] -> IO ()  
view [fileName] = do  
    contents <- readFile fileName  
    let todoTasks = lines contents  
        numberedTasks = zipWith (\n line -> show n ++ " - " ++ line) [0..] todoTasks  
    putStr $ unlines numberedTasks  
  
remove :: [String] -> IO ()  
remove [fileName, numberString] = do  
    handle <- openFile fileName ReadMode  
    (tempName, tempHandle) <- openTempFile "." "temp"  
    contents <- hGetContents handle  
    let number = read numberString  
        todoTasks = lines contents  
        newTodoItems = delete (todoTasks !! number) todoTasks  
    hPutStr tempHandle $ unlines newTodoItems  
    hClose handle  
    hClose tempHandle  
    removeFile fileName  
    renameFile tempName fileName  

ch09-15.hs

import System.Random 
import Data.List
import Control.Monad(when)

a = random(mkStdGen 100) :: (Int, StdGen)
b = random(mkStdGen 100) :: (Int, StdGen)
c = random(mkStdGen 100) :: (Int, StdGen)

d = random(mkStdGen 949494) :: (Int, StdGen)

e = random(mkStdGen 949488) :: (Float, StdGen)
f = random(mkStdGen 949488) :: (Bool, StdGen)
g = random(mkStdGen 949488) :: (Integer, StdGen)

threeCoins :: StdGen -> (Bool, Bool, Bool)
threeCoins gen =
    let (firstCoin, newGen) = random gen
        (secondCoin, newGen') = random newGen
        (thirdCoin, newGen'') = random newGen'
    in (firstCoin, secondCoin, thirdCoin)

h = threeCoins (mkStdGen 21)
i = threeCoins (mkStdGen 22)
j = threeCoins (mkStdGen 943)
k = threeCoins (mkStdGen 944)

l = take 5 $ randoms (mkStdGen 11) :: [Int]
m = take 5 $ randoms (mkStdGen 11) :: [Bool]
n = take 5 $ randoms (mkStdGen 11) :: [Float]

randoms' :: (RandomGen g, Random a) => g -> [a]
randoms' gen = let (value, newGen) = random gen in value:randoms' newGen

-- We could make a function that generates a finite stream of numbers and a new generator like this:
finiteRandoms :: (RandomGen g, Random a, Num n, Eq n) => n -> g -> ([a], g)
finiteRandoms 0 gen = ([], gen)
finiteRandoms n gen =
    let (value, newGen) = random gen
        (restOfList, finalGen) = finiteRandoms (n-1) newGen
    in (value:restOfList, finalGen)

-- o = randomR (1, 6) (mkStdGen 359353)
-- p = randomR (1, 6) (mkStdGen 35935335)
-- r = take 10 $ randomR ('a', 'z') (mkStdGen 3) :: [Char]

main0 = do
    gen <- getStdGen
    putStr $ take 20 (randomRs ('a', 'z') gen)

main1 = do
    gen <- getStdGen
    putStrLn $ take 20 (randomRs ('a', 'z') gen)
    gen2 <- getStdGen
    putStr $ take 20 (randomRs ('a', 'z') gen2)

main2 = do
    gen <- getStdGen
    let randomChars = randomRs ('a', 'z') gen
        (first20, rest) = splitAt 20 randomChars
        (second20, _) = splitAt 20 rest
    putStrLn first20
    putStrLn second20

main3 = do
    gen <- getStdGen
    putStrLn $ take 20 (randomRs ('a', 'z') gen)
    gen' <- newStdGen
    putStr $ take 20 (randomRs ('a', 'z') gen)

main4 = do
    gen <- getStdGen
    askForNumber gen

askForNumber :: StdGen -> IO ()
askForNumber gen = do
    let (randNumber, newGen) = randomR (1,10) gen :: (Int, StdGen)
    putStr "Which number in the range from 1 to 10 am I thinking of?"
    numberString <- getLine
    when (not $ null numberString) $ do
        let number = read numberString
        if randNumber == number
            then putStrLn "You are correct!"
            else putStrLn $ "Sorry, it was " ++ show randNumber
        askForNumber newGen
-- $ runhaskell guess_the_number.hs  
-- Which number in the range from 1 to 10 am I thinking of? 4  
-- Sorry, it was 3  
-- Which number in the range from 1 to 10 am I thinking of? 10  
-- You are correct!  
-- Which number in the range from 1 to 10 am I thinking of? 2  
-- Sorry, it was 4  
-- Which number in the range from 1 to 10 am I thinking of? 5  
-- Sorry, it was 10  
-- Which number in the range from 1 to 10 am I thinking of?  

main5 = do
    gen <- getStdGen
    let (randNumber, _) = randomR (1,10) gen :: (Int, StdGen)
    putStr "Which number in the range from 1 to 10 am I thinking of?"
    numberString <- getLine
    when (not $ null numberString) $ do
        let number = read numberString
        if randNumber == number
            then putStrLn "You are correct!"
            else putStrLn $ "Sorry, it was " ++ show randNumber
        newStdGen
        main5

ch09-16.hs

import qualified Data.ByteString.Lazy as B  
import qualified Data.ByteString as S

a = B.pack [99,97,110]

b = B.pack [98..120]

c =  B.fromChunks [
    S.pack [40,41,42],
    S.pack [43,44,45],
    S.pack [46,47,48]
    ]  

d = B.cons 85 $ B.pack [80,81,82,84]
e = B.cons' 85 $ B.pack [80,81,82,84]
 
f = foldr B.cons B.empty [50..60]
g = foldr B.cons' B.empty [50..60]  

ch09-17.hs

import System.Environment
import qualified Data.ByteString.Lazy as B

main = do
    (fileName1:fileName2:_) <- getArgs
    copyFile fileName1 fileName2

copyFile :: FilePath -> FilePath -> IO ()
copyFile source dest = do
    contents <- B.readFile source
    B.writeFile dest contents

ch09-18.hs

import System.Environment
import System.IO

main = do (fileName:_) <- getArgs
          contents     <- readFile fileName
          putStrLn $ "The file has " ++ show (length (lines contents)) ++ " lines!"

--   $ runhaskell 18-exceptions.hs shortlines.txt 
--   The file has 7 lines!
--   $ runhaskell 18-exceptions.hs shortlines.txtaaa 
--   18-exceptions.hs: shortlines.txtaaa: openFile: does not exist (No such file or directory)
          

ch09-19.hs

import System.Environment
import System.IO
import System.Directory

main = do (fileName:_) <- getArgs
          fileExists   <- doesFileExist fileName
          if fileExists
            then do contents <- readFile fileName
                    putStrLn $ "The file has " ++ show (length (lines contents)) ++ " lines!"
            else do putStrLn "The file doesn't exist!"

-- runhaskell 19-exceptions.hs shortlines.txt 
-- The file has 7 lines!
-- $ runhaskell 19-exceptions.hs shortlines.txtaaa 
-- The file doesn't exist!
                      

ch09-20.hs

import System.Environment
import System.IO
import System.IO.Error

main = toTry `catchIOError` handler
    
toTry :: IO ()    
toTry = do (fileName:_) <- getArgs
           contents     <- readFile fileName
           putStrLn $ "The file has " ++ show (length (lines contents)) ++ " lines!"

handler :: IOError -> IO ()
handler e = putStrLn "Whoops, had some trouble!"


-- $ runhaskell 20-exceptions.hs shortlines.txt 
-- The file has 7 lines!
-- $ runhaskell 20-exceptions.hs shortlines.txtaaa 
-- Whoops, had some trouble!

                      

ch09-21.hs

import System.Environment
import System.IO
import System.IO.Error

main = toTry `catchIOError` handler
    
toTry :: IO ()    
toTry = do (fileName:_) <- getArgs
           contents     <- readFile fileName
           putStrLn $ "The file has " ++ show (length (lines contents)) ++ " lines!"

handler :: IOError -> IO ()
handler e
    | isDoesNotExistError e = putStrLn "Whoops, had some trouble!"
    | otherwise             = ioError e


-- $ runhaskell 21-exceptions.hs shortlines.txt 
-- The file has 7 lines!
-- $ runhaskell 21-exceptions.hs shortlines.txtaaa 
-- Whoops, had some trouble!

                      

ch09-22.hs

import System.Environment
import System.IO
import System.IO.Error

main = toTry `catchIOError` handler
    
toTry :: IO ()    
toTry = do (fileName:_) <- getArgs
           contents     <- readFile fileName
           putStrLn $ "The file has " ++ show (length (lines contents)) ++ " lines!"

handler :: IOError -> IO ()
handler e
    | isDoesNotExistError e =
         case ioeGetFileName e of Just path -> putStrLn $ "Whoops, File does not exist at: " ++ path
                                  Nothing   -> putStrLn $ "Whoops, File does not exist unknown location!"
    | otherwise             = ioError e


-- $ runhaskell 22-exceptions.hs shortlines.txt 
-- The file has 7 lines!
-- $ runhaskell 22-exceptions.hs shortlines.txtaaa 
-- Whoops, File does not exist at: shortlines.txtaaa
    

                      

ch09-23.hs

option :: Maybe Int
option = do
    a <- Just 5
    b <- Just 1
    return (a + b)

none :: Maybe Int
none = do
    a <- Nothing
    b <- Just 1
    return (a + b)
    
rights :: Either String Int
rights = do
    a <- Right 5
    b <- Right 1
    return (a + b)    

left :: Either String Int
left = do
    a <- Left "uh oh ... error"
    b <- Right 1
    return (a + b)
    
cons :: [Int]
cons = do
    a <- [1..3]
    b <- [4..6]
    return (a + b)
    
nil :: [Int]
nil = do
    a <- []
    b <- [4..6]
    return (a + b)    

ch10.hs

a :: Num b => Maybe b
a = Just (+3) <*> Just 9  

b :: Num b => Maybe b
b = pure (+3) <*> Just 10

c :: Num b => Maybe b
c = pure (+3) <*> Just 9  

d :: Maybe [Char]
d = Just (++"hahah") <*> Nothing  

e :: Maybe [Char]
e = Nothing <*> Just "woot"  

f :: Num b => Maybe b
f = pure (+) <*> Just 3 <*> Just 5  

g :: Num b => Maybe b
g = pure (+) <*> Just 3 <*> Nothing  

h :: Num b => Maybe b
h = pure (+) <*> Nothing <*> Just 5  

i :: Maybe [Char]
i = (++) <$> Just "johntra" <*> Just "volta"  

j :: [Char]
j = (++) "johntra" "volta"  

k :: [String]
k = pure "Hey"  

l :: Maybe String 
l = pure "Hey"

ch14.hs

import Data.List (break)
-- Zippers

-- Taking a walk
data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show)

freeTree :: Tree Char
freeTree =
    Node 'P'
        (Node 'O'
            (Node 'L'
                (Node 'N' Empty Empty)
                (Node 'T' Empty Empty)
            )
            (Node 'Y'
                (Node 'S' Empty Empty)
                (Node 'A' Empty Empty)
            )
        )
        (Node 'L'
            (Node 'W'
                (Node 'C' Empty Empty)
                (Node 'R' Empty Empty)
            )
            (Node 'A'
                (Node 'A' Empty Empty)
                (Node 'C' Empty Empty)
            )
        )

changeToP0 :: Tree Char -> Tree Char
changeToP0 (Node x l (Node y (Node _ m n) r)) = Node x l (Node y (Node 'P' m n) r)

data Direction = L | R deriving (Show)
type Directions = [Direction]

changeToP :: Directions -> Tree Char -> Tree Char
changeToP (L:ds) (Node x l r) = Node x (changeToP ds l) r
changeToP (R:ds) (Node x l r) = Node x l (changeToP ds r)
changeToP [] (Node _ l r) = Node 'P' l r

elemAt :: Directions -> Tree a -> a
elemAt (L:ds) (Node _ l _) = elemAt ds l
elemAt (R:ds) (Node _ _ r) = elemAt ds r
elemAt [] (Node x _ _) = x

newTree = changeToP [R,L] freeTree
asdf = elemAt [R,L] newTree

-- A trail of breadcrumbs
type Breadcrumbs0 = [Direction]

goLeft0 :: (Tree a, Breadcrumbs0) -> (Tree a, Breadcrumbs0)
goLeft0 (Node _ l _, bs) = (l, L:bs)

goRight0 :: (Tree a, Breadcrumbs0) -> (Tree a, Breadcrumbs0)
goRight0 (Node _ _ r, bs) = (r, R:bs)

test1 = goLeft0 (goRight0 (freeTree, []))

(-:) :: t1 -> (t1 -> t) -> t
x -: f = f x

test2 = (freeTree, []) -: goRight0 -: goLeft0

-- Going back up
data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Show)
type Breadcrumbs a = [Crumb a]

goLeft :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a)
goLeft (Node x l r, bs) = (l, LeftCrumb x r:bs)

goRight :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a)
goRight (Node x l r, bs) = (r, RightCrumb x l:bs)

goUp :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a)
goUp (t, LeftCrumb x r:bs) = (Node x t r, bs)
goUp (t, RightCrumb x l:bs) = (Node x l t, bs)

type Zipper a = (Tree a, Breadcrumbs a)

-- Manipulating trees under focus

modify :: (a -> a) -> Zipper a -> Zipper a
modify f (Node x l r, bs) = (Node (f x) l r, bs)
modify f (Empty, bs) = (Empty, bs)

newFocus0 = modify (\_ -> 'P') (goRight (goLeft (freeTree, [])))
newFocus  = (freeTree, []) -: goLeft -: goRight -: modify (\_ -> 'P')
newFocus2  = modify (\_ -> 'X') (goUp newFocus)
newFocus2' = newFocus -: goUp -: modify (\_ -> 'X')

attach :: Tree a -> Zipper a -> Zipper a
attach t (_, bs) = (t, bs)

farLeft = (freeTree, []) -: goLeft -: goLeft -: goLeft -: goLeft
newFocus1 = farLeft -: attach (Node 'Z' Empty Empty)

-- I'm going straight to the top, oh yeah, up where the air is fresh and clean!
topMost :: Zipper a -> Zipper a
topMost (t, []) = (t, [])
topMost z = topMost (goUp z)

-- Focusing on lists
data List a = LEmpty | Cons a (List a) deriving (Show, Read, Eq, Ord)

type ListZipper a = ([a], [a])

goForward :: ListZipper a -> ListZipper a
goForward (x:xs, bs) = (xs, x:bs)

goBack :: ListZipper a -> ListZipper a
goBack (xs, b:bs) = (b:xs, bs)

xs = [1,2,3,4]
xsgf = goForward (xs, [])
xsgfgf = goForward xsgf
xsgfgfgf = goForward xsgfgf
xsgfgfgfgb = goBack xsgfgfgf

-- A very simple file system

type Name = String
type Data = String
data FSItem = File Name Data | Folder Name [FSItem] deriving (Show)

myDisk :: FSItem  
myDisk = 
    Folder "root"   
        [ File "goat_yelling_like_man.wmv" "baaaaaa"  
        , File "pope_time.avi" "god bless"  
        , Folder "pics"  
            [ File "ape_throwing_up.jpg" "bleargh"  
            , File "watermelon_smash.gif" "smash!!"  
            , File "skull_man(scary).bmp" "Yikes!"  
            ]  
        , File "dijon_poupon.doc" "best mustard"  
        , Folder "programs"  
            [ File "fartwizard.exe" "10gotofart"  
            , File "owl_bandit.dmg" "mov eax, h00t"  
            , File "not_a_virus.exe" "really not a virus"  
            , Folder "source code"  
                [ File "best_hs_prog.hs" "main = print (fix error)"  
                , File "random.hs" "main = print 4"  
                ]  
            ]  
        ]

-- A zipper for our file system
data FSCrumb = FSCrumb Name [FSItem] [FSItem] deriving (Show)
type FSZipper = (FSItem, [FSCrumb])

fsUp :: FSZipper -> FSZipper
fsUp (item, FSCrumb name ls rs:bs) = (Folder name (ls ++ [item] ++ rs), bs)

fsTo :: Name -> FSZipper -> FSZipper
fsTo name (Folder folderName items, bs) =
    let (ls, item:rs) = break (nameIs name) items
    in  (item, FSCrumb folderName ls rs:bs)

nameIs :: Name -> FSItem -> Bool
nameIs name (Folder folderName _) = name == folderName
nameIs name (File fileName _) = name == fileName

newFocus3 = (myDisk, []) -: fsTo "pics" -: fsTo "skull_man(scary).bmp"
test3 = fst newFocus3

newFocus4 = newFocus3 -: fsUp -: fsTo "watermelon_splash.gif"
test4 = fst newFocus4 -- TODO: seems to fail?

-- Manipulating our file system

fsRename :: Name -> FSZipper -> FSZipper
fsRename newName (Folder name items, bs) = (Folder newName items, bs)
fsRename newName (File name dat, bs) = (File newName dat, bs)

newFocus5 = (myDisk, []) -: fsTo "pics" -: fsRename "cspi" -: fsUp

fsNewFile :: FSItem -> FSZipper -> FSZipper
fsNewFile item (Folder folderName items, bs) = (Folder folderName (item:items), bs)

newFocus6 = (myDisk, []) -: fsTo "pics" -: fsNewFile (File "heh.jpg" "lol") -: fsUp

-- Watch your step
safeGoLeft :: Zipper a -> Maybe (Zipper a)  
safeGoLeft (Node x l r, bs) = Just (l, LeftCrumb x r:bs)  
safeGoLeft (Empty, _) = Nothing  
  
safeGoRight :: Zipper a -> Maybe (Zipper a)  
safeGoRight (Node x l r, bs) = Just (r, RightCrumb x l:bs)  
safeGoRight (Empty, _) = Nothing

test5 = safeGoLeft (Empty, [])  
test6 = safeGoLeft (Node 'A' Empty Empty, []) 

safeGoUp :: Zipper a -> Maybe (Zipper a)  
safeGoUp (t, LeftCrumb x r:bs) = Just (Node x t r, bs)  
safeGoUp (t, RightCrumb x l:bs) = Just (Node x l t, bs)  
safeGoUp (_, []) = Nothing  

newFocus7 = (freeTree,[]) -: goLeft -: goRight  
coolTree = Node 1 Empty (Node 3 Empty Empty)  

test7 = return (coolTree,[]) >>= safeGoRight  
-- -- Just (Node 3 Empty Empty,[RightCrumb 1 Empty])  
test8 = return (coolTree,[]) >>= safeGoRight >>= safeGoRight  
-- -- Just (Empty,[RightCrumb 3 Empty,RightCrumb 1 Empty])  
test9 = return (coolTree,[]) >>= safeGoRight >>= safeGoRight >>= safeGoRight  
-- -- Nothing  

Cube.hs

module Geometry.Cube  
( volume  
, area  
) where  
  
import qualified Geometry.Cuboid as Cuboid  
  
volume :: Float -> Float  
volume side = Cuboid.volume side side side  
  
area :: Float -> Float  
area side = Cuboid.area side side side  

Cuboid.hs

module Geometry.Cuboid  
( volume  
, area  
) where  
  
volume :: Float -> Float -> Float -> Float  
volume a b c = rectangleArea a b * c  
  
area :: Float -> Float -> Float -> Float  
area a b c = rectangleArea a b * 2 + rectangleArea a c * 2 + rectangleArea c b * 2  
  
rectangleArea :: Float -> Float -> Float  
rectangleArea a b = a * b  

Geometry.hs

-- module Ch07

-- Making our own modules

module Geometry
( sphereVolume
, sphereArea
, cubeVolume
, cubeArea
, cuboidArea
, cuboidVolume    
) where

sphereVolume :: Float -> Float
sphereVolume radius = (4.0 / 3.0) * pi * (radius ^ 3)

sphereArea :: Float -> Float
sphereArea radius = 4 * pi * (radius ^ 2)

cubeVolume :: Float -> Float
cubeVolume side = cuboidVolume side side side

cubeArea :: Float -> Float
cubeArea side = cuboidArea side side side

cuboidArea :: Float -> Float -> Float -> Float
cuboidArea a b c = rectangleArea a b * 2 + rectangleArea a c * 2 + rectangleArea c b * 2

cuboidVolume  :: Float -> Float -> Float -> Float
cuboidVolume a b c = rectangleArea a b * c

rectangleArea :: Float -> Float -> Float
rectangleArea a b = a * b

-- Ok, modules loaded: Geometry.
-- *Geometry> import Geometry 
-- *Geometry Geometry> sphereArea 4
-- 201.06194
-- *Geometry Geometry> cuboidVolume 3 4 5
-- 60.0

-- Ok, modules loaded: Geometry.
-- *Geometry> :m + Geometry 
-- *Geometry Geometry> cuboidVolume 3 4 5
-- 60.0

Sphere.hs

module Geometry.Sphere
( volume
, area
) where

volume :: Float -> Float
volume radius = (4.0 / 3.0) * pi (radius ^ 3)

area :: Float -> Float
area radius = 4 * pi * (radius ^ 2)