├── Setup.hs ├── test └── Spec.hs ├── src ├── Module1 │ ├── Task4.hs │ ├── Task1.hs │ ├── Task2.hs │ ├── Task8.hs │ ├── Task3.hs │ ├── Task7.hs │ ├── Task6.hs │ ├── Task9.hs │ ├── Task5.hs │ ├── Task11.hs │ ├── Task13.hs │ ├── Task10.hs │ └── Task12.hs ├── Module3 │ ├── Task24.hs │ ├── Task18.hs │ ├── Task19.hs │ ├── Task4.hs │ ├── Task1.hs │ ├── Task20.hs │ ├── Task3_Elegant.hs │ ├── Task13.hs │ ├── Task14.hs │ ├── Task10.hs │ ├── Task15.hs │ ├── Task21.hs │ ├── Task8.hs │ ├── Task12.hs │ ├── Task5_Elegant.hs │ ├── Task2.hs │ ├── Task7.hs │ ├── Task22.hs │ ├── Task25.hs │ ├── Task9.hs │ ├── Task3.hs │ ├── Task17.hs │ ├── Task11.hs │ ├── Task6.hs │ ├── Task5.hs │ ├── Task17_Unique.hs │ └── Task16.hs ├── Lib.hs ├── Module2 │ ├── Task1.hs │ ├── Task10.hs │ ├── Task2.hs │ ├── Task4.hs │ ├── Task3.hs │ ├── Task8.hs │ ├── Task5.hs │ ├── Task9.hs │ ├── Task6.hs │ └── Task7.hs ├── Module5 │ ├── Task6.hs │ ├── Task17.hs │ ├── Task7.hs │ ├── Task1.hs │ ├── Task13.hs │ ├── Task20.hs │ ├── Task21.hs │ ├── Task12.hs │ ├── Task3.hs │ ├── Task2.hs │ ├── Task16.hs │ ├── Task5.hs │ ├── Task4.hs │ ├── Task9.hs │ ├── Task22.hs │ ├── Task11.hs │ ├── Task18.hs │ ├── Task8.hs │ ├── Task15.hs │ ├── Task10.hs │ ├── Task23.hs │ ├── Task19.hs │ └── Task14.hs └── Module4 │ ├── Task2.hs │ ├── Task20.hs │ ├── Task3.hs │ ├── Task7.hs │ ├── Task9.hs │ ├── Task26.hs │ ├── Task6.hs │ ├── Task12.hs │ ├── Task16.hs │ ├── Task1.hs │ ├── Task17.hs │ ├── Task18.hs │ ├── Task4.hs │ ├── Task21.hs │ ├── Task13.hs │ ├── Task23.hs │ ├── Task14.hs │ ├── Task27.hs │ ├── Task24.hs │ ├── Task15.hs │ ├── Task5.hs │ ├── Task22.hs │ ├── Task8.hs │ ├── Task11.hs │ ├── Task25.hs │ ├── Task29.hs │ ├── Task10.hs │ ├── Task19.hs │ └── Task28.hs ├── app └── Main.hs ├── .gitignore ├── README.md ├── Vagrantfile ├── cm └── vagrant.yml ├── stack.yaml ├── stepic-haskell.cabal └── LICENSE /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /src/Module1/Task4.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task4 where 2 | 3 | x |-| y = abs (x - y) 4 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Lib 4 | 5 | main :: IO () 6 | main = someFunc 7 | -------------------------------------------------------------------------------- /src/Module1/Task1.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task1 where 2 | 3 | main = putStrLn "Hello, world!" 4 | -------------------------------------------------------------------------------- /src/Module1/Task2.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task2 where 2 | 3 | lenVec3 a b c = sqrt (a^2 + b^2 + c^2) 4 | -------------------------------------------------------------------------------- /src/Module3/Task24.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task24 where 2 | 3 | lastElem :: [a] -> a 4 | lastElem = foldl1 $ flip const 5 | -------------------------------------------------------------------------------- /src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | -------------------------------------------------------------------------------- /src/Module3/Task18.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task18 where 2 | 3 | concatList :: [[a]] -> [a] 4 | concatList = foldr (++) [] 5 | -------------------------------------------------------------------------------- /src/Module2/Task1.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task1 where 2 | 3 | getSecondFrom :: t -> t2 -> t1 -> t2 4 | getSecondFrom a b c = b 5 | -------------------------------------------------------------------------------- /src/Module3/Task19.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task19 where 2 | 3 | lengthList :: [a] -> Int 4 | lengthList = foldr (\x s -> s + 1) 0 5 | -------------------------------------------------------------------------------- /src/Module3/Task4.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task4 where 2 | 3 | isPalindrome :: Eq a => [a] -> Bool 4 | isPalindrome x = x == reverse x 5 | -------------------------------------------------------------------------------- /src/Module3/Task1.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task1 where 2 | 3 | addTwoElements :: a -> a -> [a] -> [a] 4 | addTwoElements a b l = a : b : l 5 | -------------------------------------------------------------------------------- /src/Module3/Task20.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task20 where 2 | 3 | sumOdd :: [Integer] -> Integer 4 | sumOdd = (foldr (+) 0) . (filter odd) 5 | -------------------------------------------------------------------------------- /src/Module2/Task10.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task10 where 2 | 3 | avg :: Int -> Int -> Int -> Double 4 | avg a b c = fromIntegral (a + b + c) / 3 5 | -------------------------------------------------------------------------------- /src/Module3/Task3_Elegant.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task3_Elegant where 2 | 3 | oddsOnly :: Integral a => [a] -> [a] 4 | oddsOnly = filter odd 5 | -------------------------------------------------------------------------------- /src/Module5/Task6.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task6 where 2 | import Module5.Task5 (Log(..)) 3 | 4 | returnLog :: a -> Log a 5 | returnLog = Log [] 6 | -------------------------------------------------------------------------------- /src/Module4/Task2.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task2 where 2 | 3 | charToInt :: Char -> Int 4 | charToInt x | x `elem` ['0'..'9'] = (fromEnum x) - 48 5 | -------------------------------------------------------------------------------- /src/Module3/Task13.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task13 where 2 | 3 | max3 :: Ord a => [a] -> [a] -> [a] -> [a] 4 | max3 = zipWith3 (\a b c -> max c $ max b a) 5 | -------------------------------------------------------------------------------- /src/Module3/Task14.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task14 where 2 | 3 | fibStream :: [Integer] 4 | fibStream = [0, 1] ++ zipWith (+) fibStream (tail fibStream) 5 | -------------------------------------------------------------------------------- /src/Module2/Task2.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task2 where 2 | 3 | import Data.Function 4 | 5 | multSecond = g `on` h 6 | 7 | g = (*) 8 | 9 | h = snd 10 | -------------------------------------------------------------------------------- /src/Module2/Task4.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task4 where 2 | 3 | doItYourself = f . g . h 4 | 5 | f = logBase 2 6 | 7 | g = (^ 3) 8 | 9 | h = max 42 10 | -------------------------------------------------------------------------------- /src/Module3/Task10.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task10 where 2 | 3 | squares'n'cubes :: Num a => [a] -> [a] 4 | squares'n'cubes = concatMap (\x -> [x*x, x*x*x]) 5 | -------------------------------------------------------------------------------- /src/Module3/Task15.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task15 where 2 | 3 | import Prelude hiding (repeat) 4 | 5 | repeat = iterate repeatHelper 6 | repeatHelper = id 7 | -------------------------------------------------------------------------------- /src/Module1/Task8.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task8 where 2 | 3 | doubleFact :: Integer -> Integer 4 | doubleFact n = if n < 1 then 1 else n * doubleFact (n - 2) 5 | -------------------------------------------------------------------------------- /src/Module2/Task3.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task3 where 2 | 3 | on3 :: (b -> b -> b -> c) -> (a -> b) -> a -> a -> a -> c 4 | on3 op f x y z = op (f x) (f y) (f z) 5 | -------------------------------------------------------------------------------- /src/Module3/Task21.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task21 where 2 | 3 | meanList :: [Double] -> Double 4 | meanList = (uncurry (/)) . foldr (\x (s,c) -> (s+x,c+1)) (0,0) 5 | -------------------------------------------------------------------------------- /src/Module3/Task8.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task8 where 2 | 3 | filterDisj :: (a -> Bool) -> (a -> Bool) -> [a] -> [a] 4 | filterDisj a b = filter (\x -> a x || b x) 5 | -------------------------------------------------------------------------------- /src/Module1/Task3.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task3 where 2 | 3 | sign x = 4 | if x > 0 5 | then 1 6 | else if x < 0 7 | then -1 8 | else 0 9 | -------------------------------------------------------------------------------- /src/Module3/Task12.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task12 where 2 | 3 | import Data.Char 4 | delAllUpper :: String -> String 5 | delAllUpper = unwords . (filter $ any isLower) . words 6 | -------------------------------------------------------------------------------- /src/Module5/Task17.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task17 where 2 | import Control.Monad.Writer (Writer, runWriter) 3 | 4 | evalWriter :: Writer w a -> a 5 | evalWriter = fst . runWriter 6 | -------------------------------------------------------------------------------- /src/Module4/Task20.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task20 where 2 | 3 | eitherToMaybe :: Either a b -> Maybe a 4 | eitherToMaybe (Left a) = Just a 5 | eitherToMaybe (Right _) = Nothing 6 | -------------------------------------------------------------------------------- /src/Module3/Task5_Elegant.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task5_Elegant where 2 | 3 | import Data.List 4 | sum3 :: Num a => [a] -> [a] -> [a] -> [a] 5 | sum3 a b c = map sum $ transpose [a, b, c] 6 | -------------------------------------------------------------------------------- /src/Module4/Task3.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task3 where 2 | 3 | data Color = Red | Green | Blue deriving (Show, Read) 4 | 5 | stringToColor :: String -> Color 6 | stringToColor = read 7 | -------------------------------------------------------------------------------- /src/Module1/Task7.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task7 where 2 | 3 | dist :: (Double, Double) -> (Double, Double) -> Double 4 | dist x y = 5 | sqrt $ (fst y - fst x) ^ 2 + (snd y - snd x) ^ 2 6 | -------------------------------------------------------------------------------- /src/Module3/Task2.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task2 where 2 | 3 | nTimes:: a -> Int -> [a] 4 | nTimes x n = iter [] x n 5 | where 6 | iter a _ 0 = a 7 | iter a x n = iter (x : a) x (n - 1) 8 | -------------------------------------------------------------------------------- /src/Module3/Task7.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task7 where 2 | 3 | import Data.Char 4 | 5 | readDigits :: String -> (String, String) 6 | readDigits x = (takeWhile isDigit x, dropWhile isDigit x) 7 | -------------------------------------------------------------------------------- /src/Module3/Task22.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task22 where 2 | 3 | -- it also works for task 23 4 | evenOnly :: [a] -> [a] 5 | evenOnly = (foldr (\(n, x) xs -> if even n then x:xs else xs) []) . (zip [1..]) 6 | -------------------------------------------------------------------------------- /src/Module2/Task8.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task8 where 2 | 3 | -- system part 4 | ip = show a ++ show b ++ show c ++ show d 5 | 6 | -- solution part 7 | a = 12 8 | b = 7.22 9 | c = 4.12 10 | d = 0.12 11 | -------------------------------------------------------------------------------- /src/Module4/Task7.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task7 where 2 | 3 | data Shape = Circle Double | Rectangle Double Double 4 | 5 | area :: Shape -> Double 6 | area (Circle r) = pi * r^2 7 | area (Rectangle h w) = h * w 8 | -------------------------------------------------------------------------------- /src/Module4/Task9.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task9 where 2 | 3 | data Shape = Circle Double | Rectangle Double Double 4 | 5 | isSquare :: Shape -> Bool 6 | isSquare (Rectangle h w) = h == w 7 | isSquare _ = False 8 | -------------------------------------------------------------------------------- /src/Module5/Task7.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task7 where 2 | import Module5.Task5 (Log(..)) 3 | 4 | bindLog :: Log a -> (a -> Log b) -> Log b 5 | bindLog (Log msga a) f = Log (msga ++ msgb) b where 6 | (Log msgb b) = f a 7 | -------------------------------------------------------------------------------- /src/Module4/Task26.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task26 where 2 | 3 | newtype Xor = Xor { getXor :: Bool } deriving (Eq,Show) 4 | 5 | instance Monoid Xor where 6 | mempty = Xor False 7 | Xor a `mappend` Xor b = Xor (a /= b) 8 | -------------------------------------------------------------------------------- /src/Module4/Task6.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task6 where 2 | 3 | data Point = Point Double Double 4 | 5 | distance :: Point -> Point -> Double 6 | distance (Point x1 y1) (Point x2 y2) = 7 | sqrt $ (x1 - x2) ^ 2 + (y1 - y2) ^ 2 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | *.dyn_o 8 | *.dyn_hi 9 | .hpc 10 | .hsenv 11 | .cabal-sandbox/ 12 | cabal.sandbox.config 13 | *.prof 14 | *.aux 15 | *.hp 16 | .stack-work/ 17 | .vagrant/ 18 | -------------------------------------------------------------------------------- /src/Module1/Task6.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task6 where 2 | 3 | import Data.Char 4 | twoDigits2Int :: Char -> Char -> Int 5 | twoDigits2Int x y = 6 | if isDigit x && isDigit y 7 | then digitToInt x * 10 + digitToInt y 8 | else 100 9 | -------------------------------------------------------------------------------- /src/Module3/Task25.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task25 where 2 | 3 | import Data.List 4 | revRange :: (Char,Char) -> [Char] 5 | revRange = unfoldr g 6 | where g (a, b) | a > b = Nothing 7 | | otherwise = Just (b, (a, pred b)) 8 | -------------------------------------------------------------------------------- /src/Module5/Task1.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task1 where 2 | 3 | -- system code 4 | data Point3D a = Point3D a a a deriving Show 5 | 6 | -- solution code 7 | instance Functor Point3D where 8 | fmap f (Point3D a b c) = Point3D (f a) (f b) (f c) 9 | -------------------------------------------------------------------------------- /src/Module5/Task13.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task13 where 2 | 3 | main' :: IO () 4 | main' = do 5 | putStr $ "What is your name?\nName: " 6 | name <- getLine 7 | if null name 8 | then main' 9 | else putStrLn $ "Hi, " ++ name ++ "!" 10 | -------------------------------------------------------------------------------- /src/Module1/Task9.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task9 where 2 | 3 | fibonacci :: Integer -> Integer 4 | fibonacci n 5 | | n == 0 = 0 6 | | n == 1 = 1 7 | | n < 0 = -(-1) ^ (-n) * fibonacci (-n) 8 | | n > 0 = fibonacci (n - 1) + fibonacci (n - 2) 9 | -------------------------------------------------------------------------------- /src/Module4/Task12.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task12 where 2 | 3 | data Person = Person { firstName :: String, lastName :: String, age :: Int } 4 | 5 | updateLastName :: Person -> Person -> Person 6 | updateLastName p1 p2 = p2 { lastName = (lastName p1) } 7 | -------------------------------------------------------------------------------- /src/Module4/Task16.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task16 where 2 | 3 | import Data.Char(isDigit) 4 | 5 | findDigit :: [Char] -> Maybe Char 6 | findDigit [] = Nothing 7 | findDigit (x:xs) | isDigit x = Just x 8 | | otherwise = findDigit xs 9 | -------------------------------------------------------------------------------- /src/Module5/Task20.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task20 where 2 | import Control.Monad.State (State, state) 3 | import Control.Monad.Reader (Reader, runReader) 4 | 5 | readerToState :: Reader r a -> State r a 6 | readerToState m = state $ \e -> (runReader m e, e) 7 | -------------------------------------------------------------------------------- /src/Module4/Task1.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task1 where 2 | 3 | -- system code 4 | data Color = Red | Green | Blue 5 | 6 | -- solution code 7 | instance Show Color where 8 | show Red = "Red" 9 | show Green = "Green" 10 | show Blue = "Blue" 11 | -------------------------------------------------------------------------------- /src/Module4/Task17.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task17 where 2 | import Module4.Task16 (findDigit) 3 | 4 | import Data.Char(isDigit) 5 | 6 | findDigitOrX :: [Char] -> Char 7 | findDigitOrX str = case findDigit str of 8 | Nothing -> 'X' 9 | Just c -> c 10 | -------------------------------------------------------------------------------- /src/Module4/Task18.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task18 where 2 | 3 | maybeToList :: Maybe a -> [a] 4 | maybeToList Nothing = [] 5 | maybeToList (Just x) = [x] 6 | 7 | listToMaybe :: [a] -> Maybe a 8 | listToMaybe [] = Nothing 9 | listToMaybe (x:_) = Just x 10 | -------------------------------------------------------------------------------- /src/Module1/Task5.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task5 where 2 | 3 | discount :: Double -> Double -> Double -> Double 4 | discount limit proc sum = if sum >= limit then sum * (100 - proc) / 100 else sum 5 | 6 | standardDiscount :: Double -> Double 7 | standardDiscount = discount 1000 5 8 | -------------------------------------------------------------------------------- /src/Module3/Task9.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task9 where 2 | 3 | qsort :: Ord a => [a] -> [a] 4 | qsort [] = [] 5 | qsort [x] = [x] 6 | qsort (x:xs) = let 7 | left = filter (\y -> y <= x) xs 8 | right = filter (\y -> y > x) xs 9 | in (qsort left) ++ [x] ++ (qsort right) 10 | -------------------------------------------------------------------------------- /src/Module2/Task5.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task5 where 2 | 3 | class Printable a where 4 | toString :: a -> [Char] 5 | 6 | instance Printable Bool where 7 | toString True = "true" 8 | toString False = "false" 9 | 10 | instance Printable () where 11 | toString () = "unit type" 12 | -------------------------------------------------------------------------------- /src/Module3/Task3.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task3 where 2 | 3 | oddsOnly :: Integral a => [a] -> [a] 4 | oddsOnly = iter [] 5 | where 6 | reverse l [] = l 7 | reverse l (x:xs) = reverse (x:l) xs 8 | iter l [] = reverse [] l 9 | iter l (x:xs) = iter (if odd x then (x:l) else l) xs 10 | -------------------------------------------------------------------------------- /src/Module4/Task4.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task4 where 2 | 3 | -- system code 4 | data LogLevel = Error | Warning | Info 5 | 6 | -- solution code 7 | cmp :: LogLevel -> LogLevel -> Ordering 8 | cmp a b = compare (i a) (i b) where 9 | i Error = 2 10 | i Warning = 1 11 | i Info = 0 12 | -------------------------------------------------------------------------------- /src/Module5/Task21.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task21 where 2 | import Control.Monad.State (State, state) 3 | import Control.Monad.Writer (Writer, runWriter) 4 | 5 | writerToState :: Monoid w => Writer w a -> State w a 6 | writerToState m = let 7 | (a, w) = runWriter m 8 | in state $ \e -> (a, e `mappend` w) 9 | -------------------------------------------------------------------------------- /src/Module3/Task17.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task17 where 2 | 3 | -- system code 4 | coins :: (Ord a, Num a) => [a] 5 | coins = [2, 3, 7] 6 | 7 | -- solution code 8 | change :: (Ord a, Num a) => a -> [[a]] 9 | change 0 = [[]] 10 | change s = [coin:ch | coin <- coins, coin <= s, ch <- (change $ s - coin)] 11 | -------------------------------------------------------------------------------- /src/Module5/Task12.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task12 where 2 | 3 | pythagoreanTriple :: Int -> [(Int, Int, Int)] 4 | pythagoreanTriple x 5 | | x <= 0 = [] 6 | | otherwise = do 7 | b <- [1..x] 8 | a <- [1..b-1] 9 | c <- [1..x] 10 | True <- return $ (a^2 + b^2) == c^2 11 | return (a,b,c) 12 | -------------------------------------------------------------------------------- /src/Module2/Task9.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task9 where 2 | 3 | class (Enum a, Bounded a, Eq a) => SafeEnum a where 4 | ssucc :: a -> a 5 | ssucc x 6 | | x == maxBound = minBound 7 | | otherwise = succ x 8 | spred :: a -> a 9 | spred x 10 | | x == minBound = maxBound 11 | | otherwise = pred x 12 | -------------------------------------------------------------------------------- /src/Module3/Task11.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task11 where 2 | 3 | perms :: [a] -> [[a]] 4 | perms [] = [[]] 5 | perms (x:xs) = let 6 | len = length xs 7 | xperm p n = let 8 | (l, r) = splitAt n p 9 | in l ++ [x] ++ r 10 | xperms p = map (xperm p) [0..len] 11 | in concatMap xperms $ perms xs 12 | -------------------------------------------------------------------------------- /src/Module4/Task21.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task21 where 2 | 3 | data List a = Nil | Cons a (List a) deriving Show 4 | 5 | fromList :: List a -> [a] 6 | fromList Nil = [] 7 | fromList (Cons a b) = a : fromList b 8 | 9 | toList :: [a] -> List a 10 | toList [] = Nil 11 | toList (x:xs) = Cons x $ toList xs 12 | -------------------------------------------------------------------------------- /src/Module4/Task13.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task13 where 2 | 3 | data Person = Person { 4 | firstName :: String, 5 | lastName :: String, 6 | age :: Int } deriving Show 7 | 8 | abbrFirstName :: Person -> Person 9 | abbrFirstName p@Person{ firstName = (x:_:_) } = p { firstName = x : "." } 10 | abbrFirstName p = p 11 | -------------------------------------------------------------------------------- /src/Module4/Task23.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task23 where 2 | 3 | data Tree a = Leaf a | Node (Tree a) (Tree a) 4 | 5 | height :: Tree a -> Int 6 | height (Leaf _) = 0 7 | height (Node l r) = 1 + max (height l) (height r) 8 | 9 | size :: Tree a -> Int 10 | size (Leaf _) = 1 11 | size (Node l r) = 1 + size l + size r 12 | -------------------------------------------------------------------------------- /src/Module5/Task3.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task3 where 2 | 3 | -- system code 4 | data Tree a = Leaf (Maybe a) | Branch (Tree a) (Maybe a) (Tree a) deriving Show 5 | 6 | -- solution code 7 | instance Functor Tree where 8 | fmap f (Leaf x) = Leaf (fmap f x) 9 | fmap f (Branch l x r) = Branch (fmap f l) (fmap f x) (fmap f r) 10 | -------------------------------------------------------------------------------- /src/Module1/Task11.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task11 where 2 | 3 | seqA :: Integer -> Integer 4 | seqA n 5 | | n == 0 = 1 6 | | n == 1 = 2 7 | | n == 2 = 3 8 | | otherwise = let 9 | iter a0 a1 a2 (-1) = a2 10 | iter a0 a1 a2 n = 11 | iter a1 a2 (a2 + a1 - 2 * a0) (n - 1) 12 | in iter 1 2 3 (n - 3) 13 | -------------------------------------------------------------------------------- /src/Module3/Task6.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task6 where 2 | 3 | groupElems :: Eq a => [a] -> [[a]] 4 | groupElems = iter [] 5 | where iter a [] = reverse a 6 | iter [] (x:xs) = iter [[x]] xs 7 | iter ((y:ys):yss) (x:xs) 8 | | x == y = iter ((x:y:ys):yss) xs 9 | | otherwise = iter ([x]:(y:ys):yss) xs 10 | -------------------------------------------------------------------------------- /src/Module1/Task13.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task13 where 2 | 3 | integration :: (Double -> Double) -> Double -> Double -> Double 4 | integration f a b = let 5 | chunks = 1000 6 | h = (b - a) / chunks 7 | sum acc x 0 = acc 8 | sum acc x n = sum (acc + f x) (x + h) (n - 1) 9 | in h * (f a + f b + 2 * (sum 0 (a + h) (chunks - 1))) / 2 10 | -------------------------------------------------------------------------------- /src/Module1/Task10.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task10 where 2 | 3 | fibonacci :: Integer -> Integer 4 | fibonacci n 5 | | n == 0 = 0 6 | | n == 1 = 1 7 | | n < 0 = -(-1) ^ (-n) * fibonacci (-n) 8 | | n > 0 = fibonacciIter 0 1 (n - 2) 9 | 10 | fibonacciIter acc1 acc2 0 = acc1 + acc2 11 | fibonacciIter acc1 acc2 n = 12 | fibonacciIter (acc2) (acc1 + acc2) (n - 1) 13 | -------------------------------------------------------------------------------- /src/Module4/Task14.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task14 where 2 | 3 | data Coord a = Coord a a 4 | 5 | distance :: Coord Double -> Coord Double -> Double 6 | distance (Coord x1 y1) (Coord x2 y2) = 7 | sqrt $ (x1 - x2)^2 + (y1 - y2)^2 8 | 9 | manhDistance :: Coord Int -> Coord Int -> Int 10 | manhDistance (Coord x1 y1) (Coord x2 y2) = 11 | abs (x1 - x2) + abs (y1 - y2) 12 | -------------------------------------------------------------------------------- /src/Module5/Task2.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task2 where 2 | import Module5.Task1 3 | 4 | -- system code 5 | data GeomPrimitive a = Point (Point3D a) | LineSegment (Point3D a) (Point3D a) 6 | deriving Show 7 | 8 | -- solution code 9 | instance Functor GeomPrimitive where 10 | fmap f (Point x) = Point (fmap f x) 11 | fmap f (LineSegment x y) = LineSegment (fmap f x) (fmap f y) 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ### Solutions to MOOC "Functional programming in Haskell" by [stepic.org](https://stepic.org/course/%D0%A4%D1%83%D0%BD%D0%BA%D1%86%D0%B8%D0%BE%D0%BD%D0%B0%D0%BB%D1%8C%D0%BD%D0%BE%D0%B5-%D0%BF%D1%80%D0%BE%D0%B3%D1%80%D0%B0%D0%BC%D0%BC%D0%B8%D1%80%D0%BE%D0%B2%D0%B0%D0%BD%D0%B8%D0%B5-%D0%BD%D0%B0-%D1%8F%D0%B7%D1%8B%D0%BA%D0%B5-Haskell-75/) 2 | 3 | Please don't use it for cheating. 4 | -------------------------------------------------------------------------------- /src/Module1/Task12.hs: -------------------------------------------------------------------------------- 1 | module Module1.Task12 where 2 | 3 | sum'n'count :: Integer -> (Integer, Integer) 4 | sum'n'count x 5 | | x == 0 = (0, 1) 6 | | x < 0 = iter 0 0 (-x) 7 | | otherwise = iter 0 0 x 8 | where 9 | iter sum count 0 = (sum, count) 10 | iter sum count x = let 11 | (x', d) = divMod x 10 12 | in iter (sum + d) (count + 1) x' 13 | -------------------------------------------------------------------------------- /src/Module3/Task5.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task5 where 2 | 3 | sum3 :: Num a => [a] -> [a] -> [a] -> [a] 4 | sum3 = iter [] 5 | where 6 | iter a [] [] [] = reverse a 7 | iter a [] a2 a3 = iter a [0] a2 a3 8 | iter a a1 [] a3 = iter a a1 [0] a3 9 | iter a a1 a2 [] = iter a a1 a2 [0] 10 | iter a (x1:xs1) (x2:xs2) (x3:xs3) = 11 | iter (x1 + x2 + x3 : a) xs1 xs2 xs3 12 | -------------------------------------------------------------------------------- /src/Module4/Task27.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task27 where 2 | 3 | newtype Maybe' a = Maybe' { getMaybe :: Maybe a } deriving (Eq,Show) 4 | 5 | instance Monoid a => Monoid (Maybe' a) where 6 | mempty = Maybe' $ Just mempty 7 | mappend (Maybe' Nothing) _ = Maybe' Nothing 8 | mappend _ (Maybe' Nothing) = Maybe' Nothing 9 | mappend (Maybe' a) (Maybe' b) = Maybe' (mappend a b) 10 | -------------------------------------------------------------------------------- /src/Module5/Task16.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task16 where 2 | import Control.Monad.Reader (Reader, asks) 3 | 4 | -- system code 5 | type User = String 6 | type Password = String 7 | type UsersTable = [(User, Password)] 8 | 9 | -- solution code 10 | usersWithBadPasswords :: Reader UsersTable [User] 11 | usersWithBadPasswords = asks $ map fst . filter isBad where 12 | isBad = ("123456" ==) . snd 13 | -------------------------------------------------------------------------------- /src/Module5/Task5.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task5 where 2 | 3 | -- system code 4 | data Log a = Log [String] a deriving Show 5 | 6 | -- solution code 7 | toLogger :: (a -> b) -> String -> (a -> Log b) 8 | toLogger f msg = Log [msg] . f 9 | 10 | execLoggers :: a -> (a -> Log b) -> (b -> Log c) -> Log c 11 | execLoggers a f g = Log (logb ++ logc) c where 12 | (Log logb b) = f a 13 | (Log logc c) = g b 14 | -------------------------------------------------------------------------------- /src/Module4/Task24.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task24 where 2 | 3 | data Tree a = Leaf a | Node (Tree a) (Tree a) 4 | 5 | avg :: Tree Int -> Int 6 | avg t = 7 | let (c,s) = go t 8 | in s `div` c 9 | where 10 | go :: Tree Int -> (Int,Int) 11 | go (Leaf x) = (1, x) 12 | go (Node l r) = let 13 | (lc, ls) = go l 14 | (rc, rs) = go r 15 | in (lc + rc, ls + rs) 16 | -------------------------------------------------------------------------------- /src/Module5/Task4.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task4 where 2 | 3 | -- system code 4 | data Entry k1 k2 v = Entry (k1, k2) v deriving Show 5 | data Map k1 k2 v = Map [Entry k1 k2 v] deriving Show 6 | 7 | -- solution code 8 | instance Functor (Entry k1 k2) where 9 | fmap f (Entry (k1, k2) v) = Entry (k1, k2) (f v) 10 | 11 | instance Functor (Map k1 k2) where 12 | fmap f (Map entries) = Map (map (fmap f) entries) 13 | -------------------------------------------------------------------------------- /src/Module3/Task17_Unique.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task17_Unique (change) where 2 | 3 | import Data.List (nub, sort) 4 | 5 | -- system code 6 | coins :: (Ord a, Num a) => [a] 7 | coins = [2, 3, 7] 8 | 9 | --solution code 10 | change :: (Ord a, Num a) => a -> [[a]] 11 | change = f where 12 | f 0 = [[]] 13 | f s = nub [ 14 | sort (coin:ch) | 15 | coin <- coins, 16 | coin <= s, 17 | ch <- (f $ s - coin)] 18 | -------------------------------------------------------------------------------- /src/Module4/Task15.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task15 where 2 | 3 | data Coord a = Coord a a deriving Show 4 | 5 | getCenter :: Double -> Coord Int -> Coord Double 6 | getCenter unit (Coord x y) = let 7 | c a = unit * (fromIntegral a + 0.5) 8 | in Coord (c x) (c y) 9 | 10 | getCell :: Double -> Coord Double -> Coord Int 11 | getCell unit (Coord x y) = let 12 | n x = floor $ x / unit 13 | in Coord (n x) (n y) 14 | -------------------------------------------------------------------------------- /src/Module5/Task9.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task9 where 2 | import Control.Monad (ap) 3 | 4 | -- system code 5 | data SomeType a = This a | That a 6 | deriving Show 7 | 8 | instance Monad SomeType where 9 | return x = This x 10 | (>>=) (This x) f = f x 11 | 12 | instance Applicative SomeType where 13 | pure = return 14 | (<*>) = ap 15 | 16 | -- solution code 17 | instance Functor SomeType where 18 | fmap f x = x >>= return . f 19 | -------------------------------------------------------------------------------- /src/Module5/Task22.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task22 where 2 | import Control.Monad.State (State, get, put, execState) 3 | import Control.Monad (replicateM) 4 | 5 | -- system code 6 | fib :: Int -> Integer 7 | fib n = fst $ execStateN n fibStep (0, 1) 8 | 9 | -- solution code 10 | fibStep :: State (Integer, Integer) () 11 | fibStep = do 12 | (a, b) <- get 13 | put (b, a + b) 14 | 15 | execStateN :: Int -> State s a -> s -> s 16 | execStateN n m = execState (replicateM n m) 17 | -------------------------------------------------------------------------------- /src/Module2/Task6.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task6 where 2 | 3 | -- it's a system part 4 | class Printable a where 5 | toString :: a -> [Char] 6 | 7 | instance Printable Bool where 8 | toString True = "true" 9 | toString False = "false" 10 | 11 | instance Printable () where 12 | toString () = "unit type" 13 | 14 | -- solution starts from here 15 | instance (Printable a, Printable b) => Printable (a, b) where 16 | toString (a, b) = "(" ++ (toString a) ++ "," ++ (toString b) ++ ")" 17 | -------------------------------------------------------------------------------- /src/Module4/Task5.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task5 where 2 | 3 | -- system code 4 | data Result = Fail | Success 5 | data SomeData = ValidData | InvalidData 6 | 7 | doSomeWork :: SomeData -> (Result, Int) 8 | doSomeWork ValidData = (Success, 0) 9 | doSomeWork InvalidData = (Fail, 5) 10 | 11 | -- solution code 12 | processData :: SomeData -> String 13 | processData d = 14 | case doSomeWork d of 15 | (Success, _) -> "Success" 16 | (_, erNo) -> "Fail: " ++ show erNo 17 | -------------------------------------------------------------------------------- /src/Module3/Task16.hs: -------------------------------------------------------------------------------- 1 | module Module3.Task16 where 2 | 3 | data Odd = Odd Integer deriving (Eq, Show) 4 | 5 | instance Enum Odd where 6 | succ (Odd x) = Odd $ x + 2 7 | pred (Odd x) = Odd $ x - 2 8 | toEnum x = Odd $ toInteger x * 2 + 1 9 | fromEnum (Odd x) = quot (fromInteger x - 1) 2 10 | enumFrom = iterate succ 11 | enumFromThen (Odd x) (Odd y) = map Odd [x, y ..] 12 | enumFromTo (Odd x) (Odd y) = map Odd [x, x + 2 .. y] 13 | enumFromThenTo (Odd x) (Odd y) (Odd z) = map Odd [x , y .. z] 14 | -------------------------------------------------------------------------------- /src/Module2/Task7.hs: -------------------------------------------------------------------------------- 1 | module Module2.Task7 where 2 | 3 | class KnownToGork a where 4 | stomp :: a -> a 5 | doesEnrageGork :: a -> Bool 6 | 7 | class KnownToMork a where 8 | stab :: a -> a 9 | doesEnrageMork :: a -> Bool 10 | 11 | class (KnownToGork a, KnownToMork a) => KnownToGorkAndMork a where 12 | stompOrStab :: a -> a 13 | stompOrStab x 14 | | doesEnrageMork x && doesEnrageGork x = stomp (stab x) 15 | | doesEnrageMork x = stomp x 16 | | doesEnrageGork x = stab x 17 | | otherwise = x 18 | -------------------------------------------------------------------------------- /src/Module5/Task11.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task11 where 2 | 3 | -- system code 4 | data Board = Board Int deriving Show 5 | 6 | nextPositions :: Board -> [Board] 7 | nextPositions (Board i) = [Board (i * 10 + 1), Board (i * 10 + 2)] 8 | 9 | -- solution code 10 | nextPositionsN :: Board -> Int -> (Board -> Bool) -> [Board] 11 | nextPositionsN b n pred 12 | | n < 0 = [] 13 | | n == 0 = filter pred [b] 14 | | otherwise = do 15 | move <- nextPositions b 16 | restMoves <- nextPositionsN move (n - 1) pred 17 | return restMoves 18 | -------------------------------------------------------------------------------- /src/Module5/Task18.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task18 where 2 | import Data.Monoid (Sum(..)) 3 | import Control.Monad.Writer (Writer, execWriter, writer) 4 | 5 | -- system code 6 | type Shopping = Writer (Sum Integer) () 7 | 8 | shopping1 :: Shopping 9 | shopping1 = do 10 | purchase "Jeans" 19200 11 | purchase "Water" 180 12 | purchase "Lettuce" 328 13 | 14 | -- solution code 15 | purchase :: String -> Integer -> Shopping 16 | purchase _ cost = writer ((), Sum cost) 17 | 18 | total :: Shopping -> Integer 19 | total = getSum . execWriter 20 | -------------------------------------------------------------------------------- /src/Module5/Task8.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task8 where 2 | import Control.Monad (liftM, ap) 3 | import Module5.Task5 (Log(..)) 4 | import Module5.Task6 (returnLog) 5 | import Module5.Task7 (bindLog) 6 | 7 | -- system code 8 | instance Monad Log where 9 | return = returnLog 10 | (>>=) = bindLog 11 | 12 | instance Functor Log where 13 | fmap = liftM 14 | 15 | instance Applicative Log where 16 | pure = return 17 | (<*>) = ap 18 | 19 | -- solution code 20 | execLoggersList :: a -> [a -> Log a] -> Log a 21 | execLoggersList = foldl (>>=) . return 22 | -------------------------------------------------------------------------------- /src/Module5/Task15.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task15 where 2 | import Control.Monad (ap, liftM) 3 | 4 | -- system code 5 | data Reader r a = Reader { runReader :: (r -> a) } 6 | 7 | instance Monad (Reader r) where 8 | return x = Reader $ \_ -> x 9 | m >>= k = Reader $ \r -> runReader (k (runReader m r)) r 10 | 11 | instance Applicative (Reader m) where 12 | pure = return 13 | (<*>) = ap 14 | 15 | instance Functor (Reader m) where 16 | fmap = liftM 17 | 18 | -- solution code 19 | local' :: (r -> r') -> Reader r' a -> Reader r a 20 | local' f m = Reader $ (runReader m) . f 21 | -------------------------------------------------------------------------------- /Vagrantfile: -------------------------------------------------------------------------------- 1 | Vagrant.configure(2) do |config| 2 | config.vm.box = "ubuntu/wily64" 3 | 4 | config.ssh.forward_agent = true 5 | 6 | config.vm.synced_folder ".", "/vagrant", type: "nfs" 7 | 8 | config.vm.network "private_network", type: "dhcp" 9 | config.vm.network "forwarded_port", guest: 3000, host: 3000 10 | 11 | config.vm.provision "ansible_local" do |ansible| 12 | ansible.playbook = "cm/vagrant.yml" 13 | ansible.verbose = true 14 | end 15 | 16 | config.vm.provider "virtualbox" do |v| 17 | v.memory = 4096 18 | v.cpus = 4 19 | end 20 | end 21 | -------------------------------------------------------------------------------- /src/Module5/Task10.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task10 where 2 | import Data.Char (isDigit) 3 | 4 | -- system code 5 | data Token = Number Int | Plus | Minus | LeftBrace | RightBrace 6 | deriving (Eq, Show) 7 | 8 | -- solution code 9 | asToken :: String -> Maybe Token 10 | asToken x = case x of 11 | [] -> Nothing 12 | "(" -> Just LeftBrace 13 | ")" -> Just RightBrace 14 | "-" -> Just Minus 15 | "+" -> Just Plus 16 | _ | all isDigit x -> Just $ Number $ read x 17 | | otherwise -> Nothing 18 | 19 | tokenize :: String -> Maybe [Token] 20 | tokenize = sequence . (map asToken) . words 21 | -------------------------------------------------------------------------------- /src/Module5/Task23.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task23 where 2 | import Control.Monad.State (State, get, modify', runState, evalState) 3 | import Control.Monad (replicateM) 4 | 5 | -- system code 6 | data Tree a = Leaf a | Fork (Tree a) a (Tree a) deriving Show 7 | 8 | -- solution code 9 | numberTree :: Tree () -> Tree Integer 10 | numberTree tree = evalState (helper tree) 1 where 11 | helper (Leaf _) = do 12 | n <- get 13 | modify' succ 14 | return $ Leaf n 15 | helper (Fork l _ r) = do 16 | l' <- helper l 17 | n <- get 18 | modify' succ 19 | r' <- helper r 20 | return $ Fork l' n r' 21 | -------------------------------------------------------------------------------- /src/Module5/Task19.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task19 where 2 | import Control.Monad.Writer (Writer, execWriter, writer) 3 | 4 | -- system code 5 | shopping1 :: Shopping 6 | shopping1 = do 7 | purchase "Jeans" 19200 8 | purchase "Water" 180 9 | purchase "Lettuce" 328 10 | 11 | -- solution code 12 | type Shopping = Writer ([(String, Integer)]) () 13 | 14 | purchase :: String -> Integer -> Shopping 15 | purchase item price = writer ((), [(item, price)]) 16 | 17 | total :: Shopping -> Integer 18 | total = sum . (map snd) . execWriter 19 | 20 | items :: Shopping -> [String] 21 | items = (map fst) . execWriter 22 | -------------------------------------------------------------------------------- /src/Module4/Task22.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task22 where 2 | 3 | data Nat = Zero | Suc Nat deriving Show 4 | 5 | fromNat :: Nat -> Integer 6 | fromNat Zero = 0 7 | fromNat (Suc n) = fromNat n + 1 8 | 9 | toNat :: Integer -> Nat 10 | toNat 0 = Zero 11 | toNat n = Suc $ toNat $ n - 1 12 | 13 | bin :: (Integer -> Integer -> Integer) -> Nat -> Nat -> Nat 14 | bin f a b = toNat $ f (fromNat a) (fromNat b) 15 | 16 | add :: Nat -> Nat -> Nat 17 | add = bin (+) 18 | 19 | mul :: Nat -> Nat -> Nat 20 | mul = bin (*) 21 | 22 | facI 0 = 1 23 | facI x = x * (facI $ x - 1) 24 | 25 | fac :: Nat -> Nat 26 | fac = bin (const facI) Zero 27 | -------------------------------------------------------------------------------- /src/Module4/Task8.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task8 where 2 | 3 | -- system code 4 | data Result = Fail | Success 5 | data SomeData = ValidData | InvalidData 6 | 7 | doSomeWork :: SomeData -> (Result, Int) 8 | doSomeWork ValidData = (Success, 0) 9 | doSomeWork InvalidData = (Fail, 5) 10 | 11 | -- solution code 12 | data Result' = Fail' Int | Success' 13 | 14 | instance Show Result' where 15 | show Success' = "Success" 16 | show (Fail' erNo) = "Fail: " ++ show erNo 17 | 18 | doSomeWork' :: SomeData -> Result' 19 | doSomeWork' x = 20 | case doSomeWork x of 21 | (Success, _) -> Success' 22 | (_, erNo) -> Fail' erNo 23 | -------------------------------------------------------------------------------- /src/Module5/Task14.hs: -------------------------------------------------------------------------------- 1 | module Module5.Task14 where 2 | import System.Directory (getDirectoryContents, removeFile) 3 | import Data.List (isInfixOf, filter) 4 | import Control.Monad(liftM) 5 | 6 | main' :: IO () 7 | main' = do 8 | putStr $ "Substring: " 9 | pattern <- getLine 10 | if null pattern 11 | then putStrLn "Canceled" 12 | else getFiles pattern >>= mapM_ deleteFile 13 | 14 | getFiles :: String -> IO [FilePath] 15 | getFiles pattern = 16 | liftM (filter (isInfixOf pattern)) $ getDirectoryContents "." 17 | 18 | deleteFile :: FilePath -> IO () 19 | deleteFile path = do 20 | putStrLn $ "Removing file: " ++ path 21 | removeFile path 22 | -------------------------------------------------------------------------------- /src/Module4/Task11.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task11 where 2 | 3 | import Data.Time.Clock 4 | import Data.Time.Format 5 | 6 | timeToString :: UTCTime -> String 7 | timeToString = formatTime defaultTimeLocale "%a %d %T" 8 | 9 | data LogLevel = Error | Warning | Info deriving Show 10 | 11 | data LogEntry = LogEntry { timestamp :: UTCTime, logLevel :: LogLevel, message :: String } 12 | 13 | logLevelToString :: LogLevel -> String 14 | logLevelToString = show 15 | 16 | logEntryToString :: LogEntry -> String 17 | logEntryToString r = 18 | (timeToString $ timestamp r) ++ ": " ++ 19 | (logLevelToString $ logLevel r) ++ ": " ++ 20 | (message r) 21 | -------------------------------------------------------------------------------- /src/Module4/Task25.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task25 where 2 | 3 | infixl 6 :+: 4 | infixl 7 :*: 5 | data Expr = Val Int | Expr :+: Expr | Expr :*: Expr 6 | deriving (Show, Eq) 7 | 8 | expand :: Expr -> Expr 9 | expand ((e1 :+: e2) :*: e) = 10 | expand (expand e1 :*: expand e) :+: 11 | expand (expand e2 :*: expand e) 12 | expand (e :*: (e1 :+: e2)) = 13 | expand (expand e :*: expand e1) :+: 14 | expand (expand e :*: expand e2) 15 | expand (e1 :+: e2) = expand e1 :+: expand e2 16 | expand (e1 :*: e2) = let 17 | ee1 = expand e1 18 | ee2 = expand e2 19 | in if ee1 == e1 && ee2 == e2 then e1 :*: e2 else expand $ ee1 :*: ee2 20 | expand e = e 21 | -------------------------------------------------------------------------------- /src/Module4/Task29.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task29 where 2 | 3 | import Prelude hiding (lookup) 4 | 5 | class MapLike m where 6 | empty :: m k v 7 | lookup :: Ord k => k -> m k v -> Maybe v 8 | insert :: Ord k => k -> v -> m k v -> m k v 9 | delete :: Ord k => k -> m k v -> m k v 10 | fromList :: Ord k => [(k,v)] -> m k v 11 | fromList [] = empty 12 | fromList ((k,v):xs) = insert k v (fromList xs) 13 | 14 | newtype ArrowMap k v = ArrowMap { getArrowMap :: k -> Maybe v } 15 | 16 | instance MapLike ArrowMap where 17 | empty = ArrowMap $ const Nothing 18 | lookup key (ArrowMap map) = map key 19 | insert key value (ArrowMap map) = 20 | ArrowMap (\k -> if k == key then Just value else map k) 21 | delete key (ArrowMap map) = 22 | ArrowMap (\k -> if k == key then Nothing else map k) 23 | -------------------------------------------------------------------------------- /src/Module4/Task10.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task10 where 2 | 3 | import Data.List (unfoldr) 4 | 5 | data Bit = Zero | One deriving Show 6 | data Sign = Minus | Plus deriving Show 7 | data Z = Z Sign [Bit] deriving Show 8 | 9 | zToInt (Z Minus bits) = - zToInt (Z Plus bits) 10 | zToInt (Z _ bits) = foldr (\x a -> a * 2 + toInt x) 0 bits where 11 | toInt One = 1 12 | toInt Zero = 0 13 | 14 | intToZ x = (Z (sign x) (toBin $ abs x)) where 15 | sign n = if n < 0 then Minus else Plus 16 | toDigit 0 = Zero 17 | toDigit 1 = One 18 | toBin = unfoldr (\x -> if x > 0 19 | then Just (toDigit $ rem x 2, div x 2) 20 | else Nothing) 21 | 22 | op f a b = intToZ $ f (zToInt a) (zToInt b) 23 | 24 | add :: Z -> Z -> Z 25 | add = op (+) 26 | 27 | mul :: Z -> Z -> Z 28 | mul = op (*) 29 | -------------------------------------------------------------------------------- /cm/vagrant.yml: -------------------------------------------------------------------------------- 1 | - hosts: all 2 | gather_facts: no 3 | vars: 4 | ghc_version: "7.10.3" 5 | 6 | tasks: 7 | - block: 8 | - apt_repository: repo=ppa:hvr/ghc 9 | - apt: name=ghc-{{ghc_version}} 10 | - lineinfile: 11 | dest: /home/vagrant/.bashrc 12 | create: yes 13 | line: export PATH="$HOME/.cabal/bin:/opt/ghc/{{ghc_version}}/bin:$PATH" 14 | become: yes 15 | 16 | - block: 17 | - apt_key: keyserver=keyserver.ubuntu.com id=575159689BEFB442 18 | - apt_repository: repo='deb http://download.fpcomplete.com/ubuntu wily main' 19 | - apt: name=stack 20 | - lineinfile: 21 | dest: /home/vagrant/.bashrc 22 | create: yes 23 | line: export PATH="$HOME/.local/bin:$PATH" 24 | become: yes 25 | 26 | - lineinfile: 27 | dest: /home/vagrant/.bashrc 28 | create: yes 29 | line: cd /vagrant 30 | become: yes 31 | 32 | - apt: name={{item}} 33 | with_items: 34 | - build-essential 35 | - zlib1g-dev 36 | - libmysqlclient-dev 37 | - libpq-dev 38 | become: yes 39 | -------------------------------------------------------------------------------- /src/Module4/Task19.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task19 where 2 | 3 | import Data.List.Split (splitOn) 4 | import Text.Read (readMaybe) 5 | 6 | data Error = ParsingError 7 | | IncompleteDataError 8 | | IncorrectDataError String 9 | deriving Show 10 | 11 | data Person = Person { 12 | firstName :: String, 13 | lastName :: String, 14 | age :: Int } deriving Show 15 | 16 | parsePerson :: String -> Either Error Person 17 | parsePerson str = let 18 | fields = map (splitOn " = ") $ splitOn "\n" str 19 | 20 | isInvalid [k,(v:vs)] = False 21 | isInvalid _ = True 22 | 23 | parse | any isInvalid fields = Left ParsingError 24 | | otherwise = checkCompletness 25 | 26 | pairs = map (\[key, value] -> (key, value)) fields 27 | value key = lookup key pairs 28 | 29 | checkCompletness = case (value "firstName", value "lastName", value "age") of 30 | (Just f, Just l, Just a) -> checkData (f, l, a) 31 | _ -> Left IncompleteDataError 32 | 33 | checkData (f, l, a) = case readMaybe a :: Maybe Int of 34 | (Just a) -> Right (Person f l a) 35 | _ -> Left (IncorrectDataError a) 36 | in parse 37 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by stack init 2 | # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/ 3 | 4 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 5 | resolver: lts-5.6 6 | 7 | # Local packages, usually specified by relative directory name 8 | packages: 9 | - '.' 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: [] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: {} 15 | 16 | # Extra package databases containing global packages 17 | extra-package-dbs: [] 18 | 19 | # Control whether we use the GHC we find on the path 20 | # system-ghc: true 21 | 22 | # Require a specific version of stack, using version ranges 23 | # require-stack-version: -any # Default 24 | # require-stack-version: >= 1.0.0 25 | 26 | # Override the architecture used by stack, especially useful on Windows 27 | # arch: i386 28 | # arch: x86_64 29 | 30 | # Extra directories used by stack for building 31 | # extra-include-dirs: [/path/to/dir] 32 | # extra-lib-dirs: [/path/to/dir] 33 | 34 | # Allow a newer minor version of GHC than the snapshot specifies 35 | # compiler-check: newer-minor 36 | -------------------------------------------------------------------------------- /src/Module4/Task28.hs: -------------------------------------------------------------------------------- 1 | module Module4.Task28 where 2 | 3 | import Prelude hiding (lookup) 4 | import qualified Data.List as L 5 | 6 | class MapLike m where 7 | empty :: m k v 8 | lookup :: Ord k => k -> m k v -> Maybe v 9 | insert :: Ord k => k -> v -> m k v -> m k v 10 | delete :: Ord k => k -> m k v -> m k v 11 | fromList :: Ord k => [(k,v)] -> m k v 12 | fromList [] = empty 13 | fromList ((k,v):xs) = insert k v (fromList xs) 14 | 15 | newtype ListMap k v = ListMap { getListMap :: [(k,v)] } 16 | deriving (Eq,Show) 17 | 18 | instance MapLike ListMap where 19 | empty = ListMap [] 20 | lookup _ (ListMap []) = Nothing 21 | lookup key (ListMap ((k,v):xs)) 22 | | k == key = Just v 23 | | otherwise = lookup key (ListMap xs) 24 | insert key newValue (ListMap []) = ListMap [(key, newValue)] 25 | insert key newValue (ListMap ((k,v):xs)) 26 | | k == key = ListMap ((k,newValue):xs) 27 | | otherwise = let 28 | (ListMap t) = insert key newValue (ListMap xs) 29 | in ListMap ((k,v):t) 30 | delete key l@(ListMap []) = l 31 | delete key (ListMap ((k,v):xs)) 32 | | k == key = ListMap xs 33 | | otherwise = let 34 | (ListMap t) = delete key (ListMap xs) 35 | in ListMap ((k,v):t) 36 | -------------------------------------------------------------------------------- /stepic-haskell.cabal: -------------------------------------------------------------------------------- 1 | name: stepic-haskell 2 | version: 0.1.0.0 3 | synopsis: Initial project template from stack 4 | description: Please see README.md 5 | homepage: http://github.com/dstarcev/stepic-haskell#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Dmitriy Startsev 9 | maintainer: starcev.da@gmail.com 10 | copyright: 2016 Dmitriy Startsev 11 | category: Learning 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Lib 19 | build-depends: base >= 4.7 && < 5 20 | , time 21 | , split 22 | , directory 23 | , mtl 24 | default-language: Haskell2010 25 | 26 | test-suite stepic-haskell-test 27 | type: exitcode-stdio-1.0 28 | hs-source-dirs: test 29 | main-is: Spec.hs 30 | build-depends: base 31 | , stepic-haskell 32 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 33 | default-language: Haskell2010 34 | 35 | source-repository head 36 | type: git 37 | location: https://github.com/dstarcev/stepic-haskell 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2016 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. --------------------------------------------------------------------------------