-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Data/PhoneNumber/Internal/Util.chs" #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Data.PhoneNumber.Internal.Util where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Control.Applicative
import Data.ByteString (ByteString)
import Data.PhoneNumber.Internal.Common
import Data.PhoneNumber.Internal.Number
{-# LINE 7 "src/Data/PhoneNumber/Internal/Util.chs" #-}

import Foreign
import Foreign.C.Types
import GHC.Generics (Generic)




newtype CString = CString (Ptr CChar, (C2HSImp.CULong))

unCString :: CString -> (Ptr CChar, (C2HSImp.CULong))
unCString :: CString -> (Ptr CChar, CULong)
unCString (CString (Ptr CChar, CULong)
pair) = (Ptr CChar, CULong)
pair

instance Storable CString where
  sizeOf :: CString -> Int
sizeOf CString
_ = Int
16
{-# LINE 21 "src/Data/PhoneNumber/Internal/Util.chs" #-}

  alignment _ = 8
{-# LINE 22 "src/Data/PhoneNumber/Internal/Util.chs" #-}

  peek p = CString <$> liftA2 (,)
    ((\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) p)
    ((\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CULong}) p)
  poke :: Ptr CString -> CString -> IO ()
poke Ptr CString
p (CString (Ptr CChar
str, CULong
sz)) = do
    (\Ptr CString
ptr Ptr CChar
val -> do {forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr CString
ptr Int
0 (Ptr CChar
val :: (C2HSImp.Ptr C2HSImp.CChar))}) Ptr CString
p Ptr CChar
str
    (\Ptr CString
ptr CULong
val -> do {forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr CString
ptr Int
8 (CULong
val :: C2HSImp.CULong)}) Ptr CString
p CULong
sz


{-# LINE 30 "src/Data/PhoneNumber/Internal/Util.chs" #-}


data PhoneNumberFormat = E164
                       | International
                       | National
                       | Rfc3966
  deriving (Int -> PhoneNumberFormat
PhoneNumberFormat -> Int
PhoneNumberFormat -> [PhoneNumberFormat]
PhoneNumberFormat -> PhoneNumberFormat
PhoneNumberFormat -> PhoneNumberFormat -> [PhoneNumberFormat]
PhoneNumberFormat
-> PhoneNumberFormat -> PhoneNumberFormat -> [PhoneNumberFormat]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PhoneNumberFormat
-> PhoneNumberFormat -> PhoneNumberFormat -> [PhoneNumberFormat]
$cenumFromThenTo :: PhoneNumberFormat
-> PhoneNumberFormat -> PhoneNumberFormat -> [PhoneNumberFormat]
enumFromTo :: PhoneNumberFormat -> PhoneNumberFormat -> [PhoneNumberFormat]
$cenumFromTo :: PhoneNumberFormat -> PhoneNumberFormat -> [PhoneNumberFormat]
enumFromThen :: PhoneNumberFormat -> PhoneNumberFormat -> [PhoneNumberFormat]
$cenumFromThen :: PhoneNumberFormat -> PhoneNumberFormat -> [PhoneNumberFormat]
enumFrom :: PhoneNumberFormat -> [PhoneNumberFormat]
$cenumFrom :: PhoneNumberFormat -> [PhoneNumberFormat]
fromEnum :: PhoneNumberFormat -> Int
$cfromEnum :: PhoneNumberFormat -> Int
toEnum :: Int -> PhoneNumberFormat
$ctoEnum :: Int -> PhoneNumberFormat
pred :: PhoneNumberFormat -> PhoneNumberFormat
$cpred :: PhoneNumberFormat -> PhoneNumberFormat
succ :: PhoneNumberFormat -> PhoneNumberFormat
$csucc :: PhoneNumberFormat -> PhoneNumberFormat
Enum)

{-# LINE 32 "src/Data/PhoneNumber/Internal/Util.chs" #-}


-- | Type of a phone number.
--
-- 'FixedLineOrMobile' designates cases where it is impossible to distinguish
-- between fixed-line and mobile numbers by looking at the phone number itself
-- (e.g. the USA).
--
-- 'TollFree' designates freephone lines.
--
-- 'SharedCost' designates numbers where the cost of the call is shared between
-- the caller and the recipient, and is hence typically less than for
-- 'PremiumRate'. See http://en.wikipedia.org/wiki/Shared_Cost_Service for more
-- information.
--
-- 'Voip' designates Voice over IP numbers. This includes TSoIP (Telephony
-- Service over IP).
--
-- 'Uan' designates "Universal Access Numbers" or "Company Numbers". They may be
-- further routed to specific offices, but allow one number to be used for a
-- company.
--
-- 'Voicemail' designates "Voice Mail Access Numbers".
data PhoneNumberType = FixedLine
                     | Mobile
                     | FixedLineOrMobile
                     | TollFree
                     | PremiumRate
                     | SharedCost
                     | Voip
                     | PersonalNumber
                     | Pager
                     | Uan
                     | Voicemail
                     | Unknown
  deriving (Int -> PhoneNumberType
PhoneNumberType -> Int
PhoneNumberType -> [PhoneNumberType]
PhoneNumberType -> PhoneNumberType
PhoneNumberType -> PhoneNumberType -> [PhoneNumberType]
PhoneNumberType
-> PhoneNumberType -> PhoneNumberType -> [PhoneNumberType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PhoneNumberType
-> PhoneNumberType -> PhoneNumberType -> [PhoneNumberType]
$cenumFromThenTo :: PhoneNumberType
-> PhoneNumberType -> PhoneNumberType -> [PhoneNumberType]
enumFromTo :: PhoneNumberType -> PhoneNumberType -> [PhoneNumberType]
$cenumFromTo :: PhoneNumberType -> PhoneNumberType -> [PhoneNumberType]
enumFromThen :: PhoneNumberType -> PhoneNumberType -> [PhoneNumberType]
$cenumFromThen :: PhoneNumberType -> PhoneNumberType -> [PhoneNumberType]
enumFrom :: PhoneNumberType -> [PhoneNumberType]
$cenumFrom :: PhoneNumberType -> [PhoneNumberType]
fromEnum :: PhoneNumberType -> Int
$cfromEnum :: PhoneNumberType -> Int
toEnum :: Int -> PhoneNumberType
$ctoEnum :: Int -> PhoneNumberType
pred :: PhoneNumberType -> PhoneNumberType
$cpred :: PhoneNumberType -> PhoneNumberType
succ :: PhoneNumberType -> PhoneNumberType
$csucc :: PhoneNumberType -> PhoneNumberType
Enum,PhoneNumberType -> PhoneNumberType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhoneNumberType -> PhoneNumberType -> Bool
$c/= :: PhoneNumberType -> PhoneNumberType -> Bool
== :: PhoneNumberType -> PhoneNumberType -> Bool
$c== :: PhoneNumberType -> PhoneNumberType -> Bool
Eq,Eq PhoneNumberType
PhoneNumberType -> PhoneNumberType -> Bool
PhoneNumberType -> PhoneNumberType -> Ordering
PhoneNumberType -> PhoneNumberType -> PhoneNumberType
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 :: PhoneNumberType -> PhoneNumberType -> PhoneNumberType
$cmin :: PhoneNumberType -> PhoneNumberType -> PhoneNumberType
max :: PhoneNumberType -> PhoneNumberType -> PhoneNumberType
$cmax :: PhoneNumberType -> PhoneNumberType -> PhoneNumberType
>= :: PhoneNumberType -> PhoneNumberType -> Bool
$c>= :: PhoneNumberType -> PhoneNumberType -> Bool
> :: PhoneNumberType -> PhoneNumberType -> Bool
$c> :: PhoneNumberType -> PhoneNumberType -> Bool
<= :: PhoneNumberType -> PhoneNumberType -> Bool
$c<= :: PhoneNumberType -> PhoneNumberType -> Bool
< :: PhoneNumberType -> PhoneNumberType -> Bool
$c< :: PhoneNumberType -> PhoneNumberType -> Bool
compare :: PhoneNumberType -> PhoneNumberType -> Ordering
$ccompare :: PhoneNumberType -> PhoneNumberType -> Ordering
Ord,Show,forall x. Rep PhoneNumberType x -> PhoneNumberType
forall x. PhoneNumberType -> Rep PhoneNumberType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PhoneNumberType x -> PhoneNumberType
$cfrom :: forall x. PhoneNumberType -> Rep PhoneNumberType x
Generic)

{-# LINE 56 "src/Data/PhoneNumber/Internal/Util.chs" #-}


-- | Types of phone number matches. See 'Data.PhoneNumber.Util.matchNumbers'.
data MatchType = InvalidNumber
               | NoMatch
               | ShortNsnMatch
               | NsnMatch
               | ExactMatch
  deriving (Enum,Eq,Show,Generic)

{-# LINE 60 "src/Data/PhoneNumber/Internal/Util.chs" #-}


data ErrorType = NoParsingError
               | InvalidCountryCodeError
               | NotANumber
               | TooShortAfterIdd
               | TooShortNsn
               | TooLongNsn
  deriving (Enum)

{-# LINE 62 "src/Data/PhoneNumber/Internal/Util.chs" #-}


-- | Possible outcomes when testing if a t'PhoneNumber' is possible.
--
-- 'IsPossible' means the number length matches that of valid numbers for this
-- region.
--
-- 'IsPossibleLocalOnly' means the number length matches that of local numbers
-- for this region only (i.e. numbers that may be able to be dialled within an
-- area, but do not have all the information to be dialled from anywhere inside
-- or outside the country).
--
-- 'InvalidCountryCode' means the number has an invalid country calling code.
--
-- 'TooShort' means the number is shorter than all valid numbers for this
-- region.
--
-- 'TooLong' means the number is longer than all valid numbers for this region.
--
-- 'InvalidLength' means the number is longer than the shortest valid numbers
-- for this region, shorter than the longest valid numbers for this region, and
-- does not itself have a number length that matches valid numbers for this
-- region. This can also be returned in the case when there are no numbers of a
-- specific type at all for this region.
data ValidationResult = IsPossible
                      | IsPossibleLocalOnly
                      | InvalidCountryCode
                      | TooShort
                      | InvalidLength
                      | TooLong
  deriving (Enum,Eq,Show,Generic)

{-# LINE 87 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_supported_regions :: IO (([ByteString]))
c_phone_number_util_get_supported_regions =
  alloca2 $ \(a1'1, a1'2) -> 
  c_phone_number_util_get_supported_regions'_ a1'1  a1'2 >>
  peekAcquireCStringList  a1'1  a1'2>>= \a1'' -> 
  return (a1'')

{-# LINE 91 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_supported_global_network_calling_codes :: IO (([CInt]))
c_phone_number_util_get_supported_global_network_calling_codes =
  alloca2 $ \(a1'1, a1'2) -> 
  c_phone_number_util_get_supported_global_network_calling_codes'_ a1'1  a1'2 >>
  peekAcquireList  a1'1  a1'2>>= \a1'' -> 
  return (a1'')

{-# LINE 95 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_supported_calling_codes :: IO (([CInt]))
c_phone_number_util_get_supported_calling_codes =
  alloca2 $ \(a1'1, a1'2) -> 
  c_phone_number_util_get_supported_calling_codes'_ a1'1  a1'2 >>
  peekAcquireList  a1'1  a1'2>>= \a1'' -> 
  return (a1'')

{-# LINE 99 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_supported_types_for_region :: (ByteString) -> IO (([PhoneNumberType]))
c_phone_number_util_get_supported_types_for_region a1 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  alloca2 $ \(a2'1, a2'2) -> 
  c_phone_number_util_get_supported_types_for_region'_ a1'1  a1'2 a2'1  a2'2 >>
  peekAcquireEnumList  a2'1  a2'2>>= \a2'' -> 
  return (a2'')

{-# LINE 104 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_supported_types_for_non_geo_entity :: (CInt) -> IO (([PhoneNumberType]))
c_phone_number_util_get_supported_types_for_non_geo_entity a1 =
  let {a1' = fromIntegral a1} in 
  alloca2 $ \(a2'1, a2'2) -> 
  c_phone_number_util_get_supported_types_for_non_geo_entity'_ a1' a2'1  a2'2 >>
  peekAcquireEnumList  a2'1  a2'2>>= \a2'' -> 
  return (a2'')

{-# LINE 109 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_alpha_number :: (ByteString) -> IO ((Bool))
c_phone_number_util_is_alpha_number a1 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  c_phone_number_util_is_alpha_number'_ a1'1  a1'2 >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 113 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_convert_alpha_characters_in_number :: (ByteString) -> IO ((ByteString))
c_phone_number_util_convert_alpha_characters_in_number a1 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  alloca $ \a2' -> 
  c_phone_number_util_convert_alpha_characters_in_number'_ a1'1  a1'2 a2' >>
  peekAcquireCString  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 118 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_normalize_digits_only :: (ByteString) -> IO ((ByteString))
c_phone_number_util_normalize_digits_only a1 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  alloca $ \a2' -> 
  c_phone_number_util_normalize_digits_only'_ a1'1  a1'2 a2' >>
  peekAcquireCString  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 123 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_normalize_dialable_chars_only :: (ByteString) -> IO ((ByteString))
c_phone_number_util_normalize_dialable_chars_only a1 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  alloca $ \a2' -> 
  c_phone_number_util_normalize_dialable_chars_only'_ a1'1  a1'2 a2' >>
  peekAcquireCString  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 128 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_national_significant_number :: (PhoneNumber) -> IO ((ByteString))
c_phone_number_util_get_national_significant_number a1 =
  (withPhoneNumber) a1 $ \a1' -> 
  alloca $ \a2' -> 
  c_phone_number_util_get_national_significant_number'_ a1' a2' >>
  peekAcquireCString  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 133 "src/Data/PhoneNumber/Internal/Util.chs" #-}



c_phone_number_util_get_country_mobile_token :: (CInt) -> IO ((ByteString))
c_phone_number_util_get_country_mobile_token a1 =
  let {a1' = fromIntegral a1} in 
  alloca $ \a2' -> 
  c_phone_number_util_get_country_mobile_token'_ a1' a2' >>
  peekAcquireCString  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 139 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_format :: (PhoneNumber) -> (PhoneNumberFormat) -> IO ((ByteString))
c_phone_number_util_format a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  let {a2' = (fromIntegral . fromEnum) a2} in 
  alloca $ \a3' -> 
  c_phone_number_util_format'_ a1' a2' a3' >>
  peekAcquireCString  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 145 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_format_national_number_with_carrier_code :: (PhoneNumber) -> (ByteString) -> IO ((ByteString))
c_phone_number_util_format_national_number_with_carrier_code a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  alloca $ \a3' -> 
  c_phone_number_util_format_national_number_with_carrier_code'_ a1' a2'1  a2'2 a3' >>
  peekAcquireCString  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 151 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_format_national_number_with_preferred_carrier_code :: (PhoneNumber) -> (ByteString) -> IO ((ByteString))
c_phone_number_util_format_national_number_with_preferred_carrier_code a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  alloca $ \a3' -> 
  c_phone_number_util_format_national_number_with_preferred_carrier_code'_ a1' a2'1  a2'2 a3' >>
  peekAcquireCString  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 157 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_format_number_for_mobile_dialing :: (PhoneNumber) -> (ByteString) -> (Bool) -> IO ((ByteString))
c_phone_number_util_format_number_for_mobile_dialing a1 a2 a3 =
  (withPhoneNumber) a1 $ \a1' -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  let {a3' = C2HSImp.fromBool a3} in 
  alloca $ \a4' -> 
  c_phone_number_util_format_number_for_mobile_dialing'_ a1' a2'1  a2'2 a3' a4' >>
  peekAcquireCString  a4'>>= \a4'' -> 
  return (a4'')

{-# LINE 164 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_format_out_of_country_calling_number :: (PhoneNumber) -> (ByteString) -> IO ((ByteString))
c_phone_number_util_format_out_of_country_calling_number a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  alloca $ \a3' -> 
  c_phone_number_util_format_out_of_country_calling_number'_ a1' a2'1  a2'2 a3' >>
  peekAcquireCString  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 170 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_format_in_original_format :: (PhoneNumber) -> (ByteString) -> IO ((ByteString))
c_phone_number_util_format_in_original_format a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  alloca $ \a3' -> 
  c_phone_number_util_format_in_original_format'_ a1' a2'1  a2'2 a3' >>
  peekAcquireCString  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 176 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_format_out_of_country_keeping_alpha_chars :: (PhoneNumber) -> (ByteString) -> IO ((ByteString))
c_phone_number_util_format_out_of_country_keeping_alpha_chars a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  alloca $ \a3' -> 
  c_phone_number_util_format_out_of_country_keeping_alpha_chars'_ a1' a2'1  a2'2 a3' >>
  peekAcquireCString  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 182 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_truncate_too_long_number :: (PhoneNumber) -> IO ((Maybe PhoneNumber))
c_phone_number_util_truncate_too_long_number a1 =
  (withPhoneNumber) a1 $ \a1' -> 
  c_phone_number_util_truncate_too_long_number'_ a1' >>= \res ->
  acquireMaybePhoneNumber res >>= \res' ->
  return (res')

{-# LINE 186 "src/Data/PhoneNumber/Internal/Util.chs" #-}

  where
    acquireMaybePhoneNumber p
      | p == nullPtr = pure Nothing
      | otherwise = Just <$> acquirePhoneNumber p

c_phone_number_util_get_number_type :: (PhoneNumber) -> IO ((PhoneNumberType))
c_phone_number_util_get_number_type :: PhoneNumber -> IO PhoneNumberType
c_phone_number_util_get_number_type PhoneNumber
a1 =
  (forall b. PhoneNumber -> (Ptr PhoneNumber -> IO b) -> IO b
withPhoneNumber) PhoneNumber
a1 forall a b. (a -> b) -> a -> b
$ \Ptr PhoneNumber
a1' -> 
  Ptr PhoneNumber -> IO CInt
c_phone_number_util_get_number_type'_ Ptr PhoneNumber
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: PhoneNumberType
res' = (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (PhoneNumberType
res')

{-# LINE 194 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_valid_number :: (PhoneNumber) -> IO ((Bool))
c_phone_number_util_is_valid_number a1 =
  (withPhoneNumber) a1 $ \a1' -> 
  c_phone_number_util_is_valid_number'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 198 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_valid_number_for_region :: (PhoneNumber) -> (ByteString) -> IO ((Bool))
c_phone_number_util_is_valid_number_for_region a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  c_phone_number_util_is_valid_number_for_region'_ a1' a2'1  a2'2 >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 203 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_region_code_for_number :: (PhoneNumber) -> IO ((ByteString))
c_phone_number_util_get_region_code_for_number a1 =
  (withPhoneNumber) a1 $ \a1' -> 
  alloca $ \a2' -> 
  c_phone_number_util_get_region_code_for_number'_ a1' a2' >>
  peekAcquireCString  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 208 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_country_code_for_region :: (ByteString) -> IO ((CInt))
c_phone_number_util_get_country_code_for_region a1 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  c_phone_number_util_get_country_code_for_region'_ a1'1  a1'2 >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 212 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_region_code_for_country_code :: (Int) -> IO ((ByteString))
c_phone_number_util_get_region_code_for_country_code a1 =
  let {a1' = fromIntegral a1} in 
  alloca $ \a2' -> 
  c_phone_number_util_get_region_code_for_country_code'_ a1' a2' >>
  peekAcquireCString  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 217 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_region_codes_for_country_calling_code :: (Int) -> IO (([ByteString]))
c_phone_number_util_get_region_codes_for_country_calling_code a1 =
  let {a1' = fromIntegral a1} in 
  alloca2 $ \(a2'1, a2'2) -> 
  c_phone_number_util_get_region_codes_for_country_calling_code'_ a1' a2'1  a2'2 >>
  peekAcquireCStringList  a2'1  a2'2>>= \a2'' -> 
  return (a2'')

{-# LINE 222 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_nanpa_country :: (ByteString) -> IO ((Bool))
c_phone_number_util_is_nanpa_country a1 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  c_phone_number_util_is_nanpa_country'_ a1'1  a1'2 >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 226 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_get_ndd_prefix_for_region :: (ByteString) -> (Bool) -> IO ((ByteString))
c_phone_number_util_get_ndd_prefix_for_region a1 a2 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  let {a2' = C2HSImp.fromBool a2} in 
  alloca $ \a3' -> 
  c_phone_number_util_get_ndd_prefix_for_region'_ a1'1  a1'2 a2' a3' >>
  peekAcquireCString  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 232 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_possible_number_for_type_with_reason :: (PhoneNumber) -> (PhoneNumberType) -> IO ((ValidationResult))
c_phone_number_util_is_possible_number_for_type_with_reason a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  let {a2' = (fromIntegral . fromEnum) a2} in 
  c_phone_number_util_is_possible_number_for_type_with_reason'_ a1' a2' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 237 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_can_be_internationally_dialed :: (PhoneNumber) -> IO ((Bool))
c_phone_number_util_can_be_internationally_dialed a1 =
  (withPhoneNumber) a1 $ \a1' -> 
  c_phone_number_util_can_be_internationally_dialed'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 241 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_number_geographical_1 :: (PhoneNumber) -> IO ((Bool))
c_phone_number_util_is_number_geographical_1 a1 =
  (withPhoneNumber) a1 $ \a1' -> 
  c_phone_number_util_is_number_geographical_1'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 245 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_number_geographical_2 :: (PhoneNumberType) -> (CInt) -> IO ((Bool))
c_phone_number_util_is_number_geographical_2 a1 a2 =
  let {a1' = (fromIntegral . fromEnum) a1} in 
  let {a2' = fromIntegral a2} in 
  c_phone_number_util_is_number_geographical_2'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 250 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_parse :: (ByteString) -> (ByteString) -> IO ((ErrorType), (PhoneNumber))
c_phone_number_util_parse a1 a2 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  alloca $ \a3' -> 
  c_phone_number_util_parse'_ a1'1  a1'2 a2'1  a2'2 a3' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  peekAcquirePhoneNumber  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 256 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_parse_and_keep_raw_input :: (ByteString) -> (ByteString) -> IO ((ErrorType), (PhoneNumber))
c_phone_number_util_parse_and_keep_raw_input a1 a2 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  alloca $ \a3' -> 
  c_phone_number_util_parse_and_keep_raw_input'_ a1'1  a1'2 a2'1  a2'2 a3' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  peekAcquirePhoneNumber  a3'>>= \a3'' -> 
  return (res', a3'')

{-# LINE 262 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_number_match :: (PhoneNumber) -> (PhoneNumber) -> IO ((MatchType))
c_phone_number_util_is_number_match a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  (withPhoneNumber) a2 $ \a2' -> 
  c_phone_number_util_is_number_match'_ a1' a2' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 267 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_number_match_with_two_strings :: (ByteString) -> (ByteString) -> IO ((MatchType))
c_phone_number_util_is_number_match_with_two_strings a1 a2 =
  withByteString a1 $ \(a1'1, a1'2) -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  c_phone_number_util_is_number_match_with_two_strings'_ a1'1  a1'2 a2'1  a2'2 >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 272 "src/Data/PhoneNumber/Internal/Util.chs" #-}


c_phone_number_util_is_number_match_with_one_string :: (PhoneNumber) -> (ByteString) -> IO ((MatchType))
c_phone_number_util_is_number_match_with_one_string a1 a2 =
  (withPhoneNumber) a1 $ \a1' -> 
  withByteString a2 $ \(a2'1, a2'2) -> 
  c_phone_number_util_is_number_match_with_one_string'_ a1' a2'1  a2'2 >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 277 "src/Data/PhoneNumber/Internal/Util.chs" #-}


peekAcquireList :: Storable a => Ptr (Ptr a) -> Ptr (C2HSImp.CULong) -> IO [a]
peekAcquireList pList pSize = do
  size <- peek pSize
  list <- peek pList
  xs <- peekArray (fromIntegral size) list
  stdlibFree $ castPtr list
  pure xs

peekAcquireCStringList :: Ptr (Ptr CString) -> Ptr (C2HSImp.CULong) -> IO [ByteString]
peekAcquireCStringList :: Ptr (Ptr CString) -> Ptr CULong -> IO [ByteString]
peekAcquireCStringList Ptr (Ptr CString)
pList Ptr CULong
pSize =
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Ptr CChar -> CULong -> IO ByteString
acquireCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> (Ptr CChar, CULong)
unCString) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr (Ptr a) -> Ptr CULong -> IO [a]
peekAcquireList Ptr (Ptr CString)
pList Ptr CULong
pSize

peekAcquireEnumList :: Enum a => Ptr (Ptr CInt) -> Ptr (C2HSImp.CULong) -> IO [a]
peekAcquireEnumList :: forall a. Enum a => Ptr (Ptr CInt) -> Ptr CULong -> IO [a]
peekAcquireEnumList Ptr (Ptr CInt)
pList Ptr CULong
pSize =
  forall a b. (a -> b) -> [a] -> [b]
map (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr (Ptr a) -> Ptr CULong -> IO [a]
peekAcquireList Ptr (Ptr CInt)
pList Ptr CULong
pSize

peekAcquireCString :: Ptr CString -> IO ByteString
peekAcquireCString :: Ptr CString -> IO ByteString
peekAcquireCString Ptr CString
p = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Ptr CChar -> CULong -> IO ByteString
acquireCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> (Ptr CChar, CULong)
unCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr CString
p

acquirePhoneNumber :: Ptr PhoneNumber -> IO PhoneNumber
acquirePhoneNumber :: Ptr PhoneNumber -> IO PhoneNumber
acquirePhoneNumber Ptr PhoneNumber
p = ForeignPtr PhoneNumber -> PhoneNumber
PhoneNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr PhoneNumber
c_phone_number_free Ptr PhoneNumber
p

peekAcquirePhoneNumber :: Ptr (Ptr PhoneNumber) -> IO PhoneNumber
peekAcquirePhoneNumber :: Ptr (Ptr PhoneNumber) -> IO PhoneNumber
peekAcquirePhoneNumber Ptr (Ptr PhoneNumber)
p = Ptr PhoneNumber -> IO PhoneNumber
acquirePhoneNumber forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr PhoneNumber)
p

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_supported_regions"
  c_phone_number_util_get_supported_regions'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr (CString))) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO ())))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_supported_global_network_calling_codes"
  c_phone_number_util_get_supported_global_network_calling_codes'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CInt)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO ())))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_supported_calling_codes"
  c_phone_number_util_get_supported_calling_codes'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CInt)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO ())))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_supported_types_for_region"
  c_phone_number_util_get_supported_types_for_region'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CInt)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO ())))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_supported_types_for_non_geo_entity"
  c_phone_number_util_get_supported_types_for_non_geo_entity'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CInt)) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO ()))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_alpha_number"
  c_phone_number_util_is_alpha_number'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_convert_alpha_characters_in_number"
  c_phone_number_util_convert_alpha_characters_in_number'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (CString)) -> (IO ()))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_normalize_digits_only"
  c_phone_number_util_normalize_digits_only'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (CString)) -> (IO ()))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_normalize_dialable_chars_only"
  c_phone_number_util_normalize_dialable_chars_only'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (CString)) -> (IO ()))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_national_significant_number"
  c_phone_number_util_get_national_significant_number'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr (CString)) -> (IO ())))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_country_mobile_token"
  c_phone_number_util_get_country_mobile_token'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr (CString)) -> (IO ())))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_format"
  c_phone_number_util_format'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (CString)) -> (IO ()))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_format_national_number_with_carrier_code"
  c_phone_number_util_format_national_number_with_carrier_code'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (CString)) -> (IO ())))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_format_national_number_with_preferred_carrier_code"
  c_phone_number_util_format_national_number_with_preferred_carrier_code'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (CString)) -> (IO ())))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_format_number_for_mobile_dialing"
  c_phone_number_util_format_number_for_mobile_dialing'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (C2HSImp.CInt -> ((C2HSImp.Ptr (CString)) -> (IO ()))))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_format_out_of_country_calling_number"
  c_phone_number_util_format_out_of_country_calling_number'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (CString)) -> (IO ())))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_format_in_original_format"
  c_phone_number_util_format_in_original_format'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (CString)) -> (IO ())))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_format_out_of_country_keeping_alpha_chars"
  c_phone_number_util_format_out_of_country_keeping_alpha_chars'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (CString)) -> (IO ())))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_truncate_too_long_number"
  c_phone_number_util_truncate_too_long_number'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> (IO (C2HSImp.Ptr (PhoneNumber))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_number_type"
  c_phone_number_util_get_number_type'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_valid_number"
  c_phone_number_util_is_valid_number'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_valid_number_for_region"
  c_phone_number_util_is_valid_number_for_region'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_region_code_for_number"
  c_phone_number_util_get_region_code_for_number'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr (CString)) -> (IO ())))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_country_code_for_region"
  c_phone_number_util_get_country_code_for_region'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_region_code_for_country_code"
  c_phone_number_util_get_region_code_for_country_code'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr (CString)) -> (IO ())))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_region_codes_for_country_calling_code"
  c_phone_number_util_get_region_codes_for_country_calling_code'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr (CString))) -> ((C2HSImp.Ptr C2HSImp.CULong) -> (IO ()))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_nanpa_country"
  c_phone_number_util_is_nanpa_country'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_get_ndd_prefix_for_region"
  c_phone_number_util_get_ndd_prefix_for_region'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (C2HSImp.CInt -> ((C2HSImp.Ptr (CString)) -> (IO ())))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_possible_number_for_type_with_reason"
  c_phone_number_util_is_possible_number_for_type_with_reason'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_can_be_internationally_dialed"
  c_phone_number_util_can_be_internationally_dialed'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_number_geographical_1"
  c_phone_number_util_is_number_geographical_1'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_number_geographical_2"
  c_phone_number_util_is_number_geographical_2'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_parse"
  c_phone_number_util_parse'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (C2HSImp.Ptr (PhoneNumber))) -> (IO C2HSImp.CInt))))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_parse_and_keep_raw_input"
  c_phone_number_util_parse_and_keep_raw_input'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr (C2HSImp.Ptr (PhoneNumber))) -> (IO C2HSImp.CInt))))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_number_match"
  c_phone_number_util_is_number_match'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr (PhoneNumber)) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_number_match_with_two_strings"
  c_phone_number_util_is_number_match_with_two_strings'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h c_phone_number_util_is_number_match_with_one_string"
  c_phone_number_util_is_number_match_with_one_string'_ :: ((C2HSImp.Ptr (PhoneNumber)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/PhoneNumber/Internal/Util.chs.h free"
  stdlibFree :: ((C2HSImp.Ptr ()) -> (IO ()))