{- |
International Standard Book Number

<https://en.wikipedia.org/wiki/International_Standard_Book_Number>

Covers only ISBN-10. For ISBN-13 simply use "Math.Checksum.EAN".
-}
module Math.Checksum.ISBN (checksum, valid) where

import qualified Math.Checksum.Utility as Util

import qualified Control.Monad.Exception.Synchronous as ME
import Control.Monad.Exception.Synchronous (Exceptional)
import Control.Monad (zipWithM)
import Control.Applicative ((<$>))


{- |
> checksum "346811124" == Success 10
-}
checksum :: String -> Exceptional String Int
checksum :: String -> Exceptional String Int
checksum String
xs = [Int] -> [Int] -> Int
remainder [Int
1..] 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
Util.intFromDigit String
xs

{- |
> valid "346811124X" == Nothing
> valid "3468111240" == Just "check sum does not match"
-}
valid :: String -> Maybe String
valid :: String -> Maybe String
valid String
xs = Exceptional String Bool -> Maybe String
Util.processValid forall a b. (a -> b) -> a -> b
$ do
   [Int]
ds <-
      forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall a. a -> a
id
         (forall a. Int -> a -> [a]
replicate Int
9 (Char -> Exceptional String Int
Util.intFromDigitforall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a. [a] -> [a] -> [a]
++ (Char -> Exceptional String Int
intFromCheckdigitforall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a. a -> [a] -> [a]
:
          [forall e b a. (e -> b) -> (a -> b) -> Exceptional e a -> b
ME.switch
            (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Int
0) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e a. e -> Exceptional e a
ME.throw String
"more than 10 characters")])
         (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return String
xs forall a. [a] -> [a] -> [a]
++ [forall e a. e -> Exceptional e a
ME.throw String
"less than 10 characters"])
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
0 forall a. Eq a => a -> a -> Bool
== [Int] -> [Int] -> Int
remainder [Int]
weights [Int]
ds

intFromCheckdigit :: Char -> Exceptional String Int
intFromCheckdigit :: Char -> Exceptional String Int
intFromCheckdigit Char
'X' = forall (m :: * -> *) a. Monad m => a -> m a
return Int
10
intFromCheckdigit Char
c = Char -> Exceptional String Int
Util.intFromDigit Char
c

remainder :: [Int] -> [Int] -> Int
remainder :: [Int] -> [Int] -> Int
remainder [Int]
ws [Int]
ds = forall a. Integral a => a -> a -> a
mod (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(*) [Int]
ws [Int]
ds)) Int
11

weights :: [Int]
weights :: [Int]
weights = [Int
1..Int
10] forall a. [a] -> [a] -> [a]
++ [-Int
1]