{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MagicHash #-}

{-# OPTIONS_GHC -Wall #-}

-- | Country type and helpers.
module Country
  ( Country
    -- * Three digit code
  , encodeNumeric
  , decodeNumeric
    -- * Name
  , encodeEnglish
  , encodeEnglishShort
  , decode
  , decodeUtf8
  , decodeUtf8Bytes
  , parser
  , parserUtf8
    -- * Alpha-2 and Alpha-3
  , alphaTwoUpper
  , alphaTwoUpperUtf8Ptr
  , alphaTwoUpperUtf8BoundedBuilder
  , alphaThreeUpper
  , alphaThreeLower
  , alphaTwoLower
  , decodeAlphaTwo
  , decodeAlphaThree
    -- * Hash Maps for Decoding
  , hashMapUtf8
  , hashMapUtf16
  ) where

import Control.Monad (forM_)
import Control.Monad.ST (runST)
import Country.Unexposed.AlphaTwoPtr (alphaTwoPtr)
import Country.Unexposed.Encode.English (countryNameQuads)
import Country.Unexposed.Names (hashMapUtf16,hashMapUtf8)
import Country.Unexposed.Names (numberOfPossibleCodes,alphaTwoHashMap,alphaThreeHashMap,decodeMap,decodeMapUtf8,decodeNumeric,encodeEnglish,encodeEnglishShort)
import Country.Unexposed.Trie (Trie,trieFromList,trieParser)
import Country.Unexposed.TrieByte (TrieByte,trieByteFromList,trieByteParser)
import Country.Unexposed.Util (mapTextArray,charToWord8,word16ToInt,timesTwo,timesThree)
import Country.Unsafe (Country(..))
import Data.Bytes.Types (Bytes(Bytes))
import Data.ByteString (ByteString)
import Data.Char (toLower)
import Data.Coerce (coerce)
import Data.Primitive (writeByteArray,indexByteArray,unsafeFreezeByteArray,newByteArray)
import Data.Primitive.ByteArray (ByteArray(..))
import Data.Primitive.Ptr (indexOffPtr)
import Data.Text (Text)
import Data.Word (Word16)
import Data.Word (Word8)
import Foreign.Ptr (Ptr,plusPtr)

import qualified Data.Attoparsec.ByteString as AB
import qualified Data.Attoparsec.Text as AT
import qualified Data.Bytes.Builder.Bounded.Unsafe as BBU
import qualified Data.Bytes.HashMap.Word as BytesHashMap
import qualified Data.HashMap.Strict as HM
import qualified Data.Text.Array as TA
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Internal as TI

-- | Convert a country to its numeric code. This is a
--   three-digit number and will consequently be less than 1000.
encodeNumeric :: Country -> Word16
encodeNumeric :: Country -> Word16
encodeNumeric (Country Word16
n) = Word16
n

-- | The alpha-2 country code, uppercase
alphaTwoUpper :: Country -> Text
alphaTwoUpper :: Country -> Text
alphaTwoUpper Country
c = Array -> Int -> Int -> Text
TI.text Array
allAlphaTwoUpper (Int -> Int
timesTwo (Country -> Int
indexOfCountry Country
c)) Int
2

-- | The alpha-2 country code, uppercase. The resulting address always
-- has two bytes at it.
alphaTwoUpperUtf8Ptr :: Country -> Ptr Word8
alphaTwoUpperUtf8Ptr :: Country -> Ptr Word8
alphaTwoUpperUtf8Ptr (Country Word16
c) =
  forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
alphaTwoPtr (Int
2 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
c)

alphaTwoUpperUtf8BoundedBuilder :: Country -> BBU.Builder 2
alphaTwoUpperUtf8BoundedBuilder :: Country -> Builder 2
alphaTwoUpperUtf8BoundedBuilder !Country
c = forall (n :: Nat).
(forall s. MutableByteArray s -> Int -> ST s Int) -> Builder n
BBU.construct
  (\MutableByteArray s
arr Int
ix -> do
    let ptr :: Ptr Word8
ptr = Country -> Ptr Word8
alphaTwoUpperUtf8Ptr Country
c
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
arr Int
ix (forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr Int
0)
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
arr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (forall a. Prim a => Ptr a -> Int -> a
indexOffPtr Ptr Word8
ptr Int
1)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
ix forall a. Num a => a -> a -> a
+ Int
2)
  )

-- | The alpha-3 country code, uppercase
alphaThreeUpper :: Country -> Text
alphaThreeUpper :: Country -> Text
alphaThreeUpper Country
c = Array -> Int -> Int -> Text
TI.text Array
allAlphaThreeUpper (Int -> Int
timesThree (Country -> Int
indexOfCountry Country
c)) Int
3

-- | The alpha-2 country code, lowercase
alphaTwoLower :: Country -> Text
alphaTwoLower :: Country -> Text
alphaTwoLower Country
c = Array -> Int -> Int -> Text
TI.text Array
allAlphaTwoLower (Int -> Int
timesTwo (Country -> Int
indexOfCountry Country
c)) Int
2

-- | The alpha-3 country code, lowercase
alphaThreeLower :: Country -> Text
alphaThreeLower :: Country -> Text
alphaThreeLower Country
c = Array -> Int -> Int -> Text
TI.text Array
allAlphaThreeLower (Int -> Int
timesThree (Country -> Int
indexOfCountry Country
c)) Int
3

-- | Decode a 'Country' using its alpha-2 country code.
decodeAlphaTwo :: Text -> Maybe Country
decodeAlphaTwo :: Text -> Maybe Country
decodeAlphaTwo = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap Text Country
alphaTwoHashMap

-- | Decode a 'Country' using its alpha-3 country code.
decodeAlphaThree :: Text -> Maybe Country
decodeAlphaThree :: Text -> Maybe Country
decodeAlphaThree = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap Text Country
alphaThreeHashMap


-- | Parse a country from its name. This function is language-agnostic
--   and is very generous with what it accepts. It handles official
--   names, colloquial names, acroynms, and obsolete names for many
--   countries. It strives to handle any source language. Open an
--   issue on the issue tracker if there are names that are missing.
decode :: Text -> Maybe Country
decode :: Text -> Maybe Country
decode (TI.Text (TA.ByteArray ByteArray#
arr) Int
off8 Int
len8) =
  case (Bytes -> Map -> Maybe Word
BytesHashMap.lookup (ByteArray -> Int -> Int -> Bytes
Bytes (ByteArray# -> ByteArray
ByteArray ByteArray#
arr) Int
off8 Int
len8) Map
hashMapUtf8) of
    Maybe Word
Nothing -> forall a. Maybe a
Nothing
    Just Word
w -> forall a. a -> Maybe a
Just (Word16 -> Country
Country (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w))

-- | Decode a 'Country' from a UTF-8-encoded 'ByteString'.
decodeUtf8 :: ByteString -> Maybe Country
decodeUtf8 :: ByteString -> Maybe Country
decodeUtf8 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap ByteString Country
decodeMapUtf8

decodeUtf8Bytes :: Bytes -> Maybe Country
decodeUtf8Bytes :: Bytes -> Maybe Country
decodeUtf8Bytes !Bytes
bs = case (Bytes -> Map -> Maybe Word
BytesHashMap.lookup Bytes
bs Map
hashMapUtf8) of
  Maybe Word
Nothing -> forall a. Maybe a
Nothing
  Just Word
w -> forall a. a -> Maybe a
Just (Word16 -> Country
Country (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w))

-- | Parse a country from its name using an attoparsec text parser. This
--   function is language-agnostic and can handle any source language.
--   In the case that one possible country name is a prefix of another
--   possible name (for example, United States vs United States of America),
--   the longest possible will be parsed.
parser :: AT.Parser Country
parser :: Parser Country
parser = coerce :: forall a b. Coercible a b => a -> b
coerce (Trie -> Parser Word16
trieParser Trie
decodeTrie)

-- | Parse a 'Country' using an 'AB.Parser'.
parserUtf8 :: AB.Parser Country
parserUtf8 :: Parser Country
parserUtf8 = coerce :: forall a b. Coercible a b => a -> b
coerce (TrieByte -> Parser Word16
trieByteParser TrieByte
decodeTrieUtf8)

numberOfCountries :: Int
numberOfCountries :: Int
numberOfCountries = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads

-- | The elements in this array are Word16
positions :: ByteArray
positions :: ByteArray
positions = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
m <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int
timesTwo Int
numberOfPossibleCodes)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Enum a => a -> [a]
enumFrom (Word16
0 :: Word16)) [(Word16, Text, (Char, Char), (Char, Char, Char))]
countryNameQuads) forall a b. (a -> b) -> a -> b
$ \(Word16
ix,(Word16
n,Text
_,(Char, Char)
_,(Char, Char, Char)
_)) -> do
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
m (Word16 -> Int
word16ToInt Word16
n) Word16
ix
  forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
m
{-# NOINLINE positions #-}

-- get the index of the country. this refers not to the
-- country code but to the position it shows up in the
-- hard-coded list of all the countries.
indexOfCountry :: Country -> Int
indexOfCountry :: Country -> Int
indexOfCountry (Country Word16
n) =
  Word16 -> Int
word16ToInt (forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
positions (Word16 -> Int
word16ToInt Word16
n))

allAlphaTwoUpper :: TA.Array
allAlphaTwoUpper :: Array
allAlphaTwoUpper = (forall s. ST s (MArray s)) -> Array
TA.run forall a b. (a -> b) -> a -> b
$ do
  MArray s
m <- forall s. Int -> ST s (MArray s)
TA.new (Int -> Int
timesTwo Int
numberOfCountries)
  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
a1,Char
a2),(Char, Char, Char)
_) -> do
    let ix :: Int
ix = Int -> Int
timesTwo (Country -> Int
indexOfCountry (Word16 -> Country
Country Word16
n))
    forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
m Int
ix (Char -> Word8
charToWord8 Char
a1)
    forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
m (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (Char -> Word8
charToWord8 Char
a2)
  forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
m
{-# NOINLINE allAlphaTwoUpper #-}

allAlphaThreeUpper :: TA.Array
allAlphaThreeUpper :: Array
allAlphaThreeUpper = (forall s. ST s (MArray s)) -> Array
TA.run forall a b. (a -> b) -> a -> b
$ do
  MArray s
m <- forall s. Int -> ST s (MArray s)
TA.new (Int -> Int
timesThree Int
numberOfCountries)
  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
a1,Char
a2,Char
a3)) -> do
    let ix :: Int
ix = Int -> Int
timesThree (Country -> Int
indexOfCountry (Word16 -> Country
Country Word16
n))
    forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
m Int
ix (Char -> Word8
charToWord8 Char
a1)
    forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
m (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (Char -> Word8
charToWord8 Char
a2)
    forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
m (Int
ix forall a. Num a => a -> a -> a
+ Int
2) (Char -> Word8
charToWord8 Char
a3)
  forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
m
{-# NOINLINE allAlphaThreeUpper #-}

allAlphaThreeLower :: TA.Array
allAlphaThreeLower :: Array
allAlphaThreeLower = (Char -> Char) -> Array -> Array
mapTextArray Char -> Char
toLower Array
allAlphaThreeUpper
{-# NOINLINE allAlphaThreeLower #-}

allAlphaTwoLower :: TA.Array
allAlphaTwoLower :: Array
allAlphaTwoLower = (Char -> Char) -> Array -> Array
mapTextArray Char -> Char
toLower Array
allAlphaTwoUpper
{-# NOINLINE allAlphaTwoLower #-}

decodeTrie :: Trie
decodeTrie :: Trie
decodeTrie = [(Text, Word16)] -> Trie
trieFromList (forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,Country Word16
x) -> (Text
a,Word16
x)) (forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Country
decodeMap))
{-# NOINLINE decodeTrie #-}

decodeTrieUtf8 :: TrieByte
decodeTrieUtf8 :: TrieByte
decodeTrieUtf8 = [(ByteString, Word16)] -> TrieByte
trieByteFromList (forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,Country Word16
x) -> (Text -> ByteString
TE.encodeUtf8 Text
a,Word16
x)) (forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Country
decodeMap))
{-# NOINLINE decodeTrieUtf8 #-}