TDD add exercise (advanced)

TDD.hs

module TDD (add, ArgumentError(..)) where

import Data.Foldable
import Data.Monoid
import Data.Semigroup (Semigroup(..))
import Data.Validation (AccValidation(..))
import Data.Semigroup.Applicative (Ap(..), getApp)
import qualified Data.Text as T

newtype ArgumentError = ArgumentError [Integer] deriving (Show, Eq)

instance Semigroup ArgumentError where
	(ArgumentError xs) <> (ArgumentError ys) = ArgumentError (xs ++ ys)

accValidationToEither :: AccValidation err a -> Either err a
accValidationToEither (AccFailure x) = Left x
accValidationToEither (AccSuccess x) = Right x

add :: String -> Maybe Char -> Either ArgumentError Integer
add s customDelim =
	accValidationToEither $ fmap getSum $ getApp $
	foldMap (Ap . fmap Sum . nonNegativeGuard) $
	filter (<=1000) $ map toI $
	T.split (\d -> d == ',' || d == '\n' || Just d == customDelim) (T.pack s)

nonNegativeGuard :: Integer -> AccValidation ArgumentError Integer
nonNegativeGuard i
	| i < 0 = AccFailure $ ArgumentError [i]
	| otherwise = AccSuccess i

toI :: T.Text -> Integer
toI s
	| ((n, _) : _) <- reads (T.unpack s) = n
	| otherwise                          = 0

Test.hs

{-# 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