{-|
Module      : Text.StringRandom.Parser
Description : Simple regular expression parser
Copyright   : Copyright (C) 2016- hiratara
License     : GPL-3
Maintainer  : hiratara@cpan.org
Stability   : experimental

Parse the regular expression so that it can be used with the
"Text.StringRandom" module.

See <https://github.com/cho45/String_random.js/blob/master/lib/String_random.js String_random.js>
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
module Text.StringRandom.Parser
  ( Parsed(..)
  , processParse
  ) where

import qualified Data.Attoparsec.Text as Attoparsec
import Data.Attoparsec.Text
  ( char
  , anyChar
  , satisfy
  , string
  , digit
  , many1
  , endOfInput
  )
import Data.List ((\\))
import qualified Data.Text as Text
import Control.Applicative ((<|>), optional, many)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict (evalStateT, StateT, gets, put)

-- Int :: A sequence number of groups (X)
type RegParser a = StateT Int Attoparsec.Parser a

-- | Abstract syntax tree of parsed regular expression
data Parsed  = PClass   [Char]               -- ^ [abc], \d, [^abc]
             | PRange Int (Maybe Int) Parsed -- ^ X*, X{1,2}, X+, X?
             | PConcat [Parsed]              -- ^ XYZ
             | PSelect [Parsed]              -- ^ X|Y|Z
             | PGrouped Int Parsed           -- ^ (X)
             | PBackward Int                 -- ^ \1, \2, ..., \9
             | PIgnored                      -- ^ ^, $, \b
             deriving (Int -> Parsed -> ShowS
[Parsed] -> ShowS
Parsed -> [Char]
(Int -> Parsed -> ShowS)
-> (Parsed -> [Char]) -> ([Parsed] -> ShowS) -> Show Parsed
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Parsed -> ShowS
showsPrec :: Int -> Parsed -> ShowS
$cshow :: Parsed -> [Char]
show :: Parsed -> [Char]
$cshowList :: [Parsed] -> ShowS
showList :: [Parsed] -> ShowS
Show, Parsed -> Parsed -> Bool
(Parsed -> Parsed -> Bool)
-> (Parsed -> Parsed -> Bool) -> Eq Parsed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Parsed -> Parsed -> Bool
== :: Parsed -> Parsed -> Bool
$c/= :: Parsed -> Parsed -> Bool
/= :: Parsed -> Parsed -> Bool
Eq)

pConcat :: [Parsed] -> Parsed
pConcat :: [Parsed] -> Parsed
pConcat [Parsed
x] = Parsed
x
pConcat [Parsed]
xs  = [Parsed] -> Parsed
PConcat [Parsed]
xs

pSelect :: [Parsed] -> Parsed
pSelect :: [Parsed] -> Parsed
pSelect [Parsed
x] = Parsed
x
pSelect [Parsed]
xs  = [Parsed] -> Parsed
PSelect [Parsed]
xs

{-|
'processParse' parses the regular expression string and returns an abstract
syntax tree. If there is an error in the regular expression, it returns the
'Left' value.
-}
processParse :: Text.Text -> Either String Parsed
processParse :: Text -> Either [Char] Parsed
processParse = let p :: Parser Parsed
p = StateT Int (Parser Text) Parsed -> Int -> Parser Parsed
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT Int (Parser Text) Parsed
selectParser Int
0
               in Parser Parsed -> Text -> Either [Char] Parsed
forall a. Parser a -> Text -> Either [Char] a
Attoparsec.parseOnly (Parser Parsed
p Parser Parsed -> Parser Text () -> Parser Parsed
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput)

selectParser :: RegParser Parsed
selectParser :: StateT Int (Parser Text) Parsed
selectParser = do
  Parsed
p0 <- StateT Int (Parser Text) Parsed
concats
  [Parsed]
ps <- StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) [Parsed]
forall a.
StateT Int (Parser Text) a -> StateT Int (Parser Text) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Char -> StateT Int (Parser Text) Char
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
char Char
'|') StateT Int (Parser Text) Char
-> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
forall a b.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) b -> StateT Int (Parser Text) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT Int (Parser Text) Parsed
concats)
  Parsed -> StateT Int (Parser Text) Parsed
forall a. a -> StateT Int (Parser Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parsed -> StateT Int (Parser Text) Parsed)
-> Parsed -> StateT Int (Parser Text) Parsed
forall a b. (a -> b) -> a -> b
$ [Parsed] -> Parsed
pSelect (Parsed
p0Parsed -> [Parsed] -> [Parsed]
forall a. a -> [a] -> [a]
:[Parsed]
ps)
  where
    concats :: StateT Int (Parser Text) Parsed
concats = [Parsed] -> Parsed
pConcat ([Parsed] -> Parsed)
-> StateT Int (Parser Text) [Parsed]
-> StateT Int (Parser Text) Parsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) [Parsed]
forall a.
StateT Int (Parser Text) a -> StateT Int (Parser Text) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT Int (Parser Text) Parsed
rangedParser

rangedParser :: RegParser Parsed
rangedParser :: StateT Int (Parser Text) Parsed
rangedParser = do
  Parsed
p <- StateT Int (Parser Text) Parsed
groupingParser
  let opt :: Parser Parsed
opt  = Char -> Parser Char
char Char
'?' Parser Char -> Parser Parsed -> Parser Parsed
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsed -> Parser Parsed
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int -> Parsed -> Parsed
PRange Int
0 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Parsed
p)
      star :: Parser Parsed
star = Char -> Parser Char
char Char
'*' Parser Char -> Parser Parsed -> Parser Parsed
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsed -> Parser Parsed
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int -> Parsed -> Parsed
PRange Int
0 Maybe Int
forall a. Maybe a
Nothing Parsed
p)
      plus :: Parser Parsed
plus = Char -> Parser Char
char Char
'+' Parser Char -> Parser Parsed -> Parser Parsed
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsed -> Parser Parsed
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int -> Parsed -> Parsed
PRange Int
1 Maybe Int
forall a. Maybe a
Nothing Parsed
p)
      rep :: Parser Parsed
rep = do
        Char -> Parser Char
char Char
'{'
        Int
min  <- [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> Parser Text [Char] -> Parser Text Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Char
digit
        Maybe [Char]
max' <- Parser Text [Char] -> Parser Text (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text [Char] -> Parser Text (Maybe [Char]))
-> Parser Text [Char] -> Parser Text (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
',' Parser Char -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char -> Parser Text [Char]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Char
digit
        let max :: Maybe Int
max = case Maybe [Char]
max' of
                    Maybe [Char]
Nothing -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
min
                    Just [] -> Maybe Int
forall a. Maybe a
Nothing
                    Just [Char]
ds -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
ds
        Char -> Parser Char
char Char
'}'
        Parsed -> Parser Parsed
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parsed -> Parser Parsed) -> Parsed -> Parser Parsed
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Parsed -> Parsed
PRange Int
min Maybe Int
max Parsed
p
  Parser Parsed -> StateT Int (Parser Text) Parsed
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Parsed -> StateT Int (Parser Text) Parsed)
-> Parser Parsed -> StateT Int (Parser Text) Parsed
forall a b. (a -> b) -> a -> b
$ Parser Parsed
opt Parser Parsed -> Parser Parsed -> Parser Parsed
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Parsed
star Parser Parsed -> Parser Parsed -> Parser Parsed
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Parsed
plus Parser Parsed -> Parser Parsed -> Parser Parsed
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Parsed
rep Parser Parsed -> Parser Parsed -> Parser Parsed
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsed -> Parser Parsed
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Parsed
p

groupingParser :: RegParser Parsed
groupingParser :: StateT Int (Parser Text) Parsed
groupingParser = StateT Int (Parser Text) Parsed
ngroup StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
forall a.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) a -> StateT Int (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Int (Parser Text) Parsed
group StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
forall a.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) a -> StateT Int (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Int (Parser Text) Parsed
classParser StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
forall a.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) a -> StateT Int (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Int (Parser Text) Parsed
escaped StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
forall a.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) a -> StateT Int (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Int (Parser Text) Parsed
dot StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
forall a.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) a -> StateT Int (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Int (Parser Text) Parsed
ignored StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
forall a.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) a -> StateT Int (Parser Text) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Int (Parser Text) Parsed
others
  where
    ngroup :: StateT Int (Parser Text) Parsed
ngroup  = Parser Text Text -> StateT Int (Parser Text) Text
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Text -> Parser Text Text
string Text
"(?:") StateT Int (Parser Text) Text
-> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
forall a b.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) b -> StateT Int (Parser Text) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT Int (Parser Text) Parsed
selectParser StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Char -> StateT Int (Parser Text) Parsed
forall a b.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) b -> StateT Int (Parser Text) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> StateT Int (Parser Text) Char
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
char Char
')')
    group :: StateT Int (Parser Text) Parsed
group   = do
      Int
n <- (Int -> Int) -> StateT Int (Parser Text) Int
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      Int -> StateT Int (Parser Text) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Int
n
      Parsed
p <- Parser Char -> StateT Int (Parser Text) Char
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
char Char
'(') StateT Int (Parser Text) Char
-> StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Parsed
forall a b.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) b -> StateT Int (Parser Text) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT Int (Parser Text) Parsed
selectParser StateT Int (Parser Text) Parsed
-> StateT Int (Parser Text) Char -> StateT Int (Parser Text) Parsed
forall a b.
StateT Int (Parser Text) a
-> StateT Int (Parser Text) b -> StateT Int (Parser Text) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> StateT Int (Parser Text) Char
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Char -> Parser Char
char Char
')')
      Parsed -> StateT Int (Parser Text) Parsed
forall a. a -> StateT Int (Parser Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parsed -> StateT Int (Parser Text) Parsed)
-> Parsed -> StateT Int (Parser Text) Parsed
forall a b. (a -> b) -> a -> b
$ Int -> Parsed -> Parsed
PGrouped Int
n Parsed
p
    escaped :: StateT Int (Parser Text) Parsed
escaped = Parser Parsed -> StateT Int (Parser Text) Parsed
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Parsed -> StateT Int (Parser Text) Parsed)
-> Parser Parsed -> StateT Int (Parser Text) Parsed
forall a b. (a -> b) -> a -> b
$ do
      Char
ch <- Char -> Parser Char
char Char
'\\' Parser Char -> Parser Char -> Parser Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
anyChar
      Parsed -> Parser Parsed
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parsed -> Parser Parsed) -> Parsed -> Parser Parsed
forall a b. (a -> b) -> a -> b
$ case Char
ch of
        Char
_ | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'b'              -> Parsed
PIgnored -- Don't support \b
          | Char
ch Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'1' .. Char
'9'] -> Int -> Parsed
PBackward ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char
ch])
          | Bool
otherwise              -> [Char] -> Parsed
PClass (Char -> [Char]
classes Char
ch)
    dot :: StateT Int (Parser Text) Parsed
dot     = Parser Parsed -> StateT Int (Parser Text) Parsed
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Parsed -> StateT Int (Parser Text) Parsed)
-> Parser Parsed -> StateT Int (Parser Text) Parsed
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
'.' Parser Char -> Parser Parsed -> Parser Parsed
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsed -> Parser Parsed
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Parsed
PClass [Char]
allC)
    ignored :: StateT Int (Parser Text) Parsed
ignored = Parser Parsed -> StateT Int (Parser Text) Parsed
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Parsed -> StateT Int (Parser Text) Parsed)
-> Parser Parsed -> StateT Int (Parser Text) Parsed
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
satisfy (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'^', Char
'$']) Parser Char -> Parser Parsed -> Parser Parsed
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsed -> Parser Parsed
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Parsed
PIgnored
    others :: StateT Int (Parser Text) Parsed
others  = Parser Parsed -> StateT Int (Parser Text) Parsed
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Parsed -> StateT Int (Parser Text) Parsed)
-> Parser Parsed -> StateT Int (Parser Text) Parsed
forall a b. (a -> b) -> a -> b
$ [Char] -> Parsed
PClass ([Char] -> Parsed) -> (Char -> [Char]) -> Char -> Parsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS
forall a. a -> [a] -> [a]
: [])  (Char -> Parsed) -> Parser Char -> Parser Parsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
satisfy (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
reservedChars)

classParser :: RegParser Parsed
classParser :: StateT Int (Parser Text) Parsed
classParser = Parser Parsed -> StateT Int (Parser Text) Parsed
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Parsed -> StateT Int (Parser Text) Parsed)
-> Parser Parsed -> StateT Int (Parser Text) Parsed
forall a b. (a -> b) -> a -> b
$
      [Char] -> Parsed
PClass ([Char] -> Parsed) -> ShowS -> [Char] -> Parsed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
allC [Char] -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\) ([Char] -> Parsed) -> Parser Text [Char] -> Parser Parsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text Text
string Text
"[^" Parser Text Text -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text [Char]
p Parser Text [Char] -> Parser Char -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
']')
  Parser Parsed -> Parser Parsed -> Parser Parsed
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parsed
PClass  ([Char] -> Parsed) -> Parser Text [Char] -> Parser Parsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'[' Parser Char -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text [Char]
p Parser Text [Char] -> Parser Char -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
']')
  where
    p :: Attoparsec.Parser [Char]
    p :: Parser Text [Char]
p = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> Parser Text [[Char]] -> Parser Text [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Char] -> Parser Text [[Char]]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text [Char]
p1
    p1 :: Parser Text [Char]
p1 = do
      [Char]
ch <- Parser Text [Char]
onechar
      Maybe [Char]
r  <- Parser Text [Char] -> Parser Text (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
char Char
'-' Parser Char -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text [Char]
onechar)
      [Char] -> Parser Text [Char]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Parser Text [Char]) -> [Char] -> Parser Text [Char]
forall a b. (a -> b) -> a -> b
$ case Maybe [Char]
r of
        Just [Char]
rch
          | [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
ch Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
rch Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
            -> Char -> Char -> [Char]
forall a. Enum a => a -> a -> [a]
enumFromTo ([Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
ch) ([Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
rch)
          -- Handle the case of [^\w-\d]
          | Bool
otherwise
            -> [Char]
ch [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
rch
        Maybe [Char]
Nothing -> [Char]
ch
    onechar :: Parser Text [Char]
onechar =  Char -> [Char]
classes (Char -> [Char]) -> Parser Char -> Parser Text [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'\\' Parser Char -> Parser Char -> Parser Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
anyChar)
           Parser Text [Char] -> Parser Text [Char] -> Parser Text [Char]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> ShowS
forall a. a -> [a] -> [a]
: [])  (Char -> [Char]) -> Parser Char -> Parser Text [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
satisfy (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
classReservedChars)

uppersC, lowersC, digitsC, spacesC, othersC, allC :: [Char]
uppersC :: [Char]
uppersC = [Char
'A'..Char
'Z']
lowersC :: [Char]
lowersC = [Char
'a'..Char
'z']
digitsC :: [Char]
digitsC = [Char
'0'..Char
'9']
spacesC :: [Char]
spacesC = [Char]
" \n\t"
othersC :: [Char]
othersC = [Char]
"!\"#$%&'()*+,-./:;<=>?@[\\]^`{|}~"
allC :: [Char]
allC    = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
uppersC, [Char]
lowersC, [Char]
digitsC, [Char]
" ", [Char]
othersC, [Char]
"_"]

classes :: Char -> [Char]
classes :: Char -> [Char]
classes Char
'd' = [Char]
digitsC
classes Char
'D' = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
uppersC, [Char]
lowersC, [Char]
spacesC, [Char]
othersC, [Char]
"_"]
classes Char
'w' = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
uppersC, [Char]
lowersC, [Char]
digitsC, [Char]
"_"]
classes Char
'W' = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
spacesC, [Char]
othersC]
classes Char
't' = [Char]
"\t"
classes Char
'n' = [Char]
"\n"
classes Char
'v' = [Char]
"\x000b"
classes Char
'f' = [Char]
"\x000c"
classes Char
'r' = [Char]
"\r"
classes Char
's' = [Char]
spacesC
classes Char
'S' = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
uppersC, [Char]
lowersC, [Char]
digitsC, [Char]
othersC, [Char]
"_"]
classes Char
'0' = [Char]
"\0"
classes Char
c   = [Char
c]

reservedChars :: [Char]
reservedChars :: [Char]
reservedChars = [Char]
"\\()|^$*+{?[." -- ]

classReservedChars :: [Char]
classReservedChars :: [Char]
classReservedChars = [Char]
"\\]" -- -^