{-# 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
(Subdivision -> Subdivision -> Bool)
-> (Subdivision -> Subdivision -> Bool) -> Eq Subdivision
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
Eq Subdivision
-> (Subdivision -> Subdivision -> Ordering)
-> (Subdivision -> Subdivision -> Bool)
-> (Subdivision -> Subdivision -> Bool)
-> (Subdivision -> Subdivision -> Bool)
-> (Subdivision -> Subdivision -> Bool)
-> (Subdivision -> Subdivision -> Subdivision)
-> (Subdivision -> Subdivision -> Subdivision)
-> Ord 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
$cp1Ord :: Eq Subdivision
Ord,Addr# -> Int# -> Subdivision
Addr# -> Int# -> Int# -> Subdivision -> State# s -> State# s
Addr# -> Int# -> State# s -> (# State# s, Subdivision #)
Addr# -> Int# -> Subdivision -> State# s -> State# s
ByteArray# -> Int# -> Subdivision
MutableByteArray# s
-> Int# -> State# s -> (# State# s, Subdivision #)
MutableByteArray# s -> Int# -> Subdivision -> State# s -> State# s
MutableByteArray# s
-> Int# -> Int# -> Subdivision -> State# s -> State# s
Subdivision -> Int#
(Subdivision -> Int#)
-> (Subdivision -> Int#)
-> (ByteArray# -> Int# -> Subdivision)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, Subdivision #))
-> (forall s.
    MutableByteArray# s -> Int# -> Subdivision -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> Subdivision -> State# s -> State# s)
-> (Addr# -> Int# -> Subdivision)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, Subdivision #))
-> (forall s. Addr# -> Int# -> Subdivision -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> Subdivision -> State# s -> State# s)
-> Prim Subdivision
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# :: Addr# -> Int# -> Int# -> Subdivision -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> Subdivision -> State# s -> State# s
writeOffAddr# :: Addr# -> Int# -> Subdivision -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> Subdivision -> State# s -> State# s
readOffAddr# :: 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# :: MutableByteArray# s
-> Int# -> Int# -> Subdivision -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> Subdivision -> State# s -> State# s
writeByteArray# :: MutableByteArray# s -> Int# -> Subdivision -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> Subdivision -> State# s -> State# s
readByteArray# :: 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
Eq Subdivision
-> (Int -> Subdivision -> Int)
-> (Subdivision -> Int)
-> Hashable 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
$cp1Hashable :: Eq Subdivision
Hashable,Ptr b -> Int -> IO Subdivision
Ptr b -> Int -> Subdivision -> IO ()
Ptr Subdivision -> IO Subdivision
Ptr Subdivision -> Int -> IO Subdivision
Ptr Subdivision -> Int -> Subdivision -> IO ()
Ptr Subdivision -> Subdivision -> IO ()
Subdivision -> Int
(Subdivision -> Int)
-> (Subdivision -> Int)
-> (Ptr Subdivision -> Int -> IO Subdivision)
-> (Ptr Subdivision -> Int -> Subdivision -> IO ())
-> (forall b. Ptr b -> Int -> IO Subdivision)
-> (forall b. Ptr b -> Int -> Subdivision -> IO ())
-> (Ptr Subdivision -> IO Subdivision)
-> (Ptr Subdivision -> Subdivision -> IO ())
-> Storable Subdivision
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 :: Ptr b -> Int -> Subdivision -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Subdivision -> IO ()
peekByteOff :: 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 = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (Subdivision -> Text) -> Subdivision -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subdivision -> Text
encodeAlpha

instance Enum Subdivision where
  fromEnum :: Subdivision -> Int
fromEnum (Subdivision Word16
w) = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w
  toEnum :: Int -> Subdivision
toEnum Int
number = if Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
Arrays.actualNumberOfSubdivisions
    then Word16 -> Subdivision
Subdivision (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
number)
    else String -> Subdivision
forall a. HasCallStack => String -> a
error (String
"toEnum: cannot convert " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
number String -> ShowS
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 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
Arrays.actualNumberOfSubdivisions Int -> Int -> Int
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) = SmallArray Text -> Int -> Text
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index SmallArray Text
Arrays.codeArray (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
i)

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

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

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

category :: Subdivision -> Text
category :: Subdivision -> Text
category (Subdivision Word16
i) = SmallArray Text -> Int -> Text
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index SmallArray Text
Arrays.categoryArray (Word16 -> Int
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 = (Text -> HashMap Text Subdivision -> Maybe Subdivision)
-> HashMap Text Subdivision -> Text -> Maybe Subdivision
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashMap Text Subdivision -> Maybe Subdivision
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 = (HashMap Text Subdivision
 -> Int -> Text -> HashMap Text Subdivision)
-> HashMap Text Subdivision
-> SmallArray Text
-> HashMap Text Subdivision
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 ->
      Text
-> Subdivision
-> HashMap Text Subdivision
-> HashMap Text Subdivision
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
x (Word16 -> Subdivision
Subdivision (Word16 -> Subdivision) -> Word16 -> Subdivision
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    (HashMap Text Subdivision -> HashMap Text Subdivision)
-> HashMap Text Subdivision -> HashMap Text Subdivision
forall a b. (a -> b) -> a -> b
$ HashMap Text Subdivision
hm
  )
  HashMap Text Subdivision
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 = (Text -> HashMap Text Subdivision -> Maybe Subdivision)
-> HashMap Text Subdivision -> Text -> Maybe Subdivision
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashMap Text Subdivision -> Maybe Subdivision
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 = (HashMap Text Subdivision
 -> Int -> Text -> HashMap Text Subdivision)
-> HashMap Text Subdivision
-> SmallArray Text
-> HashMap Text Subdivision
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 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
     in Text
-> Subdivision
-> HashMap Text Subdivision
-> HashMap Text Subdivision
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
x Subdivision
place
      (HashMap Text Subdivision -> HashMap Text Subdivision)
-> HashMap Text Subdivision -> HashMap Text Subdivision
forall a b. (a -> b) -> a -> b
$ Text
-> Subdivision
-> HashMap Text Subdivision
-> HashMap Text Subdivision
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
x) Subdivision
place
      (HashMap Text Subdivision -> HashMap Text Subdivision)
-> HashMap Text Subdivision -> HashMap Text Subdivision
forall a b. (a -> b) -> a -> b
$ HashMap Text Subdivision
hm
  )
  HashMap Text Subdivision
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
  ( (Int -> Text -> (Bytes, Word)) -> [Text] -> [(Bytes, Word)]
forall a b. (Int -> a -> b) -> [a] -> [b]
imap
    (\Int
i Text
t -> ([Item Bytes] -> Bytes
forall l. IsList l => [Item l] -> l
Exts.fromList (ByteString -> [Word8]
ByteString.unpack (Text -> ByteString
encodeUtf8 Text
t)),Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    ) (SmallArray Text -> [Item (SmallArray Text)]
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 -> Maybe Subdivision
forall a. Maybe a
Nothing
  Just Word
w -> Subdivision -> Maybe Subdivision
forall a. a -> Maybe a
Just (Word16 -> Subdivision
Subdivision (Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w))

imap :: (Int -> a -> b) -> [a] -> [b]
imap :: (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 b -> [b] -> [b]
forall a. a -> [a] -> [a]
: Int -> [a] -> [b]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs
    go !Int
_ []     = []