{-# LANGUAGE OverloadedStrings #-}

module Data.BCP47.Internal.Language
  ( ISO639_1
  , languageFromText
  , languageToText
  , languageP
  )
where

import Data.BCP47.Internal.Parser (complete)
import Data.Bifunctor (first)
import Data.LanguageCodes (ISO639_1, fromChars)
import Data.Text (Text, pack, toLower)
import Data.Void (Void)
import Text.Megaparsec (Parsec, parse)
import Text.Megaparsec.Char (lowerChar)
import Text.Megaparsec.Error (errorBundlePretty)

languageToText :: ISO639_1 -> Text
languageToText :: ISO639_1 -> Text
languageToText = Text -> Text
toLower (Text -> Text) -> (ISO639_1 -> Text) -> ISO639_1 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (ISO639_1 -> String) -> ISO639_1 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ISO639_1 -> String
forall a. Show a => a -> String
show

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

-- | BCP-47 language parser
--
-- This only implements the ISO 639 portion of the grammar.
--
-- @@
--  language      = 2*3ALPHA            ; shortest ISO 639 code
--                  ["-" extlang]       ; sometimes followed by
--                                      ; extended language subtags
--                / 4ALPHA              ; or reserved for future use
--                / 5*8ALPHA            ; or registered language subtag
-- @@
--
languageP :: Parsec Void Text ISO639_1
languageP :: Parsec Void Text ISO639_1
languageP = Parsec Void Text ISO639_1 -> Parsec Void Text ISO639_1
forall a. Parsec Void Text a -> Parsec Void Text a
complete (Parsec Void Text ISO639_1 -> Parsec Void Text ISO639_1)
-> Parsec Void Text ISO639_1 -> Parsec Void Text ISO639_1
forall a b. (a -> b) -> a -> b
$ do
  Maybe ISO639_1
mCode <- Char -> Char -> Maybe ISO639_1
fromChars (Char -> Char -> Maybe ISO639_1)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Char -> Maybe ISO639_1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar ParsecT Void Text Identity (Char -> Maybe ISO639_1)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe ISO639_1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
  Parsec Void Text ISO639_1
-> (ISO639_1 -> Parsec Void Text ISO639_1)
-> Maybe ISO639_1
-> Parsec Void Text ISO639_1
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parsec Void Text ISO639_1
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown ISO-639-1 code") ISO639_1 -> Parsec Void Text ISO639_1
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ISO639_1
mCode