diff --git a/exercises/Mooc/LimitedPrelude.hs b/exercises/Mooc/LimitedPrelude.hs new file mode 100644 index 0000000..15eb1eb --- /dev/null +++ b/exercises/Mooc/LimitedPrelude.hs @@ -0,0 +1 @@ +module Mooc.LimitedPrelude (Int,Integer,Bool(..),Ordering(..),Eq(..),Ord(..),Num(..),Maybe(..),otherwise) where diff --git a/exercises/Mooc/Test.hs b/exercises/Mooc/Test.hs new file mode 100644 index 0000000..303e3af --- /dev/null +++ b/exercises/Mooc/Test.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE CPP, ScopedTypeVariables, TemplateHaskell #-} + +module Mooc.Test where + +import Control.Exception (evaluate,SomeException,fromException) +import Control.Monad +import Data.Foldable +import Data.Functor +import Data.List +import Data.Monoid +import Data.Semigroup +import System.Timeout +import Test.QuickCheck +import Test.QuickCheck.Monadic + +import Mooc.Todo + +-- better assertions + +expectation expected actual = counterexample (" Expected: " ++ show expected ++ "\n Was: " ++ show actual) + +expected ==? actual = expectation expected actual (expected == actual) +actual ?== expected = expected ==? actual + +infix 4 ==? +infix 4 ?== + +actual ?~= expected = expectation expected actual (abs (actual-expected) < 0.01) +expected =~? actual = actual ?~= expected + +infix 4 =~? +infix 4 ?~= + +hasElements expected actual = counterexample (" Expected elements (in any order): " ++ show expected + ++ "\n Was: " ++ show actual) + (sort expected == sort actual) + +was f actual = counterexample (" Was: "++show actual) (f actual) + +-- helpers + +shrinkPositive :: Int -> [Int] +shrinkPositive = map getPositive . shrink . Positive + +forAllShrink_ :: Arbitrary a => Gen a -> (a -> Property) -> Property +forAllShrink_ gen = forAllShrinkBlind gen shrink + +forAll_ :: Arbitrary a => (a -> Property) -> Property +forAll_ = forAllShrink_ arbitrary + +-- timeouts for evaluation + +timedMillis = 500 + +timed val k = monadicIO $ do + res <- run $ timeout (timedMillis*1000) $ evaluate val + case res of + Nothing -> return $ counterexample (" didn't return in "++show timedMillis++"ms") $ False + Just v -> return $ k v + +-- handling TODO excercises + +isTodo :: SomeException -> Bool +isTodo e = case fromException e of Just TODO -> True + _ -> False + +resultIsTodo :: Result -> Bool +resultIsTodo (Failure {theException = (Just e)}) = isTodo e +resultIsTodo _ = False + +-- scoring + +data Outcome = Pass | Fail | Todo deriving (Show, Eq, Ord) + +instance Semigroup Outcome where + (<>) = max + +instance Monoid Outcome where + mempty = Pass + +quietArgs = stdArgs {chatty=False} + +myCheck :: Testable prop => prop -> IO Outcome +myCheck prop = quickCheckWithResult quietArgs prop >>= interpret + where interpret res + | resultIsTodo res = return Todo + | isSuccess res = return Pass + | otherwise = putStrLn (output res) >> return Fail + +histogram vals = [(head xs, length xs) | xs <- group (sort vals)] + +textAttr a s = "\ESC[" ++ a ++ "m" ++ s ++ "\ESC[0m" +textBold = textAttr "1" +textBoldGreen = textAttr "1;32" +textBoldRed = textAttr "1;31" +textBlue = textAttr "34" + +showCheck :: Outcome -> String +showCheck Todo = "_" +showCheck Pass = textBoldGreen "\x2713" +showCheck Fail = textBoldRed "\x2715" + +showOutcome :: Outcome -> String +showOutcome Pass = textBoldGreen "+++++ Pass" +showOutcome Fail = textBoldRed "----- Fail" +showOutcome Todo = textBlue "00000 Todo" + +showExercise :: Int -> String +showExercise i = textBold $ "===== EXERCISE " ++ show i + +showFinal :: [Outcome] -> String +showFinal outs = concatMap showCheck outs ++ "\n" ++ show score ++ " / " ++ show total + where score = length $ filter (==Pass) outs + total = length outs + +type Test = (Int,String,[Property]) + +toJSON :: [(Int,String,Outcome)] -> String +toJSON ts = "[" ++ intercalate "," (map f ts) ++ "]" + where f (i,name,outcome) = "{\"number\":"++show i++",\"name\":"++show name++",\"outcome\":\""++show outcome++"\"}" + +score :: [Test] -> IO () +score tests = do + triples <- forM tests $ \(i,n,ts) -> do + putStrLn $ showExercise i + out <- fold <$> mapM myCheck ts + putStrLn $ showOutcome out + return (i,n,out) + let outcomes = [o | (_,_,o) <- triples] + putStrLn "===== TOTAL" + putStrLn $ showFinal outcomes + writeFile "score.json" $ toJSON triples diff --git a/exercises/Mooc/Th.hs b/exercises/Mooc/Th.hs new file mode 100644 index 0000000..125e9fb --- /dev/null +++ b/exercises/Mooc/Th.hs @@ -0,0 +1,197 @@ +{-# LANGUAGE TemplateHaskell, DeriveLift, StandaloneDeriving #-} + +module Mooc.Th (testing, testing', + isDefined, withDefined, hasType, importsOnly, show', + reifyType, DataType(..), FieldType(..), Constructor(..), + withInstance, withInstance1) +where + +import Data.Char +import Data.List +import Data.Maybe +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +-- testing presence of definitions + +isDefined :: String -> Q Exp +isDefined s = do + mn <- lookupValueName s + let defined = isJust mn + [|counterexample ("You haven't defined '"++s++"' yet!") defined|] + +varOrCon :: Name -> Q Exp +varOrCon n@(Name (OccName s) _) + | isUpper (head s) = return $ ConE n + | otherwise = return $ VarE n + +withDefined :: String -> Q Exp +withDefined s = do + mn <- lookupValueName s + case mn of + Nothing -> [|(\_ -> counterexample ("You haven't defined '"++s++"' yet!") False)|] + Just n -> [|(\f -> f $(varOrCon n))|] + +getType :: String -> Q (Maybe Type) +getType s = do + mn <- lookupValueName s + case mn of Nothing -> return Nothing + Just n -> do i <- reify n + case i of VarI _ typ _ -> return (Just typ) + DataConI _ typ _ -> return (Just typ) + _ -> return Nothing + +showType :: Type -> String +showType (ConT name) = nameBase name +showType (AppT (AppT ArrowT arg) typ) = showType arg ++ " -> " ++ showType typ +showType (AppT ListT typ) = "[" ++ showType typ ++ "]" +showType t = show t +-- TODO: more cases as needed + +hasType :: String -> Q Type -> Q Exp +hasType s qtyp = do + mt <- getType s + typ <- qtyp + let correct = mt == Just typ + let expected = showType typ + let actual = case mt of Nothing -> "nothing" + Just t -> showType t + if correct + then [|\k -> counterexample s (k $(varOrCon $ mkName s))|] + else [|\k -> counterexample ("The type of '"++s++"'\n Expected: "++expected++"\n Was: "++actual) False|] + +-- testing types + +data FieldType = SimpleType String | WeirdType + deriving (Eq,Show,Lift) + +interpretFieldType (ConT n) = SimpleType $ nameBase n +interpretFieldType (VarT n) = SimpleType $ nameBase n +interpretFieldType (AppT t1 t2) = + case (interpretFieldType t1, interpretFieldType t2) of + (SimpleType s1, SimpleType s2) -> SimpleType $ s1 ++ " " ++ s2 + _ -> WeirdType +interpretFieldType _ = WeirdType + +data Constructor = Constructor String [FieldType] | Weird String + deriving (Eq,Show,Lift) + +interpretConstructor (NormalC n bts) = Constructor (nameBase n) args + where (_,typs) = unzip bts + args = map interpretFieldType typs +interpretConstructor c = Weird (constructorName c) + +data DataType = DataType [String] [Constructor] + deriving (Eq,Show,Lift) + +reifyType :: String -> Q Exp +reifyType s = do + n <- lookupTypeName s + case n of + Nothing -> [|\k -> counterexample ("Type "++s++" not defined!") False|] + Just n -> do info <- reify n + case info of + TyConI (DataD _ _ vs _ cs _) -> let cons = map interpretConstructor cs + vars = map bndrName vs + in [|\k -> counterexample ("The type "++s) $ k (DataType vars cons)|] + _ -> [|\k -> counterexample ("Definition "++s++" is not a data declaration!") False|] + +bndrName (PlainTV n) = nameBase n +bndrName (KindedTV n _) = nameBase n + +constructorName = nameBase . constructorName' + +constructorName' :: Con -> Name +constructorName' c = case c of + NormalC n _ -> n + RecC n _ -> n + InfixC _ n _ -> n + ForallC _ _ c -> constructorName' c + GadtC (n:_) _ _ -> n + RecGadtC (n:_) _ _ -> n + +-- testing classes + +withInstance :: String -> String -> Q Exp -> Q Exp +withInstance cln typn val = do + cl <- lookupTypeName cln + typ <- lookupTypeName typn + case (cl,typ) of + (Nothing,_) -> [|\k -> counterexample ("Class "++cln++" not found") (property False)|] + (_,Nothing) -> [|\k -> counterexample ("Type "++typn++" not found") (property False)|] + (Just c, Just t) -> do b <- isInstance c [(ConT t)] + if b + then [|\k -> k $val|] + else [|\k -> counterexample ("Type "++typn++" is not an instance of class "++cln) (property False)|] + +lookupConstructor :: String -> Q (Maybe Type) +lookupConstructor "[]" = return (Just ListT) +lookupConstructor x = (fmap.fmap) ConT $ lookupTypeName x + +withInstance1 :: String -> String -> Q Exp -> Q Exp +withInstance1 cln typn val = do + cl <- lookupTypeName cln + cons <- lookupConstructor typn + case (cl,cons) of + (Nothing,_) -> [|\k -> counterexample ("Class "++cln++" not found") (property False)|] + (_,Nothing) -> [|\k -> counterexample ("Type "++typn++" not found") (property False)|] + (Just c, Just t) -> do b <- isInstance c [(AppT t (VarT (mkName "a")))] + if b + then [|\k -> k $val|] + else [|\k -> counterexample ("Type "++typn++" is not an instance of class "++cln) (property False)|] + +-- verbose testing + +data Call = Prefix Name [Exp] | Operator Name Exp Exp + +parseCall :: Exp -> Call +parseCall (VarE name) = Prefix name [] +parseCall (AppE f arg) = Prefix name (args ++ [arg]) + where Prefix name args = parseCall f +parseCall (InfixE (Just l) (VarE op) (Just r)) = Operator op l r +parseCall x = error $ "Unsupported: " ++ show x + +show' v = showsPrec 11 v "" + +showArgs :: Call -> Q Exp +showArgs (Prefix name args) = [|fstring ++ " " ++ intercalate " " $arglist|] + where fstring = nameBase name + arglist = foldr (\arg exp -> [| show' $arg : $exp |]) [| [] |] (map return args) +showArgs (Operator name left right) = [| show' $(return left) ++ " " ++ opstring ++ " " ++ show' $(return right) |] + where opstring = nameBase name + +testing :: Q Exp -> Q Exp +testing call = do + parsed <- fmap parseCall call + [| \k -> counterexample $(showArgs parsed) (k $call) |] + +-- TH pprint prints all names as qualified, let's convert the names to unqualified locals +unqualifyName (Name n _) = Name n NameS + +unqualify :: Exp -> Exp +unqualify (VarE n) = VarE (unqualifyName n) +unqualify (ConE n) = ConE (unqualifyName n) +unqualify (AppE f x) = AppE (unqualify f) (unqualify x) +unqualify (InfixE mleft op mright) = InfixE (fmap unqualify mleft) (unqualify op) (fmap unqualify mright) +unqualify (UInfixE left op right) = UInfixE (unqualify left) (unqualify op) (unqualify right) +unqualify (LitE l) = LitE l +unqualify (TupE exps) = TupE (map unqualify exps) +unqualify (ListE exps) = ListE (map unqualify exps) +unqualify x = error $ "Unsupported: " ++ show x + +testing' :: Q Exp -> Q Exp +testing' call = do + str <- fmap (pprint.unqualify) call + --str <- fmap show call + [| \k -> counterexample str (k $call) |] + +-- checking imports + +importsOnly :: String -> [String] -> Q Exp +importsOnly name allowed = do + (ModuleInfo pkgImports) <- reifyModule (Module (PkgName "main") (ModName name)) + let imports = [nam | (Module _ (ModName nam)) <- pkgImports] + let forbidden = imports \\ allowed + case forbidden of + [] -> [|property True|] + xs -> [|counterexample ("forbidden imports: " ++ show xs) False|] diff --git a/exercises/Mooc/Todo.hs b/exercises/Mooc/Todo.hs new file mode 100644 index 0000000..70f827e --- /dev/null +++ b/exercises/Mooc/Todo.hs @@ -0,0 +1,7 @@ +module Mooc.Todo where + +import Control.Exception (Exception, throw) + +data TODO = TODO deriving Show +instance Exception TODO +todo = throw TODO diff --git a/exercises/Set1.hs b/exercises/Set1.hs new file mode 100644 index 0000000..00a9c80 --- /dev/null +++ b/exercises/Set1.hs @@ -0,0 +1,251 @@ +-- Welcome to the first exercise set of the Haskell Mooc! Edit this +-- file according to the instructions, and check your answers with +-- +-- stack runhaskell Set1Test.hs +-- +-- You can also play around with your answers in GHCi with +-- +-- stack ghci Set1.hs +-- +-- This set contains exercises on +-- * defining functions +-- * basic expressions +-- * pattern matching +-- * recursion + + +module Set1 where + +import Mooc.Todo + +------------------------------------------------------------------------------ +-- Ex 1: define variables one and two. They should have type Int and +-- values 1 and 2, respectively. + + +------------------------------------------------------------------------------ +-- Ex 2: define the function double of type Integer->Integer. Double +-- should take one argument and return it multiplied by two. + +double :: Integer -> Integer +double x = todo + +------------------------------------------------------------------------------ +-- Ex 3: define the function quadruple that uses the function double +-- from the previous exercise to return its argument multiplied by +-- four. + +quadruple :: Integer -> Integer +quadruple x = todo + +------------------------------------------------------------------------------ +-- Ex 4: define the function distance. It should take four arguments of +-- type Double: x1, y1, x2, and y2 and return the (euclidean) distance +-- between points (x1,y1) and (x2,y2). +-- +-- Give distance a type signature, i.e. distance :: something. +-- +-- PS. if you can't remember how the distance is computed, the formula is: +-- square root of ((x distance) squared + (y distance) squared) + +distance = todo + +------------------------------------------------------------------------------ +-- Ex 5: define the function eeny that returns "eeny" for even inputs +-- and "meeny" for odd inputs. +-- +-- Ps. have a look at the built in function "even" + +eeny :: Integer -> String +eeny = todo + +------------------------------------------------------------------------------ +-- Ex 6: here's the function checkPassword from the course material. +-- Modify it so that it accepts two passwords, "swordfish" and +-- "mellon". + +checkPassword :: String -> String +checkPassword password = if password == "swordfish" + then "You're in." + else "ACCESS DENIED!" + +------------------------------------------------------------------------------ +-- Ex 7: A postal service prices packages the following way. +-- Packages that weigh up to 500 grams cost 250 credits. +-- Packages over 500 grams cost 300 credit + 1 credit per gram. +-- Packages over 5000 grams cost a constant 6000 credits. +-- +-- Write a function postagePrice that takes the weight of a package +-- in, and returns the cost in credits. + +postagePrice :: Int -> Int +postagePrice = todo + +------------------------------------------------------------------------------ +-- Ex 8: define a function isZero that returns True if it is given an +-- Integer that is 0, and False otherwise. Give isZero a type signature. +-- +-- Use pattern matching! Don't use comparisons! +-- +-- Ps. remember, the type of booleans in haskell is Bool + +isZero = todo + +------------------------------------------------------------------------------ +-- Ex 9: implement using recursion a function sumTo such that +-- sumTo n +-- computes the sum 1+2+...+n + +sumTo :: Integer -> Integer +sumTo = todo + +------------------------------------------------------------------------------ +-- Ex 10: power n k should compute n to the power k (i.e. n^k) +-- Use recursion. + +power :: Integer -> Integer -> Integer +power = todo + +------------------------------------------------------------------------------ +-- Ex 11: ilog3 n should be the number of times you can divide given +-- number by three (rounding down) before you get 0. +-- +-- For example, ilog3 20 ==> 3 since +-- 20/3 = 6.66 (gets rounded down to 6) +-- 6/3 = 2 +-- 2/3 = 0.666 (gets rounded down to 0) +-- +-- Use recursion to define ilog3. Use the function "div" for integer +-- division. It rounds down for you. +-- +-- More examples: +-- ilog3 2 ==> 1 +-- ilog3 7 ==> 2 + +ilog3 :: Integer -> Integer +ilog3 = todo + +------------------------------------------------------------------------------ +-- Ex 12: compute binomial coefficients using recursion. Binomial +-- coefficients are defined by the following equations: +-- +-- B(n,k) = B(n-1,k) + B(n-1,k-1) +-- B(n,0) = 1 +-- B(0,k) = 0, when k>0 +-- +-- Hint! pattern matching is your friend. + +binomial :: Integer -> Integer -> Integer +binomial = todo + +------------------------------------------------------------------------------ +-- Ex 13: implement the odd factorial function. Odd factorial is like +-- factorial, but it only multiplies odd numbers. +-- +-- Examples: +-- oddFactorial 7 ==> 7*5*3*1 ==> 105 +-- oddFactorial 6 ==> 5*3*1 ==> 15 + +oddFactorial :: Integer -> Integer +oddFactorial = todo + +------------------------------------------------------------------------------ +-- Ex 14: implement the Euclidean Algorithm for finding the greatest +-- common divisor: +-- +-- Given two numbers, a and b, +-- * if one is zero, return the other number +-- * if not, subtract the smaller number from the larger one +-- * replace the larger number with this new number +-- * repeat +-- +-- For example, +-- myGcd 9 12 ==> 3 +-- In this case, the algorithm proceeds like this +-- +-- a b +-- +-- 9 12 +-- 9 (12-9) +-- 9 3 +-- (9-3) 3 +-- 6 3 +-- (6-3) 3 +-- 3 3 +-- (3-3) 3 +-- 0 3 +-- +-- Background reading: +-- * https://en.wikipedia.org/wiki/Euclidean_algorithm + +myGcd :: Integer -> Integer -> Integer +myGcd = todo + +------------------------------------------------------------------------------ +-- Ex 15: Implement the function leftpad which adds space characters +-- to the start of the string until it is long enough. +-- +-- Examples: +-- leftpad "foo" 5 ==> " foo" +-- leftpad "13" 3 ==> " 13" +-- leftpad "xxxxx" 3 ==> "xxxxx" +-- +-- Tips: +-- * you can combine strings with the ++ operator. +-- * you can compute the length of a string with the length function + +leftpad :: String -> Int -> String +leftpad = todo + +------------------------------------------------------------------------------ +-- Ex 16: let's make a countdown for a rocket! Given a number, you +-- should produce a string that says "Ready!", counts down from the +-- number, and then says "Liftoff!". +-- +-- For example, +-- countdown 4 ==> "Ready! 4... 3... 2... 1... Liftoff!" +-- +-- Hints: +-- * you can combine strings with the ++ operator +-- * you can use the show function to convert a number into a string +-- * you'll probably need a recursive helper function + +countdown :: Integer -> String +countdown = todo + +------------------------------------------------------------------------------ +-- Ex 17: implement the function smallestDivisor that returns the +-- smallest number (greater than 1) that divides the given number evenly. +-- +-- That is, when +-- smallestDivisor n ==> k +-- we have +-- n = t*k +-- for some t. +-- +-- Ps. your function doesn't need to work for inputs 0 and 1, but +-- remember this in the next exercise! + +smallestDivisor :: Integer -> Integer +smallestDivisor = todo + +------------------------------------------------------------------------------ +-- Ex 18: implement a function isPrime that checks if the given number +-- is a prime number. Use the function smallestDivisor. +-- +-- Ps. 0 and 1 are not prime numbers + +isPrime :: Integer -> Bool +isPrime = todo + +------------------------------------------------------------------------------ +-- Ex 19: implement a function biggestPrimeAtMost that returns the +-- biggest prime number that is less than or equal to the given +-- number. Use the function isPrime you just defined. +-- +-- Examples: +-- biggestPrimeAtMost 3 ==> 3 +-- biggestPrimeAtMost 10 ==> 7 + +biggestPrimeAtMost :: Integer -> Integer +biggestPrimeAtMost = todo diff --git a/exercises/Set1Test.hs b/exercises/Set1Test.hs new file mode 100644 index 0000000..30c09e1 --- /dev/null +++ b/exercises/Set1Test.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Set1Test where + +import Data.List +import Test.QuickCheck + +import Mooc.Th +import Mooc.Test + +import Set1 + +main = score tests + +tests = [(1,"onetwo",[ex1_one_defined, ex1_one_type + ,ex1_two_defined, ex1_two_type]) + ,(2,"double",[ex2_double]) + ,(3,"quadruple",[ex3_quadruple]) + ,(4,"distance",[property ex4_distance]) + ,(5,"eeny",[property ex5_eeny_even, property ex5_meeny_odd]) + ,(6,"checkPassword",[property ex6_denied, property ex6_accepted]) + ,(7,"postagePrice",[property ex7_corners + ,property ex7_cheap + ,property ex7_medium + ,property ex7_large]) + ,(8,"isZero",[property ex8_isZero_0 + ,property ex8_isZero_positive + ,property ex8_isZero_negative]) + ,(9,"sumTo",[ex9_sumTo]) + ,(10,"power",[ex10_power]) + ,(11,"ilog3",[property ex11_ilog3]) + ,(12,"binomial",[ex12_binomial]) + ,(13,"oddFactorial",[ex13_oddFactorial]) + ,(14,"myGcd",[ex14_myGcd]) + ,(15,"leftpad",[property ex15_leftpad]) + ,(16,"countdown",[ex16_countdown]) + ,(17,"smallestDivisor",[ex17_smallestDivisor_prime, property ex17_smallestDivisor_comp]) + ,(18,"isPrime",[ex18_isPrime]) + ,(19,"biggestPrimeAtMost",[ex19_biggestPrimeAtMost])] + +-- -- -- -- -- -- + +ex1_one_defined = $(isDefined "one") +ex1_two_defined = $(isDefined "two") +ex1_one_type = $(hasType "one" [t|Int|]) (?==1) +ex1_two_type = $(hasType "two" [t|Int|]) (?==2) + +ex2_double = forAll_ $ \x -> $(testing [|double x|]) (?==2*x) + +ex3_quadruple = forAll_ $ \x -> $(testing [|quadruple x|]) (?==4*x) + +ex4_distance = do + (deltax,deltay,dist) <- elements ([(3,4,5),(5,12,13),(8,15,17),(7,24,25)] :: [(Double,Double,Double)]) + x1 <- elements [-5..5] + y1 <- elements [-5..5] + let x2 = x1+deltax + let y2 = y1+deltay + return $ $(testing [|distance x1 x2 y1 y2|]) (dist=~?) + +ex5_eeny_even = forAll_ $ \x -> $(testing [|eeny (2*x)|]) (?=="eeny") +ex5_meeny_odd = forAll_ $ \x -> $(testing [|eeny (2*x+1)|]) (?=="meeny") + +word = listOf1 (choose ('a','z')) +passwords = ["swordfish","mellon"] + +ex6_denied = do + w <- word `suchThat` (\w -> not (elem w passwords)) + return $ $(testing [|checkPassword w|]) (?=="ACCESS DENIED!") + +ex6_accepted = do + w <- elements passwords + return $ $(testing [|checkPassword w|]) (?=="You're in.") + +ex7_corners = + $(testing [|postagePrice 500|]) (?==250) + .&&. + $(testing [|postagePrice 5000|]) (?==5300) + +ex7_cheap = + forAllBlind (choose (0,500)) $ \w -> + $(testing [|postagePrice w|]) (?==250) + +ex7_medium = + forAllBlind (choose (501,5000)) $ \w -> + $(testing [|postagePrice w|]) (?==300+w) + +ex7_large = + forAllBlind (choose (5001,10000)) $ \w -> + $(testing [|postagePrice w|]) (?==6000) + +ex8_isZero_0 = $(testing [|isZero 0|]) (?== True) + +ex8_isZero_positive :: Positive Integer -> Property +ex8_isZero_positive (Positive n) = $(testing [|isZero n|]) (?== False) + +ex8_isZero_negative :: Positive Integer -> Property +ex8_isZero_negative (Positive n) = $(testing [|isZero n|]) (?== False) + +ex9_sumTo = + forAllBlind (elements [1..100]) $ \n -> + $(testing [|sumTo n|]) (?==sum [1..n]) + +ex10_power = + forAllBlind (elements [1..10]) $ \n -> + forAllBlind (elements [1..10]) $ \k -> + $(testing [|power n k|]) (?==n^k) + +ex11_ilog3 (Blind (Positive n)) = + $(testing [|ilog3 n|]) (?== 1 + floor (logBase 3 $ fromIntegral n)) + +ex12_binomial = + forAllBlind (elements [0..10]) $ \n -> + forAllBlind (elements [0..n]) $ \k -> + $(testing [|binomial n k|]) (?== f n `div` (f k * f (n-k))) + where f n = product [1..n] + +ex13_oddFactorial = + forAllBlind (elements [1..15]) $ \n -> + $(testing [|oddFactorial n|]) (?== f n) + where f n = product [1,3..n] + +ex14_myGcd = + forAllBlind (elements [1..max]) $ \x -> + forAllBlind (elements [1..max]) $ \y -> + $(testing [|myGcd x y|]) (?== gcd x y) + where max = 10000 + +ex15_leftpad = + do text <- word + ws <- listOf (return ' ') + let res = ws++text + let len = length res + return $ $(testing [|leftpad text len|]) (?==res) + +ex16_countdown = + forAllBlind (elements [1..20]) $ \n -> + $(testing [|countdown n|]) . was $ \v -> + counterexample "should start with \"Ready!\"" (take 6 v ?== "Ready!") + .&&. + counterexample "should end with \"Liftoff!\"" (reverse (take 8 (reverse v)) ?== "Liftoff!") + .&&. + let cnt = init $ init $ intercalate "... " (map show [n,n-1..0]) + in counterexample ("should contain the string " ++ show cnt) (isInfixOf cnt v) + +primes = go [2..] + where go (x:xs) = x : go (filter (notDivBy x) xs) + notDivBy x y = mod y x /= 0 + +ex17_smallestDivisor_prime = do + forAllBlind (elements $ take 12 primes) $ \p -> + $(testing [|smallestDivisor p|]) (?== p) + +ex17_smallestDivisor_comp = do + k <- (elements . take 10 $ primes) + p <- (elements . take 20 . drop 10 $ primes) + let n = k*p + return $ $(testing [|smallestDivisor n|]) (?== k) + +ex18_isPrime = + forAllBlind (elements [0..max]) $ \n -> + $(testing [|isPrime n|]) (?== elem n primes') + where max = 20 + primes' = takeWhile (<=max) primes + +ex19_biggestPrimeAtMost = + forAllBlind (elements [2..max]) $ \n -> + $(testing [|biggestPrimeAtMost n|]) (?== last (takeWhile (<=n) primes)) + where max = 100 diff --git a/exercises/stack.yaml b/exercises/stack.yaml new file mode 100644 index 0000000..a7df233 --- /dev/null +++ b/exercises/stack.yaml @@ -0,0 +1,2 @@ +resolver: lts-14.9 +install-ghc: true diff --git a/exercises/tests.cabal b/exercises/tests.cabal new file mode 100644 index 0000000..d1f9e34 --- /dev/null +++ b/exercises/tests.cabal @@ -0,0 +1,8 @@ +name: tests +version: 0.0.1 +build-type: Simple +cabal-version: >= 1.10 + +library + build-depends: QuickCheck, hspec, base, template-haskell, generic-random, JuicyPixels + default-language: Haskell2010