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

module Data.BCP47.Internal.PrivateUse
  ( PrivateUse(PrivateUse)
  , privateUseFromText
  , privateUseToText
  , privateUseP
  )
where

import Control.Monad (void)
import Data.BCP47.Internal.Arbitrary
  (Arbitrary, alphaNumString, arbitrary, choose)
import Data.BCP47.Internal.Parser (complete)
import Data.Bifunctor (first)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text, pack)
import Data.Void (Void)
import Text.Megaparsec (Parsec, count', parse, some)
import Text.Megaparsec.Char (alphaNumChar, char)
import Text.Megaparsec.Error (errorBundlePretty)

-- | Private Use subtags
--
-- Private use subtags are used to indicate distinctions in language
-- that are important in a given context by private agreement.
--
newtype PrivateUse = PrivateUse { PrivateUse -> Text
privateUseToText :: Text }
  deriving stock (Int -> PrivateUse -> ShowS
[PrivateUse] -> ShowS
PrivateUse -> String
(Int -> PrivateUse -> ShowS)
-> (PrivateUse -> String)
-> ([PrivateUse] -> ShowS)
-> Show PrivateUse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivateUse] -> ShowS
$cshowList :: [PrivateUse] -> ShowS
show :: PrivateUse -> String
$cshow :: PrivateUse -> String
showsPrec :: Int -> PrivateUse -> ShowS
$cshowsPrec :: Int -> PrivateUse -> ShowS
Show, PrivateUse -> PrivateUse -> Bool
(PrivateUse -> PrivateUse -> Bool)
-> (PrivateUse -> PrivateUse -> Bool) -> Eq PrivateUse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivateUse -> PrivateUse -> Bool
$c/= :: PrivateUse -> PrivateUse -> Bool
== :: PrivateUse -> PrivateUse -> Bool
$c== :: PrivateUse -> PrivateUse -> Bool
Eq, Eq PrivateUse
Eq PrivateUse
-> (PrivateUse -> PrivateUse -> Ordering)
-> (PrivateUse -> PrivateUse -> Bool)
-> (PrivateUse -> PrivateUse -> Bool)
-> (PrivateUse -> PrivateUse -> Bool)
-> (PrivateUse -> PrivateUse -> Bool)
-> (PrivateUse -> PrivateUse -> PrivateUse)
-> (PrivateUse -> PrivateUse -> PrivateUse)
-> Ord PrivateUse
PrivateUse -> PrivateUse -> Bool
PrivateUse -> PrivateUse -> Ordering
PrivateUse -> PrivateUse -> PrivateUse
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 :: PrivateUse -> PrivateUse -> PrivateUse
$cmin :: PrivateUse -> PrivateUse -> PrivateUse
max :: PrivateUse -> PrivateUse -> PrivateUse
$cmax :: PrivateUse -> PrivateUse -> PrivateUse
>= :: PrivateUse -> PrivateUse -> Bool
$c>= :: PrivateUse -> PrivateUse -> Bool
> :: PrivateUse -> PrivateUse -> Bool
$c> :: PrivateUse -> PrivateUse -> Bool
<= :: PrivateUse -> PrivateUse -> Bool
$c<= :: PrivateUse -> PrivateUse -> Bool
< :: PrivateUse -> PrivateUse -> Bool
$c< :: PrivateUse -> PrivateUse -> Bool
compare :: PrivateUse -> PrivateUse -> Ordering
$ccompare :: PrivateUse -> PrivateUse -> Ordering
$cp1Ord :: Eq PrivateUse
Ord)

instance Arbitrary PrivateUse where
  arbitrary :: Gen PrivateUse
arbitrary = do
    Int
len <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
8)
    String
chars <- Int -> Gen String
alphaNumString Int
len
    PrivateUse -> Gen PrivateUse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivateUse -> Gen PrivateUse)
-> (Text -> PrivateUse) -> Text -> Gen PrivateUse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PrivateUse
PrivateUse (Text -> Gen PrivateUse) -> Text -> Gen PrivateUse
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
chars

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

-- | BCP-47 private use parser
--
-- @@
-- privateuse    = "x" 1*("-" (1*8alphanum))
-- @@
--
privateUseP :: Parsec Void Text (Set PrivateUse)
privateUseP :: Parsec Void Text (Set PrivateUse)
privateUseP = Parsec Void Text (Set PrivateUse)
-> Parsec Void Text (Set PrivateUse)
forall a. Parsec Void Text a -> Parsec Void Text a
complete (Parsec Void Text (Set PrivateUse)
 -> Parsec Void Text (Set PrivateUse))
-> Parsec Void Text (Set PrivateUse)
-> Parsec Void Text (Set PrivateUse)
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'x'
  [String]
rest <- ParsecT Void Text Identity String
-> ParsecT Void Text Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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
1 Int
8 ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar)
  Set PrivateUse -> Parsec Void Text (Set PrivateUse)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set PrivateUse -> Parsec Void Text (Set PrivateUse))
-> Set PrivateUse -> Parsec Void Text (Set PrivateUse)
forall a b. (a -> b) -> a -> b
$ [PrivateUse] -> Set PrivateUse
forall a. Ord a => [a] -> Set a
Set.fromList ([PrivateUse] -> Set PrivateUse) -> [PrivateUse] -> Set PrivateUse
forall a b. (a -> b) -> a -> b
$ Text -> PrivateUse
PrivateUse (Text -> PrivateUse) -> (String -> Text) -> String -> PrivateUse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> PrivateUse) -> [String] -> [PrivateUse]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
rest