-- | This is a POSIX version of parseRegex that allows NUL characters.
-- Lazy\/Possessive\/Backrefs are not recognized.  Anchors \^ and \$ are
-- recognized.
--
-- A 'PGroup' returned always has @(Maybe 'GroupIndex')@ set to @(Just _)@
-- and never to @Nothing@.

module Text.Regex.TDFA.ReadRegex (parseRegex) where

{- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -}

import Text.Regex.TDFA.Pattern {- all -}
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)

-- | An element inside @[...]@, denoting a character class.
data BracketElement
  = BEChar  Char       -- ^ A single character.
  | BERange Char Char  -- ^ A character range (e.g. @a-z@).
  | BEColl  String     -- ^ @foo@ in @[.foo.]@.
  | BEEquiv String     -- ^ @bar@ in @[=bar=]@.
  | BEClass String     -- ^ A POSIX character class (candidate), e.g. @alpha@ parsed from @[:alpha:]@.

-- | Return either an error message or a tuple of the Pattern and the
-- largest group index and the largest DoPa index (both have smallest
-- index of 1).  Since the regular expression is supplied as [Char] it
-- automatically supports unicode and @\\NUL@ characters.
parseRegex :: String -> Either ParseError (Pattern,(GroupIndex,DoPa))
parseRegex :: [Char] -> Either ParseError (Pattern, (GroupIndex, DoPa))
parseRegex [Char]
x = forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser (do Pattern
pat <- P Pattern
p_regex
                             forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
                             (GroupIndex
lastGroupIndex,GroupIndex
lastDopa) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                             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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Pattern] -> Pattern
POr forall a b. (a -> b) -> a -> b
$ 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 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')

-- man re_format helps a lot, it says one-or-more pieces so this is
-- many1 not many.  Use "()" to indicate an empty piece.
p_branch :: P Pattern
p_branch :: P Pattern
p_branch = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Pattern] -> Pattern
PConcat forall a b. (a -> b) -> a -> b
$ 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 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_atom) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pattern -> P Pattern
p_post_atom -- correct specification

p_atom :: P Pattern
p_atom :: P Pattern
p_atom =  P Pattern
p_group forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_bracket forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_char 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) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let index :: GroupIndex
index = forall a. Enum a => a -> a
succ GroupIndex
gi
  forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (GroupIndex
index,GroupIndex
ci)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just GroupIndex
index)

p_group :: P Pattern
p_group :: P Pattern
p_group = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Maybe GroupIndex
index <- P (Maybe GroupIndex)
group_index
  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe GroupIndex -> Pattern -> Pattern
PGroup Maybe GroupIndex
index) forall a b. (a -> b) -> a -> b
$ 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 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')') P Pattern
p_regex

-- p_post_atom takes the previous atom as a parameter
p_post_atom :: Pattern -> P Pattern
p_post_atom :: Pattern -> P Pattern
p_post_atom Pattern
atom = (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Pattern
PQuest Pattern
atom))
               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> Pattern
PPlus Pattern
atom))
               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Pattern -> Pattern
PStar Bool
True Pattern
atom))
               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
               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m 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 = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ 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 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 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 <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                       let lowI :: GroupIndex
lowI = forall a. Read a => [Char] -> a
read [Char]
lowS
                       Maybe GroupIndex
highMI <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (forall a. a -> Maybe a
Just GroupIndex
lowI) forall a b. (a -> b) -> a -> b
$ forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
                                   Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
  -- parsec note: if 'many digits' fails below then the 'try' ensures
  -- that the ',' will not match the closing '}' in p_bound, same goes
  -- for any non '}' garbage after the 'many digits'.
                                   [Char]
highS <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                                   if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
highS then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing -- no upper bound
                                     else do let highI :: GroupIndex
highI = forall a. Read a => [Char] -> a
read [Char]
highS
                                             forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GroupIndex
lowI forall a. Ord a => a -> a -> Bool
<= GroupIndex
highI)
                                             forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall a. Read a => [Char] -> a
read [Char]
highS))
                       forall (m :: * -> *) a. Monad m => a -> m a
return (GroupIndex -> Maybe GroupIndex -> Pattern -> Pattern
PBound GroupIndex
lowI Maybe GroupIndex
highMI Pattern
atom)

-- An anchor cannot be modified by a repetition specifier
p_anchor :: P Pattern
p_anchor :: P Pattern
p_anchor = (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM DoPa -> Pattern
PCarat P DoPa
char_index)
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM DoPa -> Pattern
PDollar P DoPa
char_index)
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall tok st a. GenParser tok st a -> GenParser tok st a
try (do [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
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe GroupIndex -> Pattern -> Pattern
PGroup Maybe GroupIndex
index Pattern
PEmpty)
       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 :: P DoPa
char_index = do (GroupIndex
gi,GroupIndex
ci) <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                let ci' :: GroupIndex
ci' = forall a. Enum a => a -> a
succ GroupIndex
ci
                forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (GroupIndex
gi,GroupIndex
ci')
                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 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 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Pattern
p_escaped 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 = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P DoPa
char_index forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoPa -> Pattern
PDot
  p_left_brace :: P Pattern
p_left_brace = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P DoPa
char_index forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DoPa -> Char -> Pattern
`PChar` Char
'{'))
  p_escaped :: P Pattern
p_escaped = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> P DoPa
char_index forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DoPa -> Char -> Pattern
`PEscape` Char
c)
  p_other_char :: P Pattern
p_other_char = forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
specials forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> P DoPa
char_index forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DoPa -> Char -> Pattern
`PChar` Char
c)
    where specials :: [Char]
specials  = [Char]
"^.[$()|*+?{\\"

-- parse [bar] and [^bar] sets of characters
p_bracket :: P Pattern
p_bracket :: P Pattern
p_bracket = (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> P Pattern
p_set Bool
True) 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 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"]")
                  [BracketElement]
values <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
initial then forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 P BracketElement
p_set_elem else forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many P BracketElement
p_set_elem
                  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
                  DoPa
ci <- P DoPa
char_index
                  let chars :: Maybe (Set Char)
chars = forall {a}. Ord a => [a] -> Maybe (Set a)
maybe'set forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
                        [Char]
initial forall a. a -> [a] -> [a]
:
                        [ Char
c | BEChar Char
c <- [BracketElement]
values ] forall a. a -> [a] -> [a]
:
                        [ [Char
start..Char
end] | BERange Char
start Char
end <- [BracketElement]
values ]
                      colls :: Maybe (Set PatternSetCollatingElement)
colls = 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 = 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 = 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
x then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (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 seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return 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

-- From here down the code is the parser and functions for pattern [ ] set things

p_set_elem :: P BracketElement
p_set_elem :: P BracketElement
p_set_elem = BracketElement -> P BracketElement
checkBracketElement forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
  [ P BracketElement
p_set_elem_class
  , P BracketElement
p_set_elem_equiv
  , P BracketElement
p_set_elem_coll
  , P BracketElement
p_set_elem_range
  , P BracketElement
p_set_elem_char
  , 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 :: P BracketElement
p_set_elem_class = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Char] -> BracketElement
BEClass forall a b. (a -> b) -> a -> b
$
  forall tok st a. GenParser tok st a -> GenParser tok st a
try (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 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[:") (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
":]") (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ 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 :: P BracketElement
p_set_elem_equiv = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Char] -> BracketElement
BEEquiv forall a b. (a -> b) -> a -> b
$
  forall tok st a. GenParser tok st a -> GenParser tok st a
try (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 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[=") (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"=]") (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ 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 :: P BracketElement
p_set_elem_coll =  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Char] -> BracketElement
BEColl forall a b. (a -> b) -> a -> b
$
  forall tok st a. GenParser tok st a -> GenParser tok st a
try (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 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[.") (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
".]") (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ 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 :: P BracketElement
p_set_elem_range = forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do
  Char
start <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"]"
  Char
_  <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
  Char
end <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"]"
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: P BracketElement
p_set_elem_char = do
  Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"]"
  forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> BracketElement
BEChar Char
c)

-- | Fail when 'BracketElement' is invalid, e.g. empty range @1-0@.
-- This failure should not be caught.
--
checkBracketElement :: BracketElement -> P BracketElement
checkBracketElement :: BracketElement -> P BracketElement
checkBracketElement BracketElement
e =
  case BracketElement
e of
    BERange Char
start Char
end
      | Char
start forall a. Ord a => a -> a -> Bool
> Char
end -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords
          [ [Char]
"End point"
          , forall a. Show a => a -> [Char]
show Char
end
          , [Char]
"of dashed character range is less than starting point"
          , forall a. Show a => a -> [Char]
show Char
start
          ]
      | Bool
otherwise -> P BracketElement
ok
    BEChar  Char
_ -> P BracketElement
ok
    BEClass [Char]
_ -> P BracketElement
ok
    BEColl  [Char]
_ -> P BracketElement
ok
    BEEquiv [Char]
_ -> P BracketElement
ok
  where
    ok :: P BracketElement
ok = forall (m :: * -> *) a. Monad m => a -> m a
return BracketElement
e