{-# LANGUAGE OverloadedStrings #-}

module Data.ISBN.ISBN13
    ( ISBN(..)
    , validateISBN13
      -- * Validation Errors
    , renderISBN13ValidationError
    , ISBN13ValidationError(..)
      -- * Helpers
    , confirmISBN13CheckDigit
    , calculateISBN13CheckDigitValue
    , numericValueToISBN13Char
    , isISBN13
      -- * Unsafe Coercion
    , unsafeToISBN13
    ) where

import           Control.Monad
import           Data.Char
import           Data.Text       ( Text )
import qualified Data.Text       as Text

import           Data.ISBN.Types ( ISBN (ISBN13) )



-- | Used to safely create 'ISBN13' values represented by the 'ISBN' data type.
-- Assumes that the 'Data.Text.Text' input is an ISBN-13 string, either with or
-- without hyphens.
--
-- Will return either a validated ISBN-13 or an 'ISBN13ValidationError', which can be
-- rendered as a descriptive string using 'renderISBN13ValidationError'.
--
-- /Examples:/
--
-- @
-- validateISBN13 "9780345816023"     == Right (ISBN13 "9780345816023")
-- validateISBN13 "9780807014295"     == Right (ISBN13 "9780807014295")
-- validateISBN13 "9780306406157"     == Right (ISBN13 "9780306406157")
-- validateISBN13 "978-0-306-40615-7" == Right (ISBN13 "9780306406157")
-- validateISBN13 "9780345816029"     == Left ISBN13InvalidCheckDigit
-- validateISBN13 "9780807014299"     == Left ISBN13InvalidCheckDigit
-- validateISBN13 "00000000000000"    == Left ISBN13InvalidInputLength
-- validateISBN13 "0X00000000000"     == Left ISBN13IllegalCharactersInInput
-- @
validateISBN13 :: Text -> Either ISBN13ValidationError ISBN
validateISBN13 :: Text -> Either ISBN13ValidationError ISBN
validateISBN13 Text
input = do
    -- Make a copy of the text input before further manipulation to prevent
    -- space leaks if input text is a slice of a larger string
    let inputWithoutHyphens :: Text
inputWithoutHyphens = (Char -> Bool) -> Text -> Text
Text.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.copy Text
input

    Bool
-> Either ISBN13ValidationError ()
-> Either ISBN13ValidationError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Int
Text.length Text
inputWithoutHyphens Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
13) (Either ISBN13ValidationError ()
 -> Either ISBN13ValidationError ())
-> Either ISBN13ValidationError ()
-> Either ISBN13ValidationError ()
forall a b. (a -> b) -> a -> b
$
        ISBN13ValidationError -> Either ISBN13ValidationError ()
forall a b. a -> Either a b
Left ISBN13ValidationError
ISBN13InvalidInputLength

    let illegalCharacters :: Text
illegalCharacters = (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNumericCharacter) Text
inputWithoutHyphens

    Bool
-> Either ISBN13ValidationError ()
-> Either ISBN13ValidationError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Int
Text.length Text
illegalCharacters Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Either ISBN13ValidationError ()
 -> Either ISBN13ValidationError ())
-> Either ISBN13ValidationError ()
-> Either ISBN13ValidationError ()
forall a b. (a -> b) -> a -> b
$
        ISBN13ValidationError -> Either ISBN13ValidationError ()
forall a b. a -> Either a b
Left ISBN13ValidationError
ISBN13IllegalCharactersInInput

    Bool
-> Either ISBN13ValidationError ()
-> Either ISBN13ValidationError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
confirmISBN13CheckDigit Text
inputWithoutHyphens) (Either ISBN13ValidationError ()
 -> Either ISBN13ValidationError ())
-> Either ISBN13ValidationError ()
-> Either ISBN13ValidationError ()
forall a b. (a -> b) -> a -> b
$
        ISBN13ValidationError -> Either ISBN13ValidationError ()
forall a b. a -> Either a b
Left ISBN13ValidationError
ISBN13InvalidCheckDigit

    ISBN -> Either ISBN13ValidationError ISBN
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ISBN -> Either ISBN13ValidationError ISBN)
-> ISBN -> Either ISBN13ValidationError ISBN
forall a b. (a -> b) -> a -> b
$ Text -> ISBN
ISBN13 Text
inputWithoutHyphens



-- | Possible validation errors resulting from ISBN-13 validation.
data ISBN13ValidationError
    = ISBN13InvalidInputLength       -- ^ The length of the input string is not 13 characters, not counting hyphens
    | ISBN13IllegalCharactersInInput -- ^ The ISBN-13 input contains non-numeric characters
    | ISBN13InvalidCheckDigit        -- ^ The check digit is not valid for the given ISBN-13
    deriving (Int -> ISBN13ValidationError -> ShowS
[ISBN13ValidationError] -> ShowS
ISBN13ValidationError -> String
(Int -> ISBN13ValidationError -> ShowS)
-> (ISBN13ValidationError -> String)
-> ([ISBN13ValidationError] -> ShowS)
-> Show ISBN13ValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ISBN13ValidationError] -> ShowS
$cshowList :: [ISBN13ValidationError] -> ShowS
show :: ISBN13ValidationError -> String
$cshow :: ISBN13ValidationError -> String
showsPrec :: Int -> ISBN13ValidationError -> ShowS
$cshowsPrec :: Int -> ISBN13ValidationError -> ShowS
Show, ISBN13ValidationError -> ISBN13ValidationError -> Bool
(ISBN13ValidationError -> ISBN13ValidationError -> Bool)
-> (ISBN13ValidationError -> ISBN13ValidationError -> Bool)
-> Eq ISBN13ValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ISBN13ValidationError -> ISBN13ValidationError -> Bool
$c/= :: ISBN13ValidationError -> ISBN13ValidationError -> Bool
== :: ISBN13ValidationError -> ISBN13ValidationError -> Bool
$c== :: ISBN13ValidationError -> ISBN13ValidationError -> Bool
Eq)

-- | Convert an 'ISBN13ValidationError' into a human-friendly error message.
renderISBN13ValidationError :: ISBN13ValidationError -> Text
renderISBN13ValidationError :: ISBN13ValidationError -> Text
renderISBN13ValidationError ISBN13ValidationError
validationError =
    case ISBN13ValidationError
validationError of
        ISBN13ValidationError
ISBN13InvalidInputLength ->
            Text
"An ISBN-13 must be 13 characters, not counting hyphens"

        ISBN13ValidationError
ISBN13IllegalCharactersInInput ->
            Text
"Every non-hyphen character of an ISBN-13 must be a number"

        ISBN13ValidationError
ISBN13InvalidCheckDigit ->
            Text
"The supplied ISBN-13 is not valid"


-- | Determines whether a character is numeric (e.g. in the range of @0-9@).
isNumericCharacter :: Char -> Bool
isNumericCharacter :: Char -> Bool
isNumericCharacter Char
char = Char
char Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"1234567890" :: String)

-- | Confirms that the check digit of an ISBN-13 is correct. Assumes that the
-- input consists of 12 numeric characters followed by a legal check digit
-- character (@0-9@).
--
-- /Examples:/
--
-- @
-- confirmISBN13CheckDigit "9780306406157" == True
-- confirmISBN13CheckDigit "9780345816029" == False
-- @
confirmISBN13CheckDigit :: Text -> Bool
confirmISBN13CheckDigit :: Text -> Bool
confirmISBN13CheckDigit Text
isbn13 =
    Text -> Int
calculateISBN13CheckDigitValue (Text -> Text
Text.init Text
isbn13) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Int
isbn13CharToNumericValue (Text -> Char
Text.last Text
isbn13)

-- | Calculates an ISBN-13 check digit value using the standard check digit
-- calculation formula. Assumes that the input is 12 numeric characters. The
-- check digit value will be a number from 0 to 9.
--
-- See: <https://en.wikipedia.org/wiki/International_Standard_Book_Number#ISBN-13_check_digit_calculation>
--
-- /Examples:/
--
-- @
-- calculateISBN13CheckDigitValue "978030640615" == 7
-- calculateISBN13CheckDigitValue "978151915024" == 0
-- @
calculateISBN13CheckDigitValue :: Text -> Int
calculateISBN13CheckDigitValue :: Text -> Int
calculateISBN13CheckDigitValue Text
input =
    Int -> String -> Int -> Int
go Int
1 (Text -> String
Text.unpack Text
input) Int
0
      where
        go :: Int -> String -> Int -> Int
go Int
w String
charList Int
acc =
            case String
charList of
              [] -> (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
acc Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10
              Char
c:String
clist -> Int -> String -> Int -> Int
go ((Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) String
clist (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Char -> Int
isbn13CharToNumericValue Char
c)


-- | Converts an ISBN-13 character to a numeric value. Valid input characters
-- include @0-9@ as well as @X@.
isbn13CharToNumericValue :: Char -> Int
isbn13CharToNumericValue :: Char -> Int
isbn13CharToNumericValue = Char -> Int
digitToInt

-- | Converts a numeric value to an ISBN-13 character. Valid input values
-- are the numbers from 0 to 10.
numericValueToISBN13Char :: Int -> Char
numericValueToISBN13Char :: Int -> Char
numericValueToISBN13Char Int
c = Text -> Char
Text.head (Text -> Char) -> Text -> Char
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
c

-- | Determines whether an 'ISBN' value is an ISBN-13.
--
-- /Examples:/
--
-- @
-- isISBN13 (unsafeToISBN10 "0060899220")    == False
-- isISBN13 (unsafeToISBN13 "9780060899226") == True
-- @
--
-- /Since: 1.1.0.0/
isISBN13 :: ISBN -> Bool
isISBN13 :: ISBN -> Bool
isISBN13 (ISBN13 Text
_) = Bool
True
isISBN13 ISBN
_          = Bool
False


-- | Will create an 'ISBN13' value without any validation.
unsafeToISBN13 :: Text -> ISBN
unsafeToISBN13 :: Text -> ISBN
unsafeToISBN13 = Text -> ISBN
ISBN13