{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | See <http://pubs.opengroup.org/onlinepubs/9699919799/utilities/awk.html> for the
-- full awk grammar.
module Test.Tasty.Patterns.Parser
  ( Parser
  , runParser
  , ParseResult(..)
  , expr
  , parseAwkExpr
  )
  where

import Prelude hiding (Ordering(..))
import Text.ParserCombinators.ReadP hiding (many, optional)
import Text.ParserCombinators.ReadPrec (readPrec_to_P, minPrec)
import Text.Read (readPrec)
import Data.Functor
import Data.Char
import Control.Applicative
import Control.Monad
import Test.Tasty.Patterns.Types
import Test.Tasty.Patterns.Expr

type Token = ReadP

-- | A separate 'Parser' data type ensures that we don't forget to skip
-- spaces.
newtype Parser a = Parser (ReadP a)
  deriving (a -> Parser b -> Parser a
(a -> b) -> Parser a -> Parser b
(forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parser b -> Parser a
$c<$ :: forall a b. a -> Parser b -> Parser a
fmap :: (a -> b) -> Parser a -> Parser b
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
Functor, Functor Parser
a -> Parser a
Functor Parser
-> (forall a. a -> Parser a)
-> (forall a b. Parser (a -> b) -> Parser a -> Parser b)
-> (forall a b c.
    (a -> b -> c) -> Parser a -> Parser b -> Parser c)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser a)
-> Applicative Parser
Parser a -> Parser b -> Parser b
Parser a -> Parser b -> Parser a
Parser (a -> b) -> Parser a -> Parser b
(a -> b -> c) -> Parser a -> Parser b -> Parser c
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Parser a -> Parser b -> Parser a
$c<* :: forall a b. Parser a -> Parser b -> Parser a
*> :: Parser a -> Parser b -> Parser b
$c*> :: forall a b. Parser a -> Parser b -> Parser b
liftA2 :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
$cliftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
<*> :: Parser (a -> b) -> Parser a -> Parser b
$c<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
pure :: a -> Parser a
$cpure :: forall a. a -> Parser a
$cp1Applicative :: Functor Parser
Applicative, Applicative Parser
Parser a
Applicative Parser
-> (forall a. Parser a)
-> (forall a. Parser a -> Parser a -> Parser a)
-> (forall a. Parser a -> Parser [a])
-> (forall a. Parser a -> Parser [a])
-> Alternative Parser
Parser a -> Parser a -> Parser a
Parser a -> Parser [a]
Parser a -> Parser [a]
forall a. Parser a
forall a. Parser a -> Parser [a]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: Parser a -> Parser [a]
$cmany :: forall a. Parser a -> Parser [a]
some :: Parser a -> Parser [a]
$csome :: forall a. Parser a -> Parser [a]
<|> :: Parser a -> Parser a -> Parser a
$c<|> :: forall a. Parser a -> Parser a -> Parser a
empty :: Parser a
$cempty :: forall a. Parser a
$cp1Alternative :: Applicative Parser
Alternative, Applicative Parser
a -> Parser a
Applicative Parser
-> (forall a b. Parser a -> (a -> Parser b) -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a. a -> Parser a)
-> Monad Parser
Parser a -> (a -> Parser b) -> Parser b
Parser a -> Parser b -> Parser b
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Parser a
$creturn :: forall a. a -> Parser a
>> :: Parser a -> Parser b -> Parser b
$c>> :: forall a b. Parser a -> Parser b -> Parser b
>>= :: Parser a -> (a -> Parser b) -> Parser b
$c>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
$cp1Monad :: Applicative Parser
Monad, Monad Parser
Alternative Parser
Parser a
Alternative Parser
-> Monad Parser
-> (forall a. Parser a)
-> (forall a. Parser a -> Parser a -> Parser a)
-> MonadPlus Parser
Parser a -> Parser a -> Parser a
forall a. Parser a
forall a. Parser a -> Parser a -> Parser a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: Parser a -> Parser a -> Parser a
$cmplus :: forall a. Parser a -> Parser a -> Parser a
mzero :: Parser a
$cmzero :: forall a. Parser a
$cp2MonadPlus :: Monad Parser
$cp1MonadPlus :: Alternative Parser
MonadPlus)

data ParseResult a = Success a | Invalid | Ambiguous [a]
  deriving (ParseResult a -> ParseResult a -> Bool
(ParseResult a -> ParseResult a -> Bool)
-> (ParseResult a -> ParseResult a -> Bool) -> Eq (ParseResult a)
forall a. Eq a => ParseResult a -> ParseResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseResult a -> ParseResult a -> Bool
$c/= :: forall a. Eq a => ParseResult a -> ParseResult a -> Bool
== :: ParseResult a -> ParseResult a -> Bool
$c== :: forall a. Eq a => ParseResult a -> ParseResult a -> Bool
Eq, Int -> ParseResult a -> ShowS
[ParseResult a] -> ShowS
ParseResult a -> String
(Int -> ParseResult a -> ShowS)
-> (ParseResult a -> String)
-> ([ParseResult a] -> ShowS)
-> Show (ParseResult a)
forall a. Show a => Int -> ParseResult a -> ShowS
forall a. Show a => [ParseResult a] -> ShowS
forall a. Show a => ParseResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseResult a] -> ShowS
$cshowList :: forall a. Show a => [ParseResult a] -> ShowS
show :: ParseResult a -> String
$cshow :: forall a. Show a => ParseResult a -> String
showsPrec :: Int -> ParseResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ParseResult a -> ShowS
Show)

token :: Token a -> Parser a
token :: Token a -> Parser a
token Token a
a = Token a -> Parser a
forall a. ReadP a -> Parser a
Parser (Token a
a Token a -> ReadP () -> Token a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
skipSpaces)

sym :: Char -> Parser ()
sym :: Char -> Parser ()
sym = Parser Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> Parser ())
-> (Char -> Parser Char) -> Char -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token Char -> Parser Char
forall a. ReadP a -> Parser a
token (Token Char -> Parser Char)
-> (Char -> Token Char) -> Char -> Parser Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Token Char
char

str :: String -> Parser ()
str :: String -> Parser ()
str = Parser String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser String -> Parser ())
-> (String -> Parser String) -> String -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token String -> Parser String
forall a. ReadP a -> Parser a
token (Token String -> Parser String)
-> (String -> Token String) -> String -> Parser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Token String
string

-- | Run a parser
runParser
  :: Parser a
  -> String -- ^ text to parse
  -> ParseResult a
runParser :: Parser a -> String -> ParseResult a
runParser (Parser ReadP a
p) String
s =
  case ((a, String) -> Bool) -> [(a, String)] -> [(a, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> ((a, String) -> String) -> (a, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> String
forall a b. (a, b) -> b
snd) ([(a, String)] -> [(a, String)]) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> a -> b
$ ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S (ReadP ()
skipSpaces ReadP () -> ReadP a -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP a
p) String
s of
    [(a
a, String
_)] -> a -> ParseResult a
forall a. a -> ParseResult a
Success a
a
    [] -> ParseResult a
forall a. ParseResult a
Invalid
    [(a, String)]
as -> [a] -> ParseResult a
forall a. [a] -> ParseResult a
Ambiguous ((a, String) -> a
forall a b. (a, b) -> a
fst ((a, String) -> a) -> [(a, String)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, String)]
as)

intP :: Parser Int
intP :: Parser Int
intP = Token Int -> Parser Int
forall a. ReadP a -> Parser a
token (Token Int -> Parser Int) -> Token Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
  -- we cannot use the standard Int ReadP parser because it recognizes
  -- negative numbers, making -1 ambiguous
  String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Token String -> Token Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Token String
munch1 Char -> Bool
isDigit

strP :: Parser String
strP :: Parser String
strP = Token String -> Parser String
forall a. ReadP a -> Parser a
token (Token String -> Parser String) -> Token String -> Parser String
forall a b. (a -> b) -> a -> b
$ ReadPrec String -> Int -> Token String
forall a. ReadPrec a -> Int -> ReadP a
readPrec_to_P ReadPrec String
forall a. Read a => ReadPrec a
readPrec Int
minPrec
  -- this deviates somewhat from the awk string literals, by design

-- | An awk ERE token such as @/foo/@. No special characters are recognized
-- at the moment, except @\@ as an escape character for @/@ and itself.
patP :: Parser String
patP :: Parser String
patP = Token String -> Parser String
forall a. ReadP a -> Parser a
token (Token String -> Parser String) -> Token String -> Parser String
forall a b. (a -> b) -> a -> b
$ Char -> Token Char
char Char
'/' Token Char -> Token String -> Token String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Token Char -> Token String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Token Char
ch Token String -> Token Char -> Token String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Token Char
char Char
'/'
  where
    ch :: Token Char
ch =
      (Char -> Bool) -> Token Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"/\\") Token Char -> Token Char -> Token Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      (Char -> Token Char
char Char
'\\' Token Char -> Token Char -> Token Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Token Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"/\\"))

nfP :: Parser ()
nfP :: Parser ()
nfP = ReadP () -> Parser ()
forall a. ReadP a -> Parser a
token (ReadP () -> Parser ()) -> ReadP () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token String -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token String -> ReadP ()) -> Token String -> ReadP ()
forall a b. (a -> b) -> a -> b
$ String -> Token String
string String
"NF"

-- | Built-in functions
builtin :: Parser Expr
builtin :: Parser Expr
builtin = [Parser Expr] -> Parser Expr
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
  [ String -> Parser Expr -> Parser Expr
forall a. String -> Parser a -> Parser a
fn String
"length" (Parser Expr -> Parser Expr) -> Parser Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Maybe Expr -> Expr
LengthFn (Maybe Expr -> Expr) -> Parser (Maybe Expr) -> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr -> Parser (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Expr
expr
    -- we don't support length without parentheses at all,
    -- because that makes length($1) ambiguous
    -- (we don't require spaces for concatenation)
  , String -> Parser Expr -> Parser Expr
forall a. String -> Parser a -> Parser a
fn String
"toupper" (Parser Expr -> Parser Expr) -> Parser Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
ToUpperFn (Expr -> Expr) -> Parser Expr -> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr
expr
  , String -> Parser Expr -> Parser Expr
forall a. String -> Parser a -> Parser a
fn String
"tolower" (Parser Expr -> Parser Expr) -> Parser Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
ToLowerFn (Expr -> Expr) -> Parser Expr -> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr
expr
  , String -> Parser Expr -> Parser Expr
forall a. String -> Parser a -> Parser a
fn String
"match" (Parser Expr -> Parser Expr) -> Parser Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Expr -> String -> Expr
MatchFn (Expr -> String -> Expr) -> Parser Expr -> Parser (String -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr
expr Parser (String -> Expr) -> Parser () -> Parser (String -> Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
sym Char
',' Parser (String -> Expr) -> Parser String -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
patP
  , String -> Parser Expr -> Parser Expr
forall a. String -> Parser a -> Parser a
fn String
"substr" (Parser Expr -> Parser Expr) -> Parser Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Maybe Expr -> Expr
SubstrFn (Expr -> Expr -> Maybe Expr -> Expr)
-> Parser Expr -> Parser (Expr -> Maybe Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr
expr Parser (Expr -> Maybe Expr -> Expr)
-> Parser () -> Parser (Expr -> Maybe Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
sym Char
',' Parser (Expr -> Maybe Expr -> Expr)
-> Parser Expr -> Parser (Maybe Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Expr
expr Parser (Maybe Expr -> Expr) -> Parser (Maybe Expr) -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      Parser Expr -> Parser (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ()
sym Char
',' Parser () -> Parser Expr -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr
expr)
  ]
  where
    fn :: String -> Parser a -> Parser a
    fn :: String -> Parser a -> Parser a
fn String
name Parser a
args = Token String -> Parser String
forall a. ReadP a -> Parser a
token (String -> Token String
string String
name) Parser String -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ()
sym Char
'(' Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
args Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
sym Char
')'

-- | Atomic expressions
expr0 :: Parser Expr
expr0 :: Parser Expr
expr0 =
  (Char -> Parser ()
sym Char
'(' Parser () -> Parser Expr -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr
expr Parser Expr -> Parser () -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
sym Char
')') Parser Expr -> Parser Expr -> Parser Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Int -> Expr
IntLit (Int -> Expr) -> Parser Int -> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
intP) Parser Expr -> Parser Expr -> Parser Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (String -> Expr
StringLit (String -> Expr) -> Parser String -> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
strP) Parser Expr -> Parser Expr -> Parser Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (String -> Expr
ERE (String -> Expr) -> Parser String -> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
patP) Parser Expr -> Parser Expr -> Parser Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Expr
NF Expr -> Parser () -> Parser Expr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
nfP) Parser Expr -> Parser Expr -> Parser Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Expr
builtin

-- | Arguments to unary operators: atomic expressions and field
-- expressions
expr1 :: Parser Expr
expr1 :: Parser Expr
expr1 = Parser Expr -> [[Operator Parser Expr]] -> Parser Expr
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser Parser Expr
expr0
  [ [ Parser (Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix  (Expr -> Expr
Field (Expr -> Expr) -> Parser () -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
'$') ] ]

-- | Whether a parser is unary or non-unary.
--
-- This roughly corresponds to the @unary_expr@ and @non_unary_expr@
-- non-terminals in the awk grammar.
-- (Why roughly? See @expr2@.)
data Unary = Unary | NonUnary

-- | Arithmetic expressions.
--
-- Unlike awk, non-unary expressions disallow unary operators everywhere,
-- not just in the leading position, to avoid extra complexity in
-- @makeExprParser@.
--
-- For example, the expression
--
-- >1 3 + -4
--
-- is valid in awk because @3 + -4@ is non-unary, but we disallow it here
-- because @makeExprParser@ does not allow us to distinguish it from
--
-- >1 -4 + 3
--
-- which is ambiguous.
expr2 :: Unary -> Parser Expr
expr2 :: Unary -> Parser Expr
expr2 Unary
unary = Parser Expr -> [[Operator Parser Expr]] -> Parser Expr
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser Parser Expr
expr1
  [ [ Parser (Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix  (Expr -> Expr
Not (Expr -> Expr) -> Parser () -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
'!') ] [Operator Parser Expr]
-> [Operator Parser Expr] -> [Operator Parser Expr]
forall a. [a] -> [a] -> [a]
++
    (case Unary
unary of
      Unary
Unary -> [ Parser (Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix  (Expr -> Expr
Neg (Expr -> Expr) -> Parser () -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
'-') ]
      Unary
NonUnary -> []
    )
  , [ Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL  (Expr -> Expr -> Expr
Add (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
'+')
    , Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL  (Expr -> Expr -> Expr
Sub (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
'-')
    ]
  ]

-- | Expressions that may include string concatenation
expr3 :: Parser Expr
expr3 :: Parser Expr
expr3 = Parser Expr
concatExpr Parser Expr -> Parser Expr -> Parser Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Unary -> Parser Expr
expr2 Unary
Unary
  where
    -- The awk spec mandates that concatenation associates to the left.
    -- But concatenation is associative, so why would we care.
    concatExpr :: Parser Expr
concatExpr = Expr -> Expr -> Expr
Concat (Expr -> Expr -> Expr) -> Parser Expr -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr
nonUnary Parser (Expr -> Expr) -> Parser Expr -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Expr
nonUnary Parser Expr -> Parser Expr -> Parser Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Expr
concatExpr)
    nonUnary :: Parser Expr
nonUnary = Unary -> Parser Expr
expr2 Unary
NonUnary

-- | Everything with lower precedence than concatenation
expr4 :: Parser Expr
expr4 :: Parser Expr
expr4 = Parser Expr -> [[Operator Parser Expr]] -> Parser Expr
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser Parser Expr
expr3
  [ [ Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Expr -> Expr -> Expr
LT (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
'<')
    , Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Expr -> Expr -> Expr
GT (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
'>')
    , Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Expr -> Expr -> Expr
LE (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
str String
"<=")
    , Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Expr -> Expr -> Expr
GE (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
str String
">=")
    , Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Expr -> Expr -> Expr
EQ (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
str String
"==")
    , Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Expr -> Expr -> Expr
NE (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
str String
"!=")
    ]
  , [ Parser (Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Postfix ((Expr -> String -> Expr) -> String -> Expr -> Expr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Expr -> String -> Expr
Match (String -> Expr -> Expr)
-> Parser () -> Parser (String -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
'~' Parser (String -> Expr -> Expr)
-> Parser String -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
patP)
    , Parser (Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Postfix ((Expr -> String -> Expr) -> String -> Expr -> Expr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Expr -> String -> Expr
NoMatch (String -> Expr -> Expr)
-> Parser () -> Parser (String -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
str String
"!~" Parser (String -> Expr -> Expr)
-> Parser String -> Parser (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
patP)
    ]
  , [ Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Expr -> Expr -> Expr
And (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
str String
"&&") ]
  , [ Parser (Expr -> Expr -> Expr) -> Operator Parser Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Expr -> Expr -> Expr
Or  (Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
str String
"||") ]
  , [ Parser (Parser (Expr -> Expr -> Expr -> Expr))
-> Operator Parser Expr
forall (m :: * -> *) a. m (m (a -> a -> a -> a)) -> Operator m a
TernR  ((Expr -> Expr -> Expr -> Expr
If (Expr -> Expr -> Expr -> Expr)
-> Parser () -> Parser (Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
':') Parser (Expr -> Expr -> Expr -> Expr)
-> Parser () -> Parser (Parser (Expr -> Expr -> Expr -> Expr))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ()
sym Char
'?') ]
  ]

-- | The awk-like expression parser
expr :: Parser Expr
expr :: Parser Expr
expr = Parser Expr
expr4

-- | Parse an awk expression
parseAwkExpr :: String -> Maybe Expr
parseAwkExpr :: String -> Maybe Expr
parseAwkExpr String
s =
  case Parser Expr -> String -> ParseResult Expr
forall a. Parser a -> String -> ParseResult a
runParser Parser Expr
expr String
s of
    Success Expr
e -> Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
    ParseResult Expr
_ -> Maybe Expr
forall a. Maybe a
Nothing