country-0.2.3.1: 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 (mapTextArray,charToWord8,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 = 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