module Text.Regex.TDFA.ReadRegex (parseRegex) where
import Text.Regex.TDFA.Pattern
import Text.ParserCombinators.Parsec((<|>), (<?>),
try, runParser, many, getState, setState, CharParser, ParseError,
sepBy1, option, notFollowedBy, many1, lookAhead, eof, between,
string, noneOf, digit, char, anyChar)
import Control.Monad (liftM, guard)
import Data.Foldable (asum)
import qualified Data.Set as Set(fromList)
data BracketElement
= BEChar Char
| BERange Char Char
| BEColl String
| BEEquiv String
| BEClass String
parseRegex :: String -> Either ParseError (Pattern,(GroupIndex,DoPa))
parseRegex :: [Char] -> Either ParseError (Pattern, (GroupIndex, DoPa))
parseRegex [Char]
x = GenParser
Char (GroupIndex, GroupIndex) (Pattern, (GroupIndex, DoPa))
-> (GroupIndex, GroupIndex)
-> [Char]
-> [Char]
-> Either ParseError (Pattern, (GroupIndex, DoPa))
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser (do Pattern
pat <- P Pattern
p_regex
ParsecT [Char] (GroupIndex, GroupIndex) Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
(GroupIndex
lastGroupIndex,GroupIndex
lastDopa) <- ParsecT
[Char] (GroupIndex, GroupIndex) Identity (GroupIndex, GroupIndex)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(Pattern, (GroupIndex, DoPa))
-> GenParser
Char (GroupIndex, GroupIndex) (Pattern, (GroupIndex, DoPa))
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern
pat,(GroupIndex
lastGroupIndex,GroupIndex -> DoPa
DoPa GroupIndex
lastDopa))) (GroupIndex
0,GroupIndex
0) [Char]
x [Char]
x
type P = CharParser (GroupIndex, Int)
p_regex :: P Pattern
p_regex :: P Pattern
p_regex = ([Pattern] -> Pattern)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Pattern]
-> P Pattern
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Pattern] -> Pattern
POr (ParsecT [Char] (GroupIndex, GroupIndex) Identity [Pattern]
-> P Pattern)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Pattern]
-> P Pattern
forall a b. (a -> b) -> a -> b
$ P Pattern
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Pattern]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 P Pattern
p_branch (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
p_branch :: P Pattern
p_branch :: P Pattern
p_branch = ([Pattern] -> Pattern)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Pattern]
-> P Pattern
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Pattern] -> Pattern
PConcat (ParsecT [Char] (GroupIndex, GroupIndex) Identity [Pattern]
-> P Pattern)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Pattern]
-> P Pattern
forall a b. (a -> b) -> a -> b
$ P Pattern
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Pattern]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 P Pattern
p_piece
p_piece :: P Pattern
p_piece :: P Pattern
p_piece = (P Pattern
p_anchor P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_atom) P Pattern -> (Pattern -> P Pattern) -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> (a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity b)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pattern -> P Pattern
p_post_atom
p_atom :: P Pattern
p_atom :: P Pattern
p_atom = P Pattern
p_group P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_bracket P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_char P Pattern -> [Char] -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"an atom"
group_index :: P (Maybe GroupIndex)
group_index :: P (Maybe GroupIndex)
group_index = do
(GroupIndex
gi,GroupIndex
ci) <- ParsecT
[Char] (GroupIndex, GroupIndex) Identity (GroupIndex, GroupIndex)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let index :: GroupIndex
index = GroupIndex -> GroupIndex
forall a. Enum a => a -> a
succ GroupIndex
gi
(GroupIndex, GroupIndex)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (GroupIndex
index,GroupIndex
ci)
Maybe GroupIndex -> P (Maybe GroupIndex)
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
index)
p_group :: P Pattern
p_group :: P Pattern
p_group = ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(') ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
Maybe GroupIndex
index <- P (Maybe GroupIndex)
group_index
(Pattern -> Pattern) -> P Pattern -> P Pattern
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe GroupIndex -> Pattern -> Pattern
PGroup Maybe GroupIndex
index) (P Pattern -> P Pattern) -> P Pattern -> P Pattern
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern
-> P Pattern
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(') (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')') P Pattern
p_regex
p_post_atom :: Pattern -> P Pattern
p_post_atom :: Pattern -> P Pattern
p_post_atom Pattern
atom = (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Pattern
PQuest Pattern
atom))
P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Pattern
PPlus Pattern
atom))
P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Pattern -> Pattern
PStar Bool
True Pattern
atom))
P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Pattern -> P Pattern
p_bound Pattern
atom
P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern
atom
p_bound :: Pattern -> P Pattern
p_bound :: Pattern -> P Pattern
p_bound Pattern
atom = P Pattern -> P Pattern
forall tok st a. GenParser tok st a -> GenParser tok st a
try (P Pattern -> P Pattern) -> P Pattern -> P Pattern
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern
-> P Pattern
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{') (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}') (Pattern -> P Pattern
p_bound_spec Pattern
atom)
p_bound_spec :: Pattern -> P Pattern
p_bound_spec :: Pattern -> P Pattern
p_bound_spec Pattern
atom = do [Char]
lowS <- ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
let lowI :: GroupIndex
lowI = [Char] -> GroupIndex
forall a. Read a => [Char] -> a
read [Char]
lowS
Maybe GroupIndex
highMI <- Maybe GroupIndex -> P (Maybe GroupIndex) -> P (Maybe GroupIndex)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
lowI) (P (Maybe GroupIndex) -> P (Maybe GroupIndex))
-> P (Maybe GroupIndex) -> P (Maybe GroupIndex)
forall a b. (a -> b) -> a -> b
$ P (Maybe GroupIndex) -> P (Maybe GroupIndex)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (P (Maybe GroupIndex) -> P (Maybe GroupIndex))
-> P (Maybe GroupIndex) -> P (Maybe GroupIndex)
forall a b. (a -> b) -> a -> b
$ do
Char
_ <- Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
[Char]
highS <- ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
highS then Maybe GroupIndex -> P (Maybe GroupIndex)
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GroupIndex
forall a. Maybe a
Nothing
else do let highI :: GroupIndex
highI = [Char] -> GroupIndex
forall a. Read a => [Char] -> a
read [Char]
highS
Bool -> ParsecT [Char] (GroupIndex, GroupIndex) Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GroupIndex
lowI GroupIndex -> GroupIndex -> Bool
forall a. Ord a => a -> a -> Bool
<= GroupIndex
highI)
Maybe GroupIndex -> P (Maybe GroupIndex)
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just ([Char] -> GroupIndex
forall a. Read a => [Char] -> a
read [Char]
highS))
Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupIndex -> Maybe GroupIndex -> Pattern -> Pattern
PBound GroupIndex
lowI Maybe GroupIndex
highMI Pattern
atom)
p_anchor :: P Pattern
p_anchor :: P Pattern
p_anchor = (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (DoPa -> Pattern)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
-> P Pattern
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM DoPa -> Pattern
PCarat ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
char_index)
P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (DoPa -> Pattern)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
-> P Pattern
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM DoPa -> Pattern
PDollar ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
char_index)
P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern -> P Pattern
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do [Char]
_ <- [Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"()"
Maybe GroupIndex
index <- P (Maybe GroupIndex)
group_index
Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> P Pattern) -> Pattern -> P Pattern
forall a b. (a -> b) -> a -> b
$ Maybe GroupIndex -> Pattern -> Pattern
PGroup Maybe GroupIndex
index Pattern
PEmpty)
P Pattern -> [Char] -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"empty () or anchor ^ or $"
char_index :: P DoPa
char_index :: ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
char_index = do (GroupIndex
gi,GroupIndex
ci) <- ParsecT
[Char] (GroupIndex, GroupIndex) Identity (GroupIndex, GroupIndex)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let ci' :: GroupIndex
ci' = GroupIndex -> GroupIndex
forall a. Enum a => a -> a
succ GroupIndex
ci
(GroupIndex, GroupIndex)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (GroupIndex
gi,GroupIndex
ci')
DoPa -> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupIndex -> DoPa
DoPa GroupIndex
ci')
p_char :: P Pattern
p_char :: P Pattern
p_char = P Pattern
p_dot P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_left_brace P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_escaped P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_other_char where
p_dot :: P Pattern
p_dot = Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
char_index ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
-> (DoPa -> P Pattern) -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> (a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity b)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> P Pattern) -> (DoPa -> Pattern) -> DoPa -> P Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoPa -> Pattern
PDot
p_left_brace :: P Pattern
p_left_brace = P Pattern -> P Pattern
forall tok st a. GenParser tok st a -> GenParser tok st a
try (P Pattern -> P Pattern) -> P Pattern -> P Pattern
forall a b. (a -> b) -> a -> b
$ (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity ()
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity ()
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT [Char] (GroupIndex, GroupIndex) Identity ()
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
char_index ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
-> (DoPa -> P Pattern) -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> (a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity b)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> P Pattern) -> (DoPa -> Pattern) -> DoPa -> P Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DoPa -> Char -> Pattern
`PChar` Char
'{'))
p_escaped :: P Pattern
p_escaped = Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> (Char -> P Pattern) -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> (a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity b)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
char_index ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
-> (DoPa -> P Pattern) -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> (a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity b)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> P Pattern) -> (DoPa -> Pattern) -> DoPa -> P Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DoPa -> Char -> Pattern
`PEscape` Char
c)
p_other_char :: P Pattern
p_other_char = [Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
specials ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> (Char -> P Pattern) -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> (a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity b)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
char_index ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
-> (DoPa -> P Pattern) -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> (a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity b)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> P Pattern) -> (DoPa -> Pattern) -> DoPa -> P Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DoPa -> Char -> Pattern
`PChar` Char
c)
where specials :: [Char]
specials = [Char]
"^.[$()|*+?{\\"
p_bracket :: P Pattern
p_bracket :: P Pattern
p_bracket = (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> P Pattern -> P Pattern
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> P Pattern
p_set Bool
True) P Pattern -> P Pattern -> P Pattern
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool -> P Pattern
p_set Bool
False) )
p_set :: Bool -> P Pattern
p_set :: Bool -> P Pattern
p_set Bool
invert = do [Char]
initial <- [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']' ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall a b.
ParsecT [Char] (GroupIndex, GroupIndex) Identity a
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"]")
[BracketElement]
values <- if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
initial then ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
-> ParsecT
[Char] (GroupIndex, GroupIndex) Identity [BracketElement]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem else ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
-> ParsecT
[Char] (GroupIndex, GroupIndex) Identity [BracketElement]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem
Char
_ <- Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
DoPa
ci <- ParsecT [Char] (GroupIndex, GroupIndex) Identity DoPa
char_index
let chars :: Maybe (Set Char)
chars = [Char] -> Maybe (Set Char)
forall {a}. Ord a => [a] -> Maybe (Set a)
maybe'set ([Char] -> Maybe (Set Char)) -> [Char] -> Maybe (Set Char)
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char]
initial [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
[ Char
c | BEChar Char
c <- [BracketElement]
values ] [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
[ [Char
start..Char
end] | BERange Char
start Char
end <- [BracketElement]
values ]
colls :: Maybe (Set PatternSetCollatingElement)
colls = [PatternSetCollatingElement]
-> Maybe (Set PatternSetCollatingElement)
forall {a}. Ord a => [a] -> Maybe (Set a)
maybe'set [[Char] -> PatternSetCollatingElement
PatternSetCollatingElement [Char]
coll | BEColl [Char]
coll <- [BracketElement]
values ]
equivs :: Maybe (Set PatternSetEquivalenceClass)
equivs = [PatternSetEquivalenceClass]
-> Maybe (Set PatternSetEquivalenceClass)
forall {a}. Ord a => [a] -> Maybe (Set a)
maybe'set [[Char] -> PatternSetEquivalenceClass
PatternSetEquivalenceClass [Char]
equiv | BEEquiv [Char]
equiv <- [BracketElement]
values]
class's :: Maybe (Set PatternSetCharacterClass)
class's = [PatternSetCharacterClass] -> Maybe (Set PatternSetCharacterClass)
forall {a}. Ord a => [a] -> Maybe (Set a)
maybe'set [[Char] -> PatternSetCharacterClass
PatternSetCharacterClass [Char]
a'class | BEClass [Char]
a'class <- [BracketElement]
values]
maybe'set :: [a] -> Maybe (Set a)
maybe'set [a]
x = if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
x then Maybe (Set a)
forall a. Maybe a
Nothing else Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
x)
sets :: PatternSet
sets = Maybe (Set Char)
-> Maybe (Set PatternSetCharacterClass)
-> Maybe (Set PatternSetCollatingElement)
-> Maybe (Set PatternSetEquivalenceClass)
-> PatternSet
PatternSet Maybe (Set Char)
chars Maybe (Set PatternSetCharacterClass)
class's Maybe (Set PatternSetCollatingElement)
colls Maybe (Set PatternSetEquivalenceClass)
equivs
PatternSet
sets PatternSet -> P Pattern -> P Pattern
forall a b. a -> b -> b
`seq` Pattern -> P Pattern
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> P Pattern) -> Pattern -> P Pattern
forall a b. (a -> b) -> a -> b
$ if Bool
invert then DoPa -> PatternSet -> Pattern
PAnyNot DoPa
ci PatternSet
sets else DoPa -> PatternSet -> Pattern
PAny DoPa
ci PatternSet
sets
p_set_elem :: P BracketElement
p_set_elem :: ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem = BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
checkBracketElement (BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
[ ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_class
, ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_equiv
, ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_coll
, ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_range
, ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_char
, [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a.
[Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Failed to parse bracketed string"
]
p_set_elem_class :: P BracketElement
p_set_elem_class :: ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_class = ([Char] -> BracketElement)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Char] -> BracketElement
BEClass (ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a b. (a -> b) -> a -> b
$
ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ([Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[:") ([Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
":]") (ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char])
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
":]"))
p_set_elem_equiv :: P BracketElement
p_set_elem_equiv :: ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_equiv = ([Char] -> BracketElement)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Char] -> BracketElement
BEEquiv (ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a b. (a -> b) -> a -> b
$
ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ([Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[=") ([Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"=]") (ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char])
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"=]"))
p_set_elem_coll :: P BracketElement
p_set_elem_coll :: ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_coll = ([Char] -> BracketElement)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Char] -> BracketElement
BEColl (ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a b. (a -> b) -> a -> b
$
ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ([Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[.") ([Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
".]") (ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char])
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
".]"))
p_set_elem_range :: P BracketElement
p_set_elem_range :: ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_range = ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement)
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a b. (a -> b) -> a -> b
$ do
Char
start <- [Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"]"
Char
_ <- Char -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
Char
end <- [Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"]"
BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement)
-> BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a b. (a -> b) -> a -> b
$ Char -> Char -> BracketElement
BERange Char
start Char
end
p_set_elem_char :: P BracketElement
p_set_elem_char :: ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
p_set_elem_char = do
Char
c <- [Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"]"
BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> BracketElement
BEChar Char
c)
checkBracketElement :: BracketElement -> P BracketElement
checkBracketElement :: BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
checkBracketElement BracketElement
e =
case BracketElement
e of
BERange Char
start Char
end
| Char
start Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
end -> [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a.
[Char] -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement)
-> [Char]
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords
[ [Char]
"End point"
, Char -> [Char]
forall a. Show a => a -> [Char]
show Char
end
, [Char]
"of dashed character range is less than starting point"
, Char -> [Char]
forall a. Show a => a -> [Char]
show Char
start
]
| Bool
otherwise -> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
ok
BEChar Char
_ -> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
ok
BEClass [Char]
_ -> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
ok
BEColl [Char]
_ -> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
ok
BEEquiv [Char]
_ -> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
ok
where
ok :: ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
ok = BracketElement
-> ParsecT [Char] (GroupIndex, GroupIndex) Identity BracketElement
forall a. a -> ParsecT [Char] (GroupIndex, GroupIndex) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return BracketElement
e