{-# LANGUAGE FlexibleContexts #-}
module Text.Regex.Glob.Generic.RegexParser
( parseRegex
, parseRegexNoCase
)
where
import Data.Char (isLower, isUpper,
toLower, toUpper)
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 =>
(Char -> Char -> GenRegex s) -> String -> GenRegex s
parseRegex' forall s. StringLike s => Char -> Char -> GenRegex s
mkSymRng forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StringLike a => a -> String
toString
parseRegexNoCase :: StringLike s => s -> GenRegex s
parseRegexNoCase :: forall s. StringLike s => s -> GenRegex s
parseRegexNoCase
= forall s.
StringLike s =>
(Char -> Char -> GenRegex s) -> String -> GenRegex s
parseRegex' forall s. StringLike s => Char -> Char -> GenRegex s
mkNoCaseSymRng forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StringLike a => a -> String
toString
parseRegex' :: StringLike s => (Char -> Char -> GenRegex s) -> String -> GenRegex s
parseRegex' :: forall s.
StringLike s =>
(Char -> Char -> GenRegex s) -> String -> GenRegex s
parseRegex' Char -> Char -> GenRegex s
mkS
= 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 <- forall s.
StringLike s =>
(Char -> Char -> GenRegex s) -> Parser (GenRegex s)
pattern Char -> Char -> GenRegex s
mkS
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
""
pattern :: StringLike s => (Char -> Char -> GenRegex s) -> Parser (GenRegex s)
pattern :: forall s.
StringLike s =>
(Char -> Char -> GenRegex s) -> Parser (GenRegex s)
pattern Char -> Char -> GenRegex s
mkS
= forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT String u Identity (GenRegex s)
part 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
. forall s. [GenRegex s] -> GenRegex s
mkSeqs
where
part :: ParsecT String u Identity (GenRegex s)
part
= ( 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 =>
String -> ParsecT s u m Char
noneOf String
"\\?*[{") 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
. String -> GenRegex s
mkWord' )
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 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
<|>
( 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 forall s. StringLike s => GenRegex s
mkAll )
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
'}') forall {u}. ParsecT String u Identity (GenRegex s)
wordList )
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
']') forall {u}. ParsecT String u Identity (GenRegex s)
charSet )
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 -> 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. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> Char -> GenRegex s
mkS Char
c Char
c
)
mkWord' :: String -> GenRegex s
mkWord'
= forall s. [GenRegex s] -> GenRegex s
mkSeqs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ Char
c -> Char -> Char -> GenRegex s
mkS Char
c Char
c)
wordList :: ParsecT String u Identity (GenRegex s)
wordList
= 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]
sepBy (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 =>
String -> ParsecT s u m Char
noneOf String
",}")) (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
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
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt (forall s. StringLike s => String -> GenRegex s
mkZero' String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> GenRegex s
mkWord'
charSet :: ParsecT String u Identity (GenRegex s)
charSet
= ( do GenRegex s
p1 <- forall {s} {m :: * -> *} {u}.
Stream s m Char =>
ParsecT s u m Char -> ParsecT s u m (GenRegex s)
charSet' forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
[GenRegex s]
ps <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall {s} {m :: * -> *} {u}.
Stream s m Char =>
ParsecT s u m Char -> ParsecT s u m (GenRegex s)
charSet' (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"]")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt (forall s. StringLike s => String -> GenRegex s
mkZero' String
"") (GenRegex s
p1 forall a. a -> [a] -> [a]
: [GenRegex s]
ps)
)
where
charSet' :: ParsecT s u m Char -> ParsecT s u m (GenRegex s)
charSet' ParsecT s u m Char
cp
= do Char
c1 <- ParsecT s u m Char
cp
Char
c2 <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
rest Char
c1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> Char -> GenRegex s
mkS Char
c1 Char
c2
rest :: Char -> ParsecT s u m Char
rest Char
c1
= forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Char
c1 (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)
mkNoCaseSymRng :: StringLike s => Char -> Char -> GenRegex s
mkNoCaseSymRng :: forall s. StringLike s => Char -> Char -> GenRegex s
mkNoCaseSymRng Char
c1 Char
c2
| Char -> Bool
isLower Char
c1
Bool -> Bool -> Bool
&&
Char -> Bool
isLower Char
c2
= forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt (forall s. StringLike s => Char -> Char -> GenRegex s
mkSymRng (Char -> Char
toUpper Char
c1) (Char -> Char
toUpper Char
c2)) (forall s. StringLike s => Char -> Char -> GenRegex s
mkSymRng Char
c1 Char
c2)
| Char -> Bool
isUpper Char
c1
Bool -> Bool -> Bool
&&
Char -> Bool
isUpper Char
c2
= forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
mkAlt (forall s. StringLike s => Char -> Char -> GenRegex s
mkSymRng (Char -> Char
toLower Char
c1) (Char -> Char
toLower Char
c2)) (forall s. StringLike s => Char -> Char -> GenRegex s
mkSymRng Char
c1 Char
c2)
| Bool
otherwise
= forall s. StringLike s => Char -> Char -> GenRegex s
mkSymRng Char
c1 Char
c2