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 :: String -> String -> Exceptional String Int
checksum country bban =
(98-) . remainder <$>
mapM intFromAlphaNum bban +++
mapM intFromAlpha country +++ pure [(100,0)]
valid :: String -> Maybe String
valid (country0:country1:sum0:sum1:bban) = Util.processValid $ do
k <-
remainder <$>
mapM intFromAlphaNum bban +++
mapM intFromAlpha [country0,country1] +++
mapM intFromDigit [sum0,sum1]
return (k==1)
valid _ = Just "too few characters"
infixr 5 +++
(+++) :: (Applicative f) => f [a] -> f [a] -> f [a]
(+++) = liftA2 (++)
remainder :: [(Int,Int)] -> Int
remainder = divide 97
divide :: Int -> [(Int,Int)] -> Int
divide divisor = foldl (\r (base,x) -> mod (base*r+x) divisor) 0
intFromDigit :: Char -> Exceptional String (Int,Int)
intFromDigit c = (,) 10 <$> Util.intFromDigit c
intFromAlpha :: Char -> Exceptional String (Int,Int)
intFromAlpha c =
fmap ((,) 100 . (10+)) $
if' (inRange ('a','z') c) (Success $ index ('a','z') c) $
if' (inRange ('A','Z') c) (Success $ index ('A','Z') c) $
throw $ "not a letter: " ++ [c]
intFromAlphaNum :: Char -> Exceptional String (Int,Int)
intFromAlphaNum c =
ME.mapException (const $ "invalid alphanumeric character: " ++ [c]) $
ME.alternative (intFromDigit c) (intFromAlpha c)