diff options
-rw-r--r-- | appendtodo.hs | 8 | ||||
-rw-r--r-- | arg-test.hs | 11 | ||||
-rw-r--r-- | capscont.hs | 5 | ||||
-rw-r--r-- | capslock.hs | 6 | ||||
-rw-r--r-- | charlist.hs | 2 | ||||
-rw-r--r-- | copyFile.hs | 21 | ||||
-rw-r--r-- | fac.hs | 6 | ||||
-rw-r--r-- | fib.hs | 13 | ||||
-rw-r--r-- | girlfriend.hs | 6 | ||||
-rw-r--r-- | girlfriend.txt | 4 | ||||
-rw-r--r-- | girlfriend1.txt | 4 | ||||
-rw-r--r-- | helloworld.hs | 5 | ||||
-rw-r--r-- | hl.hs | 8 | ||||
-rw-r--r-- | lengthComp.hs | 4 | ||||
-rw-r--r-- | pole.hs | 27 | ||||
-rw-r--r-- | prime.hs | 11 | ||||
-rw-r--r-- | reverse.hs | 10 | ||||
-rw-r--r-- | rmtodo.hs | 21 | ||||
-rw-r--r-- | rmtodo1.hs | 19 | ||||
-rw-r--r-- | rmtodo2.hs | 25 | ||||
-rw-r--r-- | sandbox.hs | 28 | ||||
-rw-r--r-- | sequenceA.hs | 4 | ||||
-rw-r--r-- | shape.hs | 6 | ||||
-rw-r--r-- | shortlines.hs | 7 | ||||
-rw-r--r-- | test.hs | 2 | ||||
-rw-r--r-- | todo.hs | 52 | ||||
-rw-r--r-- | todo.txt | 3 | ||||
-rw-r--r-- | traffic.hs | 14 | ||||
-rw-r--r-- | tree.hs | 38 |
29 files changed, 370 insertions, 0 deletions
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) @@ -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 @@ -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!") @@ -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) @@ -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 + @@ -0,0 +1,2 @@ +isSB "Phil" = "yes" +isSB a = "no" @@ -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 @@ -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) + ) |