module Data.BCP47.Internal.Region
  ( Country
  , regionToText
  , regionFromText
  , regionP
  )
where

import Control.Applicative ((<|>))
import Country (Country, alphaTwoUpper, decodeAlphaTwo, decodeNumeric)
import Data.BCP47.Internal.Parser (asciiDigit, asciiLetter, complete)
import Data.Bifunctor (first)
import Data.Text (Text, pack, toUpper)
import Data.Void (Void)
import Text.Megaparsec (Parsec, count, parse, try, (<?>))
import Text.Megaparsec.Error (errorBundlePretty)
import Text.Read (readEither)

regionToText :: Country -> Text
regionToText :: Country -> Text
regionToText = Country -> Text
alphaTwoUpper

-- | Parse a region subtag from 'Text'
--
-- >>> regionFromText $ pack "zw"
-- Right zimbabwe
--
-- >>> regionFromText $ pack "ZW"
-- Right zimbabwe
--
-- >>> regionFromText $ pack "Zw"
-- Right zimbabwe
--
-- >>> regionFromText $ pack "zW"
-- Right zimbabwe
--
-- >>> regionFromText $ pack "012"
-- Right algeria
--
-- >>> regionFromText $ pack "asdf"
-- Left "regionFromText:1:3:\n  |\n1 | asdf\n  |   ^\nunexpected 'd'\nexpecting 2 or 3 character country code\n"
regionFromText :: Text -> Either Text Country
regionFromText :: Text -> Either Text Country
regionFromText =
  (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) Country
-> Either Text Country
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) (Either (ParseErrorBundle Text Void) Country
 -> Either Text Country)
-> (Text -> Either (ParseErrorBundle Text Void) Country)
-> Text
-> Either Text Country
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Country
-> String -> Text -> Either (ParseErrorBundle Text Void) Country
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text Country
regionP String
"regionFromText"

-- | BCP-47 region parser
--
-- @@
-- region        = 2ALPHA              ; ISO 3166-1 code
--               / 3DIGIT              ; UN M.49 code
-- @@
regionP :: Parsec Void Text Country
regionP :: Parsec Void Text Country
regionP =
  Parsec Void Text Country -> Parsec Void Text Country
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text Country -> Parsec Void Text Country
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
complete Parsec Void Text Country
asciiLetter2)
    Parsec Void Text Country
-> Parsec Void Text Country -> Parsec Void Text Country
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Country -> Parsec Void Text Country
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text Country -> Parsec Void Text Country
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
complete Parsec Void Text Country
num3)
    Parsec Void Text Country -> String -> Parsec Void Text Country
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"2 or 3 character country code"
 where
  asciiLetter2 :: Parsec Void Text Country
asciiLetter2 = do
    Text
code <- String -> Text
pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 ParsecT Void Text Identity Char
asciiLetter
    let region :: Maybe Country
region = Text -> Maybe Country
decodeAlphaTwo (Text -> Maybe Country) -> Text -> Maybe Country
forall a b. (a -> b) -> a -> b
$ Text -> Text
toUpper Text
code
    String -> Maybe Country -> Parsec Void Text Country
forall a. String -> Maybe a -> Parsec Void Text a
unwrap String
"Invalid 2 character country code" Maybe Country
region

  num3 :: Parsec Void Text Country
num3 = do
    String
code <- Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 ParsecT Void Text Identity Char
asciiDigit
    Maybe Country
region <- Word16 -> Maybe Country
decodeNumeric (Word16 -> Maybe Country)
-> ParsecT Void Text Identity Word16
-> ParsecT Void Text Identity (Maybe Country)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT Void Text Identity Word16)
-> (Word16 -> ParsecT Void Text Identity Word16)
-> Either String Word16
-> ParsecT Void Text Identity Word16
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParsecT Void Text Identity Word16
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Word16 -> ParsecT Void Text Identity Word16
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String Word16
forall a. Read a => String -> Either String a
readEither String
code)
    String -> Maybe Country -> Parsec Void Text Country
forall a. String -> Maybe a -> Parsec Void Text a
unwrap String
"Invalid 3 character country code" Maybe Country
region

  unwrap :: String -> Maybe a -> Parsec Void Text a
  unwrap :: forall a. String -> Maybe a -> Parsec Void Text a
unwrap String
message = Parsec Void Text a
-> (a -> Parsec Void Text a) -> Maybe a -> Parsec Void Text a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parsec Void Text a
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
message) a -> Parsec Void Text a
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure