Refactor Cheque

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)

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) ++ "\"") $