{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}

{-# OPTIONS_HADDOCK not-home #-}

module Country.Unexposed.Names
  ( englishCountryNamesText
  , englishIdentifierNamesText
  , numberOfPossibleCodes
  , decodeMap
  , hashMapUtf8
  , hashMapUtf16
  , decodeMapUtf8
  , alphaTwoHashMap
  , alphaThreeHashMap
  , decodeNumeric
  , encodeEnglish
  , encodeEnglishShort
  , Country(..)
  ) where

import Control.Monad
import Control.Monad.ST
import Data.Word

import Control.DeepSeq (NFData)
import Country.Unexposed.Alias (aliases)
import Country.Unexposed.Encode.English (countryNameQuads)
import Data.Bytes.Types (Bytes(Bytes))
import Data.ByteString (ByteString)
import Data.Char (toLower,isAlpha,toUpper)
import Data.Data
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import Data.Primitive (Array,indexArray,newArray,unsafeFreezeArray,writeArray)
import Data.Primitive (sizeOf)
import Data.Primitive (writeByteArray,indexByteArray,unsafeFreezeByteArray,newByteArray)
import Data.Primitive.ByteArray (ByteArray(..))
import Data.Primitive.Types (Prim)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8,encodeUtf16BE)
import Data.Text.Short (ShortText)
import Foreign.Storable (Storable)
import GHC.Generics (Generic)

import qualified Data.Aeson as AE
import qualified Data.Aeson.Types as AET
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.HashMap.Word as BytesHashMap
import qualified Data.ByteString as ByteString
import qualified Data.HashMap.Strict as HM
import qualified Data.List as L
import qualified Data.Primitive.Unlifted.Array as PM
import qualified Data.Scientific as SCI
import qualified Data.Text as T
import qualified Data.Text.Array as Text
import qualified Data.Text.Internal as Text
import qualified Data.Text.Short as TS
import qualified GHC.Exts as Exts

-- | The name of a country given in English
encodeEnglish :: Country -> Text
{-# inline encodeEnglish #-}
encodeEnglish :: Country -> Text
encodeEnglish (Country Word16
n) = forall a. Array a -> Int -> a
indexArray Array Text
englishCountryNamesText (Word16 -> Int
word16ToInt Word16
n)

-- | The name of a country given in English
encodeEnglishShort :: Country -> ShortText
{-# inline encodeEnglishShort #-}
encodeEnglishShort :: Country -> ShortText
encodeEnglishShort (Country Word16
n) =
  forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
PM.indexUnliftedArray UnliftedArray ShortText
englishCountryNamesShortText (Word16 -> Int
word16ToInt Word16
n)

englishCountryNamesShortText :: PM.UnliftedArray ShortText
englishCountryNamesShortText :: UnliftedArray ShortText
englishCountryNamesShortText = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MutableUnliftedArray s ShortText
m <- forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
PM.newUnliftedArray Int
numberOfPossibleCodes ShortText
unnamedShort
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Word16
ix,Text
name,(Char, Char)
_,(Char, Char, Char)
_) -> forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
PM.writeUnliftedArray MutableUnliftedArray s ShortText
m (Word16 -> Int
word16ToInt Word16
ix) (Text -> ShortText
TS.fromText Text
name)) [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads
  forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
PM.unsafeFreezeUnliftedArray MutableUnliftedArray s ShortText
m
{-# NOINLINE englishCountryNamesShortText #-}

englishCountryNamesText :: Array Text
englishCountryNamesText :: Array Text
englishCountryNamesText = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MutableArray s Text
m <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
numberOfPossibleCodes Text
unnamed
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Word16
ix,Text
name,(Char, Char)
_,(Char, Char, Char)
_) -> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s Text
m (Word16 -> Int
word16ToInt Word16
ix) Text
name) [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads
  forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s Text
m
{-# NOINLINE englishCountryNamesText #-}

englishIdentifierNamesText :: Array Text
englishIdentifierNamesText :: Array Text
englishIdentifierNamesText = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MutableArray s Text
m <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
numberOfPossibleCodes Text
unnamed
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Word16
ix,Text
name,(Char, Char)
_,(Char, Char, Char)
_) -> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s Text
m (Word16 -> Int
word16ToInt Word16
ix) (Text -> Text
toIdentifier Text
name)) [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads
  forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s Text
m
{-# NOINLINE englishIdentifierNamesText #-}

toIdentifier :: Text -> Text
toIdentifier :: Text -> Text
toIdentifier Text
t = case (Text -> Maybe (Char, Text)
T.uncons forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isAlpha forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
slowToTitle) Text
t of
  Maybe (Char, Text)
Nothing -> Text
T.empty
  Just (Char
b,Text
bs) -> Char -> Text -> Text
T.cons (Char -> Char
toLower Char
b) Text
bs


unnamed :: Text
unnamed :: Text
unnamed = String -> Text
T.pack String
"Invalid Country"
{-# NOINLINE unnamed #-}

unnamedShort :: ShortText
unnamedShort :: ShortText
unnamedShort = String -> ShortText
TS.pack String
"Invalid Country"
{-# NOINLINE unnamedShort #-}

numberOfPossibleCodes :: Int
numberOfPossibleCodes :: Int
numberOfPossibleCodes = Int
1000

word16ToInt :: Word16 -> Int
word16ToInt :: Word16 -> Int
word16ToInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral

decodeMap :: HashMap Text Country
{-# NOINLINE decodeMap #-}
decodeMap :: HashMap Text Country
decodeMap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (forall a b. (a -> b) -> [a] -> [b]
map (\(Word16
a,Text
b) -> (Text
b,Word16 -> Country
Country Word16
a)) [(Word16, Text)]
countryPairs)

hashMapUtf8 :: BytesHashMap.Map
hashMapUtf8 :: Map
hashMapUtf8 = [(Bytes, Word)] -> Map
BytesHashMap.fromTrustedList
  ( forall a b. (a -> b) -> [a] -> [b]
map
    (\(Word16
a,Text
t) -> (forall l. IsList l => [Item l] -> l
Exts.fromList (ByteString -> [Word8]
ByteString.unpack (Text -> ByteString
encodeUtf8 Text
t)),forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a)
    ) [(Word16, Text)]
countryPairs
  )

-- It is a hack to pull from a source of randomness in here, but whatever.
-- Maybe I can get rid of this if GHC ever supports casing on values of
-- type ByteArray# along with good codegen for it.
hashMapUtf16 :: BytesHashMap.Map
hashMapUtf16 :: Map
hashMapUtf16 = [(Bytes, Word)] -> Map
BytesHashMap.fromTrustedList
  ( forall a b. (a -> b) -> [a] -> [b]
map
    (\(Word16
a, Text
str) ->
      (ByteString -> Bytes
Bytes.fromByteString forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf16BE Text
str, forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a)
    ) [(Word16, Text)]
countryPairs
  )
countryPairs :: [(Word16,Text)]
{-# NOINLINE countryPairs #-}
countryPairs :: [(Word16, Text)]
countryPairs =
  let x :: [(Word16, Text)]
x = [(Word16, Text)]
aliases forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
        (\(Word16
num,Text
name,(Char
c2a,Char
c2b),(Char
c3a,Char
c3b,Char
c3c)) ->
          [ (Word16
num,Text
name)
          , (Word16
num,String -> Text
T.pack [Char
c2a,Char
c2b])
          , (Word16
num,String -> Text
T.pack [Char
c3a,Char
c3b,Char
c3c])
          , (Word16
num,String -> Text
T.pack [Char -> Char
toLower Char
c2a,Char -> Char
toLower Char
c2b])
          , (Word16
num,String -> Text
T.pack [Char -> Char
toLower Char
c3a,Char -> Char
toLower Char
c3b,Char -> Char
toLower Char
c3c])
          ]
        ) [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads
   in [(Word16, Text)]
x forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(Word16
a,Text
b) -> (Word16
a,Text -> Text
slowToTitle Text
b)) [(Word16, Text)]
x

-- This is only needed to support the reflex-platform fork of text. Fortunately,
-- in all the places this is needed, it is only called to build CAFs.
slowToTitle :: Text -> Text
slowToTitle :: Text -> Text
slowToTitle = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
upperFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
T.splitOn (Char -> Text
T.singleton Char
' ')

upperFirst :: Text -> Text
upperFirst :: Text -> Text
upperFirst Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Maybe (Char, Text)
Nothing -> Text
T.empty
  Just (Char
c,Text
cs) -> Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
c) Text
cs

decodeMapUtf8 :: HashMap ByteString Country
decodeMapUtf8 :: HashMap ByteString Country
decodeMapUtf8 = forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' (\HashMap ByteString Country
hm Text
k Country
v -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (Text -> ByteString
encodeUtf8 Text
k) Country
v HashMap ByteString Country
hm) forall k v. HashMap k v
HM.empty HashMap Text Country
decodeMap
{-# NOINLINE decodeMapUtf8 #-}

-- | A country recognized by ISO 3166.
newtype Country = Country Word16
  deriving (Country -> Country -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Country -> Country -> Bool
$c/= :: Country -> Country -> Bool
== :: Country -> Country -> Bool
$c== :: Country -> Country -> Bool
Eq,Eq Country
Country -> Country -> Bool
Country -> Country -> Ordering
Country -> Country -> Country
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 :: Country -> Country -> Country
$cmin :: Country -> Country -> Country
max :: Country -> Country -> Country
$cmax :: Country -> Country -> Country
>= :: Country -> Country -> Bool
$c>= :: Country -> Country -> Bool
> :: Country -> Country -> Bool
$c> :: Country -> Country -> Bool
<= :: Country -> Country -> Bool
$c<= :: Country -> Country -> Bool
< :: Country -> Country -> Bool
$c< :: Country -> Country -> Bool
compare :: Country -> Country -> Ordering
$ccompare :: Country -> Country -> Ordering
Ord,Addr# -> Int# -> Country
ByteArray# -> Int# -> Country
Country -> Int#
forall s. Addr# -> Int# -> Int# -> Country -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, Country #)
forall s. Addr# -> Int# -> Country -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> Country -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Country #)
forall s.
MutableByteArray# s -> Int# -> Country -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> Country -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> Country -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Country -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Country -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Country #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Country #)
indexOffAddr# :: Addr# -> Int# -> Country
$cindexOffAddr# :: Addr# -> Int# -> Country
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Country -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Country -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Country -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Country -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Country #)
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Country #)
indexByteArray# :: ByteArray# -> Int# -> Country
$cindexByteArray# :: ByteArray# -> Int# -> Country
alignment# :: Country -> Int#
$calignment# :: Country -> Int#
sizeOf# :: Country -> Int#
$csizeOf# :: Country -> Int#
Prim,Eq Country
Int -> Country -> Int
Country -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Country -> Int
$chash :: Country -> Int
hashWithSalt :: Int -> Country -> Int
$chashWithSalt :: Int -> Country -> Int
Hashable,Ptr Country -> IO Country
Ptr Country -> Int -> IO Country
Ptr Country -> Int -> Country -> IO ()
Ptr Country -> Country -> IO ()
Country -> Int
forall b. Ptr b -> Int -> IO Country
forall b. Ptr b -> Int -> Country -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Country -> Country -> IO ()
$cpoke :: Ptr Country -> Country -> IO ()
peek :: Ptr Country -> IO Country
$cpeek :: Ptr Country -> IO Country
pokeByteOff :: forall b. Ptr b -> Int -> Country -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Country -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Country
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Country
pokeElemOff :: Ptr Country -> Int -> Country -> IO ()
$cpokeElemOff :: Ptr Country -> Int -> Country -> IO ()
peekElemOff :: Ptr Country -> Int -> IO Country
$cpeekElemOff :: Ptr Country -> Int -> IO Country
alignment :: Country -> Int
$calignment :: Country -> Int
sizeOf :: Country -> Int
$csizeOf :: Country -> Int
Storable,Country -> ()
forall a. (a -> ()) -> NFData a
rnf :: Country -> ()
$crnf :: Country -> ()
NFData,forall x. Rep Country x -> Country
forall x. Country -> Rep Country x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Country x -> Country
$cfrom :: forall x. Country -> Rep Country x
Generic,Typeable Country
Country -> DataType
Country -> Constr
(forall b. Data b => b -> b) -> Country -> Country
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) -> Country -> u
forall u. (forall d. Data d => d -> u) -> Country -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Country -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Country -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Country -> m Country
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Country -> m Country
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Country
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Country -> c Country
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Country)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Country)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Country -> m Country
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Country -> m Country
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Country -> m Country
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Country -> m Country
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Country -> m Country
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Country -> m Country
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Country -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Country -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Country -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Country -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Country -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Country -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Country -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Country -> r
gmapT :: (forall b. Data b => b -> b) -> Country -> Country
$cgmapT :: (forall b. Data b => b -> b) -> Country -> Country
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Country)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Country)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Country)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Country)
dataTypeOf :: Country -> DataType
$cdataTypeOf :: Country -> DataType
toConstr :: Country -> Constr
$ctoConstr :: Country -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Country
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Country
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Country -> c Country
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Country -> c Country
Data,Typeable)

instance Show Country where
  show :: Country -> String
show (Country Word16
n) = Text -> String
T.unpack (forall a. Array a -> Int -> a
indexArray Array Text
englishIdentifierNamesText (Word16 -> Int
word16ToInt Word16
n))

instance Enum Country where
  fromEnum :: Country -> Int
fromEnum (Country Word16
w) = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
countryCodeToSequentialMapping (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w)
  toEnum :: Int -> Country
toEnum Int
number = if Int
number forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
number forall a. Ord a => a -> a -> Bool
< Int
actualNumberOfCountries
    then Word16 -> Country
Country (forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
sequentialToCountryCodeMapping Int
number)
    else forall a. HasCallStack => String -> a
error (String
"toEnum: cannot convert " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
number forall a. [a] -> [a] -> [a]
++ String
" to Country")
instance Bounded Country where
  minBound :: Country
minBound = Word16 -> Country
Country (forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
sequentialToCountryCodeMapping Int
0)
  maxBound :: Country
maxBound = Word16 -> Country
Country (forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
sequentialToCountryCodeMapping (Int
actualNumberOfCountries forall a. Num a => a -> a -> a
- Int
1))

orderedCountryCodes :: [Word16]
orderedCountryCodes :: [Word16]
orderedCountryCodes = forall a. Ord a => [a] -> [a]
L.sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Word16
a,Text
_,(Char, Char)
_,(Char, Char, Char)
_) -> Word16
a) [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads

countryCodeToSequentialMapping :: ByteArray
countryCodeToSequentialMapping :: ByteArray
countryCodeToSequentialMapping = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
numbers <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int
numberOfPossibleCodes forall a. Num a => a -> a -> a
* forall a. Prim a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: Int))
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int,Int
1..] [Word16]
orderedCountryCodes) forall a b. (a -> b) -> a -> b
$ \(Int
number,Word16
code) -> do
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
numbers (Word16 -> Int
word16ToInt Word16
code) Int
number
  forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
numbers
{-# NOINLINE countryCodeToSequentialMapping #-}

sequentialToCountryCodeMapping :: ByteArray
sequentialToCountryCodeMapping :: ByteArray
sequentialToCountryCodeMapping = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
codes <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int
actualNumberOfCountries forall a. Num a => a -> a -> a
* forall a. Prim a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: Word16))
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int,Int
1..] [Word16]
orderedCountryCodes) forall a b. (a -> b) -> a -> b
$ \(Int
number,Word16
code) -> do
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
codes Int
number (Word16
code :: Word16)
  forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
codes
{-# NOINLINE sequentialToCountryCodeMapping #-}

actualNumberOfCountries :: Int
actualNumberOfCountries :: Int
actualNumberOfCountries = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads
{-# NOINLINE actualNumberOfCountries #-}


-- todo: add support for encoding directly to bytestring.
-- Also, add suport for ToJSONKey and FromJSONKey once everything
-- finally gets off of aeson-0.11 (looking at you, reflex-platform)
instance AE.ToJSON Country where
  toJSON :: Country -> Value
toJSON = Text -> Value
AET.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. Country -> Text
encodeEnglish

instance AE.FromJSON Country where
  parseJSON :: Value -> Parser Country
parseJSON Value
x = case Value
x of
    AET.String Text
t -> case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
t HashMap Text Country
decodeMap of
      Maybe Country
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid country name " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
      Just Country
country -> forall (m :: * -> *) a. Monad m => a -> m a
return Country
country
    AET.Number Scientific
n -> case forall i. (Integral i, Bounded i) => Scientific -> Maybe i
SCI.toBoundedInteger Scientific
n of
      Maybe Word16
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall {a}. [a]
errMsg
      Just Word16
w -> case Word16 -> Maybe Country
decodeNumeric Word16
w of
        Just Country
c -> forall (m :: * -> *) a. Monad m => a -> m a
return Country
c
        Maybe Country
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall {a}. [a]
errMsg
      where errMsg :: [a]
errMsg = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid country code " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
n
    Value
_ -> forall a. String -> Value -> Parser a
AET.typeMismatch String
"Country" Value
x

-- | Get a country from a numeric code. Any code greater than
--   999 will not have a country associated with it. Additionally,
--   many codes are unassigned.
decodeNumeric :: Word16 -> Maybe Country
decodeNumeric :: Word16 -> Maybe Country
decodeNumeric Word16
n = if Word16
n forall a. Ord a => a -> a -> Bool
< Word16
1000 Bool -> Bool -> Bool
&& forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
numericValidities (Word16 -> Int
word16ToInt Word16
n) forall a. Eq a => a -> a -> Bool
== (Word8
1 :: Word8)
  then forall a. a -> Maybe a
Just (Word16 -> Country
Country Word16
n)
  else forall a. Maybe a
Nothing

-- | The elements in this array are Word8 (basically boolean)
numericValidities :: ByteArray
numericValidities :: ByteArray
numericValidities = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray (PrimState (ST s))
m <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
numberOfPossibleCodes
  let clear :: Int -> ST s ()
clear !Int
ix = if Int
ix forall a. Ord a => a -> a -> Bool
< Int
numberOfPossibleCodes
        then forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState (ST s))
m Int
ix (Word8
0 :: Word8)
        else forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Int -> ST s ()
clear Int
0
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads forall a b. (a -> b) -> a -> b
$ \(Word16
n,Text
_,(Char, Char)
_,(Char, Char, Char)
_) -> do
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState (ST s))
m (Word16 -> Int
word16ToInt Word16
n) (Word8
1 :: Word8)
  forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray (PrimState (ST s))
m
{-# NOINLINE numericValidities #-}

alphaTwoHashMap :: HashMap Text Country
alphaTwoHashMap :: HashMap Text Country
alphaTwoHashMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl'
  (\HashMap Text Country
hm (Word16
countryNum,Text
_,(Char
c1,Char
c2),(Char, Char, Char)
_) ->
      forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (String -> Text
T.pack [Char
c1,Char
c2]) (Word16 -> Country
Country Word16
countryNum)
    forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (String -> Text
T.pack [Char -> Char
toLower Char
c1, Char -> Char
toLower Char
c2]) (Word16 -> Country
Country Word16
countryNum)
    forall a b. (a -> b) -> a -> b
$ HashMap Text Country
hm
  )
  forall k v. HashMap k v
HM.empty [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads
{-# NOINLINE alphaTwoHashMap #-}

alphaThreeHashMap :: HashMap Text Country
alphaThreeHashMap :: HashMap Text Country
alphaThreeHashMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl'
  (\HashMap Text Country
hm (Word16
countryNum,Text
_,(Char, Char)
_,(Char
c1,Char
c2,Char
c3)) ->
      forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (String -> Text
T.pack [Char
c1,Char
c2,Char
c3]) (Word16 -> Country
Country Word16
countryNum)
    forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (String -> Text
T.pack [Char -> Char
toLower Char
c1, Char -> Char
toLower Char
c2, Char -> Char
toLower Char
c3]) (Word16 -> Country
Country Word16
countryNum)
    forall a b. (a -> b) -> a -> b
$ HashMap Text Country
hm
  )
  forall k v. HashMap k v
HM.empty [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads
{-# NOINLINE alphaThreeHashMap #-}