module Data.BCP47.Internal.Parser
  ( complete
  ) where

import Control.Applicative ((<|>))
import Control.Monad (void)
import Data.Text (Text)
import Data.Void (Void)
import Text.Megaparsec (Parsec, eof, lookAhead, noneOf)
import Text.Megaparsec.Char (char)

-- | Ensure a subtag extends to the next '-' or end of input
--
-- Used for subtags that can match some prefix of another subtag.
-- For example, a @'Script'@ or @'Region'@ can accidentally be parsed
-- from the prefix of a @'Variant'@
--
-- The alternative would be to use @'notFollowedBy'@ with knowledge of
-- the legal characters in the next valid subtag.
--
complete :: Parsec Void Text a -> Parsec Void Text a
complete :: Parsec Void Text a -> Parsec Void Text a
complete Parsec Void Text a
parser =
  Parsec Void Text a
parser Parsec Void Text a
-> ParsecT Void Text Identity () -> Parsec Void Text a
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
lookAhead (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
[Token Text]
tagChars))

tagChars :: String
tagChars :: String
tagChars = Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: [Char
'a' .. Char
'z'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'A' .. Char
'Z'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9']