{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Collate.Lang
  ( Lang(..)
  , parseLang
  , renderLang
  , lookupLang
  )
where
import Data.Maybe (listToMaybe, mapMaybe)
import Control.Monad (mzero)
import Data.Ord (Down(..))
import Data.List (sortOn)
import Data.Char (isAlphaNum, isAscii, isDigit, isSpace, isAlpha)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Parsec as P
import Data.Binary (Binary(..))
import Data.String
import Language.Haskell.TH.Syntax (Lift(..))
import Instances.TH.Lift ()
#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup (Semigroup(..))
#endif

-- | Represents a BCP 47 language tag (<https://tools.ietf.org/html/bcp47>).
data Lang = Lang{ Lang -> Text
langLanguage   :: Text
                , Lang -> Maybe Text
langScript     :: Maybe Text
                , Lang -> Maybe Text
langRegion     :: Maybe Text
                , Lang -> [Text]
langVariants   :: [Text]
                , Lang -> [(Text, [(Text, Text)])]
langExtensions :: [(Text, [(Text , Text)])]
                , Lang -> [Text]
langPrivateUse :: [Text]
                } deriving (Lang -> Lang -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lang -> Lang -> Bool
$c/= :: Lang -> Lang -> Bool
== :: Lang -> Lang -> Bool
$c== :: Lang -> Lang -> Bool
Eq, Eq Lang
Lang -> Lang -> Bool
Lang -> Lang -> Ordering
Lang -> Lang -> Lang
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 :: Lang -> Lang -> Lang
$cmin :: Lang -> Lang -> Lang
max :: Lang -> Lang -> Lang
$cmax :: Lang -> Lang -> Lang
>= :: Lang -> Lang -> Bool
$c>= :: Lang -> Lang -> Bool
> :: Lang -> Lang -> Bool
$c> :: Lang -> Lang -> Bool
<= :: Lang -> Lang -> Bool
$c<= :: Lang -> Lang -> Bool
< :: Lang -> Lang -> Bool
$c< :: Lang -> Lang -> Bool
compare :: Lang -> Lang -> Ordering
$ccompare :: Lang -> Lang -> Ordering
Ord, Int -> Lang -> ShowS
[Lang] -> ShowS
Lang -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lang] -> ShowS
$cshowList :: [Lang] -> ShowS
show :: Lang -> String
$cshow :: Lang -> String
showsPrec :: Int -> Lang -> ShowS
$cshowsPrec :: Int -> Lang -> ShowS
Show, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Lang -> m Exp
forall (m :: * -> *). Quote m => Lang -> Code m Lang
liftTyped :: forall (m :: * -> *). Quote m => Lang -> Code m Lang
$cliftTyped :: forall (m :: * -> *). Quote m => Lang -> Code m Lang
lift :: forall (m :: * -> *). Quote m => Lang -> m Exp
$clift :: forall (m :: * -> *). Quote m => Lang -> m Exp
Lift)

instance IsString Lang where
 fromString :: String -> Lang
fromString =
   forall b a. b -> Either a b -> b
fromRight (Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> [(Text, [(Text, Text)])]
-> [Text]
-> Lang
Lang Text
"und" forall a. Maybe a
Nothing forall a. Maybe a
Nothing [] [] []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Lang
parseLang forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance Binary Lang where
 put :: Lang -> Put
put (Lang Text
a Maybe Text
b Maybe Text
c [Text]
d [(Text, [(Text, Text)])]
e [Text]
f) = forall t. Binary t => t -> Put
put (Text
a,Maybe Text
b,Maybe Text
c,[Text]
d,[(Text, [(Text, Text)])]
e,[Text]
f)
 get :: Get Lang
get = do
     (Text
a,Maybe Text
b,Maybe Text
c,[Text]
d,[(Text, [(Text, Text)])]
e,[Text]
f) <- forall t. Binary t => Get t
get
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> [(Text, [(Text, Text)])]
-> [Text]
-> Lang
Lang Text
a Maybe Text
b Maybe Text
c [Text]
d [(Text, [(Text, Text)])]
e [Text]
f

-- | Find best match for a 'Lang' in an association list.
lookupLang :: Lang -> [(Lang, a)] -> Maybe (Lang, a)
lookupLang :: forall a. Lang -> [(Lang, a)] -> Maybe (Lang, a)
lookupLang Lang
lang =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Lang
l,a
t) ->
       case Lang -> Maybe (Bool, Bool, Bool, Bool)
match Lang
l of
         Maybe (Bool, Bool, Bool, Bool)
Nothing -> forall a. Maybe a
Nothing
         Just (Bool, Bool, Bool, Bool)
x -> forall a. a -> Maybe a
Just ((Bool, Bool, Bool, Bool)
x,(Lang
l,a
t)))
 where
  langsMatch :: Lang -> Maybe Bool
langsMatch Lang
l = if Lang -> Text
langLanguage Lang
lang forall a. Eq a => a -> a -> Bool
== Lang -> Text
langLanguage Lang
l
                    then forall a. a -> Maybe a
Just Bool
True
                    else forall a. Maybe a
Nothing
  maybeMatch :: (Lang -> Maybe a) -> Lang -> Maybe Bool
maybeMatch Lang -> Maybe a
f Lang
l = case (Lang -> Maybe a
f Lang
l, Lang -> Maybe a
f Lang
lang) of
                     (Maybe a
Nothing, Maybe a
Nothing) -> forall a. a -> Maybe a
Just Bool
True
                     (Maybe a
Nothing, Just a
_)  -> forall a. a -> Maybe a
Just Bool
False
                     (Just a
x, Maybe a
mby)      -> case Maybe a
mby of
                                             Just a
y | a
x forall a. Eq a => a -> a -> Bool
== a
y -> forall a. a -> Maybe a
Just Bool
True
                                             Maybe a
_ -> forall a. Maybe a
Nothing
  langCollation :: Lang -> Maybe Text
langCollation Lang
l = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"u" (Lang -> [(Text, [(Text, Text)])]
langExtensions Lang
l) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"co"
  match :: Lang -> Maybe (Bool, Bool, Bool, Bool)
match Lang
l = do
    Bool
lm <- Lang -> Maybe Bool
langsMatch Lang
l
    Bool
sm <- forall {a}. Eq a => (Lang -> Maybe a) -> Lang -> Maybe Bool
maybeMatch Lang -> Maybe Text
langScript Lang
l
    Bool
rm <- forall {a}. Eq a => (Lang -> Maybe a) -> Lang -> Maybe Bool
maybeMatch Lang -> Maybe Text
langRegion Lang
l
    Bool
cm <- forall {a}. Eq a => (Lang -> Maybe a) -> Lang -> Maybe Bool
maybeMatch Lang -> Maybe Text
langCollation Lang
l
    forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
lm,Bool
sm,Bool
rm,Bool
cm)

-- | Render a 'Lang' in BCP 47 form.
renderLang :: Lang -> Text
renderLang :: Lang -> Text
renderLang Lang
lang =
    Lang -> Text
langLanguage Lang
lang
     forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Char -> Text -> Text
T.cons Char
'-') (Lang -> Maybe Text
langScript Lang
lang)
     forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Char -> Text -> Text
T.cons Char
'-') (Lang -> Maybe Text
langRegion Lang
lang)
     forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Char -> Text -> Text
T.cons Char
'-') (Lang -> [Text]
langVariants Lang
lang))
     forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Text, [(Text, Text)]) -> Text
renderExtension (Lang -> [(Text, [(Text, Text)])]
langExtensions Lang
lang))
     forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
renderPrivateUse (Lang -> [Text]
langPrivateUse Lang
lang)
 where
  renderExtension :: (Text, [(Text, Text)]) -> Text
renderExtension (Text
c, [(Text, Text)]
ks) = Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
c forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
renderKeyword [(Text, Text)]
ks)
  renderKeyword :: (Text, Text) -> Text
renderKeyword (Text
k, Text
v) = Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
k forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
v
                                        then Text
""
                                        else Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
v
  renderPrivateUse :: [Text] -> Text
renderPrivateUse [] = Text
""
  renderPrivateUse [Text]
ts = Text
"-x" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Char -> Text -> Text
T.cons Char
'-') [Text]
ts)

-- | Parse a BCP 47 language tag as a 'Lang'.
parseLang :: Text -> Either String Lang
parseLang :: Text -> Either String Lang
parseLang Text
lang =
  case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse ParsecT [Text] () Identity Lang
pLangTag String
"lang" ((Char -> Bool) -> Text -> [Text]
T.split (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_')
                                 forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
lang) of
       Right Lang
r -> forall a b. b -> Either a b
Right Lang
r
       Left ParseError
e  -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseError
e
  where
    -- langtag       = language
    --                ["-" script]
    --                ["-" region]
    --                 *("-" variant)
    --                 *("-" extension)
    pLangTag :: ParsecT [Text] () Identity Lang
pLangTag = do
      Text
language <- ParsecT [Text] () Identity Text
pLanguage forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
P.<?> String
"language"
      Maybe Text
script <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity Text
pScript forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
P.<?> String
"script")
      Maybe Text
region <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity Text
pRegion forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
P.<?> String
"region")
      [Text]
variants <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT [Text] () Identity Text
pVariant forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
P.<?> String
"variant"
      [(Text, [(Text, Text)])]
extensions <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT [Text] () Identity (Text, [(Text, Text)])
pExtension forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
P.<?> String
"extension"
      [Text]
privateUse <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option [] (ParsecT [Text] () Identity [Text]
pPrivateUse forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
P.<?> String
"private use")
      -- P.eof  -- like CSL, we allow garbage afterwards
      forall (m :: * -> *) a. Monad m => a -> m a
return Lang{   langLanguage :: Text
langLanguage = Text
language
                   , langScript :: Maybe Text
langScript = Maybe Text
script
                   , langRegion :: Maybe Text
langRegion = Maybe Text
region
                   , langVariants :: [Text]
langVariants = [Text]
variants
                   , langExtensions :: [(Text, [(Text, Text)])]
langExtensions = [(Text, [(Text, Text)])]
extensions
                   , langPrivateUse :: [Text]
langPrivateUse = [Text]
privateUse }

    -- 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
    pLanguage :: ParsecT [Text] () Identity Text
pLanguage = (do
      Text
baselang <- Text -> Text
T.toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> ParsecT [Text] () Identity Text
alphasBetween Int
2 Int
3
      Maybe Text
extlang <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity Text
pExtlang
      case Maybe Text
extlang of
        Maybe Text
Nothing  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
baselang
        Just Text
ext -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
baselang forall a. Semigroup a => a -> a -> a
<> Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
ext)
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Text -> Text
T.toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> ParsecT [Text] () Identity Text
alphasBetween Int
4 Int
8

    -- extlang       = 3ALPHA              ; selected ISO 639 codes
    --                 *2("-" 3ALPHA)      ; permanently reserved
    pExtlang :: ParsecT [Text] () Identity Text
pExtlang = Text -> [Text] -> Text
T.intercalate Text
"-" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {s} {u} {m :: * -> *} {a}.
Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]
countBetween Int
1 Int
3
                 (Text -> Text
T.toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT [Text] () Identity Text
alphas Int
3)

    -- script        = 4ALPHA              ; ISO 15924 code
    pScript :: ParsecT [Text] () Identity Text
pScript = Text -> Text
T.toTitle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT [Text] () Identity Text
alphas Int
4

    -- region        = 2ALPHA              ; ISO 3166-1 code
    --               / 3DIGIT              ; UN M.49 code
    pRegion :: ParsecT [Text] () Identity Text
pRegion = Text -> Text
T.toUpper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT [Text] () Identity Text
alphas Int
2 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Int -> ParsecT [Text] () Identity Text
digits Int
3

    -- variant       = 5*8alphanum         ; registered variants
    --              / (DIGIT 3alphanum)
    pVariant :: ParsecT [Text] () Identity Text
pVariant = Text -> Text
T.toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (Int -> Int -> ParsecT [Text] () Identity Text
alphanumsBetween Int
5 Int
8
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> (Text -> Bool) -> ParsecT [Text] () Identity Text
tok (\Text
t -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAsciiAlphaNum Text
t Bool -> Bool -> Bool
&& Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
&&
                                    Char -> Bool
isDigit (Text -> Char
T.head Text
t)))

    -- extension     = singleton 1*("-" (2*8alphanum))
    -- RFC6087:
    -- An 'attribute' is a subtag with a length of three to eight
    -- characters following the singleton and preceding any 'keyword'
    -- sequences.  No attributes were defined at the time of this
    -- document's publication.

    -- A 'keyword' is a sequence of subtags consisting of a 'key' subtag,
    -- followed by zero or more 'type' subtags (so a 'key' might appear
    -- alone and not be accompanied by a 'type' subtag).  A 'key' MUST
    -- NOT appear more than once in a language tag's extension string.
    -- The order of the 'type' subtags within a 'keyword' is sometimes
    -- significant to their interpretation.

    -- A.  A 'key' is a subtag with a length of exactly two characters.
    --     Each 'key' is followed by zero or more 'type' subtags.

    -- B.  A 'type' is a subtag with a length of three to eight
    --     characters following a 'key'.  'Type' subtags are specific to
    --     a particular 'key' and the order of the 'type' subtags MAY be
    --     significant to the interpretation of the 'keyword'.
    pExtension :: ParsecT [Text] () Identity (Text, [(Text, Text)])
pExtension = do
      Text
c <- Text -> Text
T.toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Bool) -> ParsecT [Text] () Identity Text
tok (\Text
t -> Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAsciiAlphaNum Text
t)
      [Text]
attrs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many
             (Text -> Text
T.toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               (Text -> Bool) -> ParsecT [Text] () Identity Text
tok (\Text
t -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAsciiAlphaNum Text
t Bool -> Bool -> Bool
&& Int -> Int -> Text -> Bool
lengthBetween Int
3 Int
8 Text
t))
      [(Text, Text)]
keywords <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT [Text] () Identity (Text, Text)
pKeyword
      forall (m :: * -> *) a. Monad m => a -> m a
return (Text
c, forall a b. (a -> b) -> [a] -> [b]
map (, Text
"") [Text]
attrs forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
keywords)

    pKeyword :: ParsecT [Text] () Identity (Text, Text)
pKeyword = do
      Text
key <- Int -> ParsecT [Text] () Identity Text
alphas Int
2
      [Text]
types <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (Int -> Int -> ParsecT [Text] () Identity Text
alphanumsBetween Int
3 Int
8)
      forall (m :: * -> *) a. Monad m => a -> m a
return (Text
key, Text -> [Text] -> Text
T.intercalate Text
"-" [Text]
types)

    -- privateuse    = "x" 1*("-" (1*8alphanum))
    pPrivateUse :: ParsecT [Text] () Identity [Text]
pPrivateUse = do
      Text
_ <- (Text -> Bool) -> ParsecT [Text] () Identity Text
tok (\Text
t -> Text -> Text
T.toLower Text
t forall a. Eq a => a -> a -> Bool
== Text
"x")
      forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (Int -> Int -> ParsecT [Text] () Identity Text
alphanumsBetween Int
1 Int
8)

    tok :: (Text -> Bool) -> P.Parsec [Text] () Text
    tok :: (Text -> Bool) -> ParsecT [Text] () Identity Text
tok Text -> Bool
f = forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
P.tokenPrim Text -> String
T.unpack (\SourcePos
pos Text
t [Text]
_ ->
                                   SourcePos -> Int -> SourcePos
P.incSourceColumn SourcePos
pos (Text -> Int
T.length Text
t))
                      (\Text
t -> if Text -> Bool
f Text
t then forall a. a -> Maybe a
Just Text
t else forall a. Maybe a
Nothing)

    countBetween :: Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]
countBetween (Int
low :: Int) (Int
hi :: Int) ParsecT s u m a
p = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ forall {s} {u} {m :: * -> *} {a}.
Int -> Int -> ParsecT s u m a -> Int -> ParsecT s u m [a]
countBetween' Int
low Int
hi ParsecT s u m a
p Int
1
    countBetween' :: Int -> Int -> ParsecT s u m a -> Int -> ParsecT s u m [a]
countBetween' Int
low Int
hi ParsecT s u m a
p (Int
n :: Int) = (do
     a
res <- ParsecT s u m a
p
     if Int
n forall a. Ord a => a -> a -> Bool
>= Int
hi
        then forall (m :: * -> *) a. Monad m => a -> m a
return [a
res]
        else (a
resforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> ParsecT s u m a -> Int -> ParsecT s u m [a]
countBetween' Int
low Int
hi ParsecT s u m a
p (Int
n forall a. Num a => a -> a -> a
+ Int
1))
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> (if Int
n forall a. Ord a => a -> a -> Bool
> Int
low then forall (m :: * -> *) a. Monad m => a -> m a
return [] else forall (m :: * -> *) a. MonadPlus m => m a
mzero)

    isAsciiAlpha :: Char -> Bool
isAsciiAlpha Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c
    alphas :: Int -> ParsecT [Text] () Identity Text
alphas Int
len = (Text -> Bool) -> ParsecT [Text] () Identity Text
tok (\Text
t -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAsciiAlpha Text
t Bool -> Bool -> Bool
&& Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
len)
    digits :: Int -> ParsecT [Text] () Identity Text
digits Int
len = (Text -> Bool) -> ParsecT [Text] () Identity Text
tok (\Text
t -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t Bool -> Bool -> Bool
&& Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
len)
    alphasBetween :: Int -> Int -> ParsecT [Text] () Identity Text
alphasBetween Int
minLen Int
maxLen =
      (Text -> Bool) -> ParsecT [Text] () Identity Text
tok (\Text
t -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAsciiAlpha Text
t Bool -> Bool -> Bool
&& Int -> Int -> Text -> Bool
lengthBetween Int
minLen Int
maxLen Text
t)
    alphanumsBetween :: Int -> Int -> ParsecT [Text] () Identity Text
alphanumsBetween Int
minLen Int
maxLen =
      (Text -> Bool) -> ParsecT [Text] () Identity Text
tok (\Text
t -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAsciiAlphaNum Text
t Bool -> Bool -> Bool
&& Int -> Int -> Text -> Bool
lengthBetween Int
minLen Int
maxLen Text
t)
    lengthBetween :: Int -> Int -> Text -> Bool
lengthBetween Int
lo Int
hi Text
t = let len :: Int
len = Text -> Int
T.length Text
t in Int
len forall a. Ord a => a -> a -> Bool
>= Int
lo Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
<= Int
hi
    isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c


-- We define fromRight here instead of importing it,
-- because it doesn't exist in some base versions we support.
fromRight :: b -> Either a b -> b
fromRight :: forall b a. b -> Either a b -> b
fromRight b
fallback (Left a
_)  = b
fallback
fromRight b
_        (Right b
x) = b
x