-- 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/Number.chs" #-}
module Data.PhoneNumber.Internal.Number where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Control.DeepSeq
import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
import Data.ByteString (ByteString)
import Data.Data
import Data.PhoneNumber.Internal.Common
import Data.List
import Foreign
import GHC.Generics (Generic)
import GHC.IO
import qualified GHC.Read as P
import qualified Text.ParserCombinators.ReadPrec as P
import qualified Text.Read.Lex as P




{-# LINE 19 "src/Data/PhoneNumber/Internal/Number.chs" #-}


data CPhoneNumber = CPhoneNumber
  { extension :: !(Maybe ByteString)
  , rawInput :: !(Maybe ByteString)
  , preferredDomesticCarrierCode :: !(Maybe ByteString)
  , nationalNumber :: !(C2HSImp.CULong)
{-# LINE 25 "src/Data/PhoneNumber/Internal/Number.chs" #-}

  , countryCode :: !(C2HSImp.CInt)
{-# LINE 26 "src/Data/PhoneNumber/Internal/Number.chs" #-}

  , italianLeadingZero :: !(Maybe Bool)
  , countryCodeSource :: !(Maybe CountryCodeSource)
  , numberOfLeadingZeros :: !(Maybe (C2HSImp.CInt))
  }
  deriving (Eq, Ord, Show, Read)

-- | Indicates what information was used to fill the
-- 'Data.PhoneNumber.Number.countryCode' field of t'PhoneNumber'.
data CountryCodeSource = Unspecified
                       | FromNumberWithPlusSign
                       | FromNumberWithIdd
                       | FromNumberWithoutPlusSign
                       | FromDefaultCountry
  deriving (CountryCodeSource -> CountryCodeSource -> Bool
(CountryCodeSource -> CountryCodeSource -> Bool)
-> (CountryCodeSource -> CountryCodeSource -> Bool)
-> Eq CountryCodeSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountryCodeSource -> CountryCodeSource -> Bool
== :: CountryCodeSource -> CountryCodeSource -> Bool
$c/= :: CountryCodeSource -> CountryCodeSource -> Bool
/= :: CountryCodeSource -> CountryCodeSource -> Bool
Eq,Eq CountryCodeSource
Eq CountryCodeSource =>
(CountryCodeSource -> CountryCodeSource -> Ordering)
-> (CountryCodeSource -> CountryCodeSource -> Bool)
-> (CountryCodeSource -> CountryCodeSource -> Bool)
-> (CountryCodeSource -> CountryCodeSource -> Bool)
-> (CountryCodeSource -> CountryCodeSource -> Bool)
-> (CountryCodeSource -> CountryCodeSource -> CountryCodeSource)
-> (CountryCodeSource -> CountryCodeSource -> CountryCodeSource)
-> Ord CountryCodeSource
CountryCodeSource -> CountryCodeSource -> Bool
CountryCodeSource -> CountryCodeSource -> Ordering
CountryCodeSource -> CountryCodeSource -> CountryCodeSource
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
$ccompare :: CountryCodeSource -> CountryCodeSource -> Ordering
compare :: CountryCodeSource -> CountryCodeSource -> Ordering
$c< :: CountryCodeSource -> CountryCodeSource -> Bool
< :: CountryCodeSource -> CountryCodeSource -> Bool
$c<= :: CountryCodeSource -> CountryCodeSource -> Bool
<= :: CountryCodeSource -> CountryCodeSource -> Bool
$c> :: CountryCodeSource -> CountryCodeSource -> Bool
> :: CountryCodeSource -> CountryCodeSource -> Bool
$c>= :: CountryCodeSource -> CountryCodeSource -> Bool
>= :: CountryCodeSource -> CountryCodeSource -> Bool
$cmax :: CountryCodeSource -> CountryCodeSource -> CountryCodeSource
max :: CountryCodeSource -> CountryCodeSource -> CountryCodeSource
$cmin :: CountryCodeSource -> CountryCodeSource -> CountryCodeSource
min :: CountryCodeSource -> CountryCodeSource -> CountryCodeSource
Ord,Int -> CountryCodeSource -> ShowS
[CountryCodeSource] -> ShowS
CountryCodeSource -> String
(Int -> CountryCodeSource -> ShowS)
-> (CountryCodeSource -> String)
-> ([CountryCodeSource] -> ShowS)
-> Show CountryCodeSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountryCodeSource -> ShowS
showsPrec :: Int -> CountryCodeSource -> ShowS
$cshow :: CountryCodeSource -> String
show :: CountryCodeSource -> String
$cshowList :: [CountryCodeSource] -> ShowS
showList :: [CountryCodeSource] -> ShowS
Show,ReadPrec [CountryCodeSource]
ReadPrec CountryCodeSource
Int -> ReadS CountryCodeSource
ReadS [CountryCodeSource]
(Int -> ReadS CountryCodeSource)
-> ReadS [CountryCodeSource]
-> ReadPrec CountryCodeSource
-> ReadPrec [CountryCodeSource]
-> Read CountryCodeSource
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CountryCodeSource
readsPrec :: Int -> ReadS CountryCodeSource
$creadList :: ReadS [CountryCodeSource]
readList :: ReadS [CountryCodeSource]
$creadPrec :: ReadPrec CountryCodeSource
readPrec :: ReadPrec CountryCodeSource
$creadListPrec :: ReadPrec [CountryCodeSource]
readListPrec :: ReadPrec [CountryCodeSource]
Read,Typeable CountryCodeSource
Typeable CountryCodeSource =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> CountryCodeSource
 -> c CountryCodeSource)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CountryCodeSource)
-> (CountryCodeSource -> Constr)
-> (CountryCodeSource -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CountryCodeSource))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CountryCodeSource))
-> ((forall b. Data b => b -> b)
    -> CountryCodeSource -> CountryCodeSource)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CountryCodeSource -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CountryCodeSource -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CountryCodeSource -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CountryCodeSource -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CountryCodeSource -> m CountryCodeSource)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CountryCodeSource -> m CountryCodeSource)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CountryCodeSource -> m CountryCodeSource)
-> Data CountryCodeSource
CountryCodeSource -> Constr
CountryCodeSource -> DataType
(forall b. Data b => b -> b)
-> CountryCodeSource -> CountryCodeSource
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) -> CountryCodeSource -> u
forall u. (forall d. Data d => d -> u) -> CountryCodeSource -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CountryCodeSource -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CountryCodeSource -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CountryCodeSource -> m CountryCodeSource
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CountryCodeSource -> m CountryCodeSource
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CountryCodeSource
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CountryCodeSource -> c CountryCodeSource
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CountryCodeSource)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CountryCodeSource)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CountryCodeSource -> c CountryCodeSource
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CountryCodeSource -> c CountryCodeSource
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CountryCodeSource
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CountryCodeSource
$ctoConstr :: CountryCodeSource -> Constr
toConstr :: CountryCodeSource -> Constr
$cdataTypeOf :: CountryCodeSource -> DataType
dataTypeOf :: CountryCodeSource -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CountryCodeSource)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CountryCodeSource)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CountryCodeSource)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CountryCodeSource)
$cgmapT :: (forall b. Data b => b -> b)
-> CountryCodeSource -> CountryCodeSource
gmapT :: (forall b. Data b => b -> b)
-> CountryCodeSource -> CountryCodeSource
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CountryCodeSource -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CountryCodeSource -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CountryCodeSource -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CountryCodeSource -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CountryCodeSource -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CountryCodeSource -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CountryCodeSource -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CountryCodeSource -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CountryCodeSource -> m CountryCodeSource
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CountryCodeSource -> m CountryCodeSource
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CountryCodeSource -> m CountryCodeSource
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CountryCodeSource -> m CountryCodeSource
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CountryCodeSource -> m CountryCodeSource
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CountryCodeSource -> m CountryCodeSource
Data,(forall x. CountryCodeSource -> Rep CountryCodeSource x)
-> (forall x. Rep CountryCodeSource x -> CountryCodeSource)
-> Generic CountryCodeSource
forall x. Rep CountryCodeSource x -> CountryCodeSource
forall x. CountryCodeSource -> Rep CountryCodeSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CountryCodeSource -> Rep CountryCodeSource x
from :: forall x. CountryCodeSource -> Rep CountryCodeSource x
$cto :: forall x. Rep CountryCodeSource x -> CountryCodeSource
to :: forall x. Rep CountryCodeSource x -> CountryCodeSource
Generic)
instance Enum CountryCodeSource where
  succ Unspecified = FromNumberWithPlusSign
  succ FromNumberWithPlusSign = FromNumberWithIdd
  succ FromNumberWithIdd = FromNumberWithoutPlusSign
  succ FromNumberWithoutPlusSign = FromDefaultCountry
  succ FromDefaultCountry = error "CountryCodeSource.succ: FromDefaultCountry has no successor"

  pred FromNumberWithPlusSign = Unspecified
  pred FromNumberWithIdd = FromNumberWithPlusSign
  pred FromNumberWithoutPlusSign = FromNumberWithIdd
  pred FromDefaultCountry = FromNumberWithoutPlusSign
  pred Unspecified = error "CountryCodeSource.pred: Unspecified has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from FromDefaultCountry

  fromEnum Unspecified = 0
  fromEnum FromNumberWithPlusSign = 1
  fromEnum FromNumberWithIdd = 5
  fromEnum FromNumberWithoutPlusSign = 10
  fromEnum FromDefaultCountry = 20

  toEnum 0 = Unspecified
  toEnum 1 = FromNumberWithPlusSign
  toEnum 5 = FromNumberWithIdd
  toEnum 10 = FromNumberWithoutPlusSign
  toEnum 20 = FromDefaultCountry
  toEnum unmatched = error ("CountryCodeSource.toEnum: Cannot match " ++ show unmatched)

{-# LINE 36 "src/Data/PhoneNumber/Internal/Number.chs" #-}


deriving anyclass instance NFData CountryCodeSource

withCPhoneNumber :: CPhoneNumber -> (Ptr CPhoneNumber -> IO a) -> IO a
withCPhoneNumber CPhoneNumber{..} = runContT $ do
  p <- ContT $ allocaBytes 72
{-# LINE 42 "src/Data/PhoneNumber/Internal/Number.chs" #-}

  withMaybeCString extension
    ((\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) p)
    ((\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CULong)}) p)
  withMaybeCString rawInput
    ((\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) p)
    ((\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: C2HSImp.CULong)}) p)
  withMaybeCString preferredDomesticCarrierCode
    ((\ptr val -> do {C2HSImp.pokeByteOff ptr 32 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) p)
    ((\ptr val -> do {C2HSImp.pokeByteOff ptr 40 (val :: C2HSImp.CULong)}) p)
  lift $ (\ptr val -> do {C2HSImp.pokeByteOff ptr 48 (val :: C2HSImp.CULong)}) p nationalNumber
  lift $ (\ptr val -> do {C2HSImp.pokeByteOff ptr 56 (val :: C2HSImp.CInt)}) p countryCode
  lift $ (\ptr val -> do {C2HSImp.pokeByteOff ptr 69 (val :: C2HSImp.CChar)}) p
    =<< case italianLeadingZero of
      Nothing -> pure 0
      Just ilz -> 1 <$ (\ptr val -> do {C2HSImp.pokeByteOff ptr 68 (val :: C2HSImp.CChar)}) p (fromIntegral $ fromEnum ilz)
  lift $ (\ptr val -> do {C2HSImp.pokeByteOff ptr 70 (val :: C2HSImp.CChar)}) p
    =<< case countryCodeSource of
      Nothing -> pure 0
      Just ccs -> 1 <$ (\ptr val -> do {C2HSImp.pokeByteOff ptr 64 (val :: C2HSImp.CInt)}) p (fromIntegral $ fromEnum ccs)
  lift $ (\ptr val -> do {C2HSImp.pokeByteOff ptr 71 (val :: C2HSImp.CChar)}) p
    =<< case numberOfLeadingZeros of
      Nothing -> pure 0
      Just nlz -> 1 <$ (\ptr val -> do {C2HSImp.pokeByteOff ptr 60 (val :: C2HSImp.CInt)}) p (fromIntegral $ fromEnum nlz)
  pure p
  where
    withMaybeCString Nothing setP _ = do
      lift $ setP nullPtr
    withMaybeCString (Just bs) setP setSZ = do
      (p, sz) <- ContT $ withByteString bs
      () <- lift $ setP p
      lift $ setSZ sz

-- Any #fun using acquireCPhoneNumber must be wrapped in a mask, so that an
-- exception cannot arrive before we assign finalizers to the strings inside
acquireCPhoneNumber :: Ptr CPhoneNumber -> IO CPhoneNumber
acquireCPhoneNumber :: Ptr CPhoneNumber -> IO CPhoneNumber
acquireCPhoneNumber Ptr CPhoneNumber
p = do
  Maybe ByteString
extension <- IO (Ptr CChar) -> IO CULong -> IO (Maybe ByteString)
acquireMaybeCString
    ((\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
0 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) Ptr CPhoneNumber
p)
    ((\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
8 :: IO C2HSImp.CULong}) Ptr CPhoneNumber
p)
  Maybe ByteString
rawInput <- IO (Ptr CChar) -> IO CULong -> IO (Maybe ByteString)
acquireMaybeCString
    ((\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
16 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) Ptr CPhoneNumber
p)
    ((\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
24 :: IO C2HSImp.CULong}) Ptr CPhoneNumber
p)
  Maybe ByteString
preferredDomesticCarrierCode <- IO (Ptr CChar) -> IO CULong -> IO (Maybe ByteString)
acquireMaybeCString
    ((\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
32 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) Ptr CPhoneNumber
p)
    ((\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
40 :: IO C2HSImp.CULong}) Ptr CPhoneNumber
p)
  CULong
nationalNumber <- (\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
48 :: IO C2HSImp.CULong}) Ptr CPhoneNumber
p
  CInt
countryCode <- (\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
56 :: IO C2HSImp.CInt}) Ptr CPhoneNumber
p
  Maybe Bool
italianLeadingZero <- (\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CChar
forall b. Ptr b -> Int -> IO CChar
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
69 :: IO C2HSImp.CChar}) Ptr CPhoneNumber
p
    IO CChar -> (CChar -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CChar
0 -> Maybe Bool -> IO (Maybe Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
      CChar
_ -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> (CChar -> Bool) -> CChar -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool
forall a. Enum a => Int -> a
toEnum (Int -> Bool) -> (CChar -> Int) -> CChar -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CChar -> Maybe Bool) -> IO CChar -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CChar
forall b. Ptr b -> Int -> IO CChar
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
68 :: IO C2HSImp.CChar}) Ptr CPhoneNumber
p
  Maybe CountryCodeSource
countryCodeSource <- (\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CChar
forall b. Ptr b -> Int -> IO CChar
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
70 :: IO C2HSImp.CChar}) Ptr CPhoneNumber
p
    IO CChar
-> (CChar -> IO (Maybe CountryCodeSource))
-> IO (Maybe CountryCodeSource)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CChar
0 -> Maybe CountryCodeSource -> IO (Maybe CountryCodeSource)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CountryCodeSource
forall a. Maybe a
Nothing
      CChar
_ -> CountryCodeSource -> Maybe CountryCodeSource
forall a. a -> Maybe a
Just (CountryCodeSource -> Maybe CountryCodeSource)
-> (CInt -> CountryCodeSource) -> CInt -> Maybe CountryCodeSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CountryCodeSource
forall a. Enum a => Int -> a
toEnum (Int -> CountryCodeSource)
-> (CInt -> Int) -> CInt -> CountryCodeSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Maybe CountryCodeSource)
-> IO CInt -> IO (Maybe CountryCodeSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
64 :: IO C2HSImp.CInt}) Ptr CPhoneNumber
p
  Maybe CInt
numberOfLeadingZeros <- (\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CChar
forall b. Ptr b -> Int -> IO CChar
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
71 :: IO C2HSImp.CChar}) Ptr CPhoneNumber
p
    IO CChar -> (CChar -> IO (Maybe CInt)) -> IO (Maybe CInt)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CChar
0 -> Maybe CInt -> IO (Maybe CInt)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CInt
forall a. Maybe a
Nothing
      CChar
_ -> CInt -> Maybe CInt
forall a. a -> Maybe a
Just (CInt -> Maybe CInt) -> IO CInt -> IO (Maybe CInt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr CPhoneNumber
ptr -> do {Ptr CPhoneNumber -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr CPhoneNumber
ptr Int
60 :: IO C2HSImp.CInt}) Ptr CPhoneNumber
p
  CPhoneNumber -> IO CPhoneNumber
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CPhoneNumber -> IO CPhoneNumber)
-> CPhoneNumber -> IO CPhoneNumber
forall a b. (a -> b) -> a -> b
$ CPhoneNumber{Maybe Bool
Maybe CInt
Maybe ByteString
Maybe CountryCodeSource
CULong
CInt
$sel:extension:CPhoneNumber :: Maybe ByteString
$sel:rawInput:CPhoneNumber :: Maybe ByteString
$sel:preferredDomesticCarrierCode:CPhoneNumber :: Maybe ByteString
$sel:nationalNumber:CPhoneNumber :: CULong
$sel:countryCode:CPhoneNumber :: CInt
$sel:italianLeadingZero:CPhoneNumber :: Maybe Bool
$sel:countryCodeSource:CPhoneNumber :: Maybe CountryCodeSource
$sel:numberOfLeadingZeros:CPhoneNumber :: Maybe CInt
extension :: Maybe ByteString
rawInput :: Maybe ByteString
preferredDomesticCarrierCode :: Maybe ByteString
nationalNumber :: CULong
countryCode :: CInt
italianLeadingZero :: Maybe Bool
countryCodeSource :: Maybe CountryCodeSource
numberOfLeadingZeros :: Maybe CInt
..}
  where
    acquireMaybeCString :: IO (Ptr CChar) -> IO CULong -> IO (Maybe ByteString)
acquireMaybeCString IO (Ptr CChar)
getP IO CULong
getSZ = do
      Ptr CChar
string <- IO (Ptr CChar)
getP
      if Ptr CChar
string Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
      then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
      else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> CULong -> IO ByteString
acquireCString Ptr CChar
string (CULong -> IO ByteString) -> IO CULong -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CULong
getSZ)

-- Any #fun returning PhoneNumber must be wrapped in a mask, so that an
-- exception cannot arrive before we assign a finalizer
-- | A decoded phone number. While internally it is a handle for the
-- corresponding C++ object, for most intents and purposes it can be used as
-- a record (using the v'Data.PhoneNumber.Number.PhoneNumber' record pattern
-- synonym) with the following structure:
--
-- @
-- v'Data.PhoneNumber.Number.PhoneNumber'
-- { 'Data.PhoneNumber.Number.extension' :: !('Maybe' 'ByteString')
-- , 'Data.PhoneNumber.Number.rawInput' :: !('Maybe' 'ByteString')
-- , 'Data.PhoneNumber.Number.preferredDomesticCarrierCode' :: !('Maybe' 'ByteString')
-- , 'Data.PhoneNumber.Number.nationalNumber' :: !'Word'
-- , 'Data.PhoneNumber.Number.countryCode' :: ! t'Data.PhoneNumber.Number.CountryCode'
-- , 'Data.PhoneNumber.Number.italianLeadingZero' :: !('Maybe' 'Bool')
-- , 'Data.PhoneNumber.Number.countryCodeSource' :: !('Maybe' 'CountryCodeSource')
-- , 'Data.PhoneNumber.Number.numberOfLeadingZeros' :: !('Maybe' 'Int')
-- }
-- @
newtype PhoneNumber = PhoneNumber (C2HSImp.ForeignPtr (PhoneNumber))
withPhoneNumber :: PhoneNumber -> (C2HSImp.Ptr PhoneNumber -> IO b) -> IO b
withPhoneNumber :: forall b. PhoneNumber -> (Ptr PhoneNumber -> IO b) -> IO b
withPhoneNumber (PhoneNumber fptr) = C2HSImp.withForeignPtr ForeignPtr PhoneNumber
fptr
{-# LINE 129 "src/Data/PhoneNumber/Internal/Number.chs" #-}


c_phone_number_marshal :: (CPhoneNumber) -> IO ((PhoneNumber))
c_phone_number_marshal :: CPhoneNumber -> IO PhoneNumber
c_phone_number_marshal CPhoneNumber
a1 =
  CPhoneNumber
-> (Ptr CPhoneNumber -> IO PhoneNumber) -> IO PhoneNumber
forall a. CPhoneNumber -> (Ptr CPhoneNumber -> IO a) -> IO a
withCPhoneNumber CPhoneNumber
a1 ((Ptr CPhoneNumber -> IO PhoneNumber) -> IO PhoneNumber)
-> (Ptr CPhoneNumber -> IO PhoneNumber) -> IO PhoneNumber
forall a b. (a -> b) -> a -> b
$ \Ptr CPhoneNumber
a1' -> 
  Ptr CPhoneNumber -> IO (Ptr PhoneNumber)
c_phone_number_marshal'_ Ptr CPhoneNumber
a1' IO (Ptr PhoneNumber)
-> (Ptr PhoneNumber -> IO PhoneNumber) -> IO PhoneNumber
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr PhoneNumber
res ->
  (\Ptr PhoneNumber
x -> FinalizerPtr PhoneNumber
-> Ptr PhoneNumber -> IO (ForeignPtr PhoneNumber)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
C2HSImp.newForeignPtr FinalizerPtr PhoneNumber
c_phone_number_free Ptr PhoneNumber
x IO (ForeignPtr PhoneNumber)
-> (ForeignPtr PhoneNumber -> IO PhoneNumber) -> IO PhoneNumber
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PhoneNumber -> IO PhoneNumber
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PhoneNumber -> IO PhoneNumber)
-> (ForeignPtr PhoneNumber -> PhoneNumber)
-> ForeignPtr PhoneNumber
-> IO PhoneNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr PhoneNumber -> PhoneNumber
PhoneNumber)) Ptr PhoneNumber
res IO PhoneNumber -> (PhoneNumber -> IO PhoneNumber) -> IO PhoneNumber
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PhoneNumber
res' ->
  PhoneNumber -> IO PhoneNumber
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PhoneNumber
res')

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


c_phone_number_unmarshal :: (PhoneNumber) -> IO ((CPhoneNumber))
c_phone_number_unmarshal a1 =
  (withPhoneNumber) a1 $ \a1' -> 
  allocaCPhoneNumber $ \a2' -> 
  c_phone_number_unmarshal'_ a1' a2' >>
  acquireCPhoneNumber  a2'>>= \a2'' -> 
  return (a2'')

{-# LINE 138 "src/Data/PhoneNumber/Internal/Number.chs" #-}

  where
    allocaCPhoneNumber :: (Ptr CPhoneNumber -> IO a) -> IO a
    allocaCPhoneNumber = allocaBytes 72
{-# LINE 141 "src/Data/PhoneNumber/Internal/Number.chs" #-}


{-# INLINABLE toCPhoneNumber #-}
toCPhoneNumber :: PhoneNumber -> CPhoneNumber
toCPhoneNumber :: PhoneNumber -> CPhoneNumber
toCPhoneNumber = IO CPhoneNumber -> CPhoneNumber
forall a. IO a -> a
unsafeDupablePerformIO (IO CPhoneNumber -> CPhoneNumber)
-> (PhoneNumber -> IO CPhoneNumber) -> PhoneNumber -> CPhoneNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CPhoneNumber -> IO CPhoneNumber
forall a. IO a -> IO a
mask_ (IO CPhoneNumber -> IO CPhoneNumber)
-> (PhoneNumber -> IO CPhoneNumber)
-> PhoneNumber
-> IO CPhoneNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhoneNumber -> IO CPhoneNumber
c_phone_number_unmarshal

{-# INLINABLE fromCPhoneNumber #-}
fromCPhoneNumber :: CPhoneNumber -> PhoneNumber
fromCPhoneNumber :: CPhoneNumber -> PhoneNumber
fromCPhoneNumber = IO PhoneNumber -> PhoneNumber
forall a. IO a -> a
unsafeDupablePerformIO (IO PhoneNumber -> PhoneNumber)
-> (CPhoneNumber -> IO PhoneNumber) -> CPhoneNumber -> PhoneNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO PhoneNumber -> IO PhoneNumber
forall a. IO a -> IO a
mask_ (IO PhoneNumber -> IO PhoneNumber)
-> (CPhoneNumber -> IO PhoneNumber)
-> CPhoneNumber
-> IO PhoneNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPhoneNumber -> IO PhoneNumber
c_phone_number_marshal

-- These would ideally be defined in @Data.PhoneNumber.Number@ but that would
-- make them orphan instances.

-- | Compares all the data fields, consider 'Data.PhoneNumber.Util.matchNumbers'
-- instead
instance Eq PhoneNumber where
  PhoneNumber
p1 == :: PhoneNumber -> PhoneNumber -> Bool
== PhoneNumber
p2 = PhoneNumber -> CPhoneNumber
toCPhoneNumber PhoneNumber
p1 CPhoneNumber -> CPhoneNumber -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneNumber -> CPhoneNumber
toCPhoneNumber PhoneNumber
p2

instance Ord PhoneNumber where
  PhoneNumber
p1 compare :: PhoneNumber -> PhoneNumber -> Ordering
`compare` PhoneNumber
p2 = PhoneNumber -> CPhoneNumber
toCPhoneNumber PhoneNumber
p1 CPhoneNumber -> CPhoneNumber -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` PhoneNumber -> CPhoneNumber
toCPhoneNumber PhoneNumber
p2
  PhoneNumber
p1 <= :: PhoneNumber -> PhoneNumber -> Bool
<= PhoneNumber
p2 = PhoneNumber -> CPhoneNumber
toCPhoneNumber PhoneNumber
p1 CPhoneNumber -> CPhoneNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= PhoneNumber -> CPhoneNumber
toCPhoneNumber PhoneNumber
p2

instance Show PhoneNumber where
  showsPrec :: Int -> PhoneNumber -> ShowS
showsPrec Int
d PhoneNumber
p = ShowS
mangleConParen ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CPhoneNumber -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (PhoneNumber -> CPhoneNumber
toCPhoneNumber PhoneNumber
p)
    where
      mangleConParen :: ShowS
mangleConParen String
xs
        | Just String
xs' <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"(" String
xs = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
mangleCon String
xs'
        | Bool
otherwise = ShowS
mangleCon String
xs
      mangleCon :: ShowS
mangleCon String
xs
        | Just String
xs' <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"CPhoneNumber " String
xs = String
"PhoneNumber " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs'
        | Bool
otherwise = String
xs

instance Read PhoneNumber where
  readPrec :: ReadPrec PhoneNumber
readPrec = ReadPrec PhoneNumber -> ReadPrec PhoneNumber
forall a. ReadPrec a -> ReadPrec a
P.parens (ReadPrec PhoneNumber -> ReadPrec PhoneNumber)
-> ReadPrec PhoneNumber -> ReadPrec PhoneNumber
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec PhoneNumber -> ReadPrec PhoneNumber
forall a. Int -> ReadPrec a -> ReadPrec a
P.prec Int
11 (ReadPrec PhoneNumber -> ReadPrec PhoneNumber)
-> ReadPrec PhoneNumber -> ReadPrec PhoneNumber
forall a b. (a -> b) -> a -> b
$ do
    Lexeme -> ReadPrec ()
P.expectP (String -> Lexeme
P.Ident String
"PhoneNumber")
    CPhoneNumber -> PhoneNumber
fromCPhoneNumber (CPhoneNumber -> PhoneNumber)
-> ReadPrec CPhoneNumber -> ReadPrec PhoneNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> ReadS CPhoneNumber) -> ReadPrec CPhoneNumber
forall a. (Int -> ReadS a) -> ReadPrec a
P.readS_to_Prec
      (\Int
d String
xs -> Int -> ReadS CPhoneNumber
forall a. Read a => Int -> ReadS a
readsPrec Int
d ReadS CPhoneNumber -> ReadS CPhoneNumber
forall a b. (a -> b) -> a -> b
$ String
"CPhoneNumber" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs)

-- | No internal structure
instance Data PhoneNumber where
  toConstr :: PhoneNumber -> Constr
toConstr PhoneNumber
_ = String -> Constr
forall a. HasCallStack => String -> a
error String
"Data.PhoneNumber.Number.Number.toConstr"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PhoneNumber
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = String -> Constr -> c PhoneNumber
forall a. HasCallStack => String -> a
error String
"Data.PhoneNumber.Number.Number.gunfold"
  dataTypeOf :: PhoneNumber -> DataType
dataTypeOf PhoneNumber
_ = String -> DataType
mkNoRepType String
"Data.PhoneNumber.Number.Number"

instance NFData PhoneNumber where
  rnf :: PhoneNumber -> ()
rnf PhoneNumber
pn = PhoneNumber
pn PhoneNumber -> () -> ()
forall a b. a -> b -> b
`seq` ()

foreign import ccall "Data/PhoneNumber/Internal/Number.chs.h &c_phone_number_free"
  c_phone_number_free :: C2HSImp.FinalizerPtr PhoneNumber

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

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