module Scrappy.Grep.DSL.Parser
  ( parseExpr
  , ParseError
  ) where

import Scrappy.Grep.DSL

import Text.Parsec hiding ((<|>), many)
import Text.Parsec.String (Parser)
import Control.Applicative ((<|>), many)
import Control.Monad (void)

-- | Parse a DSL string into an AST
parseExpr :: String -> Either ParseError ParserExpr
parseExpr :: String -> Either ParseError ParserExpr
parseExpr = Parsec String () ParserExpr
-> String -> String -> Either ParseError ParserExpr
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
-> Parsec String () ParserExpr -> Parsec String () ParserExpr
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec String () ParserExpr
exprParser Parsec String () ParserExpr
-> ParsecT String () Identity () -> Parsec String () ParserExpr
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
"parsec-grep DSL"

-- | Main expression parser - handles combinators with proper precedence
-- Precedence (lowest to highest): <|>, >> / <+>, modifiers, atoms
exprParser :: Parser ParserExpr
exprParser :: Parsec String () ParserExpr
exprParser = Parsec String () ParserExpr
altExpr

-- | Alternative: p1 <|> p2
altExpr :: Parser ParserExpr
altExpr :: Parsec String () ParserExpr
altExpr = Parsec String () ParserExpr
-> ParsecT
     String () Identity (ParserExpr -> ParserExpr -> ParserExpr)
-> Parsec String () ParserExpr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 Parsec String () ParserExpr
seqExpr ParsecT String () Identity (ParserExpr -> ParserExpr -> ParserExpr)
forall {u}.
ParsecT String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
altOp
  where
    altOp :: ParsecT String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
altOp = ParserExpr -> ParserExpr -> ParserExpr
PAlt (ParserExpr -> ParserExpr -> ParserExpr)
-> ParsecT String u Identity String
-> ParsecT
     String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
forall a b.
a -> ParsecT String u Identity b -> ParsecT String u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String u Identity ()
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<|>" ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)

-- | Sequence: p1 >> p2 or p1 <+> p2
seqExpr :: Parser ParserExpr
seqExpr :: Parsec String () ParserExpr
seqExpr = Parsec String () ParserExpr
-> ParsecT
     String () Identity (ParserExpr -> ParserExpr -> ParserExpr)
-> Parsec String () ParserExpr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 Parsec String () ParserExpr
termExpr ParsecT String () Identity (ParserExpr -> ParserExpr -> ParserExpr)
forall {u}.
ParsecT String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
seqOp
  where
    seqOp :: ParsecT String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
seqOp = ParsecT String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
-> ParsecT
     String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserExpr -> ParserExpr -> ParserExpr
PSeqConcat (ParserExpr -> ParserExpr -> ParserExpr)
-> ParsecT String u Identity String
-> ParsecT
     String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
forall a b.
a -> ParsecT String u Identity b -> ParsecT String u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String u Identity ()
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<+>" ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))
        ParsecT String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
-> ParsecT
     String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
-> ParsecT
     String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
forall a.
ParsecT String u Identity a
-> ParsecT String u Identity a -> ParsecT String u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParserExpr -> ParserExpr -> ParserExpr
PSeq (ParserExpr -> ParserExpr -> ParserExpr)
-> ParsecT String u Identity String
-> ParsecT
     String u Identity (ParserExpr -> ParserExpr -> ParserExpr)
forall a b.
a -> ParsecT String u Identity b -> ParsecT String u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String u Identity ()
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">>" ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))

-- | Term: modified expression or atom
termExpr :: Parser ParserExpr
termExpr :: Parsec String () ParserExpr
termExpr = Parsec String () ParserExpr
modifiedExpr Parsec String () ParserExpr
-> Parsec String () ParserExpr -> Parsec String () ParserExpr
forall a.
ParsecT String () Identity a
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec String () ParserExpr
atomExpr

-- | Modifiers: many, some, optional, try
modifiedExpr :: Parser ParserExpr
modifiedExpr :: Parsec String () ParserExpr
modifiedExpr = do
  ParserExpr -> ParserExpr
modifier <- ParsecT String () Identity (ParserExpr -> ParserExpr)
-> ParsecT String () Identity (ParserExpr -> ParserExpr)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity (ParserExpr -> ParserExpr)
 -> ParsecT String () Identity (ParserExpr -> ParserExpr))
-> ParsecT String () Identity (ParserExpr -> ParserExpr)
-> ParsecT String () Identity (ParserExpr -> ParserExpr)
forall a b. (a -> b) -> a -> b
$ do
    ParserExpr -> ParserExpr
m <- [ParsecT String () Identity (ParserExpr -> ParserExpr)]
-> ParsecT String () Identity (ParserExpr -> ParserExpr)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
      [ ParserExpr -> ParserExpr
PMany (ParserExpr -> ParserExpr)
-> ParsecT String () Identity String
-> ParsecT String () Identity (ParserExpr -> ParserExpr)
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"many")
      , ParserExpr -> ParserExpr
PSome (ParserExpr -> ParserExpr)
-> ParsecT String () Identity String
-> ParsecT String () Identity (ParserExpr -> ParserExpr)
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"some")
      , ParserExpr -> ParserExpr
POptional (ParserExpr -> ParserExpr)
-> ParsecT String () Identity String
-> ParsecT String () Identity (ParserExpr -> ParserExpr)
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"optional")
      , ParserExpr -> ParserExpr
PTry (ParserExpr -> ParserExpr)
-> ParsecT String () Identity String
-> ParsecT String () Identity (ParserExpr -> ParserExpr)
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"try")
      ]
    ParsecT String () Identity ()
spaces1
    (ParserExpr -> ParserExpr)
-> ParsecT String () Identity (ParserExpr -> ParserExpr)
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParserExpr -> ParserExpr
m
  ParserExpr
inner <- Parsec String () ParserExpr
termExpr
  ParserExpr -> Parsec String () ParserExpr
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserExpr -> Parsec String () ParserExpr)
-> ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ ParserExpr -> ParserExpr
modifier ParserExpr
inner

-- | At least one space
spaces1 :: Parser ()
spaces1 :: ParsecT String () Identity ()
spaces1 = ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
 -> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t\n")

-- | Atom: primitive, reference, or parenthesized expression
atomExpr :: Parser ParserExpr
atomExpr :: Parsec String () ParserExpr
atomExpr = [Parsec String () ParserExpr] -> Parsec String () ParserExpr
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
  [ Parsec String () ParserExpr
parenExpr
  , Parsec String () ParserExpr
primitiveExpr
  , Parsec String () ParserExpr
refExpr
  ]

-- | Parenthesized expression
parenExpr :: Parser ParserExpr
parenExpr :: Parsec String () ParserExpr
parenExpr = ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> Parsec String () ParserExpr
-> Parsec String () ParserExpr
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 String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String () Identity Char
-> ParsecT String () Identity () -> ParsecT String () Identity Char
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces) (ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')') Parsec String () ParserExpr
exprParser

-- | Reference to named parser: ref "name"
refExpr :: Parser ParserExpr
refExpr :: Parsec String () ParserExpr
refExpr = do
  ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"ref"
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  String -> ParserExpr
PRef (String -> ParserExpr)
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
stringLiteral

-- | Primitive parsers
primitiveExpr :: Parser ParserExpr
primitiveExpr :: Parsec String () ParserExpr
primitiveExpr = [Parsec String () ParserExpr] -> Parsec String () ParserExpr
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
  [ Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec String () ParserExpr
manyTillExpr
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec String () ParserExpr
betweenExpr
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec String () ParserExpr
countExpr
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec String () ParserExpr
charExpr
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec String () ParserExpr
stringExpr
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec String () ParserExpr
oneOfExpr
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec String () ParserExpr
noneOfExpr
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec String () ParserExpr -> Parsec String () ParserExpr)
-> Parsec String () ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ ParserExpr
PAlphaNum ParserExpr
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"alphaNum"  -- must come before 'alpha' prefix match
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec String () ParserExpr -> Parsec String () ParserExpr)
-> Parsec String () ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ ParserExpr
PAnyChar ParserExpr
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"anyChar"
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec String () ParserExpr -> Parsec String () ParserExpr)
-> Parsec String () ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ ParserExpr
PDigit ParserExpr
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"digit"
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec String () ParserExpr -> Parsec String () ParserExpr)
-> Parsec String () ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ ParserExpr
PLetter ParserExpr
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"letter"
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec String () ParserExpr -> Parsec String () ParserExpr)
-> Parsec String () ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ ParserExpr
PSpaces ParserExpr
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"spaces"      -- must come before 'space'
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec String () ParserExpr -> Parsec String () ParserExpr)
-> Parsec String () ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ ParserExpr
PSpace ParserExpr
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"space"
  , Parsec String () ParserExpr -> Parsec String () ParserExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec String () ParserExpr -> Parsec String () ParserExpr)
-> Parsec String () ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ ParserExpr
PNewline ParserExpr
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"newline"
  ]

-- | char 'x'
charExpr :: Parser ParserExpr
charExpr :: Parsec String () ParserExpr
charExpr = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"char"
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Char -> ParserExpr
PChar (Char -> ParserExpr)
-> ParsecT String () Identity Char -> Parsec String () ParserExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
charLiteral

-- | string "abc"
stringExpr :: Parser ParserExpr
stringExpr :: Parsec String () ParserExpr
stringExpr = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"string"
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  String -> ParserExpr
PString (String -> ParserExpr)
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
stringLiteral

-- | oneOf "abc"
oneOfExpr :: Parser ParserExpr
oneOfExpr :: Parsec String () ParserExpr
oneOfExpr = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"oneOf"
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  String -> ParserExpr
POneOf (String -> ParserExpr)
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
stringLiteral

-- | noneOf "abc"
noneOfExpr :: Parser ParserExpr
noneOfExpr :: Parsec String () ParserExpr
noneOfExpr = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"noneOf"
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  String -> ParserExpr
PNoneOf (String -> ParserExpr)
-> ParsecT String () Identity String -> Parsec String () ParserExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
stringLiteral

-- | between '(' ')' expr
betweenExpr :: Parser ParserExpr
betweenExpr :: Parsec String () ParserExpr
betweenExpr = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"between"
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Char
open <- ParsecT String () Identity Char
charLiteral
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Char
close <- ParsecT String () Identity Char
charLiteral
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ParserExpr
inner <- Parsec String () ParserExpr
termExpr
  ParserExpr -> Parsec String () ParserExpr
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserExpr -> Parsec String () ParserExpr)
-> ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ Char -> Char -> ParserExpr -> ParserExpr
PBetween Char
open Char
close ParserExpr
inner

-- | count 3 expr
countExpr :: Parser ParserExpr
countExpr :: Parsec String () ParserExpr
countExpr = do
  String
_ <- String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"count"
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Int
n <- String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT String () Identity String
-> ParsecT String () Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ParserExpr
inner <- Parsec String () ParserExpr
termExpr
  ParserExpr -> Parsec String () ParserExpr
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserExpr -> Parsec String () ParserExpr)
-> ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ Int -> ParserExpr -> ParserExpr
PCount Int
n ParserExpr
inner

-- | manyTill p end - match p until end, non-greedy
manyTillExpr :: Parser ParserExpr
manyTillExpr :: Parsec String () ParserExpr
manyTillExpr = do
  String
_ <- String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"manyTill"
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ParserExpr
p <- Parsec String () ParserExpr
termExpr
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ParserExpr
end <- Parsec String () ParserExpr
termExpr
  ParserExpr -> Parsec String () ParserExpr
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserExpr -> Parsec String () ParserExpr)
-> ParserExpr -> Parsec String () ParserExpr
forall a b. (a -> b) -> a -> b
$ ParserExpr -> ParserExpr -> ParserExpr
PManyTill ParserExpr
p ParserExpr
end

-- | Character literal: 'x' or '\n' etc
charLiteral :: Parser Char
charLiteral :: ParsecT String () Identity Char
charLiteral = ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () 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 String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') ParsecT String () Identity Char
charContent
  where
    charContent :: ParsecT String () Identity Char
charContent = ParsecT String () Identity Char
escapedChar ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a.
ParsecT String () Identity a
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"'\\"

-- | String literal: "abc" with escape support
stringLiteral :: Parser String
stringLiteral :: ParsecT String () Identity String
stringLiteral = ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
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 String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a.
ParsecT String () Identity a -> ParsecT String () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT String () Identity Char
stringChar)
  where
    stringChar :: ParsecT String () Identity Char
stringChar = ParsecT String () Identity Char
escapedChar ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a.
ParsecT String () Identity a
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"\\"

-- | Escape sequences
escapedChar :: Parser Char
escapedChar :: ParsecT String () Identity Char
escapedChar = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ParsecT String () Identity Char]
-> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
  [ Char
'\n' Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'n'
  , Char
'\t' Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
't'
  , Char
'\r' Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'r'
  , Char
'\\' Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  , Char
'\'' Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
  , Char
'"' Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
  ]