{- |
Module      :  Luhn
Description :  An implementation of Luhn's check digit algorithm.
Copyright   :  (c) N-Sim Ltd. 2008
License     :  BSD3

Maintainer  :  jhb@n-sim.com
Stability   :  provisional
Portability :  portable

An implementation of Luhn's check digit algorithm.
-}
module Luhn(
    -- * Creating a check digit
    addLuhnDigit,
    -- * Validating a check digit
    checkLuhnDigit,
    -- * QuickCheck tests
    prop_checkLuhn,
    prop_checkSingleError
) where

import Data.Digits
import Test.QuickCheck hiding (total)

-- | Like Python's enumerate function - returns a tuple where the first
--   element is the index from 0 of the second element in the input list.
enumerate :: Integral n => [a] -> [(n, a)]
enumerate :: forall n a. Integral n => [a] -> [(n, a)]
enumerate [a]
xs = n -> [a] -> [(n, a)]
forall {t} {b}. Num t => t -> [b] -> [(t, b)]
enumerate' n
0 [a]
xs
    where
        enumerate' :: t -> [b] -> [(t, b)]
enumerate' t
_ [] = []
        enumerate' t
counter (b
a:[b]
as) =
            (t
counter, b
a) (t, b) -> [(t, b)] -> [(t, b)]
forall a. a -> [a] -> [a]
: t -> [b] -> [(t, b)]
enumerate' (t
counter t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [b]
as

-- | Appends a Luhn check digit to the end of a number.
addLuhnDigit :: Integral n
    => n -- ^ Number to which a Luhn check digit will be appended.
    -> n -- ^ Number with the appended Luhn check digit.
addLuhnDigit :: forall n. Integral n => n -> n
addLuhnDigit n
num = n
num n -> n -> n
forall a. Num a => a -> a -> a
* n
10 n -> n -> n
forall a. Num a => a -> a -> a
+ n
checkDigit
    where
        checkDigit :: n
checkDigit = (n
10 n -> n -> n
forall a. Num a => a -> a -> a
- n
total n -> n -> n
forall a. Integral a => a -> a -> a
`mod` n
10) n -> n -> n
forall a. Integral a => a -> a -> a
`mod` n
10
        total :: n
total = [n] -> n
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([n] -> n) -> [n] -> n
forall a b. (a -> b) -> a -> b
$ [[n]] -> [n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[n]] -> [n]) -> [[n]] -> [n]
forall a b. (a -> b) -> a -> b
$ ((Int, n) -> [n]) -> [(Int, n)] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, n) -> [n]
forall n. Integral n => (Int, n) -> [n]
doubleEven ([n] -> [(Int, n)]
forall n a. Integral n => [a] -> [(n, a)]
enumerate ([n] -> [(Int, n)]) -> [n] -> [(Int, n)]
forall a b. (a -> b) -> a -> b
$ n -> n -> [n]
forall n. Integral n => n -> n -> [n]
digitsRev n
10 n
num)
        doubleEven :: Integral n => (Int, n) -> [n]
        doubleEven :: forall n. Integral n => (Int, n) -> [n]
doubleEven (Int
i, n
n) = if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
i
            then [n
n]
            else n -> n -> [n]
forall n. Integral n => n -> n -> [n]
digitsRev n
10 (n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n
n)

-- | Validates that the Luhn check digit (assumed to be the last/least-
--   significant digit in the number) is correct.
checkLuhnDigit :: Integral n
    => n -- ^ Number with a Luhn check digit as its last digit.
    -> Bool -- ^ Whether or not the check digit is consistent.
checkLuhnDigit :: forall a. Integral a => a -> Bool
checkLuhnDigit n
num = n
total n -> n -> n
forall a. Integral a => a -> a -> a
`mod` n
10 n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0
    where
        total :: n
total = [n] -> n
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([n] -> n) -> [n] -> n
forall a b. (a -> b) -> a -> b
$ [[n]] -> [n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[n]] -> [n]) -> [[n]] -> [n]
forall a b. (a -> b) -> a -> b
$ ((Int, n) -> [n]) -> [(Int, n)] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, n) -> [n]
forall n. Integral n => (Int, n) -> [n]
doubleOdd ([n] -> [(Int, n)]
forall n a. Integral n => [a] -> [(n, a)]
enumerate ([n] -> [(Int, n)]) -> [n] -> [(Int, n)]
forall a b. (a -> b) -> a -> b
$ n -> n -> [n]
forall n. Integral n => n -> n -> [n]
digitsRev n
10 n
num)
        doubleOdd :: Integral n => (Int, n) -> [n]
        doubleOdd :: forall n. Integral n => (Int, n) -> [n]
doubleOdd (Int
i, n
n) = if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
i
            then n -> n -> [n]
forall n. Integral n => n -> n -> [n]
digitsRev n
10 (n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n
n)
            else [n
n]

-- | Validates that a generated check digit validates.
prop_checkLuhn
    :: Integer -- ^ Number to validate a Luhn check digit for.
    -> Property
prop_checkLuhn :: Integer -> Property
prop_checkLuhn Integer
i = Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> (Integer -> Bool
forall a. Integral a => a -> Bool
checkLuhnDigit (Integer -> Bool) -> (Integer -> Integer) -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall n. Integral n => n -> n
addLuhnDigit) Integer
i

-- | Any single number transcription error should result in a failure in
--   the validation of a Luhn check digit. This property validates this.
prop_checkSingleError
    :: Integer -- ^ The number to transcribe.
    -> Integer -- ^ The position to introduce a transcription error.
    -> Integer -- ^ The number to transcribe in place of the original.
    -> Property
prop_checkSingleError :: Integer -> Integer -> Integer -> Property
prop_checkSingleError Integer
i Integer
modDigit Integer
replace = Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
    let checkNum :: Integer
checkNum = Integer -> Integer
forall n. Integral n => n -> n
addLuhnDigit Integer
i
        checkDigits :: [Integer]
checkDigits = Integer -> Integer -> [Integer]
forall n. Integral n => n -> n -> [n]
digits Integer
10 Integer
checkNum
        modDigit' :: Integer
modDigit' = Integer
modDigit Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
checkDigits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        start :: [Integer]
start = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
modDigit') [Integer]
checkDigits
        rest :: [Integer]
rest = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
modDigit' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)) [Integer]
checkDigits
        newDigits :: [Integer]
newDigits = [Integer]
start [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer
replace Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
10] [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer]
rest
        newNum :: Integer
newNum =  Integer -> [Integer] -> Integer
forall n. Integral n => n -> [n] -> n
unDigits Integer
10 [Integer]
newDigits
    in
    (Integer
newNum Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
checkNum) Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Integer -> Bool
forall a. Integral a => a -> Bool
checkLuhnDigit Integer
newNum)