{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.BCP47.Internal.Variant
  ( Variant(Variant)
  , variantFromText
  , variantToText
  , variantP
  )
  where

import Control.Applicative ((<|>))
import Data.BCP47.Internal.Arbitrary
  (Arbitrary, alphaNumString, arbitrary, choose, numChar, oneof)
import Data.BCP47.Internal.Parser (complete)
import Data.Bifunctor (first)
import Data.Text (Text, pack)
import Data.Void (Void)
import Text.Megaparsec (Parsec, count, count', parse, try)
import Text.Megaparsec.Char (alphaNumChar, digitChar)
import Text.Megaparsec.Error (errorBundlePretty)

-- | BCP-47 variant parser
--
-- @@
-- variant       = 5*8alphanum         ; registered variants
--               / (DIGIT 3alphanum)
-- @@
--
variantP :: Parsec Void Text Variant
variantP :: Parsec Void Text Variant
variantP =
  Parsec Void Text Variant -> Parsec Void Text Variant
forall a. Parsec Void Text a -> Parsec Void Text a
complete
    (Parsec Void Text Variant -> Parsec Void Text Variant)
-> Parsec Void Text Variant -> Parsec Void Text Variant
forall a b. (a -> b) -> a -> b
$ Text -> Variant
Variant
    (Text -> Variant) -> (String -> Text) -> String -> Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
    (String -> Variant)
-> ParsecT Void Text Identity String -> Parsec Void Text Variant
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Int
-> Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
count' Int
5 Int
8 ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar) ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity String
digitPrefixed)
 where
  digitPrefixed :: ParsecT Void Text Identity String
digitPrefixed = do
    Char
x <- ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
    String
xs <- 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)
alphaNumChar
    String -> ParsecT Void Text Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT Void Text Identity String)
-> String -> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs

-- | Variant subtags
--
-- Variant subtags are used to indicate additional, well-recognized
-- variations that define a language or its dialects that are not
-- covered by other available subtags.
--
newtype Variant = Variant { Variant -> Text
variantToText :: Text }
  deriving stock (Int -> Variant -> String -> String
[Variant] -> String -> String
Variant -> String
(Int -> Variant -> String -> String)
-> (Variant -> String)
-> ([Variant] -> String -> String)
-> Show Variant
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Variant] -> String -> String
$cshowList :: [Variant] -> String -> String
show :: Variant -> String
$cshow :: Variant -> String
showsPrec :: Int -> Variant -> String -> String
$cshowsPrec :: Int -> Variant -> String -> String
Show, Variant -> Variant -> Bool
(Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool) -> Eq Variant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variant -> Variant -> Bool
$c/= :: Variant -> Variant -> Bool
== :: Variant -> Variant -> Bool
$c== :: Variant -> Variant -> Bool
Eq, Eq Variant
Eq Variant
-> (Variant -> Variant -> Ordering)
-> (Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool)
-> (Variant -> Variant -> Variant)
-> (Variant -> Variant -> Variant)
-> Ord Variant
Variant -> Variant -> Bool
Variant -> Variant -> Ordering
Variant -> Variant -> Variant
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 :: Variant -> Variant -> Variant
$cmin :: Variant -> Variant -> Variant
max :: Variant -> Variant -> Variant
$cmax :: Variant -> Variant -> Variant
>= :: Variant -> Variant -> Bool
$c>= :: Variant -> Variant -> Bool
> :: Variant -> Variant -> Bool
$c> :: Variant -> Variant -> Bool
<= :: Variant -> Variant -> Bool
$c<= :: Variant -> Variant -> Bool
< :: Variant -> Variant -> Bool
$c< :: Variant -> Variant -> Bool
compare :: Variant -> Variant -> Ordering
$ccompare :: Variant -> Variant -> Ordering
$cp1Ord :: Eq Variant
Ord)

instance Arbitrary Variant where
  arbitrary :: Gen Variant
arbitrary = [Gen Variant] -> Gen Variant
forall a. [Gen a] -> Gen a
oneof [Gen Variant
alphaNum, Gen Variant
digitPrefixed]
   where
    alphaNum :: Gen Variant
alphaNum = do
      Int
len <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
5, Int
8)
      String
chars <- Int -> Gen String
alphaNumString Int
len
      Variant -> Gen Variant
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Variant -> Gen Variant)
-> (Text -> Variant) -> Text -> Gen Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Variant
Variant (Text -> Gen Variant) -> Text -> Gen Variant
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
chars
    digitPrefixed :: Gen Variant
digitPrefixed = do
      Char
prefix <- Gen Char
numChar
      String
chars <- Int -> Gen String
alphaNumString Int
3
      Variant -> Gen Variant
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Variant -> Gen Variant)
-> (Text -> Variant) -> Text -> Gen Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Variant
Variant (Text -> Gen Variant) -> Text -> Gen Variant
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
prefix Char -> String -> String
forall a. a -> [a] -> [a]
: String
chars

-- | Parse a 'Variant' subtag from 'Text'
variantFromText :: Text -> Either Text Variant
variantFromText :: Text -> Either Text Variant
variantFromText =
  (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) Variant
-> Either Text Variant
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) Variant
 -> Either Text Variant)
-> (Text -> Either (ParseErrorBundle Text Void) Variant)
-> Text
-> Either Text Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Variant
-> String -> Text -> Either (ParseErrorBundle Text Void) Variant
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text Variant
variantP String
"variantFromText"