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

import Control.Applicative ((<|>))
import Country (Country, alphaTwoUpper, decodeAlphaTwo, decodeNumeric)
import Data.BCP47.Internal.Parser (complete)
import Data.Bifunctor (first)
import Data.Text (Text, pack)
import Data.Void (Void)
import Text.Megaparsec (Parsec, count, parse, try, (<?>))
import Text.Megaparsec.Char (digitChar, upperChar)
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 "012"
-- Right algeria
--
-- >>> regionFromText $ pack "asdf"
-- Left "regionFromText:1:1:\n  |\n1 | asdf\n  | ^\nunexpected 'a'\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 (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. Parsec Void Text a -> Parsec Void Text a
complete (Parsec Void Text Country -> Parsec Void Text Country
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parsec Void Text Country
alpha2 Parsec Void Text Country
-> Parsec Void Text Country -> Parsec Void Text Country
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
  alpha2 :: Parsec Void Text Country
alpha2 =
    Parsec Void Text Country
-> (Country -> Parsec Void Text Country)
-> Maybe Country
-> Parsec Void Text Country
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parsec Void Text Country
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid 2 character country code") Country -> Parsec Void Text Country
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Maybe Country -> Parsec Void Text Country)
-> (String -> Maybe Country) -> String -> Parsec Void Text Country
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Country
decodeAlphaTwo
      (Text -> Maybe Country)
-> (String -> Text) -> String -> Maybe Country
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
      (String -> Parsec Void Text Country)
-> ParsecT Void Text Identity String -> Parsec Void Text Country
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
  num3 :: Parsec Void Text Country
num3 =
    Parsec Void Text Country
-> (Country -> Parsec Void Text Country)
-> Maybe Country
-> Parsec Void Text Country
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parsec Void Text Country
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid 3 character country code") Country -> Parsec Void Text Country
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Maybe Country -> Parsec Void Text Country)
-> (Word16 -> Maybe Country) -> Word16 -> Parsec Void Text Country
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Maybe Country
decodeNumeric
      (Word16 -> Parsec Void Text Country)
-> ParsecT Void Text Identity Word16 -> Parsec Void Text Country
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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 (m :: * -> *) a. MonadFail m => String -> m a
fail Word16 -> ParsecT Void Text Identity Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Either String Word16 -> ParsecT Void Text Identity Word16)
-> (String -> Either String Word16)
-> String
-> ParsecT Void Text Identity Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Word16
forall a. Read a => String -> Either String a
readEither
      (String -> ParsecT Void Text Identity Word16)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Word16
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar