{-# 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 Control.Exception (bracket)
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.Array (Array(..))
import Data.Primitive.ByteArray (ByteArray(..))
import Data.Primitive.Types (Prim)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Short (ShortText)
import Data.Word (Word16)
import Foreign.Storable (Storable)
import GHC.Generics (Generic)
import System.Entropy (openHandle,closeHandle)
import System.IO.Unsafe (unsafePerformIO)

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

-- | The name of a country given in English
encodeEnglish :: Country -> Text
{-# inline encodeEnglish #-}
encodeEnglish :: Country -> Text
encodeEnglish (Country Word16
n) = Array Text -> Int -> Text
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) =
  UnliftedArray ShortText -> Int -> ShortText
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 s. ST s (UnliftedArray ShortText))
-> UnliftedArray ShortText
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UnliftedArray ShortText))
 -> UnliftedArray ShortText)
-> (forall s. ST s (UnliftedArray ShortText))
-> UnliftedArray ShortText
forall a b. (a -> b) -> a -> b
$ do
  MutableUnliftedArray s ShortText
m <- Int
-> ShortText
-> ST s (MutableUnliftedArray (PrimState (ST s)) ShortText)
forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
PM.newUnliftedArray Int
numberOfPossibleCodes ShortText
unnamedShort
  ((Word16, Text, (Char, Char), (Char, Char, Char)) -> ST s ())
-> [(Word16, Text, (Char, Char), (Char, Char, Char))] -> ST s ()
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)
_) -> MutableUnliftedArray (PrimState (ST s)) ShortText
-> Int -> ShortText -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
PM.writeUnliftedArray MutableUnliftedArray s ShortText
MutableUnliftedArray (PrimState (ST s)) ShortText
m (Word16 -> Int
word16ToInt Word16
ix) (Text -> ShortText
TS.fromText Text
name)) [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads
  MutableUnliftedArray (PrimState (ST s)) ShortText
-> ST s (UnliftedArray ShortText)
forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
PM.unsafeFreezeUnliftedArray MutableUnliftedArray s ShortText
MutableUnliftedArray (PrimState (ST s)) ShortText
m
{-# NOINLINE englishCountryNamesShortText #-}

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

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

toIdentifier :: Text -> Text
toIdentifier :: Text -> Text
toIdentifier Text
t = case (Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text))
-> (Text -> Text) -> Text -> Maybe (Char, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isAlpha (Text -> Text) -> (Text -> Text) -> Text -> Text
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 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

decodeMap :: HashMap Text Country
{-# NOINLINE decodeMap #-}
decodeMap :: HashMap Text Country
decodeMap = [(Text, Country)] -> HashMap Text Country
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (((Word16, Text) -> (Text, Country))
-> [(Word16, Text)] -> [(Text, Country)]
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
  ( ((Word16, Text) -> (Bytes, Word))
-> [(Word16, Text)] -> [(Bytes, Word)]
forall a b. (a -> b) -> [a] -> [b]
map
    (\(Word16
a,Text
t) -> ([Item Bytes] -> Bytes
forall l. IsList l => [Item l] -> l
Exts.fromList (ByteString -> [Word8]
ByteString.unpack (Text -> ByteString
encodeUtf8 Text
t)),Word16 -> Word
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
  ( ((Word16, Text) -> (Bytes, Word))
-> [(Word16, Text)] -> [(Bytes, Word)]
forall a b. (a -> b) -> [a] -> [b]
map
    (\(Word16
a,Text.Text (Text.Array ByteArray#
arr) Int
off16 Int
len16) ->
      (ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) (Int
off16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (Int
len16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2),Word16 -> Word
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 [(Word16, Text)] -> [(Word16, Text)] -> [(Word16, Text)]
forall a. [a] -> [a] -> [a]
++ ((Word16, Text, (Char, Char), (Char, Char, Char))
 -> [(Word16, Text)])
-> [(Word16, Text, (Char, Char), (Char, Char, Char))]
-> [(Word16, Text)]
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 [(Word16, Text)] -> [(Word16, Text)] -> [(Word16, Text)]
forall a. [a] -> [a] -> [a]
++ ((Word16, Text) -> (Word16, Text))
-> [(Word16, Text)] -> [(Word16, Text)]
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
' ') ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
upperFirst ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (HashMap ByteString Country
 -> Text -> Country -> HashMap ByteString Country)
-> HashMap ByteString Country
-> HashMap Text Country
-> HashMap ByteString Country
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' (\HashMap ByteString Country
hm Text
k Country
v -> ByteString
-> Country
-> HashMap ByteString Country
-> HashMap ByteString Country
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) HashMap ByteString Country
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
(Country -> Country -> Bool)
-> (Country -> Country -> Bool) -> Eq Country
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
Eq Country
-> (Country -> Country -> Ordering)
-> (Country -> Country -> Bool)
-> (Country -> Country -> Bool)
-> (Country -> Country -> Bool)
-> (Country -> Country -> Bool)
-> (Country -> Country -> Country)
-> (Country -> Country -> Country)
-> Ord 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
$cp1Ord :: Eq Country
Ord,Addr# -> Int# -> Country
Addr# -> Int# -> Int# -> Country -> State# s -> State# s
Addr# -> Int# -> State# s -> (# State# s, Country #)
Addr# -> Int# -> Country -> State# s -> State# s
ByteArray# -> Int# -> Country
MutableByteArray# s -> Int# -> State# s -> (# State# s, Country #)
MutableByteArray# s -> Int# -> Country -> State# s -> State# s
MutableByteArray# s
-> Int# -> Int# -> Country -> State# s -> State# s
Country -> Int#
(Country -> Int#)
-> (Country -> Int#)
-> (ByteArray# -> Int# -> Country)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Country #))
-> (forall s.
    MutableByteArray# s -> Int# -> Country -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> Country -> State# s -> State# s)
-> (Addr# -> Int# -> Country)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, Country #))
-> (forall s. Addr# -> Int# -> Country -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> Country -> State# s -> State# s)
-> Prim Country
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# :: Addr# -> Int# -> Int# -> Country -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> Country -> State# s -> State# s
writeOffAddr# :: Addr# -> Int# -> Country -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Country -> State# s -> State# s
readOffAddr# :: 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# :: MutableByteArray# s
-> Int# -> Int# -> Country -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Country -> State# s -> State# s
writeByteArray# :: MutableByteArray# s -> Int# -> Country -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Country -> State# s -> State# s
readByteArray# :: 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
Eq Country
-> (Int -> Country -> Int) -> (Country -> Int) -> Hashable 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
$cp1Hashable :: Eq Country
Hashable,Ptr b -> Int -> IO Country
Ptr b -> Int -> Country -> IO ()
Ptr Country -> IO Country
Ptr Country -> Int -> IO Country
Ptr Country -> Int -> Country -> IO ()
Ptr Country -> Country -> IO ()
Country -> Int
(Country -> Int)
-> (Country -> Int)
-> (Ptr Country -> Int -> IO Country)
-> (Ptr Country -> Int -> Country -> IO ())
-> (forall b. Ptr b -> Int -> IO Country)
-> (forall b. Ptr b -> Int -> Country -> IO ())
-> (Ptr Country -> IO Country)
-> (Ptr Country -> Country -> IO ())
-> Storable Country
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 :: Ptr b -> Int -> Country -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Country -> IO ()
peekByteOff :: 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 -> ()
(Country -> ()) -> NFData Country
forall a. (a -> ()) -> NFData a
rnf :: Country -> ()
$crnf :: Country -> ()
NFData,(forall x. Country -> Rep Country x)
-> (forall x. Rep Country x -> Country) -> Generic Country
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
DataType
Constr
Typeable Country
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Country -> c Country)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Country)
-> (Country -> Constr)
-> (Country -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Country -> Country)
-> (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 u. (forall d. Data d => d -> u) -> Country -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Country -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Country -> m Country)
-> Data Country
Country -> DataType
Country -> Constr
(forall b. Data b => b -> b) -> Country -> Country
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Country -> c Country
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cCountry :: Constr
$tCountry :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Country -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Country -> u
gmapQ :: (forall d. Data d => d -> u) -> Country -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Country -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Country
Data,Typeable)

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

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

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

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


codeToEnum :: Word16 -> Int
codeToEnum :: Word16 -> Int
codeToEnum Word16
w = ByteArray -> Int -> Int
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
countryCodeToSequentialMapping (Word16 -> Int
word16ToInt Word16
w)

-- 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 (Text -> Value) -> (Country -> Text) -> Country -> Value
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 Text -> HashMap Text Country -> Maybe Country
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 -> String -> Parser Country
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Country) -> String -> Parser Country
forall a b. (a -> b) -> a -> b
$ String
"invalid country name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
      Just Country
country -> Country -> Parser Country
forall (m :: * -> *) a. Monad m => a -> m a
return Country
country
    AET.Number Scientific
n -> case Scientific -> Maybe Word16
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
SCI.toBoundedInteger Scientific
n of
      Maybe Word16
Nothing -> String -> Parser Country
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
forall a. [a]
errMsg
      Just Word16
w -> case Word16 -> Maybe Country
decodeNumeric Word16
w of
        Just Country
c -> Country -> Parser Country
forall (m :: * -> *) a. Monad m => a -> m a
return Country
c
        Maybe Country
Nothing -> String -> Parser Country
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
forall a. [a]
errMsg
      where errMsg :: [a]
errMsg = String -> [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> [a]) -> String -> [a]
forall a b. (a -> b) -> a -> b
$ String
"invalid country code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
n
    Value
_ -> String -> Value -> Parser Country
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 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
1000 Bool -> Bool -> Bool
&& ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
numericValidities (Word16 -> Int
word16ToInt Word16
n) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word8
1 :: Word8)
  then Country -> Maybe Country
forall a. a -> Maybe a
Just (Word16 -> Country
Country Word16
n)
  else Maybe Country
forall a. Maybe a
Nothing

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

alphaTwoHashMap :: HashMap Text Country
alphaTwoHashMap :: HashMap Text Country
alphaTwoHashMap = (HashMap Text Country
 -> (Word16, Text, (Char, Char), (Char, Char, Char))
 -> HashMap Text Country)
-> HashMap Text Country
-> [(Word16, Text, (Char, Char), (Char, Char, Char))]
-> HashMap Text Country
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)
_) ->
      Text -> Country -> HashMap Text Country -> HashMap Text Country
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)
    (HashMap Text Country -> HashMap Text Country)
-> HashMap Text Country -> HashMap Text Country
forall a b. (a -> b) -> a -> b
$ Text -> Country -> HashMap Text Country -> HashMap Text Country
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)
    (HashMap Text Country -> HashMap Text Country)
-> HashMap Text Country -> HashMap Text Country
forall a b. (a -> b) -> a -> b
$ HashMap Text Country
hm
  )
  HashMap Text Country
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 = (HashMap Text Country
 -> (Word16, Text, (Char, Char), (Char, Char, Char))
 -> HashMap Text Country)
-> HashMap Text Country
-> [(Word16, Text, (Char, Char), (Char, Char, Char))]
-> HashMap Text Country
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)) ->
      Text -> Country -> HashMap Text Country -> HashMap Text Country
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)
    (HashMap Text Country -> HashMap Text Country)
-> HashMap Text Country -> HashMap Text Country
forall a b. (a -> b) -> a -> b
$ Text -> Country -> HashMap Text Country -> HashMap Text Country
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)
    (HashMap Text Country -> HashMap Text Country)
-> HashMap Text Country -> HashMap Text Country
forall a b. (a -> b) -> a -> b
$ HashMap Text Country
hm
  )
  HashMap Text Country
forall k v. HashMap k v
HM.empty [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads
{-# NOINLINE alphaThreeHashMap #-}