From 5bdaa1e4ffe40add10f000ee993e6b500c419a37 Mon Sep 17 00:00:00 2001 From: Joe Zhao Date: Sat, 9 Aug 2014 10:58:03 +0800 Subject: add files from home for previous chapters and sandboxes --- appendtodo.hs | 8 ++++++++ arg-test.hs | 11 +++++++++++ capscont.hs | 5 +++++ capslock.hs | 6 ++++++ charlist.hs | 2 ++ copyFile.hs | 21 +++++++++++++++++++++ fac.hs | 6 ++++++ fib.hs | 13 +++++++++++++ girlfriend.hs | 6 ++++++ girlfriend.txt | 4 ++++ girlfriend1.txt | 4 ++++ helloworld.hs | 5 +++++ hl.hs | 8 ++++++++ lengthComp.hs | 4 ++++ pole.hs | 27 +++++++++++++++++++++++++++ prime.hs | 11 +++++++++++ reverse.hs | 10 ++++++++++ rmtodo.hs | 21 +++++++++++++++++++++ rmtodo1.hs | 19 +++++++++++++++++++ rmtodo2.hs | 25 +++++++++++++++++++++++++ sandbox.hs | 28 ++++++++++++++++++++++++++++ sequenceA.hs | 4 ++++ shape.hs | 6 ++++++ shortlines.hs | 7 +++++++ test.hs | 2 ++ todo.hs | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++ todo.txt | 3 +++ traffic.hs | 14 ++++++++++++++ tree.hs | 38 ++++++++++++++++++++++++++++++++++++++ 29 files changed, 370 insertions(+) create mode 100644 appendtodo.hs create mode 100644 arg-test.hs create mode 100644 capscont.hs create mode 100644 capslock.hs create mode 100644 charlist.hs create mode 100644 copyFile.hs create mode 100644 fac.hs create mode 100644 fib.hs create mode 100644 girlfriend.hs create mode 100644 girlfriend.txt create mode 100644 girlfriend1.txt create mode 100644 helloworld.hs create mode 100644 hl.hs create mode 100644 lengthComp.hs create mode 100644 pole.hs create mode 100644 prime.hs create mode 100644 reverse.hs create mode 100644 rmtodo.hs create mode 100644 rmtodo1.hs create mode 100644 rmtodo2.hs create mode 100644 sandbox.hs create mode 100644 sequenceA.hs create mode 100644 shape.hs create mode 100644 shortlines.hs create mode 100644 test.hs create mode 100644 todo.hs create mode 100644 todo.txt create mode 100644 traffic.hs create mode 100644 tree.hs diff --git a/appendtodo.hs b/appendtodo.hs new file mode 100644 index 0000000..6c3970c --- /dev/null +++ b/appendtodo.hs @@ -0,0 +1,8 @@ +import System.IO + +main = do + todoItem <- getLine + if null todoItem then return () + else (do + appendFile "todo.txt" (todoItem ++ "\n") + main) diff --git a/arg-test.hs b/arg-test.hs new file mode 100644 index 0000000..f986ad7 --- /dev/null +++ b/arg-test.hs @@ -0,0 +1,11 @@ +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 + diff --git a/capscont.hs b/capscont.hs new file mode 100644 index 0000000..2277d3b --- /dev/null +++ b/capscont.hs @@ -0,0 +1,5 @@ +import Data.Char + +main = do + contents <- getContents + putStr $ map toUpper contents diff --git a/capslock.hs b/capslock.hs new file mode 100644 index 0000000..be34c83 --- /dev/null +++ b/capslock.hs @@ -0,0 +1,6 @@ +import Control.Monad +import Data.Char + +main = forever $ do + l <- getLine + putStrLn $ map toUpper l diff --git a/charlist.hs b/charlist.hs new file mode 100644 index 0000000..d434a94 --- /dev/null +++ b/charlist.hs @@ -0,0 +1,2 @@ +newtype CharList = CharList { getCharList :: [Char] } deriving (Eq, Show) + diff --git a/copyFile.hs b/copyFile.hs new file mode 100644 index 0000000..0835b0e --- /dev/null +++ b/copyFile.hs @@ -0,0 +1,21 @@ +import System.Environment +import System.Directory +import System.IO +import Control.Exception +import qualified Data.ByteString.Lazy as B + +main = do + (fileName1:fileName2:_) <- getArgs + copy fileName1 fileName2 + +copy source dest = do + contents <- B.readFile source + bracketOnError + (openTempFile "." "temp") + (\(tempName, tempHandle) -> do + hClose tempHandle + removeFile tempName) + (\(tempName, tempHandle) -> do + B.hPutStr tempHandle contents + hClose tempHandle + renameFile tempName dest) diff --git a/fac.hs b/fac.hs new file mode 100644 index 0000000..dce8a26 --- /dev/null +++ b/fac.hs @@ -0,0 +1,6 @@ +facn a b = fac a b 1 + +fac a 0 c = c +fac a b c = fac (a*a) (div b 2) (c*(if odd b then a else 1)) + +--fibn a = fib a 1 1 1 1 0 diff --git a/fib.hs b/fib.hs new file mode 100644 index 0000000..647f75e --- /dev/null +++ b/fib.hs @@ -0,0 +1,13 @@ +fib n = fi n 1 1 + +fi 1 x y = x +fi a x y = fi (a-1) (x+y) x + +ffib n = ffi n 1 1 1 0 1 0 + +ffi 1 a b c d x y = (a*x + b*y) +ffi n a b c d x y = + if odd n + then ffi (div n 2) (a*a + b*c) (a*b + b*d) (a*c + c*d) (d*d + b*c) (a*x + b*y) (c*x + d*y) + else ffi (div n 2) (a*a + b*c) (a*b + b*d) (a*c + c*d) (d*d + b*c) x y + diff --git a/girlfriend.hs b/girlfriend.hs new file mode 100644 index 0000000..27a87f4 --- /dev/null +++ b/girlfriend.hs @@ -0,0 +1,6 @@ +import System.IO + +main = do + withFile "girlfriend.txt" ReadMode (\handle -> do + contents <- hGetContents handle + putStr contents) diff --git a/girlfriend.txt b/girlfriend.txt new file mode 100644 index 0000000..c3f3b39 --- /dev/null +++ b/girlfriend.txt @@ -0,0 +1,4 @@ +Hey! Hey! You! You! +I don't like your girlfriend! +No way! No way! +I think you need a new one! diff --git a/girlfriend1.txt b/girlfriend1.txt new file mode 100644 index 0000000..c3f3b39 --- /dev/null +++ b/girlfriend1.txt @@ -0,0 +1,4 @@ +Hey! Hey! You! You! +I don't like your girlfriend! +No way! No way! +I think you need a new one! diff --git a/helloworld.hs b/helloworld.hs new file mode 100644 index 0000000..485eb34 --- /dev/null +++ b/helloworld.hs @@ -0,0 +1,5 @@ +main = do + putStrLn "Hello, world !" + putStrLn "Your name?" + name <- getLine + putStrLn ("Hey, "++ name ++", you rock!") diff --git a/hl.hs b/hl.hs new file mode 100644 index 0000000..6273b5f --- /dev/null +++ b/hl.hs @@ -0,0 +1,8 @@ +data HL = HL Float Float + +instance Eq HL where + (==) (HL a1 b1) (HL a2 b2) = a1*b1==a2*b2 + +instance Show HL where + show (HL a b) = (show a) ++ ":" ++ (show b) ++ "->" + ++ (show $ sqrt(a**2+b**2)) diff --git a/lengthComp.hs b/lengthComp.hs new file mode 100644 index 0000000..e4457d2 --- /dev/null +++ b/lengthComp.hs @@ -0,0 +1,4 @@ +import Data.Monoid + +lengthComp :: String -> String -> Ordering +lengthComp x y = (length x `compare` length y) `mappend` (x `compare` y) diff --git a/pole.hs b/pole.hs new file mode 100644 index 0000000..4ec54d4 --- /dev/null +++ b/pole.hs @@ -0,0 +1,27 @@ +type Birds = Int +type Pole = (Birds, Birds) + +landLeft :: Birds -> Pole -> Maybe Pole +landLeft n (left, right) + | abs((left+n) - right) < 4 = Just (left + n, right) + | otherwise = Nothing + +landRight :: Birds -> Pole -> Maybe Pole +landRight n (left, right) + | abs((right+n) - left) < 4 = Just (left, right + n) + | otherwise = Nothing + +foo = do + x <- Just 3 + y <- Just "!" + Just (show x ++ y) + +routine = do + start <- return (0,0) + first <- landLeft 2 start + second <- landRight 2 first + landLeft 1 second + +wopwop = do + (x:xs) <- Just "" + return x diff --git a/prime.hs b/prime.hs new file mode 100644 index 0000000..2407280 --- /dev/null +++ b/prime.hs @@ -0,0 +1,11 @@ +prime = [x| x<-[2,3..], null [y|y<-[2,3..floor $ sqrt(fromIntegral x)],mod x y ==0] ] + +primes r [] = r +primes r (p:ps) = if null [y|y<-r,mod p y == 0] + then p:(primes (p:r) ps) + else primes r ps + +pr = 2:(ps [3,5..]) + +ps (x:xr) = x:(ps (filter rem xr)) + where rem y = (mod y x) /=0 diff --git a/reverse.hs b/reverse.hs new file mode 100644 index 0000000..cc82509 --- /dev/null +++ b/reverse.hs @@ -0,0 +1,10 @@ +main = do + line <- getLine + if null line + then return () + else do + putStrLn $ reverseWords line + main + +reverseWords :: String -> String +reverseWords = unwords . map reverse . words diff --git a/rmtodo.hs b/rmtodo.hs new file mode 100644 index 0000000..2507d86 --- /dev/null +++ b/rmtodo.hs @@ -0,0 +1,21 @@ +import System.IO +import System.Directory +import Data.List + +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" diff --git a/rmtodo1.hs b/rmtodo1.hs new file mode 100644 index 0000000..37b6d9b --- /dev/null +++ b/rmtodo1.hs @@ -0,0 +1,19 @@ +import System.IO +import System.Directory +import Data.List + +main = do + contents <- readFile "todo.txt" + let todoTasks = lines contents + numberedTasks = zipWith (\n line -> show n ++ " - " ++ line) [0..] todoTasks + putStrLn "These are your TO-DO items:" + mapM_ putStrLn numberedTasks + putStrLn "Which one do you want to delete?" + numberString <- getLine + let number = read numberString + newTodoItems = unlines $ delete (todoTasks !! number) todoTasks + (tempName, tempHandle) <- openTempFile "." "temp" + hPutStr tempHandle newTodoItems + hClose tempHandle + removeFile "todo.txt" + renameFile tempName "todo.txt" diff --git a/rmtodo2.hs b/rmtodo2.hs new file mode 100644 index 0000000..3d2e249 --- /dev/null +++ b/rmtodo2.hs @@ -0,0 +1,25 @@ +import System.IO +import System.Directory +import Data.List +import Control.Exception + +main = do + contents <- readFile "todo.txt" + let todoTasks = lines contents + numberedTasks = zipWith (\n line -> show n ++ " - " ++ line) [0..] todoTasks + putStrLn "These are your TO-DO items:" + mapM_ putStrLn numberedTasks + putStrLn "Which one do you want to delete?" + numberString <- getLine + let number = read numberString + newTodoItems = unlines $ delete (todoTasks !! number) todoTasks + bracketOnError (openTempFile "." "temp") + (\(tempName,tempHandle) -> do + hClose tempHandle + removeFile tempName) + (\(tempName,tempHandle) -> do + hPutStr tempHandle newTodoItems + hClose tempHandle + removeFile "todo.txt" + renameFile tempName "todo.txt") + diff --git a/sandbox.hs b/sandbox.hs new file mode 100644 index 0000000..f1a3213 --- /dev/null +++ b/sandbox.hs @@ -0,0 +1,28 @@ +import Control.Monad +import Data.Monoid + +dotest x = do + if x then return "Test" + else return "OK" + +type KnightPos = (Int, Int) + +moveKnight :: KnightPos -> [KnightPos] +moveKnight (c, r) = do + (c', r') <- [(c+2,r-1),(c+2,r+1),(c-2,r-1),(c-2,r+1) + ,(c+1,r-2),(c+1,r+2),(c-1,r-2),(c-1,r+2)] + guard (c' `elem` [1..8] && r' `elem` [1..8]) + return (c', r') + +filterDup :: [KnightPos] -> [KnightPos] +filterDup [] = [] +filterDup (x:xr) = x:(filterDup $ filter (x/=) xr) + +singleStep x = filterDup $ x >>= moveKnight + +multiStep :: Int -> [KnightPos] -> [KnightPos] +multiStep 0 x = x +multiStep n x = multiStep (n-1) (singleStep x) + +applyLog :: (Monoid m) => (a, m) -> (a -> (b, m)) -> (b, m) +applyLog (x, log) f = let (y, newLog) = f x in (y, log `mappend` newLog) diff --git a/sequenceA.hs b/sequenceA.hs new file mode 100644 index 0000000..f918a44 --- /dev/null +++ b/sequenceA.hs @@ -0,0 +1,4 @@ +import Control.Applicative + +sequenceA :: (Applicative f) => [f a] -> f [a] +sequenceA = foldr (liftA2 (:)) (pure []) diff --git a/shape.hs b/shape.hs new file mode 100644 index 0000000..0f8eca1 --- /dev/null +++ b/shape.hs @@ -0,0 +1,6 @@ +data Shape = Circle Float Float Float | Rectangle Float Float Float Float + deriving (Show) + +area :: Shape -> Float +area (Circle _ _ r) = pi * r ^ 2 +area (Rectangle x1 y1 x2 y2) = (abs $ x1 - x2) * (abs $ y1 - y2) diff --git a/shortlines.hs b/shortlines.hs new file mode 100644 index 0000000..267e595 --- /dev/null +++ b/shortlines.hs @@ -0,0 +1,7 @@ +import Data.Char + +main = do + contents <- getContents + let shortLines = unlines . filter ((<10).length) . lines in + putStr $ shortLines contents + diff --git a/test.hs b/test.hs new file mode 100644 index 0000000..1f2dca6 --- /dev/null +++ b/test.hs @@ -0,0 +1,2 @@ +isSB "Phil" = "yes" +isSB a = "no" diff --git a/todo.hs b/todo.hs new file mode 100644 index 0000000..2cb21c1 --- /dev/null +++ b/todo.hs @@ -0,0 +1,52 @@ +import System.Environment +import System.Directory +import System.IO +import Data.List +import Control.Exception +import Control.Monad(when) + +fileName = "todo.txt" + +dispatch :: String -> String -> IO () +dispatch file "add" = add file +dispatch file "view" = view file +dispatch file "rm" = remove file +dispatch file _ = do + putStrLn "Operations supported:\nadd - Append Item\nview - Inspect Item\nrm - Remove Item" + +view file = do + contents <- readFile file + let todoTasks = lines contents + putStr $ unlines $ number todoTasks + +add file = do + todoItem <- getLine + when (not $ null todoItem) (do + appendFile file todoItem) + +remove file = do + contents <- readFile file + numberString <- getLine + let todoTasks = lines contents + number = read numberString + newTodoList = unlines $ delete (todoTasks !! number) todoTasks + bracketOnError (openTempFile "." "temp") + (\(tempName,tempHandle) -> do + hClose tempHandle + removeFile tempName) + (\(tempName,tempHandle) -> do + hPutStr tempHandle newTodoList + hClose tempHandle + removeFile file + renameFile tempName file) + + +number task = zipWith (\n line -> show n ++ " - " ++ line) [0..] task + +main = do + line <- getLine + if null line then return () + else (do + dispatch fileName line + main) + diff --git a/todo.txt b/todo.txt new file mode 100644 index 0000000..cd5c47b --- /dev/null +++ b/todo.txt @@ -0,0 +1,3 @@ +Dust the dog +Take salad out of the oven +Iron the dishes \ No newline at end of file diff --git a/traffic.hs b/traffic.hs new file mode 100644 index 0000000..f409de3 --- /dev/null +++ b/traffic.hs @@ -0,0 +1,14 @@ +data TrafficLight = Red | Yellow | Green + +instance Eq TrafficLight where + Red == Red = True + Yellow == Yellow = True + Green == Green = True + _ == _ = False + +instance Show TrafficLight where + show Red = "Red light" + show Yellow = "Yellow light" + show Green = "Green light" + +data Either a b = Left a | Right b diff --git a/tree.hs b/tree.hs new file mode 100644 index 0000000..50f4774 --- /dev/null +++ b/tree.hs @@ -0,0 +1,38 @@ +import Data.Monoid +import qualified Data.Foldable as F + +data Tree a = Empty | Node a (Tree a) (Tree a) + deriving (Show) + +instance F.Foldable Tree where + foldMap f Empty = mempty + foldMap f (Node x l r) = F.foldMap f l `mappend` + f x `mappend` + F.foldMap f r + +singleton :: a -> Tree a +singleton x = Node x Empty Empty + +treeInsert :: (Ord a) => a -> Tree a -> Tree a +treeInsert x Empty = 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 Empty = False +treeElem x (Node a left right) + | x == a = True + | x < a = treeElem x left + | x > a = treeElem x right + +testTree = Node 6 + (Node 3 + (Node 1 Empty Empty) + (Node 5 Empty Empty) + ) + (Node 9 + (Node 8 Empty Empty) + (Node 10 Empty Empty) + ) -- cgit v1.2.3-70-g09d2