Skip to content

Instantly share code, notes, and snippets.

@gustavofranke
Last active Nov 19, 2020
Embed
What would you like to do?
-- 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
]
-- 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
]
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>
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$
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$
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?"
main = do
line <- getLine
if null line
then return ()
else do
putStrLn $ reverseWords line
main
reverseWords :: String -> String
reverseWords = unwords . map reverse . words
-- 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
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
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
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
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
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
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)
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"
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
-- 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
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
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]
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
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)
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!
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!
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!
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
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)
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"
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
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
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
-- 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
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment