{-# 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 (mapTextArray,charToWord16,word16ToInt,timesTwo)
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 (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 -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
m Int
ix (Char -> Word16
charToWord16 Char
a1)
    MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TA.unsafeWrite MArray s
m (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char -> Word16
charToWord16 Char
a2)
  MArray s -> ST s (MArray s)
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 (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 (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