Exercise in BigInt addition for Haskell

BigIntAddition.hs

import Data.Int(Int8)
import Data.List(foldl')
import Test.QuickCheck

type Digit = Int8

-- Feedback on a prior version of this code: https://codereview.stackexchange.com/questions/195150/haskell-bigint-addition
-- Run checkAdd to test it with QuickCheck

-- Adds two integer lists.
-- Examples:
-- add [1, 2] [4, 5, 8] == [4, 7, 0]
-- add [9, 8, 9] [1, 3] == [1, 0, 0, 2]
add :: [Digit] -> [Digit] -> [Digit]
add xs ys = toIntList $ addCarries sumWithCarry
  where (paddedXs, paddedYs) = padToSameLength xs ys
        sumWithCarry = zipWith getSumWithCarry paddedXs paddedYs
        -- If the first pair has a carry of one, add that to the list.
        -- This ensures that the resulting list can grow one digit
        -- Combines two digits to their sum and their carry
        getSumWithCarry x y | x + y >= 10 = ((x + y) - 10, 1)
                            | otherwise   = (x + y, 0)

        -- Turn the list of sums with carry into a list of sums
        toIntList [] = []
        toIntList xs@((_,carry):_) | carry > 0 = carry : map fst xs
                                   | otherwise = map fst xs

-- Once we have added two lists like [7, 9, 8] and [2, 1, 4] to a list
-- of sums and carries, [(9, 0), (0, 1), (2, 1)],
-- we want to add the carries: [(9, 1), (1, 0), (2, 0)]
addCarries :: [(Digit, Digit)] -> [(Digit, Digit)]
addCarries [] = []
addCarries xs@((sum, carry):rest) = if carry > 0
                                    -- If the most significant pair has a carry, we prepend the carry
                                    then (carry, 0) : foldr addCarry [] ((sum, 0) : rest)
                                    else foldr addCarry [] xs

  where addCarry :: (Digit, Digit) -> [(Digit, Digit)] -> [(Digit, Digit)]
        -- The rightmost pair. We don't do much since only the pair's left
        -- neighbor will use its carry
        addCarry pair [] = [pair]
        addCarry (sum, carry) pairs@((_, prevCarry):_) =
          sumWithCarry sum carry prevCarry : pairs
          where sumWithCarry sum carry prevCarry | sum + carry + prevCarry >= 10 = ((sum + carry + prevCarry) - 10, 1)
                                                 | otherwise = (sum + carry + prevCarry, 0)

-- Pads two lists of numbers to the same length by prepending zeros to the shorter one
padToSameLength :: (Num a1, Num a2) => [a1] -> [a2] -> ([a1], [a2])
padToSameLength xs ys = (pad xs (-lenDiff), pad ys lenDiff)
  where lenDiff = length xs - length ys
        pad list n = replicate n 0 ++ list

-- Code for testing
fromDigits :: [Digit] -> Integer
fromDigits = foldl' (\a x -> a *10 + x) 0 . map fromIntegral

toDigits :: Integral n => n -> [Digit]
toDigits 0 = []
toDigits n = toDigits quot ++ [fromIntegral rem]
  where (quot, rem) = n `quotRem` 10

prop_digitIdentity1 (NonNegative x) = fromDigits (toDigits x) === x

prop_digitIdentity2 =
    forAll validDigits $ \x ->
      toDigits (fromDigits x) === x
  where
    validDigits = dropWhile (== 0) <$> listOf (choose (0, 9))

checkDigitIdentity1 = quickCheck prop_digitIdentity1
checkDigitIdentity2 = quickCheck prop_digitIdentity2

prop_add (NonNegative x) (NonNegative y) =
  fromDigits ((toDigits x) `add` (toDigits y)) === x + y

checkAdd = quickCheck prop_add