{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}

module Country.Subdivision
  ( Subdivision
  -- * Accessors
  , encodeAlpha
  , encodeAlphaShort
  , encodeEnglish
  , encodeEnglishShort
  , category
  -- * Decoding
  , decodeAlpha
  , decodeEnglish
  , decodeEnglishUtf8Bytes
  ) where

import Data.Bytes (Bytes)
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import Data.Primitive.Contiguous (index)
import Data.Primitive.Types (Prim)
import Data.Text (Text)
import Data.Text.Short (ShortText)
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word16)
import Foreign.Storable (Storable)

import qualified Country.Unexposed.Subdivision as Arrays
import qualified Data.Bytes.HashMap.Word as BytesHashMap
import qualified Data.ByteString as ByteString
import qualified Data.HashMap.Strict as HM
import qualified Data.Primitive.Contiguous as Arr
import qualified Data.Text as T
import qualified GHC.Exts as Exts

newtype Subdivision = Subdivision Word16
  deriving (Subdivision -> Subdivision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subdivision -> Subdivision -> Bool
$c/= :: Subdivision -> Subdivision -> Bool
== :: Subdivision -> Subdivision -> Bool
$c== :: Subdivision -> Subdivision -> Bool
Eq,Eq Subdivision
Subdivision -> Subdivision -> Bool
Subdivision -> Subdivision -> Ordering
Subdivision -> Subdivision -> Subdivision
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Subdivision -> Subdivision -> Subdivision
$cmin :: Subdivision -> Subdivision -> Subdivision
max :: Subdivision -> Subdivision -> Subdivision
$cmax :: Subdivision -> Subdivision -> Subdivision
>= :: Subdivision -> Subdivision -> Bool
$c>= :: Subdivision -> Subdivision -> Bool
> :: Subdivision -> Subdivision -> Bool
$c> :: Subdivision -> Subdivision -> Bool
<= :: Subdivision -> Subdivision -> Bool
$c<= :: Subdivision -> Subdivision -> Bool
< :: Subdivision -> Subdivision -> Bool
$c< :: Subdivision -> Subdivision -> Bool
compare :: Subdivision -> Subdivision -> Ordering
$ccompare :: Subdivision -> Subdivision -> Ordering
Ord,Addr# -> Int# -> Subdivision
ByteArray# -> Int# -> Subdivision
Subdivision -> Int#
forall s.
Addr# -> Int# -> Int# -> Subdivision -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, Subdivision #)
forall s. Addr# -> Int# -> Subdivision -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> Subdivision -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, Subdivision #)
forall s.
MutableByteArray# s -> Int# -> Subdivision -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> Subdivision -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> Subdivision -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> Subdivision -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Subdivision -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Subdivision #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Subdivision #)
indexOffAddr# :: Addr# -> Int# -> Subdivision
$cindexOffAddr# :: Addr# -> Int# -> Subdivision
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Subdivision -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Subdivision -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> Subdivision -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Subdivision -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, Subdivision #)
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, Subdivision #)
indexByteArray# :: ByteArray# -> Int# -> Subdivision
$cindexByteArray# :: ByteArray# -> Int# -> Subdivision
alignment# :: Subdivision -> Int#
$calignment# :: Subdivision -> Int#
sizeOf# :: Subdivision -> Int#
$csizeOf# :: Subdivision -> Int#
Prim,Eq Subdivision
Int -> Subdivision -> Int
Subdivision -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Subdivision -> Int
$chash :: Subdivision -> Int
hashWithSalt :: Int -> Subdivision -> Int
$chashWithSalt :: Int -> Subdivision -> Int
Hashable,Ptr Subdivision -> IO Subdivision
Ptr Subdivision -> Int -> IO Subdivision
Ptr Subdivision -> Int -> Subdivision -> IO ()
Ptr Subdivision -> Subdivision -> IO ()
Subdivision -> Int
forall b. Ptr b -> Int -> IO Subdivision
forall b. Ptr b -> Int -> Subdivision -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Subdivision -> Subdivision -> IO ()
$cpoke :: Ptr Subdivision -> Subdivision -> IO ()
peek :: Ptr Subdivision -> IO Subdivision
$cpeek :: Ptr Subdivision -> IO Subdivision
pokeByteOff :: forall b. Ptr b -> Int -> Subdivision -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Subdivision -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Subdivision
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Subdivision
pokeElemOff :: Ptr Subdivision -> Int -> Subdivision -> IO ()
$cpokeElemOff :: Ptr Subdivision -> Int -> Subdivision -> IO ()
peekElemOff :: Ptr Subdivision -> Int -> IO Subdivision
$cpeekElemOff :: Ptr Subdivision -> Int -> IO Subdivision
alignment :: Subdivision -> Int
$calignment :: Subdivision -> Int
sizeOf :: Subdivision -> Int
$csizeOf :: Subdivision -> Int
Storable)

instance Show Subdivision where
  show :: Subdivision -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subdivision -> Text
encodeAlpha

instance Enum Subdivision where
  fromEnum :: Subdivision -> Int
fromEnum (Subdivision Word16
w) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w
  toEnum :: Int -> Subdivision
toEnum Int
number = if Int
number forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
number forall a. Ord a => a -> a -> Bool
< Int
Arrays.actualNumberOfSubdivisions
    then Word16 -> Subdivision
Subdivision (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
number)
    else forall a. HasCallStack => String -> a
error (String
"toEnum: cannot convert " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
number forall a. [a] -> [a] -> [a]
++ String
" to Subdivision")
instance Bounded Subdivision where
  minBound :: Subdivision
minBound = Word16 -> Subdivision
Subdivision Word16
0
  maxBound :: Subdivision
maxBound = Word16 -> Subdivision
Subdivision (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
Arrays.actualNumberOfSubdivisions forall a. Num a => a -> a -> a
- Int
1)


-- country :: Subdivision -> Country
-- country (Subdivision i) = index Arrays.countryArray i

encodeAlpha :: Subdivision -> Text
encodeAlpha :: Subdivision -> Text
encodeAlpha (Subdivision Word16
i) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index SmallArray Text
Arrays.codeArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
i)

encodeAlphaShort :: Subdivision -> ShortText
encodeAlphaShort :: Subdivision -> ShortText
encodeAlphaShort (Subdivision Word16
i) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index UnliftedArray ShortText
Arrays.codeArrayShort (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
i)

encodeEnglish :: Subdivision -> Text
encodeEnglish :: Subdivision -> Text
encodeEnglish (Subdivision Word16
i) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index SmallArray Text
Arrays.nameArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
i)

encodeEnglishShort :: Subdivision -> ShortText
encodeEnglishShort :: Subdivision -> ShortText
encodeEnglishShort (Subdivision Word16
i) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index UnliftedArray ShortText
Arrays.nameArrayShort (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
i)

category :: Subdivision -> Text
category :: Subdivision -> Text
category (Subdivision Word16
i) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index SmallArray Text
Arrays.categoryArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
i)


-- | Decode a 'Subdivision' using its ISO subdivision code.
decodeAlpha :: Text -> Maybe Subdivision
decodeAlpha :: Text -> Maybe Subdivision
decodeAlpha = 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 Subdivision
alphaHashMap

alphaHashMap :: HashMap Text Subdivision
alphaHashMap :: HashMap Text Subdivision
alphaHashMap = forall (arr :: * -> *) a b.
(Contiguous arr, Element arr a) =>
(b -> Int -> a -> b) -> b -> arr a -> b
Arr.ifoldl'
  (\HashMap Text Subdivision
hm Int
i Text
x ->
      forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
x (Word16 -> Subdivision
Subdivision forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    forall a b. (a -> b) -> a -> b
$ HashMap Text Subdivision
hm
  )
  forall k v. HashMap k v
HM.empty SmallArray Text
Arrays.codeArray
{-# NOINLINE alphaHashMap #-}

-- | Decode a 'Subdivision' using its ISO subdivision English name
-- It's not terribly forgiving, accepting only the official(?) names I found on wiki.
decodeEnglish :: Text -> Maybe Subdivision
decodeEnglish :: Text -> Maybe Subdivision
decodeEnglish = 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 Subdivision
englishHashMap

englishHashMap :: HashMap Text Subdivision
englishHashMap :: HashMap Text Subdivision
englishHashMap = forall (arr :: * -> *) a b.
(Contiguous arr, Element arr a) =>
(b -> Int -> a -> b) -> b -> arr a -> b
Arr.ifoldl'
  (\HashMap Text Subdivision
hm Int
i Text
x ->
    let place :: Subdivision
place = Word16 -> Subdivision
Subdivision (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
     in forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
x Subdivision
place
      forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Text
x) Subdivision
place
      forall a b. (a -> b) -> a -> b
$ HashMap Text Subdivision
hm
  )
  forall k v. HashMap k v
HM.empty SmallArray Text
Arrays.nameArray
{-# NOINLINE englishHashMap #-}

englishHashMapUtf8Bytes :: BytesHashMap.Map
{-# NOINLINE englishHashMapUtf8Bytes #-}
englishHashMapUtf8Bytes :: Map
englishHashMapUtf8Bytes = [(Bytes, Word)] -> Map
BytesHashMap.fromTrustedList
  ( forall a b. (Int -> a -> b) -> [a] -> [b]
imap
    (\Int
i Text
t -> (forall l. IsList l => [Item l] -> l
Exts.fromList (ByteString -> [Word8]
ByteString.unpack (Text -> ByteString
encodeUtf8 Text
t)),forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    ) (forall l. IsList l => l -> [Item l]
Exts.toList SmallArray Text
Arrays.nameArray)
  )

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

imap :: (Int -> a -> b) -> [a] -> [b]
imap :: forall a b. (Int -> a -> b) -> [a] -> [b]
imap Int -> a -> b
f [a]
ls = Int -> [a] -> [b]
go Int
0 [a]
ls
  where
    go :: Int -> [a] -> [b]
go !Int
i (a
x:[a]
xs) = Int -> a -> b
f Int
i a
x forall a. a -> [a] -> [a]
: Int -> [a] -> [b]
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) [a]
xs
    go !Int
_ []     = []