country-0.2.4.2: src/Continent.hs

{-# 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 = length continentNameDb
{-# NOINLINE numberOfContinents #-}

alphaUpper :: Continent -> Text
alphaUpper (Continent n) = TI.text allAlphaUpper (timesTwo (fromIntegral n)) 2

allAlphaUpper :: TA.Array
allAlphaUpper = TA.run $ do
  m <- TA.new (timesTwo numberOfContinents)
  forM_ continentNameDb $ \(n, _, (a1, a2)) -> do
    let ix = timesTwo (fromIntegral n)
    TA.unsafeWrite m ix (charToWord8 a1)
    TA.unsafeWrite m (ix + 1) (charToWord8 a2)
  return m
{-# NOINLINE allAlphaUpper #-}

alphaLower :: Continent -> Text
alphaLower (Continent n) = TI.text allAlphaLower (timesTwo (fromIntegral n)) 2

allAlphaLower :: TA.Array
allAlphaLower = mapTextArray toLower allAlphaUpper
{-# NOINLINE allAlphaLower #-}

decodeAlpha :: Text -> Maybe Continent
decodeAlpha = fmap Continent . flip lookup tbl . T.toUpper
 where
  tbl = flip map continentNameDb $ \(n, _, (a, b)) -> ((T.toUpper . T.pack) [a, b], n)

encodeEnglish :: Continent -> Text
encodeEnglish (Continent n) = Prim.indexArray englishContinentNamesText (fromIntegral n)

englishContinentNamesText :: Prim.Array Text
englishContinentNamesText = runST $ do
  m <- Prim.newArray numberOfContinents unnamed
  mapM_ (\(ix, name, _) -> Prim.writeArray m (fromIntegral ix) name) continentNameDb
  Prim.unsafeFreezeArray m
{-# NOINLINE englishContinentNamesText #-}

decodeEnglish :: Text -> Maybe Continent
decodeEnglish = fmap Continent . flip lookup tbl
 where
  tbl = flip map continentNameDb $ \(n, name, _) -> (name, n)

continent :: Country -> Continent
continent (Country n) = Continent $ Prim.indexArray allContinents (word16ToInt n)

allContinents :: Prim.Array Word8
allContinents = runST $ do
  m <- Prim.newArray numberOfPossibleCodes 255
  forM_ continentAList $ \(ix, Continent n) ->
    Prim.writeArray m (word16ToInt ix) n
  Prim.unsafeFreezeArray m
{-# NOINLINE allContinents #-}

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

numberOfPossibleCodes :: Int
numberOfPossibleCodes = 1000