{-# LANGUAGE FlexibleContexts #-}
module Text.Regex.XMLSchema.Generic.RegexParser
( parseRegex
, parseRegexExt
, parseRegex'
, parseRegexExt'
, parseContextRegex
)
where
import Data.Char.Properties.UnicodeBlocks
import Data.Char.Properties.UnicodeCharProps
import Data.Char.Properties.XMLCharProps
import Data.List (isPrefixOf,
isSuffixOf)
import Data.Maybe
import Data.Set.CharSet
import Text.ParserCombinators.Parsec
import Text.Regex.XMLSchema.Generic.Regex
import Text.Regex.XMLSchema.Generic.StringLike
parseRegex :: StringLike s => s -> GenRegex s
parseRegex :: forall s. StringLike s => s -> GenRegex s
parseRegex = forall s. StringLike s => String -> GenRegex s
parseRegex' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StringLike a => a -> String
toString
parseRegex' :: StringLike s => String -> GenRegex s
parseRegex' :: forall s. StringLike s => String -> GenRegex s
parseRegex' = forall s.
StringLike s =>
Parser (GenRegex s) -> String -> GenRegex s
parseRegex'' forall s. StringLike s => Parser (GenRegex s)
regExpStd
parseRegexExt :: StringLike s => s -> GenRegex s
parseRegexExt :: forall s. StringLike s => s -> GenRegex s
parseRegexExt = forall s. StringLike s => String -> GenRegex s
parseRegexExt' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StringLike a => a -> String
toString
parseRegexExt' :: StringLike s => String -> GenRegex s
parseRegexExt' :: forall s. StringLike s => String -> GenRegex s
parseRegexExt' = forall s.
StringLike s =>
Parser (GenRegex s) -> String -> GenRegex s
parseRegex'' forall s. StringLike s => Parser (GenRegex s)
regExpExt
parseRegex'' :: StringLike s => Parser (GenRegex s) -> String -> GenRegex s
parseRegex'' :: forall s.
StringLike s =>
Parser (GenRegex s) -> String -> GenRegex s
parseRegex'' Parser (GenRegex s)
regExp'
= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall s. StringLike s => String -> GenRegex s
mkZero' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"syntax error: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse ( do
GenRegex s
r <- Parser (GenRegex s)
regExp'
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) a. Monad m => a -> m a
return GenRegex s
r
) String
""
parseContextRegex :: StringLike s => (String -> GenRegex s) -> s -> GenRegex s
parseContextRegex :: forall s. StringLike s => (String -> GenRegex s) -> s -> GenRegex s
parseContextRegex String -> GenRegex s
parseRe s
re0
= GenRegex s
re'
where
parseAW :: GenRegex s
parseAW = forall s. StringLike s => String -> GenRegex s
parseRegexExt' String
"(\\A\\W)?"
parseWA :: GenRegex s
parseWA = forall s. StringLike s => String -> GenRegex s
parseRegexExt' String
"(\\W\\A)?"
re :: String
re = forall a. StringLike a => a -> String
toString s
re0
re' :: GenRegex s
re' = forall s. [GenRegex s] -> GenRegex s
mkSeqs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [ [GenRegex s]
startContext
, (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GenRegex s
parseRe forall a b. (a -> b) -> a -> b
$ String
re2
, [GenRegex s]
endContext
]
([GenRegex s]
startContext, String
re1)
| String
"^" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
re = ([], forall a. [a] -> [a]
tail String
re)
| String
"\\<" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
re = ([GenRegex s
parseAW], forall a. Int -> [a] -> [a]
drop Int
2 String
re)
| Bool
otherwise = ([forall s. StringLike s => GenRegex s -> GenRegex s
mkStar forall s. GenRegex s
mkDot], String
re)
([GenRegex s]
endContext, String
re2)
| String
"$" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
re1 = ([], forall a. [a] -> [a]
init String
re1)
| String
"\\>" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
re1 = ([GenRegex s
parseWA], forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ String
re1)
| Bool
otherwise = ([forall s. StringLike s => GenRegex s -> GenRegex s
mkStar forall s. GenRegex s
mkDot], String
re1)
regExpExt :: StringLike s => Parser (GenRegex s)
regExpExt :: forall s. StringLike s => Parser (GenRegex s)
regExpExt = forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s)
branchList forall s. StringLike s => Parser (GenRegex s)
orElseList
regExpStd :: StringLike s => Parser (GenRegex s)
regExpStd :: forall s. StringLike s => Parser (GenRegex s)
regExpStd = forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s)
branchList forall s. StringLike s => Parser (GenRegex s)
seqListStd
branchList :: StringLike s => Parser (GenRegex s) -> Parser (GenRegex s)
branchList :: forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s)
branchList Parser (GenRegex s)
exParser
= do
GenRegex s
r1 <- Parser (GenRegex s)
exParser
[GenRegex s]
rs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (GenRegex s)
branchList1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt forall a b. (a -> b) -> a -> b
$ GenRegex s
r1forall a. a -> [a] -> [a]
:[GenRegex s]
rs)
where
branchList1 :: Parser (GenRegex s)
branchList1
= do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
Parser (GenRegex s)
exParser
orElseList :: StringLike s => Parser (GenRegex s)
orElseList :: forall s. StringLike s => Parser (GenRegex s)
orElseList
= do
GenRegex s
r1 <- forall s. StringLike s => Parser (GenRegex s)
interleaveList
[GenRegex s]
rs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (GenRegex s)
orElseList1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkElse forall a b. (a -> b) -> a -> b
$ GenRegex s
r1forall a. a -> [a] -> [a]
:[GenRegex s]
rs)
where
orElseList1 :: Parser (GenRegex s)
orElseList1
= do
String
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"{|}")
forall s. StringLike s => Parser (GenRegex s)
interleaveList
interleaveList :: StringLike s => Parser (GenRegex s)
interleaveList :: forall s. StringLike s => Parser (GenRegex s)
interleaveList
= do
GenRegex s
r1 <- forall s. StringLike s => Parser (GenRegex s)
exorList
[GenRegex s]
rs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (GenRegex s)
interleaveList1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall s. GenRegex s -> GenRegex s -> GenRegex s
mkInterleave forall a b. (a -> b) -> a -> b
$ GenRegex s
r1forall a. a -> [a] -> [a]
:[GenRegex s]
rs)
where
interleaveList1 :: Parser (GenRegex s)
interleaveList1
= do
String
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"{:}")
forall s. StringLike s => Parser (GenRegex s)
exorList
exorList :: StringLike s => Parser (GenRegex s)
exorList :: forall s. StringLike s => Parser (GenRegex s)
exorList
= do
GenRegex s
r1 <- forall s. StringLike s => Parser (GenRegex s)
diffList
[GenRegex s]
rs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (GenRegex s)
exorList1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkExor forall a b. (a -> b) -> a -> b
$ GenRegex s
r1forall a. a -> [a] -> [a]
:[GenRegex s]
rs)
where
exorList1 :: Parser (GenRegex s)
exorList1
= do
String
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"{^}")
forall s. StringLike s => Parser (GenRegex s)
diffList
diffList :: StringLike s => Parser (GenRegex s)
diffList :: forall s. StringLike s => Parser (GenRegex s)
diffList
= do
GenRegex s
r1 <- forall s. StringLike s => Parser (GenRegex s)
intersectList
[GenRegex s]
rs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (GenRegex s)
diffList1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkDiff forall a b. (a -> b) -> a -> b
$ GenRegex s
r1forall a. a -> [a] -> [a]
:[GenRegex s]
rs)
where
diffList1 :: Parser (GenRegex s)
diffList1
= do
String
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"{\\}")
forall s. StringLike s => Parser (GenRegex s)
intersectList
intersectList :: StringLike s => Parser (GenRegex s)
intersectList :: forall s. StringLike s => Parser (GenRegex s)
intersectList
= do
GenRegex s
r1 <- forall s. StringLike s => Parser (GenRegex s)
seqListExt
[GenRegex s]
rs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (GenRegex s)
intersectList1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkIsect forall a b. (a -> b) -> a -> b
$ GenRegex s
r1forall a. a -> [a] -> [a]
:[GenRegex s]
rs)
where
intersectList1 :: Parser (GenRegex s)
intersectList1
= do
String
_ <- forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"{&}")
forall s. StringLike s => Parser (GenRegex s)
seqListExt
seqListExt :: StringLike s => Parser (GenRegex s)
seqListExt :: forall s. StringLike s => Parser (GenRegex s)
seqListExt = forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s) -> Parser (GenRegex s)
seqList' forall s. StringLike s => Parser (GenRegex s)
regExpLabel forall s. StringLike s => Parser (GenRegex s)
multiCharEscExt
seqListStd :: StringLike s => Parser (GenRegex s)
seqListStd :: forall s. StringLike s => Parser (GenRegex s)
seqListStd = forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s) -> Parser (GenRegex s)
seqList' forall s. StringLike s => Parser (GenRegex s)
regExpStd forall s. StringLike s => Parser (GenRegex s)
multiCharEsc
seqList' :: StringLike s => Parser (GenRegex s) -> Parser (GenRegex s) -> Parser (GenRegex s)
seqList' :: forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s) -> Parser (GenRegex s)
seqList' Parser (GenRegex s)
regExp' Parser (GenRegex s)
multiCharEsc'
= do
[GenRegex s]
rs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (GenRegex s)
piece
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. [GenRegex s] -> GenRegex s
mkSeqs [GenRegex s]
rs
where
piece :: Parser (GenRegex s)
piece
= do
GenRegex s
r <- Parser (GenRegex s)
atom
forall s. StringLike s => GenRegex s -> Parser (GenRegex s)
quantifier GenRegex s
r
atom :: Parser (GenRegex s)
atom
= forall s. StringLike s => Parser (GenRegex s)
char1
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Parser (GenRegex s)
charClass
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
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
')') Parser (GenRegex s)
regExp'
charClass :: Parser (GenRegex s)
charClass
= forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s)
charClassEsc Parser (GenRegex s)
multiCharEsc'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s)
charClassExpr Parser (GenRegex s)
multiCharEsc'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall s. StringLike s => Parser (GenRegex s)
wildCardEsc
quantifier :: StringLike s => GenRegex s -> Parser (GenRegex s)
quantifier :: forall s. StringLike s => GenRegex s -> Parser (GenRegex s)
quantifier GenRegex s
r
= ( do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => GenRegex s -> GenRegex s
mkOpt GenRegex s
r )
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
( do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => GenRegex s -> GenRegex s
mkStar GenRegex s
r )
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
( do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => Int -> GenRegex s -> GenRegex s
mkRep Int
1 GenRegex s
r )
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
char Char
'{'
GenRegex s
res <- forall s. StringLike s => GenRegex s -> Parser (GenRegex s)
quantity GenRegex s
r
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
forall (m :: * -> *) a. Monad m => a -> m a
return GenRegex s
res
)
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 GenRegex s
r )
quantity :: StringLike s => GenRegex s -> Parser (GenRegex s)
quantity :: forall s. StringLike s => GenRegex s -> Parser (GenRegex s)
quantity GenRegex s
r
= do
String
lb <- 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
forall s. StringLike s => GenRegex s -> Int -> Parser (GenRegex s)
quantityRest GenRegex s
r (forall a. Read a => String -> a
read String
lb)
quantityRest :: StringLike s => GenRegex s -> Int -> Parser (GenRegex s)
quantityRest :: forall s. StringLike s => GenRegex s -> Int -> Parser (GenRegex s)
quantityRest GenRegex s
r Int
lb
= ( do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
String
ub <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ub
then forall s. StringLike s => Int -> GenRegex s -> GenRegex s
mkRep Int
lb GenRegex s
r
else forall s. StringLike s => Int -> Int -> GenRegex s -> GenRegex s
mkRng Int
lb (forall a. Read a => String -> a
read String
ub) GenRegex s
r
)
)
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 forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => Int -> Int -> GenRegex s -> GenRegex s
mkRng Int
lb Int
lb GenRegex s
r)
regExpLabel :: StringLike s => Parser (GenRegex s)
regExpLabel :: forall s. StringLike s => Parser (GenRegex s)
regExpLabel
= do
GenRegex s -> GenRegex s
lab <- 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 -> a
id (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
'}') forall {u}. ParsecT String u Identity (GenRegex s -> GenRegex s)
label')
GenRegex s
r <- forall s. StringLike s => Parser (GenRegex s)
regExpExt
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GenRegex s -> GenRegex s
lab GenRegex s
r
where
label' :: ParsecT String u Identity (GenRegex s -> GenRegex s)
label'
= do
String
l <- 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 =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isXmlNameChar)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => String -> GenRegex s -> GenRegex s
mkBr' String
l
char1 :: StringLike s => Parser (GenRegex s)
char1 :: forall s. StringLike s => Parser (GenRegex s)
char1
= do
Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
".\\?*+{}()|[]")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => Char -> GenRegex s
mkSym1 Char
c
charClassEsc :: StringLike s => Parser (GenRegex s) -> Parser (GenRegex s)
charClassEsc :: forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s)
charClassEsc Parser (GenRegex s)
multiCharEsc'
= do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
( forall s. StringLike s => Parser (GenRegex s)
singleCharEsc
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Parser (GenRegex s)
multiCharEsc'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall s. StringLike s => Parser (GenRegex s)
catEsc
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall s. StringLike s => Parser (GenRegex s)
complEsc )
singleCharEsc :: StringLike s => Parser (GenRegex s)
singleCharEsc :: forall s. StringLike s => Parser (GenRegex s)
singleCharEsc
= do
Char
c <- Parser Char
singleCharEsc'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => Char -> GenRegex s
mkSym1 Char
c
singleCharEsc' :: Parser Char
singleCharEsc' :: Parser Char
singleCharEsc'
= do
Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"nrt\\|.?*+(){}-[]^")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Char
c forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip String
"ntr" forall a b. (a -> b) -> a -> b
$ String
"\n\r\t"
multiCharEscExt :: StringLike s => Parser (GenRegex s)
multiCharEscExt :: forall s. StringLike s => Parser (GenRegex s)
multiCharEscExt
= forall s. StringLike s => Parser (GenRegex s)
multiCharEsc
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
( do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'a'
forall (m :: * -> *) a. Monad m => a -> m a
return forall s. GenRegex s
mkDot )
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
( do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'A'
forall (m :: * -> *) a. Monad m => a -> m a
return forall s. StringLike s => GenRegex s
mkAll )
multiCharEsc :: StringLike s => Parser (GenRegex s)
multiCharEsc :: forall s. StringLike s => Parser (GenRegex s)
multiCharEsc
= ( do
Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
es)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => CharSet -> GenRegex s
mkSym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c forall a b. (a -> b) -> a -> b
$ [(Char, CharSet)]
pm )
where
es :: String
es = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Char, CharSet)]
pm
pm :: [(Char, CharSet)]
pm = [ (Char
's', CharSet
charPropXmlSpaceChar )
, (Char
'S', CharSet -> CharSet
compCS CharSet
charPropXmlSpaceChar )
, (Char
'i', CharSet
charPropXmlNameStartChar )
, (Char
'I', CharSet -> CharSet
compCS CharSet
charPropXmlNameStartChar )
, (Char
'c', CharSet
charPropXmlNameChar )
, (Char
'C', CharSet -> CharSet
compCS CharSet
charPropXmlNameChar )
, (Char
'd', CharSet
charPropDigit )
, (Char
'D', CharSet -> CharSet
compCS CharSet
charPropDigit )
, (Char
'w', CharSet -> CharSet
compCS CharSet
charPropNotWord )
, (Char
'W', CharSet
charPropNotWord )
]
charPropDigit :: CharSet
charPropDigit = Char -> Char -> CharSet
rangeCS Char
'0' Char
'9'
charPropNotWord :: CharSet
charPropNotWord = CharSet
charPropUnicodeP
CharSet -> CharSet -> CharSet
`unionCS`
CharSet
charPropUnicodeZ
CharSet -> CharSet -> CharSet
`unionCS`
CharSet
charPropUnicodeC
catEsc :: StringLike s => Parser (GenRegex s)
catEsc :: forall s. StringLike s => Parser (GenRegex s)
catEsc
= do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'p'
CharSet
s <- 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
'}') Parser CharSet
charProp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => CharSet -> GenRegex s
mkSym CharSet
s
charProp :: Parser CharSet
charProp :: Parser CharSet
charProp
= Parser CharSet
isCategory
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Parser CharSet
isBlock
isBlock :: Parser CharSet
isBlock :: Parser CharSet
isBlock
= do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Is"
String
name <- 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 =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
legalChar)
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, (Char, Char))]
codeBlocks of
Just (Char, Char)
b -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Char -> CharSet
rangeCS (Char, Char)
b
Maybe (Char, Char)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unknown Unicode code block " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
name
where
legalChar :: Char -> Bool
legalChar Char
c = Char
'A' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z' Bool -> Bool -> Bool
||
Char
'a' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z' Bool -> Bool -> Bool
||
Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' Bool -> Bool -> Bool
||
Char
'-' forall a. Eq a => a -> a -> Bool
== Char
c
isCategory :: Parser CharSet
isCategory :: Parser CharSet
isCategory
= do
String
pr <- Parser String
isCategory'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pr [(String, CharSet)]
categories)
categories :: [(String, CharSet)]
categories :: [(String, CharSet)]
categories
= [ (String
"C", CharSet
charPropUnicodeC )
, (String
"Cc", CharSet
charPropUnicodeCc)
, (String
"Cf", CharSet
charPropUnicodeCf)
, (String
"Co", CharSet
charPropUnicodeCo)
, (String
"Cs", CharSet
charPropUnicodeCs)
, (String
"L", CharSet
charPropUnicodeL )
, (String
"Ll", CharSet
charPropUnicodeLl)
, (String
"Lm", CharSet
charPropUnicodeLm)
, (String
"Lo", CharSet
charPropUnicodeLo)
, (String
"Lt", CharSet
charPropUnicodeLt)
, (String
"Lu", CharSet
charPropUnicodeLu)
, (String
"M", CharSet
charPropUnicodeM )
, (String
"Mc", CharSet
charPropUnicodeMc)
, (String
"Me", CharSet
charPropUnicodeMe)
, (String
"Mn", CharSet
charPropUnicodeMn)
, (String
"N", CharSet
charPropUnicodeN )
, (String
"Nd", CharSet
charPropUnicodeNd)
, (String
"Nl", CharSet
charPropUnicodeNl)
, (String
"No", CharSet
charPropUnicodeNo)
, (String
"P", CharSet
charPropUnicodeP )
, (String
"Pc", CharSet
charPropUnicodePc)
, (String
"Pd", CharSet
charPropUnicodePd)
, (String
"Pe", CharSet
charPropUnicodePe)
, (String
"Pf", CharSet
charPropUnicodePf)
, (String
"Pi", CharSet
charPropUnicodePi)
, (String
"Po", CharSet
charPropUnicodePo)
, (String
"Ps", CharSet
charPropUnicodePs)
, (String
"S", CharSet
charPropUnicodeS )
, (String
"Sc", CharSet
charPropUnicodeSc)
, (String
"Sk", CharSet
charPropUnicodeSk)
, (String
"Sm", CharSet
charPropUnicodeSm)
, (String
"So", CharSet
charPropUnicodeSo)
, (String
"Z", CharSet
charPropUnicodeZ )
, (String
"Zl", CharSet
charPropUnicodeZl)
, (String
"Zp", CharSet
charPropUnicodeZp)
, (String
"Zs", CharSet
charPropUnicodeZs)
]
isCategory' :: Parser String
isCategory' :: Parser String
isCategory'
= ( forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {s} {m :: * -> *} {t :: * -> *} {u}.
(Stream s m Char, Foldable t) =>
Char -> t Char -> ParsecT s u m String
prop) forall a b. (a -> b) -> a -> b
$
[ (Char
'L', String
"ultmo")
, (Char
'M', String
"nce")
, (Char
'N', String
"dlo")
, (Char
'P', String
"cdseifo")
, (Char
'Z', String
"slp")
, (Char
'S', String
"mcko")
, (Char
'C', String
"cfon")
]
) forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"illegal Unicode character property"
where
prop :: Char -> t Char -> ParsecT s u m String
prop Char
c1 t Char
cs2
= do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c1
String
s2 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
""
( do
Char
c2 <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
cs2)
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c2] )
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
c1forall a. a -> [a] -> [a]
:String
s2
complEsc :: StringLike s => Parser (GenRegex s)
complEsc :: forall s. StringLike s => Parser (GenRegex s)
complEsc
= do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'P'
CharSet
s <- 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
'}') Parser CharSet
charProp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => CharSet -> GenRegex s
mkSym forall a b. (a -> b) -> a -> b
$ CharSet -> CharSet
compCS CharSet
s
charClassExpr :: StringLike s => Parser (GenRegex s) -> Parser (GenRegex s)
charClassExpr :: forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s)
charClassExpr Parser (GenRegex s)
multiCharEsc'
= 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
']') Parser (GenRegex s)
charGroup
where
charGroup :: Parser (GenRegex s)
charGroup
= do
GenRegex s
r <- ( Parser (GenRegex s)
negCharGroup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Parser (GenRegex s)
posCharGroup
)
GenRegex s
s <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (forall s. StringLike s => String -> GenRegex s
mkZero' String
"")
( do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s)
charClassExpr Parser (GenRegex s)
multiCharEsc'
)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkDiff GenRegex s
r GenRegex s
s
posCharGroup :: Parser (GenRegex s)
posCharGroup
= do
[GenRegex s]
rs <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s. StringLike s => Parser (GenRegex s)
charRange forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s.
StringLike s =>
Parser (GenRegex s) -> Parser (GenRegex s)
charClassEsc Parser (GenRegex s)
multiCharEsc')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt [GenRegex s]
rs
negCharGroup :: Parser (GenRegex s)
negCharGroup
= do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^'
GenRegex s
r <- Parser (GenRegex s)
posCharGroup
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkDiff forall s. GenRegex s
mkDot GenRegex s
r
charRange :: StringLike s => Parser (GenRegex s)
charRange :: forall s. StringLike s => Parser (GenRegex s)
charRange
= forall tok st a. GenParser tok st a -> GenParser tok st a
try forall s. StringLike s => Parser (GenRegex s)
seRange
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall s. StringLike s => Parser (GenRegex s)
xmlCharIncDash
seRange :: StringLike s => Parser (GenRegex s)
seRange :: forall s. StringLike s => Parser (GenRegex s)
seRange
= do
Char
c1 <- Parser Char
charOrEsc'
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
Char
c2 <- Parser Char
charOrEsc'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => Char -> Char -> GenRegex s
mkSymRng Char
c1 Char
c2
charOrEsc' :: Parser Char
charOrEsc' :: Parser Char
charOrEsc'
= ( do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
Parser Char
singleCharEsc'
)
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 -> Bool) -> ParsecT s u m Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"\\-[]")
xmlCharIncDash :: StringLike s => Parser (GenRegex s)
xmlCharIncDash :: forall s. StringLike s => Parser (GenRegex s)
xmlCharIncDash
= 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
char Char
'-'
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 =>
Char -> ParsecT s u m Char
char Char
'[')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => Char -> GenRegex s
mkSym1 Char
'-'
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
( do
Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"-\\[]")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. StringLike s => Char -> GenRegex s
mkSym1 Char
c
)
wildCardEsc :: StringLike s => Parser (GenRegex s)
wildCardEsc :: forall s. StringLike s => Parser (GenRegex s)
wildCardEsc
= do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. StringLike s => CharSet -> GenRegex s
mkSym forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharSet -> CharSet
compCS forall a b. (a -> b) -> a -> b
$ String -> CharSet
stringCS String
"\n\r"