{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}


module Data.ISBN
    ( -- * Introduction
      -- $introduction

      -- * Documentation
      ISBN
      -- $isbn-import
    , renderISBN
      -- * ISBN Validation
    , validateISBN
      -- *** ISBN Validation Errors
    , ISBNValidationError(..)
    , renderISBNValidationError

      -- * Validating only ISBN-10
    , validateISBN10
      -- *** ISBN-13 Validation Errors
    , ISBN10ValidationError
    , renderISBN10ValidationError

      -- * Validating only ISBN-13
    , validateISBN13
      -- *** ISBN-10 Validation Errors
    , ISBN13ValidationError(..)
    , renderISBN13ValidationError

      -- * Conversion between ISBN-10 and ISBN-13
      -- $conversion
    , convertISBN10toISBN13
    , convertISBN13toISBN10
      -- * ISBN Helpers
    , isISBN10
    , isISBN13
      -- * Creating ISBN values without validation
      -- $unsafe
    , unsafeToISBN10
    , unsafeToISBN13
    ) where

import           Data.ISBN.ISBN10
import           Data.ISBN.ISBN13

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

-- $introduction
--
-- This library contains tools for validating and working with
-- [International Standard Book Numbers (ISBNs)](https://en.wikipedia.org/wiki/International_Standard_Book_Number).
-- An ISBN value can be in either the format of a ten digit ISBN-10 or a
-- thirteen digit ISBN-13. This library uses a single 'ISBN' data type with two
-- value constructors to represent ISBN values, so that a single entry point can
-- be used to validate text inputs as either an 'ISBN10', 'ISBN13', or neither.
--
-- For most users, importing only the @Data.ISBN@ module is necessary, as this
-- module re-exports all of the data types and functions necessary for
-- validating, creating, and converting between ISBN values.


------------------------------------

-- $isbn-import
--
-- __NOTE:__ This module does not export the constructors in the @ISBN@ type.
-- For access to the constructors, import the @Data.Types.ISBN@ module.


------------------------------------


-- | Used to safely create 'ISBN' values. Assumes that the 'Data.Text.Text'
-- input is an ISBN-10 or ISBN-13 string, either with or without hyphens.
--
-- Will return either a validated @ISBN@ or an 'ISBNValidationError', which can be
-- rendered as a descriptive string using 'renderISBNValidationError'.
--
-- /Examples:/
--
-- @
-- validateISBN "0345816021"        == Right (ISBN10 "0345816021")
-- validateISBN "0-807-01429-X"     == Right (ISBN10 "080701429X")
-- validateISBN "9780807014295"     == Right (ISBN13 "9780807014295")
-- validateISBN "978-0-306-40615-7" == Right (ISBN13 "9780306406157")
-- validateISBN "0-345-816"         == Left InvalidISBNInputLength
-- validateISBN "X-345-81602-1"     == Left IllegalCharactersInISBN10Body
-- validateISBN "0-345-81602-B"     == Left IllegalCharacterAsISBN10CheckDigit
-- validateISBN "0-345-81602-3"     == Left InvalidISBN10CheckDigit
-- validateISBN "00000000000000"    == Left InvalidISBNInputLength
-- validateISBN "9780807014299"     == Left InvalidISBN13CheckDigit
-- validateISBN "0X00000000000"     == Left IllegalCharactersInISBN13Input
-- @
validateISBN :: Text -> Either ISBNValidationError ISBN
validateISBN :: Text -> Either ISBNValidationError ISBN
validateISBN Text
isbn = do
    let isbn10result :: Either ISBN10ValidationError ISBN
isbn10result = Text -> Either ISBN10ValidationError ISBN
validateISBN10 Text
isbn
        isbn13result :: Either ISBN13ValidationError ISBN
isbn13result = Text -> Either ISBN13ValidationError ISBN
validateISBN13 Text
isbn

    case (Either ISBN10ValidationError ISBN
isbn10result, Either ISBN13ValidationError ISBN
isbn13result) of
        (Right ISBN
isbn10, Either ISBN13ValidationError ISBN
_) ->
            ISBN -> Either ISBNValidationError ISBN
forall a b. b -> Either a b
Right ISBN
isbn10

        (Either ISBN10ValidationError ISBN
_, Right ISBN
isbn13) ->
            ISBN -> Either ISBNValidationError ISBN
forall a b. b -> Either a b
Right ISBN
isbn13

        (Left ISBN10ValidationError
ISBN10InvalidInputLength, Left ISBN13ValidationError
ISBN13InvalidInputLength) ->
            ISBNValidationError -> Either ISBNValidationError ISBN
forall a b. a -> Either a b
Left ISBNValidationError
InvalidISBNInputLength

        (Left ISBN10ValidationError
ISBN10IllegalCharactersInBody, Either ISBN13ValidationError ISBN
_) ->
            ISBNValidationError -> Either ISBNValidationError ISBN
forall a b. a -> Either a b
Left ISBNValidationError
IllegalCharactersInISBN10Body

        (Left ISBN10ValidationError
ISBN10IllegalCharacterAsCheckDigit, Either ISBN13ValidationError ISBN
_) ->
            ISBNValidationError -> Either ISBNValidationError ISBN
forall a b. a -> Either a b
Left ISBNValidationError
IllegalCharacterAsISBN10CheckDigit

        (Either ISBN10ValidationError ISBN
_ , Left ISBN13ValidationError
ISBN13IllegalCharactersInInput) ->
            ISBNValidationError -> Either ISBNValidationError ISBN
forall a b. a -> Either a b
Left ISBNValidationError
IllegalCharactersInISBN13Input

        (Left ISBN10ValidationError
ISBN10InvalidCheckDigit, Either ISBN13ValidationError ISBN
_) ->
            ISBNValidationError -> Either ISBNValidationError ISBN
forall a b. a -> Either a b
Left ISBNValidationError
InvalidISBN10CheckDigit

        (Either ISBN10ValidationError ISBN
_, Left ISBN13ValidationError
ISBN13InvalidCheckDigit) ->
            ISBNValidationError -> Either ISBNValidationError ISBN
forall a b. a -> Either a b
Left ISBNValidationError
InvalidISBN13CheckDigit


-- | Convert an 'ISBN' value to a 'Text' string. Can be used when displaying an
-- ISBN in an application interface or before storing the plain ISBN text values
-- in a database.
--
-- 'ISBN' values created using 'validateISBN', 'validateISBN10', or
-- 'validateISBN13' will never contain hyphens.
--
-- /Examples:/
--
-- @
-- renderISBN (ISBN10 "080701429X")    == "080701429X"
-- renderISBN (ISBN13 "9780060899226") == "9780060899226"
-- @
renderISBN :: ISBN -> Text
renderISBN :: ISBN -> Text
renderISBN (ISBN10 Text
i) = Text
i
renderISBN (ISBN13 Text
i) = Text
i


-- | Possible validation errors resulting from ISBN validation. Can be
-- rendered as a descriptive error message using 'renderISBNValidationError'.
data ISBNValidationError
    = InvalidISBNInputLength             -- ^ The length of the input string is not 10 or 13 characters, not counting hyphens
    | IllegalCharactersInISBN10Body      -- ^ The first nine characters of the ISBN-10 input contain non-numeric characters
    | IllegalCharactersInISBN13Input     -- ^ The ISBN-13 input contains non-numeric characters
    | IllegalCharacterAsISBN10CheckDigit -- ^ The check digit of the ISBN-10 is not a valid character (@0-9@ or @\'X\'@)
    | InvalidISBN10CheckDigit            -- ^ The check digit is not valid for the given ISBN-10
    | InvalidISBN13CheckDigit            -- ^ The check digit is not valid for the given ISBN-13
    deriving (Int -> ISBNValidationError -> ShowS
[ISBNValidationError] -> ShowS
ISBNValidationError -> String
(Int -> ISBNValidationError -> ShowS)
-> (ISBNValidationError -> String)
-> ([ISBNValidationError] -> ShowS)
-> Show ISBNValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ISBNValidationError] -> ShowS
$cshowList :: [ISBNValidationError] -> ShowS
show :: ISBNValidationError -> String
$cshow :: ISBNValidationError -> String
showsPrec :: Int -> ISBNValidationError -> ShowS
$cshowsPrec :: Int -> ISBNValidationError -> ShowS
Show, ISBNValidationError -> ISBNValidationError -> Bool
(ISBNValidationError -> ISBNValidationError -> Bool)
-> (ISBNValidationError -> ISBNValidationError -> Bool)
-> Eq ISBNValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ISBNValidationError -> ISBNValidationError -> Bool
$c/= :: ISBNValidationError -> ISBNValidationError -> Bool
== :: ISBNValidationError -> ISBNValidationError -> Bool
$c== :: ISBNValidationError -> ISBNValidationError -> Bool
Eq)



-- | Convert an 'ISBNValidationError' into a human-friendly error message.
renderISBNValidationError :: ISBNValidationError -> Text
renderISBNValidationError :: ISBNValidationError -> Text
renderISBNValidationError ISBNValidationError
validationError =
    case ISBNValidationError
validationError of
        ISBNValidationError
InvalidISBNInputLength ->
            Text
"An ISBN must be 10 or 13 characters, not counting hyphens"

        ISBNValidationError
IllegalCharactersInISBN10Body ->
            Text
"The first nine non-hyphen characters of an ISBN-10 must all be numbers"

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

        ISBNValidationError
IllegalCharacterAsISBN10CheckDigit ->
            Text
"The last character of an ISBN-10 must be a number or the letter 'X'"

        ISBNValidationError
InvalidISBN10CheckDigit ->
            Text
"The supplied ISBN-10 is not valid"

        ISBNValidationError
InvalidISBN13CheckDigit ->
            Text
"The supplied ISBN-13 is not valid"




-- $conversion
--
-- ISBN values can be converted from ISBN-10 to ISBN-13 and vise versa.


-- | Convert an ISBN-10 to an ISBN-13. Since all ISBN-10s can be converted to
-- ISBN-13s, this operation cannot fail.
--
-- /Example:/
--
-- @
-- convertISBN10toISBN13 (unsafeToISBN10 "0060899220") == ISBN13 "9780060899226"
-- @
convertISBN10toISBN13 :: ISBN -> ISBN
convertISBN10toISBN13 :: ISBN -> ISBN
convertISBN10toISBN13 ISBN
isbn10 =
    Text -> ISBN
unsafeToISBN13 (Text -> ISBN) -> Text -> ISBN
forall a b. (a -> b) -> a -> b
$ Text
isbn13Body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
isbn13CheckDigit
      where
        isbn13CheckDigit :: Text
isbn13CheckDigit = Char -> Text
Text.singleton (Char -> Text) -> (Int -> Char) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
numericValueToISBN13Char (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Int
calculateISBN13CheckDigitValue Text
isbn13Body
        isbn13Body :: Text
isbn13Body = Text
"978" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
isbn10Body
        isbn10Body :: Text
isbn10Body = Text -> Text
Text.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ISBN -> Text
renderISBN ISBN
isbn10


-- | Convert an ISBN-13 to an ISBN-10. Since only ISBN-13s starting with '978'
-- can be converted, this operation may fail.
--
-- /Example:/
--
-- @
-- convertISBN13toISBN10 (unsafeToISBN13 "9780060899226") == Just (ISBN10 "0060899220")
-- @
convertISBN13toISBN10 :: ISBN -> Maybe ISBN
convertISBN13toISBN10 :: ISBN -> Maybe ISBN
convertISBN13toISBN10 ISBN
isbn13 = do
    let isbn13Text :: Text
isbn13Text = ISBN -> Text
renderISBN ISBN
isbn13
    Bool -> Maybe () -> Maybe ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
"978" Text -> Text -> Bool
`Text.isPrefixOf` Text
isbn13Text)
        Maybe ()
forall a. Maybe a
Nothing -- "Only ISBN-13s that begin with '978' can be converted to ISBN-10s"

    let isbn10Body :: Text
isbn10Body = Text -> Text
Text.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop Int
3 Text
isbn13Text
        isbn10CheckDigit :: Text
isbn10CheckDigit = Char -> Text
Text.singleton (Char -> Text) -> (Int -> Char) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
numericValueToISBN10Char (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Int
calculateISBN10CheckDigitValue Text
isbn10Body

    ISBN -> Maybe ISBN
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ISBN -> Maybe ISBN) -> ISBN -> Maybe ISBN
forall a b. (a -> b) -> a -> b
$ Text -> ISBN
unsafeToISBN10 (Text -> ISBN) -> Text -> ISBN
forall a b. (a -> b) -> a -> b
$ Text
isbn10Body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
isbn10CheckDigit

-- $unsafe
--
-- In most cases, creating 'ISBN10' and 'ISBN13' values should be performed
-- using the 'validateISBN', 'validateISBN10', or 'validateISBN13' functions,
-- which ensure the ISBN values they produce are valid.
--
-- The functions below allow for the creation of ISBN values without any
-- validation. They should only be used in specific cases. For example, when
-- loading already-validated ISBN values stored in a text column in a database.