From c657dcfbf3fe5bd9bb7329a9fbebab4b1fbef590 Mon Sep 17 00:00:00 2001 From: Abhijit Sarkar Date: Fri, 3 Jan 2025 17:08:59 -0800 Subject: [PATCH] Refactor Cheque --- src/Cheque.hs | 70 +++++++++++++++++++++++++----------- test/ChequeSpec.hs | 90 +++++++++++++++++++++++++++++----------------- 2 files changed, 106 insertions(+), 54 deletions(-) diff --git a/src/Cheque.hs b/src/Cheque.hs index c52fece..8132852 100644 --- a/src/Cheque.hs +++ b/src/Cheque.hs @@ -352,30 +352,15 @@ dollars xs = fmt d "dollar" L.++ " and " L.++ fmt c "cent" words :: Chars -> Chars words xs - | n <= 3 = lessThanThou ys + | (n + k) <= 3 = lessThanThou ys | otherwise = L.unwords (wl :. w :. (if L.isEmpty wr then Nil else wr :. Nil)) where ys = lstrip xs - n = L.length ys - (k, m) = n `divMod` 3 - x = if m == 0 then k - 1 else k - (l, r) = splitAt (n - 3 * x) ys - w = elemAt x illion + ((n, l), (k, r)) = split ys + w = elemAt (k `div` 3) illion wl = words l wr = words r -splitAt :: Int -> List a -> (List a, List a) -splitAt n xs = (L.take n xs, L.drop n xs) - -elemAt :: Int -> List a -> a -elemAt n xs = - case L.drop n xs of - x :. _ -> x - _ -> error "out of range" - -lstrip :: Chars -> Chars -lstrip = L.dropWhile (== '0') - lessThanThou :: Chars -> Chars lessThanThou xs = case ys of @@ -388,9 +373,9 @@ lessThanThou xs = _ -> L.unwords (elemAt (i - 1) units :. "hundred" :. "and" :. lessThanThou r :. Nil) where ys = lstrip xs - (l, r) = splitAt 1 ys - i = Core.digitToInt (elemAt 0 l) - j = Core.digitToInt (elemAt 0 r) + (l, r) = uncons ys + i = Core.digitToInt l + j = Core.digitToInt (head r) parseDecimal :: Chars -> (Chars, Chars) parseDecimal xs = (whole, decimal) @@ -399,3 +384,46 @@ parseDecimal xs = (whole, decimal) digits = L.filter isDigit whole = digits ys decimal = L.take 2 (digits zs L.++ "00") + +type Group a = (Int, List a) + +{- +Split into (prefix, suffix) such that the length +of the suffix is the longest multiple of three. + +Examples: +1001 --> (1, 001) +999999 --> (999, 999) +1000001 --> (1, 000001) +-} +split :: List a -> (Group a, Group a) +split = L.foldRight f ((0, Nil), (0, Nil)) + where + f x ((k, xs), acc@(n, ys)) = + if k == 3 + then ((1, x :. Nil), (n + 3, xs L.++ ys)) + else ((k + 1, x :. xs), acc) + +-- List helper functions. + +lstrip :: Chars -> Chars +lstrip = L.dropWhile (== '0') + +{- +The following are partial functions +that throw an error if the list doesn't +contain the required number of elements. +-} + +elemAt :: Int -> List a -> a +elemAt n xs = + case L.drop n xs of + x :. _ -> x + _ -> error "out of range" + +head :: List a -> a +head = elemAt 0 + +uncons :: List a -> (a, List a) +uncons Nil = error "empty list" +uncons (x :. xs) = (x, xs) diff --git a/test/ChequeSpec.hs b/test/ChequeSpec.hs index d29450e..fb285ed 100644 --- a/test/ChequeSpec.hs +++ b/test/ChequeSpec.hs @@ -1,6 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS -Wno-x-partial #-} +{-# OPTIONS -Wno-incomplete-uni-patterns #-} + module ChequeSpec (spec) where import qualified Cheque as Ch @@ -19,6 +22,60 @@ zipWithIndices xs = zip (L.hlist xs) [0 ..] spec :: Spec spec = do + describe "lstrip" $ do + it "no-op on an empty string" $ + Ch.lstrip "" `shouldBe` "" + it "strips a string that only contains zeros" $ + Ch.lstrip "000" `shouldBe` "" + it "doesn't strip intermediate zeros" $ + Ch.lstrip "a00b" `shouldBe` "a00b" + it "doesn't strip zeros at the right" $ + Ch.lstrip "ab0" `shouldBe` "ab0" + + describe "elemAt" $ do + prop "can't get an element from an empty list" $ + -- We can generate multiple arguments: + -- \(NonNegative (n :: Int)) (xs :: List Integer) -> do + \(NonNegative (n :: Int)) -> + E.evaluate (Ch.elemAt n (Nil :: List Integer)) `shouldThrow` anyErrorCall + prop "gets an element from a non-empty list" $ + \(NonEmpty (xs :: [Int])) -> + -- n is dependent on (length xs), so needs + -- to be generated separately. + forAll (chooseInt (0, L'.length xs - 1)) $ \n -> + Ch.elemAt n (L.listh xs) `shouldBe` xs L'.!! n + + describe "head" $ do + prop "can't get the head an empty list" $ + E.evaluate (Ch.head (Nil :: List Integer)) `shouldThrow` anyErrorCall + + prop "gets the head of a non-empty list" $ + \(NonEmpty (xs :: [Int])) -> + Ch.head (L.listh xs) `shouldBe` L'.head xs + + describe "uncons" $ do + prop "can't decompose an empty list" $ + E.evaluate (Ch.uncons (Nil :: List Integer)) `shouldThrow` anyErrorCall + + prop "decomposes a non-empty list" $ + \(NonEmpty (xs :: [Int])) -> + let (y, ys) = Ch.uncons (L.listh xs) + Just (z, zs) = L'.uncons xs + in (y, L.hlist ys) `shouldBe` (z, zs) + + describe "split" $ do + let xs = + [ ("0", ((1, "0"), (0, ""))), + ("101", ((3, "101"), (0, ""))), + ("1001", ((1, "1"), (3, "001"))), + ("999999", ((3, "999"), (3, "999"))), + ("1000001", ((1, "1"), (6, "000001"))) + ] + + CM.forM_ xs $ \(x, expected) -> do + it ("parses \"" ++ x ++ "\"") $ + Ch.split (L.listh x) `shouldBe` expected + describe "parseDecimal" $ do let xs = [ ("0", ("0", "00")), @@ -41,39 +98,6 @@ spec = do it ("parses \"" ++ x ++ "\"") $ Ch.parseDecimal (L.listh x) `shouldBe` expected - describe "splitAt" $ do - prop "splits empty list into two empty lists" $ - \(NonNegative (n :: Int)) -> - Ch.splitAt n (Nil :: List Integer) `shouldBe` (Nil, Nil) - it "splits singleton list -- index 0" $ - Ch.splitAt 0 (1 :. Nil) `shouldBe` (Nil, 1 :. Nil) - prop "splits singleton list -- positive index" $ - \(Positive (n :: Int)) -> - Ch.splitAt n (1 :. Nil) `shouldBe` (1 :. Nil, Nil) - prop "splits any list -- any index" $ - \(NonNegative (n :: Int)) (xs :: List Integer) -> do - let (ys, zs) = L'.splitAt n (L.hlist xs) - Ch.splitAt n xs `shouldBe` (L.listh ys, L.listh zs) - - describe "elemAt" $ do - prop "can't get an element from an empty list" $ - \(NonNegative (n :: Int)) -> - E.evaluate (Ch.elemAt n (Nil :: List Integer)) `shouldThrow` anyErrorCall - prop "gets an element -- any list -- any index" $ - \(NonEmpty (xs :: [Int])) -> - forAll (chooseInt (0, L'.length xs - 1)) $ \n -> - Ch.elemAt n (L.listh xs) `shouldBe` xs L'.!! n - - describe "lstrip" $ do - it "no-op on an empty string" $ - Ch.lstrip "" `shouldBe` "" - it "strips a string that only contains zeros" $ - Ch.lstrip "000" `shouldBe` "" - it "doesn't strip intermediate zeros" $ - Ch.lstrip "a00b" `shouldBe` "a00b" - it "doesn't strip zeros at the right" $ - Ch.lstrip "ab0" `shouldBe` "ab0" - describe "lessThanThou" $ do CM.forM_ (zipWithIndices Ch.units) $ \(x, i) -> do it ("monetize \"" ++ show (i + 1) ++ "\"") $