{- |
International Bank Account Number

<https://en.wikipedia.org/wiki/International_Bank_Account_Number>
-}
module Math.Checksum.IBAN (checksum, valid) where

import qualified Math.Checksum.Utility as Util

import qualified Control.Monad.Exception.Synchronous as ME
import Control.Monad.Exception.Synchronous (Exceptional(Success), throw)
import Control.Applicative (Applicative, liftA2, pure, (<$>))

import Data.Ix (inRange, index)
import Data.Bool.HT (if')


{- |
> checksum "DE" "210501700012345678" == Success 68
-}
checksum :: String -> String -> Exceptional String Int
checksum :: String -> String -> Exceptional String Int
checksum String
country String
bban =
   (Int
98forall a. Num a => a -> a -> a
-) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> Int
remainder forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Exceptional String (Int, Int)
intFromAlphaNum String
bban forall (f :: * -> *) a. Applicative f => f [a] -> f [a] -> f [a]
+++
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Exceptional String (Int, Int)
intFromAlpha String
country forall (f :: * -> *) a. Applicative f => f [a] -> f [a] -> f [a]
+++ forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Int
100,Int
0)]

{- |
> valid "DE68210501700012345678" == Nothing
> valid "DE68210501700012345679" == Just "check sum does not match"
-}
valid :: String -> Maybe String
valid :: String -> Maybe String
valid (Char
country0:Char
country1:Char
sum0:Char
sum1:String
bban) = Exceptional String Bool -> Maybe String
Util.processValid forall a b. (a -> b) -> a -> b
$ do
   Int
k <-
      [(Int, Int)] -> Int
remainder forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Exceptional String (Int, Int)
intFromAlphaNum String
bban forall (f :: * -> *) a. Applicative f => f [a] -> f [a] -> f [a]
+++
         forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Exceptional String (Int, Int)
intFromAlpha [Char
country0,Char
country1] forall (f :: * -> *) a. Applicative f => f [a] -> f [a] -> f [a]
+++
         forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Exceptional String (Int, Int)
intFromDigit [Char
sum0,Char
sum1]
   forall (m :: * -> *) a. Monad m => a -> m a
return (Int
kforall a. Eq a => a -> a -> Bool
==Int
1)
valid String
_ = forall a. a -> Maybe a
Just String
"too few characters"

infixr 5 +++

(+++) :: (Applicative f) => f [a] -> f [a] -> f [a]
+++ :: forall (f :: * -> *) a. Applicative f => f [a] -> f [a] -> f [a]
(+++) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. [a] -> [a] -> [a]
(++)

remainder :: [(Int,Int)] -> Int
remainder :: [(Int, Int)] -> Int
remainder = Int -> [(Int, Int)] -> Int
divide Int
97

divide :: Int -> [(Int,Int)] -> Int
divide :: Int -> [(Int, Int)] -> Int
divide Int
divisor = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
r (Int
base,Int
x) -> forall a. Integral a => a -> a -> a
mod (Int
baseforall a. Num a => a -> a -> a
*Int
rforall a. Num a => a -> a -> a
+Int
x) Int
divisor) Int
0

intFromDigit :: Char -> Exceptional String (Int,Int)
intFromDigit :: Char -> Exceptional String (Int, Int)
intFromDigit Char
c = (,) Int
10 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Exceptional String Int
Util.intFromDigit Char
c

intFromAlpha :: Char -> Exceptional String (Int,Int)
intFromAlpha :: Char -> Exceptional String (Int, Int)
intFromAlpha Char
c =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Int
100 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
10forall a. Num a => a -> a -> a
+)) forall a b. (a -> b) -> a -> b
$
   forall a. Bool -> a -> a -> a
if' (forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a',Char
'z') Char
c) (forall e a. a -> Exceptional e a
Success forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> a -> Int
index (Char
'a',Char
'z') Char
c) forall a b. (a -> b) -> a -> b
$
   forall a. Bool -> a -> a -> a
if' (forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'A',Char
'Z') Char
c) (forall e a. a -> Exceptional e a
Success forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> a -> Int
index (Char
'A',Char
'Z') Char
c) forall a b. (a -> b) -> a -> b
$
   forall e a. e -> Exceptional e a
throw forall a b. (a -> b) -> a -> b
$ String
"not a letter: " forall a. [a] -> [a] -> [a]
++ [Char
c]

intFromAlphaNum :: Char -> Exceptional String (Int,Int)
intFromAlphaNum :: Char -> Exceptional String (Int, Int)
intFromAlphaNum Char
c =
   forall e0 e1 a. (e0 -> e1) -> Exceptional e0 a -> Exceptional e1 a
ME.mapException (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ String
"invalid alphanumeric character: " forall a. [a] -> [a] -> [a]
++ [Char
c]) forall a b. (a -> b) -> a -> b
$
      forall e a. Exceptional e a -> Exceptional e a -> Exceptional e a
ME.alternative (Char -> Exceptional String (Int, Int)
intFromDigit Char
c) (Char -> Exceptional String (Int, Int)
intFromAlpha Char
c)