-- | Utilities for international phone numbers
module Data.PhoneNumber.Util
  ( -- * Parsing
    parseNumber
  , ParseMode(..)
  , ErrorType(..)
    -- * Formatting
  , formatNumber
  , PhoneNumberFormat(..)
    -- * Analysis
  , matchNumbers
  , MatchType(..)
  , regionForNumber
  , nationalSignificantNumber
  , isValidNumber
  , numberType
  , PhoneNumberType(..)
  , possibleNumber
  , ValidationResult(..)
  , canBeInternationallyDialed
  , isGeographicalNumber
  , isGeographicalNumberType
  , isAlphaNumber
    -- * Library Support
  , supportedRegions
  , supportedGlobalNetworkCallingCodes
  , supportedCallingCodes
  , supportedTypesForRegion
  , supportedTypesForNonGeoEntity
    -- * 'Region'/'CountryCode' Queries
  , Region(..)
  , NonGeoRegion(..)
  , CountryCode(..)
  , countryCodeForRegion
  , regionForCountryCode
  , regionsForCountryCode
  , isNANPACountry
  , countryMobileToken
  , nddPrefixForRegion
    -- * Miscellaneous
  , truncateTooLongNumber
  , convertAlphaNumber
  , normalizeNumber
  , Normalize(..)
    -- * Re-exports
  , PhoneNumber
  )
  where

import Control.DeepSeq
import Data.ByteString (ByteString)
import Data.Coerce
import Data.Data
import Data.PhoneNumber.Number
import Data.PhoneNumber.Internal.Util hiding (ErrorType(..), PhoneNumberFormat(..))
import qualified Data.PhoneNumber.Internal.Util as I
import qualified Data.Set as S
import GHC.Generics
import GHC.Exts
import GHC.IO

-- | An ISO 3166-1 alpha-2 country code in upper case.
newtype Region = Region ByteString
  deriving newtype (Region -> Region -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq, Eq Region
Region -> Region -> Bool
Region -> Region -> Ordering
Region -> Region -> Region
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Region -> Region -> Region
$cmin :: Region -> Region -> Region
max :: Region -> Region -> Region
$cmax :: Region -> Region -> Region
>= :: Region -> Region -> Bool
$c>= :: Region -> Region -> Bool
> :: Region -> Region -> Bool
$c> :: Region -> Region -> Bool
<= :: Region -> Region -> Bool
$c<= :: Region -> Region -> Bool
< :: Region -> Region -> Bool
$c< :: Region -> Region -> Bool
compare :: Region -> Region -> Ordering
$ccompare :: Region -> Region -> Ordering
Ord, Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Region] -> ShowS
$cshowList :: [Region] -> ShowS
show :: Region -> String
$cshow :: Region -> String
showsPrec :: Int -> Region -> ShowS
$cshowsPrec :: Int -> Region -> ShowS
Show, ReadPrec [Region]
ReadPrec Region
Int -> ReadS Region
ReadS [Region]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Region]
$creadListPrec :: ReadPrec [Region]
readPrec :: ReadPrec Region
$creadPrec :: ReadPrec Region
readList :: ReadS [Region]
$creadList :: ReadS [Region]
readsPrec :: Int -> ReadS Region
$creadsPrec :: Int -> ReadS Region
Read, String -> Region
forall a. (String -> a) -> IsString a
fromString :: String -> Region
$cfromString :: String -> Region
IsString, Region -> ()
forall a. (a -> ()) -> NFData a
rnf :: Region -> ()
$crnf :: Region -> ()
NFData)
  deriving stock (Typeable Region
Region -> DataType
Region -> Constr
(forall b. Data b => b -> b) -> Region -> Region
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Region -> u
forall u. (forall d. Data d => d -> u) -> Region -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Region -> m Region
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Region -> m Region
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Region
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Region -> c Region
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Region)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Region)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Region -> m Region
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Region -> m Region
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Region -> m Region
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Region -> m Region
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Region -> m Region
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Region -> m Region
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Region -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Region -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Region -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Region -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Region -> r
gmapT :: (forall b. Data b => b -> b) -> Region -> Region
$cgmapT :: (forall b. Data b => b -> b) -> Region -> Region
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Region)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Region)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Region)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Region)
dataTypeOf :: Region -> DataType
$cdataTypeOf :: Region -> DataType
toConstr :: Region -> Constr
$ctoConstr :: Region -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Region
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Region
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Region -> c Region
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Region -> c Region
Data, forall x. Rep Region x -> Region
forall x. Region -> Rep Region x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Region x -> Region
$cfrom :: forall x. Region -> Rep Region x
Generic)

-- | A "region" corresponding to non-geographical entities. The library
-- internally uses the UN M.49 code @"001"@ (meaning the world) for this.
data NonGeoRegion = Region001
  deriving stock (NonGeoRegion -> NonGeoRegion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonGeoRegion -> NonGeoRegion -> Bool
$c/= :: NonGeoRegion -> NonGeoRegion -> Bool
== :: NonGeoRegion -> NonGeoRegion -> Bool
$c== :: NonGeoRegion -> NonGeoRegion -> Bool
Eq, Eq NonGeoRegion
NonGeoRegion -> NonGeoRegion -> Bool
NonGeoRegion -> NonGeoRegion -> Ordering
NonGeoRegion -> NonGeoRegion -> NonGeoRegion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NonGeoRegion -> NonGeoRegion -> NonGeoRegion
$cmin :: NonGeoRegion -> NonGeoRegion -> NonGeoRegion
max :: NonGeoRegion -> NonGeoRegion -> NonGeoRegion
$cmax :: NonGeoRegion -> NonGeoRegion -> NonGeoRegion
>= :: NonGeoRegion -> NonGeoRegion -> Bool
$c>= :: NonGeoRegion -> NonGeoRegion -> Bool
> :: NonGeoRegion -> NonGeoRegion -> Bool
$c> :: NonGeoRegion -> NonGeoRegion -> Bool
<= :: NonGeoRegion -> NonGeoRegion -> Bool
$c<= :: NonGeoRegion -> NonGeoRegion -> Bool
< :: NonGeoRegion -> NonGeoRegion -> Bool
$c< :: NonGeoRegion -> NonGeoRegion -> Bool
compare :: NonGeoRegion -> NonGeoRegion -> Ordering
$ccompare :: NonGeoRegion -> NonGeoRegion -> Ordering
Ord, Int -> NonGeoRegion -> ShowS
[NonGeoRegion] -> ShowS
NonGeoRegion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonGeoRegion] -> ShowS
$cshowList :: [NonGeoRegion] -> ShowS
show :: NonGeoRegion -> String
$cshow :: NonGeoRegion -> String
showsPrec :: Int -> NonGeoRegion -> ShowS
$cshowsPrec :: Int -> NonGeoRegion -> ShowS
Show, ReadPrec [NonGeoRegion]
ReadPrec NonGeoRegion
Int -> ReadS NonGeoRegion
ReadS [NonGeoRegion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NonGeoRegion]
$creadListPrec :: ReadPrec [NonGeoRegion]
readPrec :: ReadPrec NonGeoRegion
$creadPrec :: ReadPrec NonGeoRegion
readList :: ReadS [NonGeoRegion]
$creadList :: ReadS [NonGeoRegion]
readsPrec :: Int -> ReadS NonGeoRegion
$creadsPrec :: Int -> ReadS NonGeoRegion
Read, Typeable NonGeoRegion
NonGeoRegion -> DataType
NonGeoRegion -> Constr
(forall b. Data b => b -> b) -> NonGeoRegion -> NonGeoRegion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NonGeoRegion -> u
forall u. (forall d. Data d => d -> u) -> NonGeoRegion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NonGeoRegion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NonGeoRegion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NonGeoRegion -> m NonGeoRegion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NonGeoRegion -> m NonGeoRegion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NonGeoRegion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NonGeoRegion -> c NonGeoRegion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NonGeoRegion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NonGeoRegion)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NonGeoRegion -> m NonGeoRegion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NonGeoRegion -> m NonGeoRegion
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NonGeoRegion -> m NonGeoRegion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NonGeoRegion -> m NonGeoRegion
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NonGeoRegion -> m NonGeoRegion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NonGeoRegion -> m NonGeoRegion
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NonGeoRegion -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NonGeoRegion -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> NonGeoRegion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NonGeoRegion -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NonGeoRegion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NonGeoRegion -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NonGeoRegion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NonGeoRegion -> r
gmapT :: (forall b. Data b => b -> b) -> NonGeoRegion -> NonGeoRegion
$cgmapT :: (forall b. Data b => b -> b) -> NonGeoRegion -> NonGeoRegion
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NonGeoRegion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NonGeoRegion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NonGeoRegion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NonGeoRegion)
dataTypeOf :: NonGeoRegion -> DataType
$cdataTypeOf :: NonGeoRegion -> DataType
toConstr :: NonGeoRegion -> Constr
$ctoConstr :: NonGeoRegion -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NonGeoRegion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NonGeoRegion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NonGeoRegion -> c NonGeoRegion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NonGeoRegion -> c NonGeoRegion
Data, forall x. Rep NonGeoRegion x -> NonGeoRegion
forall x. NonGeoRegion -> Rep NonGeoRegion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonGeoRegion x -> NonGeoRegion
$cfrom :: forall x. NonGeoRegion -> Rep NonGeoRegion x
Generic)
  deriving anyclass (NonGeoRegion -> ()
forall a. (a -> ()) -> NFData a
rnf :: NonGeoRegion -> ()
$crnf :: NonGeoRegion -> ()
NFData)

filter001 :: ByteString -> Either NonGeoRegion Region
filter001 :: ByteString -> Either NonGeoRegion Region
filter001 ByteString
region
  | ByteString
region forall a. Eq a => a -> a -> Bool
== ByteString
"001" = forall a b. a -> Either a b
Left NonGeoRegion
Region001
  | Bool
otherwise = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ByteString -> Region
Region ByteString
region

filter001ZZ :: ByteString -> Maybe (Either NonGeoRegion Region)
filter001ZZ :: ByteString -> Maybe (Either NonGeoRegion Region)
filter001ZZ ByteString
region
  | ByteString
region forall a. Eq a => a -> a -> Bool
== ByteString
"ZZ" = forall a. Maybe a
Nothing
  | ByteString
region forall a. Eq a => a -> a -> Bool
== ByteString
"001" = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left NonGeoRegion
Region001
  | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ByteString -> Region
Region ByteString
region

filter0 :: Int -> Maybe CountryCode
filter0 :: Int -> Maybe CountryCode
filter0 Int
0 = forall a. Maybe a
Nothing
filter0 Int
cc = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> CountryCode
CountryCode Int
cc

-- | All geographical regions the library has metadata for
supportedRegions :: S.Set Region
supportedRegions :: Set Region
supportedRegions = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
  coerce :: forall a b. Coercible a b => a -> b
coerce IO [ByteString]
c_phone_number_util_get_supported_regions

-- | All global network calling codes (country calling codes for
-- non-geographical entities) the library has metadata for
supportedGlobalNetworkCallingCodes :: S.Set CountryCode
supportedGlobalNetworkCallingCodes :: Set CountryCode
supportedGlobalNetworkCallingCodes = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> CountryCode
CountryCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall a b. (a -> b) -> a -> b
$
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    IO [CInt]
c_phone_number_util_get_supported_global_network_calling_codes

-- | All country calling codes the library has metadata for, covering both
-- non-geographical entities (global network calling codes) and those used for
-- geographical entities. This could be used to populate a drop-down box of
-- country calling codes for a phone-number widget, for instance.
supportedCallingCodes :: S.Set CountryCode
supportedCallingCodes :: Set CountryCode
supportedCallingCodes = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> CountryCode
CountryCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall a b. (a -> b) -> a -> b
$
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    IO [CInt]
c_phone_number_util_get_supported_calling_codes

-- | Returns the types for a given region which the library has metadata for.
-- Will not include 'FixedLineOrMobile' (if numbers for this non-geographical
-- entity could be classified as 'FixedLineOrMobile', both 'FixedLine' and
-- 'Mobile' would be present) and 'Unknown'.
--
-- No types will be returned for invalid or unknown region codes.
supportedTypesForRegion :: Region -> S.Set PhoneNumberType
supportedTypesForRegion :: Region -> Set PhoneNumberType
supportedTypesForRegion (Region ByteString
region) = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    ByteString -> IO [PhoneNumberType]
c_phone_number_util_get_supported_types_for_region ByteString
region

-- | Returns the types for a country-code belonging to a non-geographical entity
-- which the library has metadata for. Will not include 'FixedLineOrMobile' (if
-- numbers for this non-geographical entity could be classified as
-- 'FixedLineOrMobile', both 'FixedLine' and 'Mobile' would be present) and
-- 'Unknown'.
--
-- No types will be returned for country calling codes that do not map to a
-- known non-geographical entity.
supportedTypesForNonGeoEntity :: CountryCode -> S.Set PhoneNumberType
supportedTypesForNonGeoEntity :: CountryCode -> Set PhoneNumberType
supportedTypesForNonGeoEntity (CountryCode Int
cc) = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    CInt -> IO [PhoneNumberType]
c_phone_number_util_get_supported_types_for_non_geo_entity forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cc

-- | Returns true if the number is a valid vanity (alpha) number such as
-- @"800 MICROSOFT"@. A valid vanity number will start with at least 3 digits
-- and will have three or more alpha characters. This does not do
-- region-specific checks - to work out if this number is actually valid for a
-- region, you should use 'parseNumber' and 'possibleNumber'/'isValidNumber'.
isAlphaNumber :: ByteString -> Bool
isAlphaNumber :: ByteString -> Bool
isAlphaNumber ByteString
bs = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  ByteString -> IO Bool
c_phone_number_util_is_alpha_number ByteString
bs

-- | Converts all alpha characters in a number to their respective digits on
-- a keypad, but retains existing formatting
convertAlphaNumber :: ByteString -> ByteString
convertAlphaNumber :: ByteString -> ByteString
convertAlphaNumber ByteString
bs = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
  ByteString -> IO ByteString
c_phone_number_util_convert_alpha_characters_in_number ByteString
bs

-- | How 'normalizeNumber' should normalize a phone number
data Normalize
  = Digits -- ^ Convert wide-ascii and arabic-indic numerals to European
      -- numerals, and strip punctuation and alpha characters
  | Dialable -- ^ Strip all characters which are not diallable on a mobile phone
      -- keypad (including all non-ASCII digits)
  deriving stock (Normalize -> Normalize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Normalize -> Normalize -> Bool
$c/= :: Normalize -> Normalize -> Bool
== :: Normalize -> Normalize -> Bool
$c== :: Normalize -> Normalize -> Bool
Eq, Eq Normalize
Normalize -> Normalize -> Bool
Normalize -> Normalize -> Ordering
Normalize -> Normalize -> Normalize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Normalize -> Normalize -> Normalize
$cmin :: Normalize -> Normalize -> Normalize
max :: Normalize -> Normalize -> Normalize
$cmax :: Normalize -> Normalize -> Normalize
>= :: Normalize -> Normalize -> Bool
$c>= :: Normalize -> Normalize -> Bool
> :: Normalize -> Normalize -> Bool
$c> :: Normalize -> Normalize -> Bool
<= :: Normalize -> Normalize -> Bool
$c<= :: Normalize -> Normalize -> Bool
< :: Normalize -> Normalize -> Bool
$c< :: Normalize -> Normalize -> Bool
compare :: Normalize -> Normalize -> Ordering
$ccompare :: Normalize -> Normalize -> Ordering
Ord, Int -> Normalize -> ShowS
[Normalize] -> ShowS
Normalize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Normalize] -> ShowS
$cshowList :: [Normalize] -> ShowS
show :: Normalize -> String
$cshow :: Normalize -> String
showsPrec :: Int -> Normalize -> ShowS
$cshowsPrec :: Int -> Normalize -> ShowS
Show, ReadPrec [Normalize]
ReadPrec Normalize
Int -> ReadS Normalize
ReadS [Normalize]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Normalize]
$creadListPrec :: ReadPrec [Normalize]
readPrec :: ReadPrec Normalize
$creadPrec :: ReadPrec Normalize
readList :: ReadS [Normalize]
$creadList :: ReadS [Normalize]
readsPrec :: Int -> ReadS Normalize
$creadsPrec :: Int -> ReadS Normalize
Read, Typeable Normalize
Normalize -> DataType
Normalize -> Constr
(forall b. Data b => b -> b) -> Normalize -> Normalize
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Normalize -> u
forall u. (forall d. Data d => d -> u) -> Normalize -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Normalize -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Normalize -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Normalize -> m Normalize
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Normalize -> m Normalize
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Normalize
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Normalize -> c Normalize
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Normalize)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Normalize)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Normalize -> m Normalize
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Normalize -> m Normalize
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Normalize -> m Normalize
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Normalize -> m Normalize
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Normalize -> m Normalize
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Normalize -> m Normalize
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Normalize -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Normalize -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Normalize -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Normalize -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Normalize -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Normalize -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Normalize -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Normalize -> r
gmapT :: (forall b. Data b => b -> b) -> Normalize -> Normalize
$cgmapT :: (forall b. Data b => b -> b) -> Normalize -> Normalize
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Normalize)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Normalize)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Normalize)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Normalize)
dataTypeOf :: Normalize -> DataType
$cdataTypeOf :: Normalize -> DataType
toConstr :: Normalize -> Constr
$ctoConstr :: Normalize -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Normalize
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Normalize
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Normalize -> c Normalize
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Normalize -> c Normalize
Data, forall x. Rep Normalize x -> Normalize
forall x. Normalize -> Rep Normalize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Normalize x -> Normalize
$cfrom :: forall x. Normalize -> Rep Normalize x
Generic)
  deriving anyclass (Normalize -> ()
forall a. (a -> ()) -> NFData a
rnf :: Normalize -> ()
$crnf :: Normalize -> ()
NFData)

-- | Normalizes a string of characters representing a phone number. See
-- 'Normalize'.
normalizeNumber :: Normalize -> ByteString -> ByteString
normalizeNumber :: Normalize -> ByteString -> ByteString
normalizeNumber Normalize
Digits ByteString
bs = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
  ByteString -> IO ByteString
c_phone_number_util_normalize_digits_only ByteString
bs
normalizeNumber Normalize
Dialable ByteString
bs = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
  ByteString -> IO ByteString
c_phone_number_util_normalize_dialable_chars_only ByteString
bs

-- | Gets the National Significant Number (NSN) of a phone number. Note an NSN
-- doesn't contain a national prefix or any formatting.
nationalSignificantNumber :: PhoneNumber -> ByteString
nationalSignificantNumber :: PhoneNumber -> ByteString
nationalSignificantNumber PhoneNumber
pn = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> IO ByteString
c_phone_number_util_get_national_significant_number PhoneNumber
pn

-- | Returns the mobile token for the provided country calling code if it has
-- one, otherwise returns an empty string. A mobile token is a number inserted
-- before the area code when dialing a mobile number from that country from
-- abroad.
countryMobileToken :: CountryCode -> ByteString
countryMobileToken :: CountryCode -> ByteString
countryMobileToken (CountryCode Int
cc) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
  CInt -> IO ByteString
c_phone_number_util_get_country_mobile_token forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cc

-- | How 'formatNumber' should format a phone number
data PhoneNumberFormat
  = International -- ^ Consistent with the definition in ITU-T Recommendation
      -- E.123. However we follow local conventions such as using @\'-\'@
      -- instead of whitespace as separators. E.g. @"+41 44 668 1800"@.
  | National -- ^ Consistent with E.123, and also following local conventions
      -- for separators. E.g. @"044 668 1800"@.
  | E164 -- ^ Same as 'International' but with no formatting, e.g.
      -- @"+41446681800"@. See https://en.wikipedia.org/wiki/E.164.
  | RFC3966 -- ^ Same as 'International' but with all separating symbols
      -- replaced with a hyphen, and with any phone number extension appended
      -- with @";ext="@. It will also have a prefix of @"tel:"@ added, e.g.
      -- @"tel:+41-44-668-1800"@.
  | NationalWithCarrierCodeOverride ByteString -- ^ Same as 'National' but
      -- for dialing using the specified domestic carrier code.
  | NationalWithCarrierCodeFallback ByteString -- ^ Same as 'National' but
      -- use the phone number's 'preferredDomesticCarrierCode' (which is only
      -- set if parsed with 'KeepRawInput'). If a preferred carrier code is
      -- absent, the provided string is used as fallback.
  | ForMobileDialing -- ^ Format in such a way that it can be dialed from a
      -- mobile phone in a specific region. If the number cannot be reached from
      -- the region (e.g. some countries block toll-free numbers from being
      -- called outside of the country), will format to an empty string.
    { PhoneNumberFormat -> Region
from :: Region
    , PhoneNumberFormat -> Bool
withFormatting :: Bool -- ^ Whether to strip formatting as in 'E164'.
    }
  | OutOfCountry -- ^ Format for out-of-country dialing purposes. This takes
      -- care of the case of calling inside of NANPA and between Russia and
      -- Kazakhstan (who share the same country calling code). In those cases,
      -- no international prefix is used. For regions which have multiple
      -- international prefixes, formats as 'International'.
    { from :: Region
    , PhoneNumberFormat -> Bool
keepAlphaChars :: Bool -- ^ Attempt to keep alpha chars and grouping
      -- information, if 'rawInput' is available. Setting this to 'True' comes
      -- with a number of caveats:
      --
      -- 1. This will not produce good results if the country calling code is
      -- both present in 'rawInput' /and/ is the start of the national number.
      -- This is not a problem in the regions which typically use alpha numbers.
      --
      -- 2. This will also not produce good results if 'rawInput' has any
      -- grouping information within the first three digits of the national
      -- number, and if the function needs to strip preceding digits/words in
      -- 'rawInput' before these digits. Normally people group the first three
      -- digits together so this is not a huge problem.
    }
  | Original -- ^ Use 'rawInput' verbatim if present, otherwise infer
      -- 'National', 'International', or 'OutOfCountry' based on
      -- 'countryCodeSource'.
    { from :: Region
    }

-- | Formats a phone number in the specified 'PhoneNumberFormat' using default
-- rules. Note that this does not promise to produce a phone number that the
-- user can dial from where they are - as we do not currently support a more
-- abbreviated format, such as for users in the same area who could potentially
-- dial the number without area code.
formatNumber :: PhoneNumberFormat -> PhoneNumber -> ByteString
formatNumber :: PhoneNumberFormat -> PhoneNumber -> ByteString
formatNumber PhoneNumberFormat
fmt PhoneNumber
pn = case PhoneNumberFormat
fmt of
  PhoneNumberFormat
E164 -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> PhoneNumberFormat -> IO ByteString
c_phone_number_util_format PhoneNumber
pn PhoneNumberFormat
I.E164
  PhoneNumberFormat
International -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> PhoneNumberFormat -> IO ByteString
c_phone_number_util_format PhoneNumber
pn PhoneNumberFormat
I.International
  PhoneNumberFormat
National -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> PhoneNumberFormat -> IO ByteString
c_phone_number_util_format PhoneNumber
pn PhoneNumberFormat
I.National
  PhoneNumberFormat
RFC3966 -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> PhoneNumberFormat -> IO ByteString
c_phone_number_util_format PhoneNumber
pn PhoneNumberFormat
I.Rfc3966
  NationalWithCarrierCodeOverride ByteString
cc -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> ByteString -> IO ByteString
c_phone_number_util_format_national_number_with_carrier_code PhoneNumber
pn ByteString
cc
  NationalWithCarrierCodeFallback ByteString
cc -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> ByteString -> IO ByteString
c_phone_number_util_format_national_number_with_preferred_carrier_code PhoneNumber
pn ByteString
cc
  ForMobileDialing (Region ByteString
region) Bool
keepFmt -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> ByteString -> Bool -> IO ByteString
c_phone_number_util_format_number_for_mobile_dialing PhoneNumber
pn ByteString
region Bool
keepFmt
  Original (Region ByteString
region) -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> ByteString -> IO ByteString
c_phone_number_util_format_in_original_format PhoneNumber
pn ByteString
region
  OutOfCountry (Region ByteString
region) Bool
False -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> ByteString -> IO ByteString
c_phone_number_util_format_out_of_country_calling_number PhoneNumber
pn ByteString
region
  OutOfCountry (Region ByteString
region) Bool
True -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> ByteString -> IO ByteString
c_phone_number_util_format_out_of_country_keeping_alpha_chars PhoneNumber
pn ByteString
region

-- | Attempts to extract a valid number from a phone number that is too long to
-- be valid. Returns 'Nothing' if no valid number could be extracted.
truncateTooLongNumber :: PhoneNumber -> Maybe PhoneNumber
truncateTooLongNumber :: PhoneNumber -> Maybe PhoneNumber
truncateTooLongNumber PhoneNumber
pn = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> IO (Maybe PhoneNumber)
c_phone_number_util_truncate_too_long_number PhoneNumber
pn

-- | Gets the phone number type. Returns 'Unknown' if invalid.
numberType :: PhoneNumber -> PhoneNumberType
numberType :: PhoneNumber -> PhoneNumberType
numberType PhoneNumber
pn = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> IO PhoneNumberType
c_phone_number_util_get_number_type PhoneNumber
pn

-- | Tests whether a phone number is valid for a certain region (if unspecified,
-- the region the number is from). Note this doesn't verify the number is
-- actually in use, which is impossible to tell by just looking at a number
-- itself.
--
-- If the country calling code is not the same as the country calling code for
-- the provided region, this immediately returns 'False'. After this, the
-- specific number pattern rules for the region are examined.
--
-- Specifying a region may be useful for determining for example whether a
-- particular number is valid for Canada, rather than just a valid NANPA number.
-- On the other hand this may lead to undesirable results, for example numbers
-- from British Crown dependencies such as the Isle of Man are considered
-- invalid for the region @\"GB\"@ (United Kingdom), since it has its own region
-- code, @\"IM\"@.
--
-- Note that it only verifies whether the parsed, canonicalised number is valid:
-- not whether a particular series of digits entered by the user is dialable
-- from the region provided when parsing. For example, the number
-- @+41 (0) 78 927 2696@ can be parsed into a number with country code @"41"@
-- and National Significant Number @"789272696"@. This is valid, while the
-- original string is not dialable.
isValidNumber :: Maybe (Either NonGeoRegion Region) -> PhoneNumber -> Bool
isValidNumber :: Maybe (Either NonGeoRegion Region) -> PhoneNumber -> Bool
isValidNumber Maybe (Either NonGeoRegion Region)
Nothing PhoneNumber
pn = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> IO Bool
c_phone_number_util_is_valid_number PhoneNumber
pn
isValidNumber (Just (Left NonGeoRegion
Region001)) PhoneNumber
pn = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> ByteString -> IO Bool
c_phone_number_util_is_valid_number_for_region PhoneNumber
pn ByteString
"001"
isValidNumber (Just (Right (Region ByteString
region))) PhoneNumber
pn = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> ByteString -> IO Bool
c_phone_number_util_is_valid_number_for_region PhoneNumber
pn ByteString
region

-- | Returns the region where a phone number is from. This could be used for
-- geocoding at the region level. Only guarantees correct results for valid,
-- full numbers (not short-codes, or invalid numbers).
regionForNumber :: PhoneNumber -> Maybe (Either NonGeoRegion Region)
regionForNumber :: PhoneNumber -> Maybe (Either NonGeoRegion Region)
regionForNumber PhoneNumber
pn = ByteString -> Maybe (Either NonGeoRegion Region)
filter001ZZ forall a b. (a -> b) -> a -> b
$
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    PhoneNumber -> IO ByteString
c_phone_number_util_get_region_code_for_number PhoneNumber
pn

-- | Returns the country calling code for a specific region. For example, this
-- would be @1@ for the United States, and @64@ for New Zealand.
countryCodeForRegion :: Region -> Maybe CountryCode
countryCodeForRegion :: Region -> Maybe CountryCode
countryCodeForRegion (Region ByteString
region) = Int -> Maybe CountryCode
filter0 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    ByteString -> IO CInt
c_phone_number_util_get_country_code_for_region ByteString
region

-- | Returns the region code that matches the specific country code. Note that
-- it is possible that several regions share the same country calling code
-- (e.g. US and Canada), and in that case, only one of the regions (normally the
-- one with the largest population) is returned. If the country calling code
-- entered is valid but doesn't match a specific region (such as in the case of
-- non-geographical calling codes like @800@) @'Region001'@ will be returned.
regionForCountryCode :: CountryCode -> Maybe (Either NonGeoRegion Region)
regionForCountryCode :: CountryCode -> Maybe (Either NonGeoRegion Region)
regionForCountryCode (CountryCode Int
cc) = ByteString -> Maybe (Either NonGeoRegion Region)
filter001ZZ forall a b. (a -> b) -> a -> b
$
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    Int -> IO ByteString
c_phone_number_util_get_region_code_for_country_code forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cc

-- | Returns a list of the region codes that match the specific country calling
-- code. For non-geographical country calling codes, 'Region001' is returned.
-- Also, in the case of no region code being found, the list is empty.
regionsForCountryCode :: CountryCode -> [Either NonGeoRegion Region]
regionsForCountryCode :: CountryCode -> [Either NonGeoRegion Region]
regionsForCountryCode (CountryCode Int
cc) = forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Either NonGeoRegion Region
filter001 forall a b. (a -> b) -> a -> b
$
  forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
    Int -> IO [ByteString]
c_phone_number_util_get_region_codes_for_country_calling_code forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cc

-- | Checks if this is a region under the North American Numbering Plan
-- Administration (NANPA).
isNANPACountry :: Region -> Bool
isNANPACountry :: Region -> Bool
isNANPACountry (Region ByteString
region) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  ByteString -> IO Bool
c_phone_number_util_is_nanpa_country ByteString
region

-- | Returns the National Direct Dialling prefix (NDD prefix) for a specific
-- region. For example, this would be @"1"@ for the United States, and @"0"@ for
-- New Zealand. Note that this may contain symbols like @\'~\'@ (which indicates
-- a wait for a dialing tone). Returns an empty string if no national prefix is
-- present.
nddPrefixForRegion
  :: Bool -- ^ Whether to strip non-digits like @\'~\'@
  -> Region
  -> ByteString
nddPrefixForRegion :: Bool -> Region -> ByteString
nddPrefixForRegion Bool
strip (Region ByteString
region) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
  ByteString -> Bool -> IO ByteString
c_phone_number_util_get_ndd_prefix_for_region ByteString
region Bool
strip

-- | Check whether a phone number is a possible number of a particular type.
-- Pass the type 'Unknown' to check whether a number is possible at all.
--
-- For more specific types that don't exist in a particular region, this will
-- return a result that isn't so useful; it is recommended that you use
-- 'supportedTypesForRegion' or 'supportedTypesForNonGeoEntity' respectively
-- before calling this function to determine you should pass a more specific
-- type instead of 'Unknown'.
--
-- This function provides a more lenient check than 'isValidNumber' in the
-- following sense:
--
-- 1. It only checks the length of phone numbers. In particular, it doesn't
-- check starting digits of the number.
--
-- 2. If 'Unknown' is provided, it doesn't attempt to figure out the type of the
-- number, but uses general rules which apply to all types of phone numbers in a
-- region. Therefore, it is much faster than 'isValidNumber'.
--
-- 3. For some numbers (particularly fixed-line), many regions have the concept
-- of area code, which together with subscriber number constitute the National
-- Significant Number. It is sometimes okay to dial only the subscriber number
-- when dialing in the same area. This function will return
-- 'IsPossibleLocalOnly' if the subscriber-number-only version is passed in. On
-- the other hand, because 'isValidNumber' validates using information on both
-- starting digits (for fixed line numbers, that would most likely be area
-- codes) and length (obviously includes the length of area codes for fixed line
-- numbers), it will return 'False' for the subscriber-number-only version.
possibleNumber :: PhoneNumberType -> PhoneNumber -> ValidationResult
possibleNumber :: PhoneNumberType -> PhoneNumber -> ValidationResult
possibleNumber PhoneNumberType
ntype PhoneNumber
pn = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> PhoneNumberType -> IO ValidationResult
c_phone_number_util_is_possible_number_for_type_with_reason PhoneNumber
pn PhoneNumberType
ntype

-- | Returns 'True' if the number can be dialed from outside the region, or
-- unknown. If the number can only be dialled from within the region, returns
-- 'False'. Does not check the number is a valid number. Note that, at the
-- moment, this method does not handle short numbers (which are currently all
-- presumed to not be diallable from outside their country).
canBeInternationallyDialed :: PhoneNumber -> Bool
canBeInternationallyDialed :: PhoneNumber -> Bool
canBeInternationallyDialed PhoneNumber
pn = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> IO Bool
c_phone_number_util_can_be_internationally_dialed PhoneNumber
pn

-- | Tests whether a phone number has a geographical association. It checks if
-- the number is associated with a certain region in the country to which it
-- belongs. Note that this doesn't verify if the number is actually in use.
isGeographicalNumber :: PhoneNumber -> Bool
isGeographicalNumber :: PhoneNumber -> Bool
isGeographicalNumber PhoneNumber
pn = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> IO Bool
c_phone_number_util_is_number_geographical_1 PhoneNumber
pn

-- | A less expensive version of 'isGeographicalNumber' if we already know the
-- 'PhoneNumberType'
isGeographicalNumberType :: PhoneNumberType -> CountryCode -> Bool
isGeographicalNumberType :: PhoneNumberType -> CountryCode -> Bool
isGeographicalNumberType PhoneNumberType
ntype (CountryCode Int
cc) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumberType -> CInt -> IO Bool
c_phone_number_util_is_number_geographical_2 PhoneNumberType
ntype forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cc

-- | Phone number parsing error
data ErrorType
  = InvalidCountryCodeError -- ^ The number did not contain a country code and
    -- there was no default region supplied, or the number contained an invalid
    -- country code
  | NotANumber -- ^ Does not look like a phone number
  | TooShortAfterIdd -- ^ Input starts with an International Direct Dialing
    -- prefix, but ends too shortly thereafter
  | TooShortNsn -- ^ The National Significant Number is too short
  | TooLongNsn -- ^ The National Significant Number is too long
  deriving stock (ErrorType -> ErrorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorType -> ErrorType -> Bool
$c/= :: ErrorType -> ErrorType -> Bool
== :: ErrorType -> ErrorType -> Bool
$c== :: ErrorType -> ErrorType -> Bool
Eq, Eq ErrorType
ErrorType -> ErrorType -> Bool
ErrorType -> ErrorType -> Ordering
ErrorType -> ErrorType -> ErrorType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorType -> ErrorType -> ErrorType
$cmin :: ErrorType -> ErrorType -> ErrorType
max :: ErrorType -> ErrorType -> ErrorType
$cmax :: ErrorType -> ErrorType -> ErrorType
>= :: ErrorType -> ErrorType -> Bool
$c>= :: ErrorType -> ErrorType -> Bool
> :: ErrorType -> ErrorType -> Bool
$c> :: ErrorType -> ErrorType -> Bool
<= :: ErrorType -> ErrorType -> Bool
$c<= :: ErrorType -> ErrorType -> Bool
< :: ErrorType -> ErrorType -> Bool
$c< :: ErrorType -> ErrorType -> Bool
compare :: ErrorType -> ErrorType -> Ordering
$ccompare :: ErrorType -> ErrorType -> Ordering
Ord, Int -> ErrorType -> ShowS
[ErrorType] -> ShowS
ErrorType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorType] -> ShowS
$cshowList :: [ErrorType] -> ShowS
show :: ErrorType -> String
$cshow :: ErrorType -> String
showsPrec :: Int -> ErrorType -> ShowS
$cshowsPrec :: Int -> ErrorType -> ShowS
Show, ReadPrec [ErrorType]
ReadPrec ErrorType
Int -> ReadS ErrorType
ReadS [ErrorType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ErrorType]
$creadListPrec :: ReadPrec [ErrorType]
readPrec :: ReadPrec ErrorType
$creadPrec :: ReadPrec ErrorType
readList :: ReadS [ErrorType]
$creadList :: ReadS [ErrorType]
readsPrec :: Int -> ReadS ErrorType
$creadsPrec :: Int -> ReadS ErrorType
Read, Typeable ErrorType
ErrorType -> DataType
ErrorType -> Constr
(forall b. Data b => b -> b) -> ErrorType -> ErrorType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ErrorType -> u
forall u. (forall d. Data d => d -> u) -> ErrorType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorType -> m ErrorType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorType -> m ErrorType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorType -> c ErrorType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrorType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorType -> m ErrorType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorType -> m ErrorType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorType -> m ErrorType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ErrorType -> m ErrorType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorType -> m ErrorType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ErrorType -> m ErrorType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ErrorType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorType -> r
gmapT :: (forall b. Data b => b -> b) -> ErrorType -> ErrorType
$cgmapT :: (forall b. Data b => b -> b) -> ErrorType -> ErrorType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrorType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ErrorType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorType)
dataTypeOf :: ErrorType -> DataType
$cdataTypeOf :: ErrorType -> DataType
toConstr :: ErrorType -> Constr
$ctoConstr :: ErrorType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorType -> c ErrorType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorType -> c ErrorType
Data, forall x. Rep ErrorType x -> ErrorType
forall x. ErrorType -> Rep ErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorType x -> ErrorType
$cfrom :: forall x. ErrorType -> Rep ErrorType x
Generic)
  deriving anyclass (ErrorType -> ()
forall a. (a -> ()) -> NFData a
rnf :: ErrorType -> ()
$crnf :: ErrorType -> ()
NFData)

-- | How much information to retain when parsing
data ParseMode
  = Canonicalize -- ^ Canonicalize the phone number such that different
      -- representations can be easily compared, no matter what form it was
      -- originally entered in (e.g. national, international)
  | KeepRawInput -- ^ Record context about the number being parsed, such as
      -- 'rawInput', 'countryCodeSource', and 'preferredDomesticCarrierCode'
  deriving stock (ParseMode -> ParseMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseMode -> ParseMode -> Bool
$c/= :: ParseMode -> ParseMode -> Bool
== :: ParseMode -> ParseMode -> Bool
$c== :: ParseMode -> ParseMode -> Bool
Eq, Eq ParseMode
ParseMode -> ParseMode -> Bool
ParseMode -> ParseMode -> Ordering
ParseMode -> ParseMode -> ParseMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParseMode -> ParseMode -> ParseMode
$cmin :: ParseMode -> ParseMode -> ParseMode
max :: ParseMode -> ParseMode -> ParseMode
$cmax :: ParseMode -> ParseMode -> ParseMode
>= :: ParseMode -> ParseMode -> Bool
$c>= :: ParseMode -> ParseMode -> Bool
> :: ParseMode -> ParseMode -> Bool
$c> :: ParseMode -> ParseMode -> Bool
<= :: ParseMode -> ParseMode -> Bool
$c<= :: ParseMode -> ParseMode -> Bool
< :: ParseMode -> ParseMode -> Bool
$c< :: ParseMode -> ParseMode -> Bool
compare :: ParseMode -> ParseMode -> Ordering
$ccompare :: ParseMode -> ParseMode -> Ordering
Ord, Int -> ParseMode -> ShowS
[ParseMode] -> ShowS
ParseMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseMode] -> ShowS
$cshowList :: [ParseMode] -> ShowS
show :: ParseMode -> String
$cshow :: ParseMode -> String
showsPrec :: Int -> ParseMode -> ShowS
$cshowsPrec :: Int -> ParseMode -> ShowS
Show, ReadPrec [ParseMode]
ReadPrec ParseMode
Int -> ReadS ParseMode
ReadS [ParseMode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParseMode]
$creadListPrec :: ReadPrec [ParseMode]
readPrec :: ReadPrec ParseMode
$creadPrec :: ReadPrec ParseMode
readList :: ReadS [ParseMode]
$creadList :: ReadS [ParseMode]
readsPrec :: Int -> ReadS ParseMode
$creadsPrec :: Int -> ReadS ParseMode
Read, Typeable ParseMode
ParseMode -> DataType
ParseMode -> Constr
(forall b. Data b => b -> b) -> ParseMode -> ParseMode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ParseMode -> u
forall u. (forall d. Data d => d -> u) -> ParseMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParseMode -> m ParseMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseMode -> m ParseMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseMode -> c ParseMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParseMode)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseMode -> m ParseMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseMode -> m ParseMode
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseMode -> m ParseMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseMode -> m ParseMode
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParseMode -> m ParseMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParseMode -> m ParseMode
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParseMode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParseMode -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParseMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParseMode -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseMode -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseMode -> r
gmapT :: (forall b. Data b => b -> b) -> ParseMode -> ParseMode
$cgmapT :: (forall b. Data b => b -> b) -> ParseMode -> ParseMode
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParseMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParseMode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseMode)
dataTypeOf :: ParseMode -> DataType
$cdataTypeOf :: ParseMode -> DataType
toConstr :: ParseMode -> Constr
$ctoConstr :: ParseMode -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseMode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseMode -> c ParseMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseMode -> c ParseMode
Data, forall x. Rep ParseMode x -> ParseMode
forall x. ParseMode -> Rep ParseMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseMode x -> ParseMode
$cfrom :: forall x. ParseMode -> Rep ParseMode x
Generic)
  deriving anyclass (ParseMode -> ()
forall a. (a -> ()) -> NFData a
rnf :: ParseMode -> ()
$crnf :: ParseMode -> ()
NFData)

-- | Parse a phone number.
--
-- The function is quite lenient and looks for a number in the input
-- 'ByteString' and does not check whether the string is definitely only a phone
-- number. To do this, it ignores punctuation and white-space, as well as any
-- text before the number (e.g. a leading @"Tel: "@) and trims the non-number
-- bits. It will accept a number in any format (E164, national, international
-- etc.), assuming it can be interpreted with the default t'Region' supplied. It
-- also attempts to convert any alpha characters into digits if it thinks this
-- is a vanity number of the type @"1800 MICROSOFT"@.
--
-- The input can contain formatting such as @+@, @(@ and @-@, as well as a phone
-- number extension. It can also be provided in RFC3966 format.
--
-- Note that validation of whether the number is actually a valid number for a
-- particular region is not performed. This can be done separately with
-- 'isValidNumber'.
--
-- Returns an error if the string is not considered to be a viable phone number
-- (e.g. too few or too many digits) or if no 'Region' was supplied and the
-- number is not in international format (does not start with @\'+\'@).
parseNumber
  :: ParseMode
  -> Maybe Region -- ^ Default region, the country that we are expecting the
    -- number to be dialed from, which affects national and international
    -- dialing prefixes. This is only used if the number being parsed is not
    -- written in international format. In such cases the 'countryCode' of the
    -- number would be that of the default region supplied. If the number is
    -- guaranteed to start with a @\'+\'@ followed by the country calling code,
    -- then this can be omitted.
  -> ByteString -- ^ Input.
  -> Either ErrorType PhoneNumber
parseNumber :: ParseMode
-> Maybe Region -> ByteString -> Either ErrorType PhoneNumber
parseNumber ParseMode
mode Maybe Region
mRegion ByteString
number = case ErrorType
err of
  ErrorType
I.NoParsingError -> forall a b. b -> Either a b
Right PhoneNumber
pn
  ErrorType
I.InvalidCountryCodeError -> forall a b. a -> Either a b
Left ErrorType
InvalidCountryCodeError
  ErrorType
I.NotANumber -> forall a b. a -> Either a b
Left ErrorType
NotANumber
  ErrorType
I.TooShortAfterIdd -> forall a b. a -> Either a b
Left ErrorType
TooShortAfterIdd
  ErrorType
I.TooShortNsn -> forall a b. a -> Either a b
Left ErrorType
TooShortNsn
  ErrorType
I.TooLongNsn -> forall a b. a -> Either a b
Left ErrorType
TooLongNsn
  where
    region :: ByteString
region = case Maybe Region
mRegion of
      Maybe Region
Nothing -> ByteString
"ZZ"
      Just (Region ByteString
reg) -> ByteString
reg
    (ErrorType
err, PhoneNumber
pn) = case ParseMode
mode of
      ParseMode
Canonicalize -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString -> IO (ErrorType, PhoneNumber)
c_phone_number_util_parse ByteString
number ByteString
region
      ParseMode
KeepRawInput -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString -> IO (ErrorType, PhoneNumber)
c_phone_number_util_parse_and_keep_raw_input ByteString
number ByteString
region

-- | Compares two numbers for equality. A number can be provided as a string, in
-- which case it is parsed without assuming its region.
--
-- Returns 'ExactMatch' if the country calling code, National Significant
-- Number (NSN), presence of a leading zero for Italian numbers and any
-- extension present are the same.
--
-- Returns 'NsnMatch' if either or both has no country calling code specified,
-- and the NSNs and extensions are the same.
--
-- Returns 'ShortNsnMatch' if either or both has no country calling code
-- specified, or the country calling code specified is the same, and one NSN
-- could be a shorter version of the other number. This includes the case where
-- one has an extension specified, and the other does not.
--
-- Returns 'InvalidNumber' if a number that was provided as a string could not
-- be parsed.
--
-- Returns 'NoMatch' otherwise.
--
-- For example, the numbers @1 345 657 1234@ and @657 1234@ are a
-- 'ShortNsnMatch'. The numbers @1 345 657 1234@ and @345 657@ are a 'NoMatch'.
-- Note that none of these numbers can be parsed by 'parseNumber' without
-- assuming a region.
matchNumbers :: Either ByteString PhoneNumber -> Either ByteString PhoneNumber -> MatchType
matchNumbers :: Either ByteString PhoneNumber
-> Either ByteString PhoneNumber -> MatchType
matchNumbers (Left ByteString
pn1) (Left ByteString
pn2) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  ByteString -> ByteString -> IO MatchType
c_phone_number_util_is_number_match_with_two_strings ByteString
pn1 ByteString
pn2
matchNumbers (Left ByteString
pn1) (Right PhoneNumber
pn2) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> ByteString -> IO MatchType
c_phone_number_util_is_number_match_with_one_string PhoneNumber
pn2 ByteString
pn1
matchNumbers (Right PhoneNumber
pn1) (Left ByteString
pn2) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> ByteString -> IO MatchType
c_phone_number_util_is_number_match_with_one_string PhoneNumber
pn1 ByteString
pn2
matchNumbers (Right PhoneNumber
pn1) (Right PhoneNumber
pn2) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
  PhoneNumber -> PhoneNumber -> IO MatchType
c_phone_number_util_is_number_match PhoneNumber
pn1 PhoneNumber
pn2