{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Continent
  ( Continent
  , pattern Africa
  , pattern Asia
  , pattern Antarctica
  , pattern Europe
  , pattern NorthAmerica
  , pattern Oceania
  , pattern SouthAmerica

    -- * Continent Mapping
  , continent

    -- * Name
  , encodeEnglish
  , decodeEnglish

    -- * Two-letter Codes
  , alphaUpper
  , alphaLower
  , decodeAlpha
  ) where

import Continent.Unsafe

import Control.Monad (forM_)
import Control.Monad.ST (runST)
import Country.Unexposed.Continents (continentAList)
import Country.Unexposed.Util (charToWord8, mapTextArray, timesTwo, word16ToInt)
import Country.Unsafe (Country (Country))
import Data.Char (toLower)
import Data.Text (Text)
import Data.Word (Word8)

import qualified Data.Primitive as Prim
import qualified Data.Text as T
import qualified Data.Text.Array as TA
import qualified Data.Text.Internal as TI

numberOfContinents :: Int
numberOfContinents :: Int
numberOfContinents = [(Word8, Text, (Char, Char))] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Word8, Text, (Char, Char))]
continentNameDb
{-# NOINLINE numberOfContinents #-}

alphaUpper :: Continent -> Text
alphaUpper :: Continent -> Text
alphaUpper (Continent Word8
n) = Array -> Int -> Int -> Text
TI.text Array
allAlphaUpper (Int -> Int
timesTwo (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n)) Int
2

allAlphaUpper :: TA.Array
allAlphaUpper :: Array
allAlphaUpper = (forall s. ST s (MArray s)) -> Array
TA.run ((forall s. ST s (MArray s)) -> Array)
-> (forall s. ST s (MArray s)) -> Array
forall a b. (a -> b) -> a -> b
$ do
  MArray s
m <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
TA.new (Int -> Int
timesTwo Int
numberOfContinents)
  [(Word8, Text, (Char, Char))]
-> ((Word8, Text, (Char, Char)) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Word8, Text, (Char, Char))]
continentNameDb (((Word8, Text, (Char, Char)) -> ST s ()) -> ST s ())
-> ((Word8, Text, (Char, Char)) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Word8
n, Text
_, (Char
a1, Char
a2)) -> do
    let ix :: Int
ix = Int -> Int
timesTwo (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
m Int
ix (Char -> Word8
charToWord8 Char
a1)
    MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
TA.unsafeWrite MArray s
m (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char -> Word8
charToWord8 Char
a2)
  MArray s -> ST s (MArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
m
{-# NOINLINE allAlphaUpper #-}

alphaLower :: Continent -> Text
alphaLower :: Continent -> Text
alphaLower (Continent Word8
n) = Array -> Int -> Int -> Text
TI.text Array
allAlphaLower (Int -> Int
timesTwo (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n)) Int
2

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

decodeAlpha :: Text -> Maybe Continent
decodeAlpha :: Text -> Maybe Continent
decodeAlpha = (Word8 -> Continent) -> Maybe Word8 -> Maybe Continent
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Continent
Continent (Maybe Word8 -> Maybe Continent)
-> (Text -> Maybe Word8) -> Text -> Maybe Continent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [(Text, Word8)] -> Maybe Word8)
-> [(Text, Word8)] -> Text -> Maybe Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [(Text, Word8)] -> Maybe Word8
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Text, Word8)]
tbl (Text -> Maybe Word8) -> (Text -> Text) -> Text -> Maybe Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toUpper
 where
  tbl :: [(Text, Word8)]
tbl = (((Word8, Text, (Char, Char)) -> (Text, Word8))
 -> [(Word8, Text, (Char, Char))] -> [(Text, Word8)])
-> [(Word8, Text, (Char, Char))]
-> ((Word8, Text, (Char, Char)) -> (Text, Word8))
-> [(Text, Word8)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Word8, Text, (Char, Char)) -> (Text, Word8))
-> [(Word8, Text, (Char, Char))] -> [(Text, Word8)]
forall a b. (a -> b) -> [a] -> [b]
map [(Word8, Text, (Char, Char))]
continentNameDb (((Word8, Text, (Char, Char)) -> (Text, Word8)) -> [(Text, Word8)])
-> ((Word8, Text, (Char, Char)) -> (Text, Word8))
-> [(Text, Word8)]
forall a b. (a -> b) -> a -> b
$ \(Word8
n, Text
_, (Char
a, Char
b)) -> ((Text -> Text
T.toUpper (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [Char
a, Char
b], Word8
n)

encodeEnglish :: Continent -> Text
encodeEnglish :: Continent -> Text
encodeEnglish (Continent Word8
n) = Array Text -> Int -> Text
forall a. Array a -> Int -> a
Prim.indexArray Array Text
englishContinentNamesText (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n)

englishContinentNamesText :: Prim.Array Text
englishContinentNamesText :: Array Text
englishContinentNamesText = (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)
Prim.newArray Int
numberOfContinents Text
unnamed
  ((Word8, Text, (Char, Char)) -> ST s ())
-> [(Word8, Text, (Char, Char))] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Word8
ix, Text
name, (Char, Char)
_) -> MutableArray (PrimState (ST s)) Text -> Int -> Text -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
Prim.writeArray MutableArray s Text
MutableArray (PrimState (ST s)) Text
m (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ix) Text
name) [(Word8, Text, (Char, Char))]
continentNameDb
  MutableArray (PrimState (ST s)) Text -> ST s (Array Text)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
Prim.unsafeFreezeArray MutableArray s Text
MutableArray (PrimState (ST s)) Text
m
{-# NOINLINE englishContinentNamesText #-}

decodeEnglish :: Text -> Maybe Continent
decodeEnglish :: Text -> Maybe Continent
decodeEnglish = (Word8 -> Continent) -> Maybe Word8 -> Maybe Continent
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Continent
Continent (Maybe Word8 -> Maybe Continent)
-> (Text -> Maybe Word8) -> Text -> Maybe Continent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [(Text, Word8)] -> Maybe Word8)
-> [(Text, Word8)] -> Text -> Maybe Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [(Text, Word8)] -> Maybe Word8
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Text, Word8)]
tbl
 where
  tbl :: [(Text, Word8)]
tbl = (((Word8, Text, (Char, Char)) -> (Text, Word8))
 -> [(Word8, Text, (Char, Char))] -> [(Text, Word8)])
-> [(Word8, Text, (Char, Char))]
-> ((Word8, Text, (Char, Char)) -> (Text, Word8))
-> [(Text, Word8)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Word8, Text, (Char, Char)) -> (Text, Word8))
-> [(Word8, Text, (Char, Char))] -> [(Text, Word8)]
forall a b. (a -> b) -> [a] -> [b]
map [(Word8, Text, (Char, Char))]
continentNameDb (((Word8, Text, (Char, Char)) -> (Text, Word8)) -> [(Text, Word8)])
-> ((Word8, Text, (Char, Char)) -> (Text, Word8))
-> [(Text, Word8)]
forall a b. (a -> b) -> a -> b
$ \(Word8
n, Text
name, (Char, Char)
_) -> (Text
name, Word8
n)

continent :: Country -> Continent
continent :: Country -> Continent
continent (Country Word16
n) = Word8 -> Continent
Continent (Word8 -> Continent) -> Word8 -> Continent
forall a b. (a -> b) -> a -> b
$ Array Word8 -> Int -> Word8
forall a. Array a -> Int -> a
Prim.indexArray Array Word8
allContinents (Word16 -> Int
word16ToInt Word16
n)

allContinents :: Prim.Array Word8
allContinents :: Array Word8
allContinents = (forall s. ST s (Array Word8)) -> Array Word8
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array Word8)) -> Array Word8)
-> (forall s. ST s (Array Word8)) -> Array Word8
forall a b. (a -> b) -> a -> b
$ do
  MutableArray s Word8
m <- Int -> Word8 -> ST s (MutableArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
Prim.newArray Int
numberOfPossibleCodes Word8
255
  [(Word16, Continent)]
-> ((Word16, Continent) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Word16, Continent)]
continentAList (((Word16, Continent) -> ST s ()) -> ST s ())
-> ((Word16, Continent) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Word16
ix, Continent Word8
n) ->
    MutableArray (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
Prim.writeArray MutableArray s Word8
MutableArray (PrimState (ST s)) Word8
m (Word16 -> Int
word16ToInt Word16
ix) Word8
n
  MutableArray (PrimState (ST s)) Word8 -> ST s (Array Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
Prim.unsafeFreezeArray MutableArray s Word8
MutableArray (PrimState (ST s)) Word8
m
{-# NOINLINE allContinents #-}

unnamed :: Text
unnamed :: Text
unnamed = Text
"Invalid Continent"
{-# NOINLINE unnamed #-}

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