{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.BCP47
( BCP47
, inits
, mkLanguage
, mkLocalized
, fromText
, parser
, toText
, toSubtags
, ISO639_1
, language
, languageToText
, languageFromText
, LanguageExtension
, extendedLanguageSubtags
, languageExtensionToText
, languageExtensionFromText
, Script
, script
, scriptToText
, scriptFromText
, Country
, region
, regionToText
, regionFromText
, Variant
, variants
, variantToText
, variantFromText
, Extension
, extensions
, extensionToText
, extensionFromText
, PrivateUse
, privateUse
, privateUseToText
, privateUseFromText
, en
, es
, sw
, enGB
, enUS
, enTJP
, enGBTJP
)
where
import Control.Applicative ((<|>))
import Control.Monad (MonadPlus)
import Country.Identifier
(unitedKingdomOfGreatBritainAndNorthernIreland, unitedStatesOfAmerica)
import Data.Aeson
import Data.BCP47.Internal.Arbitrary
(Arbitrary, arbitrary, choose, elements, listOf, vectorOf)
import Data.BCP47.Internal.Extension
import Data.BCP47.Internal.Language
import Data.BCP47.Internal.LanguageExtension
import Data.BCP47.Internal.PrivateUse
import Data.BCP47.Internal.Region
import Data.BCP47.Internal.Script
import Data.BCP47.Internal.Subtags
import Data.BCP47.Internal.Variant
import Data.Bifunctor (first)
import Data.Foldable (toList)
import Data.LanguageCodes (ISO639_1(EN, ES, SW))
import qualified Data.List as List
import Data.Maybe (mapMaybe)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text, pack, unpack)
import qualified Data.Text as T
import Data.Void (Void)
import Text.Megaparsec (Parsec, eof, hidden, many, optional, parse, try)
import Text.Megaparsec.Char (char)
import Text.Megaparsec.Error (errorBundlePretty)
data BCP47
= BCP47
{ BCP47 -> ISO639_1
language :: ISO639_1
, BCP47 -> Set Subtags
subtags :: Set Subtags
}
deriving stock (BCP47 -> BCP47 -> Bool
(BCP47 -> BCP47 -> Bool) -> (BCP47 -> BCP47 -> Bool) -> Eq BCP47
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BCP47 -> BCP47 -> Bool
$c/= :: BCP47 -> BCP47 -> Bool
== :: BCP47 -> BCP47 -> Bool
$c== :: BCP47 -> BCP47 -> Bool
Eq, Eq BCP47
Eq BCP47
-> (BCP47 -> BCP47 -> Ordering)
-> (BCP47 -> BCP47 -> Bool)
-> (BCP47 -> BCP47 -> Bool)
-> (BCP47 -> BCP47 -> Bool)
-> (BCP47 -> BCP47 -> Bool)
-> (BCP47 -> BCP47 -> BCP47)
-> (BCP47 -> BCP47 -> BCP47)
-> Ord BCP47
BCP47 -> BCP47 -> Bool
BCP47 -> BCP47 -> Ordering
BCP47 -> BCP47 -> BCP47
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 :: BCP47 -> BCP47 -> BCP47
$cmin :: BCP47 -> BCP47 -> BCP47
max :: BCP47 -> BCP47 -> BCP47
$cmax :: BCP47 -> BCP47 -> BCP47
>= :: BCP47 -> BCP47 -> Bool
$c>= :: BCP47 -> BCP47 -> Bool
> :: BCP47 -> BCP47 -> Bool
$c> :: BCP47 -> BCP47 -> Bool
<= :: BCP47 -> BCP47 -> Bool
$c<= :: BCP47 -> BCP47 -> Bool
< :: BCP47 -> BCP47 -> Bool
$c< :: BCP47 -> BCP47 -> Bool
compare :: BCP47 -> BCP47 -> Ordering
$ccompare :: BCP47 -> BCP47 -> Ordering
$cp1Ord :: Eq BCP47
Ord)
instance Arbitrary BCP47 where
arbitrary :: Gen BCP47
arbitrary = ISO639_1 -> Set Subtags -> BCP47
BCP47 (ISO639_1 -> Set Subtags -> BCP47)
-> Gen ISO639_1 -> Gen (Set Subtags -> BCP47)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ISO639_1] -> Gen ISO639_1
forall a. [a] -> Gen a
elements [ISO639_1
EN, ISO639_1
ES] Gen (Set Subtags -> BCP47) -> Gen (Set Subtags) -> Gen BCP47
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set Subtags)
specs
where
oneOrNone :: (a -> a) -> Gen [a]
oneOrNone a -> a
f = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
1) Gen Int -> (Int -> Gen [a]) -> Gen [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
`vectorOf` (a -> a
f (a -> a) -> Gen a -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary))
manyOf :: (a -> a) -> Gen [a]
manyOf a -> a
f = Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
listOf (a -> a
f (a -> a) -> Gen a -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary)
regions :: [Country]
regions = [Country
forall a. Bounded a => a
minBound .. Country
forall a. Bounded a => a
maxBound]
specs :: Gen (Set Subtags)
specs = [Subtags] -> Set Subtags
forall a. Ord a => [a] -> Set a
Set.fromList ([Subtags] -> Set Subtags)
-> ([[Subtags]] -> [Subtags]) -> [[Subtags]] -> Set Subtags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Subtags]] -> [Subtags]
forall a. Monoid a => [a] -> a
mconcat ([[Subtags]] -> Set Subtags)
-> Gen [[Subtags]] -> Gen (Set Subtags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen [Subtags]] -> Gen [[Subtags]]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ (LanguageExtension -> Subtags) -> Gen [Subtags]
forall a a. Arbitrary a => (a -> a) -> Gen [a]
manyOf LanguageExtension -> Subtags
SpecifyLanguageExtension
, (Script -> Subtags) -> Gen [Subtags]
forall a a. Arbitrary a => (a -> a) -> Gen [a]
oneOrNone Script -> Subtags
SpecifyScript
, (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
1) Gen Int -> (Int -> Gen [Subtags]) -> Gen [Subtags]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Gen Subtags -> Gen [Subtags]
forall a. Int -> Gen a -> Gen [a]
`vectorOf` ([Subtags] -> Gen Subtags
forall a. [a] -> Gen a
elements ([Subtags] -> Gen Subtags) -> [Subtags] -> Gen Subtags
forall a b. (a -> b) -> a -> b
$ Country -> Subtags
SpecifyRegion (Country -> Subtags) -> [Country] -> [Subtags]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Country]
regions))
, (Variant -> Subtags) -> Gen [Subtags]
forall a a. Arbitrary a => (a -> a) -> Gen [a]
manyOf Variant -> Subtags
SpecifyVariant
, (Extension -> Subtags) -> Gen [Subtags]
forall a a. Arbitrary a => (a -> a) -> Gen [a]
manyOf Extension -> Subtags
SpecifyExtension
, (PrivateUse -> Subtags) -> Gen [Subtags]
forall a a. Arbitrary a => (a -> a) -> Gen [a]
oneOrNone PrivateUse -> Subtags
SpecifyPrivateUse
]
instance Show BCP47 where
show :: BCP47 -> String
show = Text -> String
T.unpack (Text -> String) -> (BCP47 -> Text) -> BCP47 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BCP47 -> Text
toText
instance Read BCP47 where
readsPrec :: Int -> ReadS BCP47
readsPrec Int
_ String
s = case Text -> Either Text BCP47
fromText (Text -> Either Text BCP47) -> Text -> Either Text BCP47
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s of
Left Text
_ -> []
Right BCP47
b -> [(BCP47
b, String
"")]
instance ToJSON BCP47 where
toEncoding :: BCP47 -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (BCP47 -> Text) -> BCP47 -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BCP47 -> Text
toText
toJSON :: BCP47 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (BCP47 -> Text) -> BCP47 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BCP47 -> Text
toText
instance FromJSON BCP47 where
parseJSON :: Value -> Parser BCP47
parseJSON = String -> (Text -> Parser BCP47) -> Value -> Parser BCP47
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"BCP47" ((Text -> Parser BCP47) -> Value -> Parser BCP47)
-> (Text -> Parser BCP47) -> Value -> Parser BCP47
forall a b. (a -> b) -> a -> b
$ (Text -> Parser BCP47)
-> (BCP47 -> Parser BCP47) -> Either Text BCP47 -> Parser BCP47
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser BCP47
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser BCP47)
-> (Text -> String) -> Text -> Parser BCP47
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) BCP47 -> Parser BCP47
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text BCP47 -> Parser BCP47)
-> (Text -> Either Text BCP47) -> Text -> Parser BCP47
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text BCP47
fromText
toText :: BCP47 -> Text
toText :: BCP47 -> Text
toText BCP47
b = Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat
[ [ISO639_1 -> Text
languageToText (ISO639_1 -> Text) -> ISO639_1 -> Text
forall a b. (a -> b) -> a -> b
$ BCP47 -> ISO639_1
language BCP47
b]
, (Subtags -> Maybe Text) -> [Subtags] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Subtags -> Maybe Text
fromSubtags ([Subtags] -> [Text])
-> (Set Subtags -> [Subtags]) -> Set Subtags -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Subtags -> [Subtags]
forall a. Set a -> [a]
Set.toList (Set Subtags -> [Text]) -> Set Subtags -> [Text]
forall a b. (a -> b) -> a -> b
$ BCP47 -> Set Subtags
subtags BCP47
b
, if Set PrivateUse -> Bool
forall a. Set a -> Bool
Set.null (BCP47 -> Set PrivateUse
privateUse BCP47
b) then [] else [Text
"x"]
, (PrivateUse -> Text) -> [PrivateUse] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PrivateUse -> Text
privateUseToText ([PrivateUse] -> [Text])
-> (Set PrivateUse -> [PrivateUse]) -> Set PrivateUse -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PrivateUse -> [PrivateUse]
forall a. Set a -> [a]
Set.toList (Set PrivateUse -> [Text]) -> Set PrivateUse -> [Text]
forall a b. (a -> b) -> a -> b
$ BCP47 -> Set PrivateUse
privateUse BCP47
b
]
where
fromSubtags :: Subtags -> Maybe Text
fromSubtags = \case
SpecifyLanguageExtension LanguageExtension
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LanguageExtension -> Text
languageExtensionToText LanguageExtension
x
SpecifyScript Script
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Script -> Text
scriptToText Script
x
SpecifyRegion Country
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Country -> Text
regionToText Country
x
SpecifyVariant Variant
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Variant -> Text
variantToText Variant
x
SpecifyExtension Extension
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Extension -> Text
extensionToText Extension
x
SpecifyPrivateUse PrivateUse
_ -> Maybe Text
forall a. Maybe a
Nothing
extendedLanguageSubtags :: BCP47 -> Set LanguageExtension
extendedLanguageSubtags :: BCP47 -> Set LanguageExtension
extendedLanguageSubtags = (Subtags -> Maybe LanguageExtension)
-> BCP47 -> Set LanguageExtension
forall a. Ord a => (Subtags -> Maybe a) -> BCP47 -> Set a
asSet ((Subtags -> Maybe LanguageExtension)
-> BCP47 -> Set LanguageExtension)
-> (Subtags -> Maybe LanguageExtension)
-> BCP47
-> Set LanguageExtension
forall a b. (a -> b) -> a -> b
$ \case
SpecifyLanguageExtension LanguageExtension
x -> LanguageExtension -> Maybe LanguageExtension
forall a. a -> Maybe a
Just LanguageExtension
x
Subtags
_otherwise -> Maybe LanguageExtension
forall a. Maybe a
Nothing
script :: BCP47 -> Maybe Script
script :: BCP47 -> Maybe Script
script = [Script] -> Maybe Script
forall x. [x] -> Maybe x
headMay ([Script] -> Maybe Script)
-> (BCP47 -> [Script]) -> BCP47 -> Maybe Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Subtags -> Maybe Script) -> [Subtags] -> [Script]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Subtags -> Maybe Script
f ([Subtags] -> [Script])
-> (BCP47 -> [Subtags]) -> BCP47 -> [Script]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Subtags -> [Subtags]
forall a. Set a -> [a]
Set.toList (Set Subtags -> [Subtags])
-> (BCP47 -> Set Subtags) -> BCP47 -> [Subtags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BCP47 -> Set Subtags
subtags
where
f :: Subtags -> Maybe Script
f = \case
SpecifyScript Script
x -> Script -> Maybe Script
forall a. a -> Maybe a
Just Script
x
Subtags
_otherwise -> Maybe Script
forall a. Maybe a
Nothing
region :: BCP47 -> Maybe Country
region :: BCP47 -> Maybe Country
region = [Country] -> Maybe Country
forall x. [x] -> Maybe x
headMay ([Country] -> Maybe Country)
-> (BCP47 -> [Country]) -> BCP47 -> Maybe Country
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Subtags -> Maybe Country) -> [Subtags] -> [Country]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Subtags -> Maybe Country
f ([Subtags] -> [Country])
-> (BCP47 -> [Subtags]) -> BCP47 -> [Country]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Subtags -> [Subtags]
forall a. Set a -> [a]
Set.toList (Set Subtags -> [Subtags])
-> (BCP47 -> Set Subtags) -> BCP47 -> [Subtags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BCP47 -> Set Subtags
subtags
where
f :: Subtags -> Maybe Country
f = \case
SpecifyRegion Country
x -> Country -> Maybe Country
forall a. a -> Maybe a
Just Country
x
Subtags
_otherwise -> Maybe Country
forall a. Maybe a
Nothing
variants :: BCP47 -> Set Variant
variants :: BCP47 -> Set Variant
variants = (Subtags -> Maybe Variant) -> BCP47 -> Set Variant
forall a. Ord a => (Subtags -> Maybe a) -> BCP47 -> Set a
asSet ((Subtags -> Maybe Variant) -> BCP47 -> Set Variant)
-> (Subtags -> Maybe Variant) -> BCP47 -> Set Variant
forall a b. (a -> b) -> a -> b
$ \case
SpecifyVariant Variant
x -> Variant -> Maybe Variant
forall a. a -> Maybe a
Just Variant
x
Subtags
_otherwise -> Maybe Variant
forall a. Maybe a
Nothing
extensions :: BCP47 -> Set Extension
extensions :: BCP47 -> Set Extension
extensions = (Subtags -> Maybe Extension) -> BCP47 -> Set Extension
forall a. Ord a => (Subtags -> Maybe a) -> BCP47 -> Set a
asSet ((Subtags -> Maybe Extension) -> BCP47 -> Set Extension)
-> (Subtags -> Maybe Extension) -> BCP47 -> Set Extension
forall a b. (a -> b) -> a -> b
$ \case
SpecifyExtension Extension
x -> Extension -> Maybe Extension
forall a. a -> Maybe a
Just Extension
x
Subtags
_otherwise -> Maybe Extension
forall a. Maybe a
Nothing
privateUse :: BCP47 -> Set PrivateUse
privateUse :: BCP47 -> Set PrivateUse
privateUse = (Subtags -> Maybe PrivateUse) -> BCP47 -> Set PrivateUse
forall a. Ord a => (Subtags -> Maybe a) -> BCP47 -> Set a
asSet ((Subtags -> Maybe PrivateUse) -> BCP47 -> Set PrivateUse)
-> (Subtags -> Maybe PrivateUse) -> BCP47 -> Set PrivateUse
forall a b. (a -> b) -> a -> b
$ \case
SpecifyPrivateUse PrivateUse
x -> PrivateUse -> Maybe PrivateUse
forall a. a -> Maybe a
Just PrivateUse
x
Subtags
_otherwise -> Maybe PrivateUse
forall a. Maybe a
Nothing
asSet :: Ord a => (Subtags -> Maybe a) -> BCP47 -> Set a
asSet :: (Subtags -> Maybe a) -> BCP47 -> Set a
asSet Subtags -> Maybe a
f = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> (BCP47 -> [a]) -> BCP47 -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Subtags -> Maybe a) -> [Subtags] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Subtags -> Maybe a
f ([Subtags] -> [a]) -> (BCP47 -> [Subtags]) -> BCP47 -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Subtags -> [Subtags]
forall a. Set a -> [a]
Set.toList (Set Subtags -> [Subtags])
-> (BCP47 -> Set Subtags) -> BCP47 -> [Subtags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BCP47 -> Set Subtags
subtags
headMay :: [x] -> Maybe x
headMay :: [x] -> Maybe x
headMay [] = Maybe x
forall a. Maybe a
Nothing
headMay (x
x : [x]
_) = x -> Maybe x
forall a. a -> Maybe a
Just x
x
toSubtags :: BCP47 -> [Subtags]
toSubtags :: BCP47 -> [Subtags]
toSubtags BCP47
tag = Set Subtags -> [Subtags]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Subtags -> [Subtags]) -> Set Subtags -> [Subtags]
forall a b. (a -> b) -> a -> b
$ BCP47 -> Set Subtags
subtags BCP47
tag
inits :: BCP47 -> [BCP47]
inits :: BCP47 -> [BCP47]
inits BCP47
tag =
([Subtags] -> BCP47) -> [[Subtags]] -> [BCP47]
forall a b. (a -> b) -> [a] -> [b]
map (ISO639_1 -> Set Subtags -> BCP47
BCP47 (BCP47 -> ISO639_1
language BCP47
tag) (Set Subtags -> BCP47)
-> ([Subtags] -> Set Subtags) -> [Subtags] -> BCP47
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Subtags] -> Set Subtags
forall a. Ord a => [a] -> Set a
Set.fromList) ([[Subtags]] -> [BCP47])
-> ([Subtags] -> [[Subtags]]) -> [Subtags] -> [BCP47]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Subtags] -> [[Subtags]]
forall a. [a] -> [[a]]
List.inits ([Subtags] -> [BCP47]) -> [Subtags] -> [BCP47]
forall a b. (a -> b) -> a -> b
$ BCP47 -> [Subtags]
toSubtags BCP47
tag
mkLanguage :: ISO639_1 -> BCP47
mkLanguage :: ISO639_1 -> BCP47
mkLanguage ISO639_1
lang = ISO639_1 -> Set Subtags -> BCP47
BCP47 ISO639_1
lang Set Subtags
forall a. Monoid a => a
mempty
mkLocalized :: ISO639_1 -> Country -> BCP47
mkLocalized :: ISO639_1 -> Country -> BCP47
mkLocalized ISO639_1
lang Country
locale = ISO639_1 -> Set Subtags -> BCP47
BCP47 ISO639_1
lang (Set Subtags -> BCP47)
-> (Subtags -> Set Subtags) -> Subtags -> BCP47
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subtags -> Set Subtags
forall a. a -> Set a
Set.singleton (Subtags -> BCP47) -> Subtags -> BCP47
forall a b. (a -> b) -> a -> b
$ Country -> Subtags
SpecifyRegion Country
locale
fromText :: Text -> Either Text BCP47
fromText :: Text -> Either Text BCP47
fromText =
(ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) BCP47 -> Either Text BCP47
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) BCP47 -> Either Text BCP47)
-> (Text -> Either (ParseErrorBundle Text Void) BCP47)
-> Text
-> Either Text BCP47
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text BCP47
-> String -> Text -> Either (ParseErrorBundle Text Void) BCP47
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void Text BCP47
parser Parsec Void Text BCP47
-> ParsecT Void Text Identity () -> Parsec Void Text BCP47
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"fromText"
_example :: Text -> Either Text (BCP47, Char)
_example :: Text -> Either Text (BCP47, Char)
_example = (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) (BCP47, Char)
-> Either Text (BCP47, Char)
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) (BCP47, Char)
-> Either Text (BCP47, Char))
-> (Text -> Either (ParseErrorBundle Text Void) (BCP47, Char))
-> Text
-> Either Text (BCP47, Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text (BCP47, Char)
-> String
-> Text
-> Either (ParseErrorBundle Text Void) (BCP47, Char)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text (BCP47, Char)
p String
"example"
where p :: Parsec Void Text (BCP47, Char)
p = (,) (BCP47 -> Char -> (BCP47, Char))
-> Parsec Void Text BCP47
-> ParsecT Void Text Identity (Char -> (BCP47, Char))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text BCP47
parser ParsecT Void Text Identity (Char -> (BCP47, Char))
-> ParsecT Void Text Identity Char
-> Parsec Void Text (BCP47, Char)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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
';'
parser :: Parsec Void Text BCP47
parser :: Parsec Void Text BCP47
parser = ISO639_1 -> Set Subtags -> BCP47
BCP47 (ISO639_1 -> Set Subtags -> BCP47)
-> ParsecT Void Text Identity ISO639_1
-> ParsecT Void Text Identity (Set Subtags -> BCP47)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity ISO639_1
languageP ParsecT Void Text Identity (Set Subtags -> BCP47)
-> ParsecT Void Text Identity (Set Subtags)
-> Parsec Void Text BCP47
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (Set Subtags)
subtagsP
where
subtagsP :: ParsecT Void Text Identity (Set Subtags)
subtagsP = [Set Subtags] -> Set Subtags
forall a. Monoid a => [a] -> a
mconcat ([Set Subtags] -> Set Subtags)
-> ParsecT Void Text Identity [Set Subtags]
-> ParsecT Void Text Identity (Set Subtags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void Text Identity (Set Subtags)]
-> ParsecT Void Text Identity [Set Subtags]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ (LanguageExtension -> Subtags)
-> ParsecT Void Text Identity LanguageExtension
-> ParsecT Void Text Identity (Set Subtags)
forall b (m :: * -> *) a.
(Ord b, MonadPlus m) =>
(a -> b) -> m a -> m (Set b)
manyAsSet LanguageExtension -> Subtags
SpecifyLanguageExtension (ParsecT Void Text Identity LanguageExtension
-> ParsecT Void Text Identity LanguageExtension
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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 LanguageExtension
-> ParsecT Void Text Identity LanguageExtension
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity LanguageExtension
languageExtensionP))
, Set Subtags
-> (Script -> Set Subtags) -> Maybe Script -> Set Subtags
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Subtags
forall a. Monoid a => a
mempty (Subtags -> Set Subtags
forall a. a -> Set a
Set.singleton (Subtags -> Set Subtags)
-> (Script -> Subtags) -> Script -> Set Subtags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> Subtags
SpecifyScript)
(Maybe Script -> Set Subtags)
-> ParsecT Void Text Identity (Maybe Script)
-> ParsecT Void Text Identity (Set Subtags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity (Maybe Script)
-> ParsecT Void Text Identity (Maybe Script)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Script
-> ParsecT Void Text Identity (Maybe Script)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Script
-> ParsecT Void Text Identity (Maybe Script))
-> ParsecT Void Text Identity Script
-> ParsecT Void Text Identity (Maybe Script)
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
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Script
-> ParsecT Void Text Identity Script
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Script
scriptP) ParsecT Void Text Identity (Maybe Script)
-> ParsecT Void Text Identity (Maybe Script)
-> ParsecT Void Text Identity (Maybe Script)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Script -> ParsecT Void Text Identity (Maybe Script)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Script
forall a. Maybe a
Nothing)
, Set Subtags
-> (Country -> Set Subtags) -> Maybe Country -> Set Subtags
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Subtags
forall a. Monoid a => a
mempty (Subtags -> Set Subtags
forall a. a -> Set a
Set.singleton (Subtags -> Set Subtags)
-> (Country -> Subtags) -> Country -> Set Subtags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Country -> Subtags
SpecifyRegion)
(Maybe Country -> Set Subtags)
-> ParsecT Void Text Identity (Maybe Country)
-> ParsecT Void Text Identity (Set Subtags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity (Maybe Country)
-> ParsecT Void Text Identity (Maybe Country)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Country
-> ParsecT Void Text Identity (Maybe Country)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Country
-> ParsecT Void Text Identity (Maybe Country))
-> ParsecT Void Text Identity Country
-> ParsecT Void Text Identity (Maybe Country)
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
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Country
-> ParsecT Void Text Identity Country
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Country
regionP) ParsecT Void Text Identity (Maybe Country)
-> ParsecT Void Text Identity (Maybe Country)
-> ParsecT Void Text Identity (Maybe Country)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Country -> ParsecT Void Text Identity (Maybe Country)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Country
forall a. Maybe a
Nothing)
, (Variant -> Subtags)
-> ParsecT Void Text Identity Variant
-> ParsecT Void Text Identity (Set Subtags)
forall b (m :: * -> *) a.
(Ord b, MonadPlus m) =>
(a -> b) -> m a -> m (Set b)
manyAsSet Variant -> Subtags
SpecifyVariant (ParsecT Void Text Identity Variant
-> ParsecT Void Text Identity Variant
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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 Variant
-> ParsecT Void Text Identity Variant
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Variant
variantP))
, (Extension -> Subtags)
-> ParsecT Void Text Identity Extension
-> ParsecT Void Text Identity (Set Subtags)
forall b (m :: * -> *) a.
(Ord b, MonadPlus m) =>
(a -> b) -> m a -> m (Set b)
manyAsSet Extension -> Subtags
SpecifyExtension (ParsecT Void Text Identity Extension
-> ParsecT Void Text Identity Extension
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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 Extension
-> ParsecT Void Text Identity Extension
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Extension
extensionP))
, (PrivateUse -> Subtags) -> Set PrivateUse -> Set Subtags
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PrivateUse -> Subtags
SpecifyPrivateUse (Set PrivateUse -> Set Subtags)
-> ParsecT Void Text Identity (Set PrivateUse)
-> ParsecT Void Text Identity (Set Subtags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity (Set PrivateUse)
-> ParsecT Void Text Identity (Set PrivateUse)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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 (Set PrivateUse)
-> ParsecT Void Text Identity (Set PrivateUse)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (Set PrivateUse)
privateUseP) ParsecT Void Text Identity (Set PrivateUse)
-> ParsecT Void Text Identity (Set PrivateUse)
-> ParsecT Void Text Identity (Set PrivateUse)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity (Set PrivateUse)
forall a. Monoid a => a
mempty)
]
manyAsSet :: (Ord b, MonadPlus m) => (a -> b) -> m a -> m (Set b)
manyAsSet :: (a -> b) -> m a -> m (Set b)
manyAsSet a -> b
f m a
p = [b] -> Set b
forall a. Ord a => [a] -> Set a
Set.fromList ([b] -> Set b) -> ([a] -> [b]) -> [a] -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f ([a] -> Set b) -> m [a] -> m (Set b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m a
p
es :: BCP47
es :: BCP47
es = ISO639_1 -> BCP47
mkLanguage ISO639_1
ES
en :: BCP47
en :: BCP47
en = ISO639_1 -> BCP47
mkLanguage ISO639_1
EN
sw :: BCP47
sw :: BCP47
sw = ISO639_1 -> BCP47
mkLanguage ISO639_1
SW
enGB :: BCP47
enGB :: BCP47
enGB = ISO639_1 -> Country -> BCP47
mkLocalized ISO639_1
EN Country
unitedKingdomOfGreatBritainAndNorthernIreland
enUS :: BCP47
enUS :: BCP47
enUS = ISO639_1 -> Country -> BCP47
mkLocalized ISO639_1
EN Country
unitedStatesOfAmerica
enTJP :: BCP47
enTJP :: BCP47
enTJP = BCP47
en
{ subtags :: Set Subtags
subtags = Subtags -> Set Subtags -> Set Subtags
forall a. Ord a => a -> Set a -> Set a
Set.insert (Extension -> Subtags
SpecifyExtension (Text -> Extension
Extension (String -> Text
pack String
"t-jp")))
(Set Subtags -> Set Subtags) -> Set Subtags -> Set Subtags
forall a b. (a -> b) -> a -> b
$ BCP47 -> Set Subtags
subtags BCP47
en
}
enGBTJP :: BCP47
enGBTJP :: BCP47
enGBTJP = BCP47
enGB
{ subtags :: Set Subtags
subtags = Subtags -> Set Subtags -> Set Subtags
forall a. Ord a => a -> Set a -> Set a
Set.insert (Extension -> Subtags
SpecifyExtension (Text -> Extension
Extension (String -> Text
pack String
"t-jp")))
(Set Subtags -> Set Subtags) -> Set Subtags -> Set Subtags
forall a b. (a -> b) -> a -> b
$ BCP47 -> Set Subtags
subtags BCP47
enGB
}