Created
April 8, 2015 18:40
-
-
Save singpolyma/147ccc0e7c8d56f9863e to your computer and use it in GitHub Desktop.
TDD add exercise (complete)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module TDD (add, ArgumentError(..)) where | |
import Data.Either | |
import Data.Monoid | |
import qualified Data.Text as T | |
newtype ArgumentError = ArgumentError [Integer] deriving (Show, Eq) | |
instance Monoid ArgumentError where | |
mempty = ArgumentError [] | |
(ArgumentError xs) `mappend` (ArgumentError ys) = ArgumentError (xs ++ ys) | |
add :: String -> Maybe Char -> Either ArgumentError Integer | |
add s customDelim | |
| null errors = Right $ sum $ rights parses | |
| otherwise = Left $ mconcat errors | |
where | |
errors = lefts parses | |
parses = map nonNegativeGuard $ filter (<=1000) $ map toI $ | |
T.split (\d -> d == ',' || d == '\n' || Just d == customDelim) (T.pack s) | |
nonNegativeGuard :: Integer -> Either ArgumentError Integer | |
nonNegativeGuard i | |
| i < 0 = Left $ ArgumentError [i] | |
| otherwise = Right i | |
toI :: T.Text -> Integer | |
toI s | |
| ((n, _) : _) <- reads (T.unpack s) = n | |
| otherwise = 0 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE GeneralizedNewtypeDeriving #-} | |
module Main (main) where | |
import Control.Applicative | |
import Test.Framework (defaultMain, testGroup, Test) | |
import Test.Framework.Providers.HUnit | |
import Test.Framework.Providers.QuickCheck2 | |
import Test.QuickCheck | |
import Test.HUnit hiding (Test) | |
import Data.List (intercalate) | |
import qualified TDD | |
testDecode1 :: Assertion | |
testDecode1 = assertEqual "for 1" (Right 1) (TDD.add "1" Nothing) | |
newtype SmallerThan1001 = SmallerThan1001 Integer deriving (Show, Eq, Ord, Num) | |
instance Arbitrary SmallerThan1001 where | |
arbitrary = SmallerThan1001 <$> choose (-1000, 1000) | |
propIntegerDecodeLoop :: NonNegative SmallerThan1001 -> Bool | |
propIntegerDecodeLoop (NonNegative (SmallerThan1001 num)) = | |
TDD.add (show num) Nothing == Right num | |
testDecodeEmpty :: Assertion | |
testDecodeEmpty = assertEqual "for empty" (Right 0) (TDD.add "" Nothing) | |
propTwoShouldDecode :: NonNegative SmallerThan1001 -> NonNegative SmallerThan1001 -> Bool | |
propTwoShouldDecode | |
(NonNegative (SmallerThan1001 x)) | |
(NonNegative (SmallerThan1001 y)) = | |
TDD.add (show x ++ "," ++ show y) Nothing == Right (x + y) | |
propSomeShouldDecode :: [NonNegative SmallerThan1001] -> Bool | |
propSomeShouldDecode xs' = | |
TDD.add (intercalate "," (map show xs)) Nothing == Right (sum xs) | |
where | |
xs = map (\(NonNegative (SmallerThan1001 x)) -> x) xs' | |
newtype Delimiter = Delimiter String deriving (Show) | |
instance Arbitrary Delimiter where | |
arbitrary = Delimiter <$> elements [",", "\n"] | |
propSomeShouldDecodeDelim :: NonEmptyList (NonNegative SmallerThan1001, Delimiter) -> Bool | |
propSomeShouldDecodeDelim (NonEmpty xs) = | |
TDD.add (tail $ concat strs) Nothing == Right (sum nums) | |
where | |
strs = map (\(NonNegative (SmallerThan1001 x), Delimiter d) -> d ++ show x) xs | |
nums = map (\(NonNegative (SmallerThan1001 x), _) -> x) xs | |
propNegativeShouldCauseError :: Positive Integer -> Bool | |
propNegativeShouldCauseError (Positive num) = | |
TDD.add (show (-num)) Nothing == Left (TDD.ArgumentError [-num]) | |
propNegativesShouldAllBeReported :: [SmallerThan1001] -> Positive Integer -> Delimiter -> Bool | |
propNegativesShouldAllBeReported xs' (Positive num) (Delimiter d) = | |
TDD.add (intercalate d (map show xs)) Nothing == Left (TDD.ArgumentError negatives) | |
where | |
negatives = filter (<0) xs | |
xs = (-num) : map (\(SmallerThan1001 x) -> x) xs' | |
newtype GreaterThan1000 = GreaterThan1000 Integer deriving (Show) | |
instance Arbitrary GreaterThan1000 where | |
arbitrary = GreaterThan1000 <$> choose (1001,999999999) | |
propIgnoreGreaterThan1000 :: [NonNegative Integer] -> GreaterThan1000 -> Delimiter -> Bool | |
propIgnoreGreaterThan1000 xs' (GreaterThan1000 num) (Delimiter d) = | |
TDD.add (intercalate d (map show xs)) Nothing == Right (sum smalls) | |
where | |
smalls = filter (<=1000) xs | |
xs = num : map (\(NonNegative x) -> x) xs' | |
newtype NonDigitChar = NonDigitChar Char deriving (Show) | |
instance Arbitrary NonDigitChar where | |
arbitrary = NonDigitChar <$> arbitrary `suchThat` (`notElem` ['0'..'9']) | |
propAllowCustomDelim :: NonEmptyList (NonNegative SmallerThan1001, Delimiter) -> NonDigitChar -> Gen Bool | |
propAllowCustomDelim (NonEmpty xs) (NonDigitChar customDelim) = do | |
str <- (tail . concat) <$> strs | |
return (TDD.add str (Just customDelim) == Right (sum nums)) | |
where | |
strs = mapM (\(NonNegative (SmallerThan1001 x), Delimiter d) -> do | |
useD <- elements [d, [customDelim]] | |
return $ useD ++ show x | |
) xs | |
nums = map (\(NonNegative (SmallerThan1001 x), _) -> x) xs | |
tests :: [Test] | |
tests = | |
[ | |
testGroup "One number" [ | |
testCase "\"1\" returns 1" testDecode1, | |
testProperty "Integer should decode" propIntegerDecodeLoop | |
], | |
testGroup "No number" [ | |
testCase "\"\" returns 0" testDecodeEmpty | |
], | |
testGroup "Two numbers" [ | |
testProperty "Two numbers should sum" propTwoShouldDecode | |
], | |
testGroup "Some numbers" [ | |
testProperty "Some numbers should sum" propSomeShouldDecode, | |
testProperty "Some numbers should sum with comma or newline" propSomeShouldDecodeDelim | |
], | |
testGroup "Errors" [ | |
testProperty "Raise ArgumentError on negative" propNegativeShouldCauseError, | |
testProperty "Raise ArgumentError with all present negatives" propNegativesShouldAllBeReported | |
], | |
testGroup "Ignore >1000" [ | |
testProperty "Ignore numbers >1000 from sum" propIgnoreGreaterThan1000 | |
], | |
testGroup "Custom delimiter" [ | |
testProperty "Should allow custom delimiter" propAllowCustomDelim | |
] | |
] | |
main :: IO () | |
main = defaultMain tests |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment