{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module GLua.PSParser where

import GLua.TokenTypes
    ( isWhitespace, mpos, rgEnd, rgStart, splitComments, tokenSize )
import GLua.AG.Token
    ( Region(..),
      MToken(..),
      Token(..) )
import GLua.AG.AST
    ( AST(..),
      AReturn(..),
      Args(..),
      BinOp(..),
      Block(..),
      Expr(..),
      Field(..),
      FieldSep(..),
      FuncName(..),
      MElse(MElse),
      MElseIf(MElseIf),
      MExpr(..),
      MStat(..),
      PFExprSuffix(..),
      PrefixExp(..),
      Stat(..),
      UnOp(..) )
import qualified GLua.Lexer as Lex

import Text.Parsec
    ( SourcePos,
      ParseError,
      SourceName,
      anyToken,
      between,
      chainl1,
      choice,
      eof,
      many1,
      option,
      optionMaybe,
      sepBy1,
      incSourceColumn,
      sourceColumn,
      sourceLine,
      (<?>),
      (<|>),
      getPosition,
      getState,
      lookAhead,
      many,
      putState,
      runParser,
      tokenPrim,
      try,
      Parsec )
import Text.Parsec.Pos ( newPos )
import Text.ParserCombinators.UU.BasicInstances(LineColPos(..))

type AParser = Parsec [MToken] LineColPos


-- | Execute a parser
execAParser :: SourceName -> AParser a -> [MToken] -> Either ParseError a
execAParser :: forall a.
SourceName -> AParser a -> [MToken] -> Either ParseError a
execAParser SourceName
name AParser a
p = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runParser AParser a
p (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0) SourceName
name

-- | Parse a string directly
parseFromString :: AParser a -> String -> Either ParseError a
parseFromString :: forall a. AParser a -> SourceName -> Either ParseError a
parseFromString AParser a
p = forall a.
SourceName -> AParser a -> [MToken] -> Either ParseError a
execAParser SourceName
"source.lua" AParser a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. MToken -> Bool
isWhitespace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> ([MToken], [Error LineColPos])
Lex.execParseTokens

-- | Parse Garry's mod Lua tokens to an abstract syntax tree.
-- Also returns parse errors
parseGLua :: [MToken] -> Either ParseError AST
parseGLua :: [MToken] -> Either ParseError AST
parseGLua [MToken]
mts = let ([MToken]
cms, [MToken]
ts) = [MToken] -> ([MToken], [MToken])
splitComments forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. MToken -> Bool
isWhitespace) forall a b. (a -> b) -> a -> b
$ [MToken]
mts in
                 forall a.
SourceName -> AParser a -> [MToken] -> Either ParseError a
execAParser SourceName
"source.lua" ([MToken] -> AParser AST
parseChunk [MToken]
cms) [MToken]
ts

parseGLuaFromString :: String -> Either ParseError AST
parseGLuaFromString :: SourceName -> Either ParseError AST
parseGLuaFromString SourceName
contents =
    [MToken] -> Either ParseError AST
parseGLua forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. MToken -> Bool
isWhitespace) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ SourceName -> ([MToken], [Error LineColPos])
Lex.execParseTokens SourceName
contents

-- | Region start to SourcePos
rgStart2sp :: Region -> SourcePos
rgStart2sp :: Region -> SourcePos
rgStart2sp (Region LineColPos
start LineColPos
_) = LineColPos -> SourcePos
lcp2sp LineColPos
start

-- | Region end to SourcePos
rgEnd2sp :: Region -> SourcePos
rgEnd2sp :: Region -> SourcePos
rgEnd2sp (Region LineColPos
_ LineColPos
end) = LineColPos -> SourcePos
lcp2sp LineColPos
end

-- | SourcePos to region
sp2Rg :: SourcePos -> Region
sp2Rg :: SourcePos -> Region
sp2Rg SourcePos
sp = LineColPos -> LineColPos -> Region
Region (SourcePos -> LineColPos
sp2lcp SourcePos
sp) (SourcePos -> LineColPos
sp2lcp SourcePos
sp)

-- | LineColPos to SourcePos
lcp2sp :: LineColPos -> SourcePos
lcp2sp :: LineColPos -> SourcePos
lcp2sp (LineColPos Int
l Int
c Int
_) = SourceName -> Int -> Int -> SourcePos
newPos SourceName
"source.lua" (Int
l forall a. Num a => a -> a -> a
+ Int
1) (Int
c forall a. Num a => a -> a -> a
+ Int
1)

-- | SourcePos to LineColPos
sp2lcp :: SourcePos -> LineColPos
sp2lcp :: SourcePos -> LineColPos
sp2lcp SourcePos
pos = Int -> Int -> Int -> LineColPos
LineColPos (SourcePos -> Int
sourceLine SourcePos
pos forall a. Num a => a -> a -> a
- Int
1) (SourcePos -> Int
sourceColumn SourcePos
pos forall a. Num a => a -> a -> a
- Int
1) Int
0

-- | Update a SourcePos with an MToken
updatePosMToken :: SourcePos -> MToken -> [MToken] -> SourcePos
updatePosMToken :: SourcePos -> MToken -> [MToken] -> SourcePos
updatePosMToken SourcePos
_ (MToken Region
p Token
tok) [] = SourcePos -> Int -> SourcePos
incSourceColumn (Region -> SourcePos
rgStart2sp Region
p) (Token -> Int
tokenSize Token
tok)
updatePosMToken SourcePos
_ MToken
_ (MToken Region
p Token
_ : [MToken]
_) = Region -> SourcePos
rgStart2sp Region
p

-- | Match a token
pMTok :: Token -> AParser MToken
pMTok :: Token -> AParser MToken
pMTok Token
tok =
  do
    let testMToken :: MToken -> Maybe MToken
        testMToken :: MToken -> Maybe MToken
testMToken mt :: MToken
mt@(MToken Region
_ Token
t) = if Token
t forall a. Eq a => a -> a -> Bool
== Token
tok then forall a. a -> Maybe a
Just MToken
mt else forall a. Maybe a
Nothing

    mt :: MToken
mt@(MToken Region
pos Token
_) <- forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> SourceName)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim forall a. Show a => a -> SourceName
show SourcePos -> MToken -> [MToken] -> SourcePos
updatePosMToken MToken -> Maybe MToken
testMToken

    forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState (Region -> LineColPos
rgEnd Region
pos)

    forall (m :: * -> *) a. Monad m => a -> m a
return MToken
mt


-- Tokens that satisfy a condition
pMSatisfy :: (MToken -> Bool) -> AParser MToken
pMSatisfy :: (MToken -> Bool) -> AParser MToken
pMSatisfy MToken -> Bool
cond =
  do
    let testMToken :: MToken -> Maybe MToken
        testMToken :: MToken -> Maybe MToken
testMToken MToken
mt = if MToken -> Bool
cond MToken
mt then forall a. a -> Maybe a
Just MToken
mt else forall a. Maybe a
Nothing

    forall a. (MToken -> Maybe a) -> AParser a
pMToken MToken -> Maybe MToken
testMToken

pMToken :: forall a. (MToken -> Maybe a) -> AParser a
pMToken :: forall a. (MToken -> Maybe a) -> AParser a
pMToken MToken -> Maybe a
cond =
  let
    testMToken :: MToken -> Maybe (MToken, a)
    testMToken :: MToken -> Maybe (MToken, a)
testMToken MToken
mt = (MToken
mt,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MToken -> Maybe a
cond MToken
mt
  in do
    (MToken Region
pos Token
_, a
res) <- forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> SourceName)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim forall a. Show a => a -> SourceName
show SourcePos -> MToken -> [MToken] -> SourcePos
updatePosMToken MToken -> Maybe (MToken, a)
testMToken

    forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState (Region -> LineColPos
rgEnd Region
pos)

    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

-- | Get the source position
-- Simply gets the position of the next token
-- Falls back on the collected position when there is no token left
pPos :: AParser LineColPos
pPos :: AParser LineColPos
pPos = Region -> LineColPos
rgStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. MToken -> Region
mpos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> SourcePos -> LineColPos
sp2lcp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition

-- | Get the source position
-- Simply gets the end position of the last parsed token
pEndPos :: AParser LineColPos
pEndPos :: AParser LineColPos
pEndPos = forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

-- | A thing of which the region is to be parsed
annotated :: (Region -> a -> b) -> AParser a -> AParser b
annotated :: forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> a -> b
f AParser a
p = (\LineColPos
s a
t LineColPos
e -> Region -> a -> b
f (LineColPos -> LineColPos -> Region
Region LineColPos
s LineColPos
e) a
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser LineColPos
pPos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser LineColPos
pEndPos

-- | Parses the full AST
-- Its first parameter contains all comments
-- Assumes the mtokens fed to the AParser have no comments
parseChunk :: [MToken] -> AParser AST
parseChunk :: [MToken] -> AParser AST
parseChunk [MToken]
cms = [MToken] -> Block -> AST
AST [MToken]
cms forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

-- | Parse a block with an optional return value
parseBlock :: AParser Block
parseBlock :: AParser Block
parseBlock = MStatList -> AReturn -> Block
Block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. AParser a -> AParser b -> AParser [b]
pInterleaved (Token -> AParser MToken
pMTok Token
Semicolon) AParser MStat
parseMStat forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT [MToken] LineColPos Identity AReturn
parseReturn 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 AReturn
NoReturn)

parseMStat :: AParser MStat
parseMStat :: AParser MStat
parseMStat = forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Stat -> MStat
MStat AParser Stat
parseStat

-- | Parser that is interleaved with 0 or more of the other parser
pInterleaved :: AParser a -> AParser b -> AParser [b]
pInterleaved :: forall a b. AParser a -> AParser b -> AParser [b]
pInterleaved AParser a
sep AParser b
q = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many AParser a
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (AParser b
q forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many AParser a
sep)

-- | Parse a return value
parseReturn :: AParser AReturn
parseReturn :: ParsecT [MToken] LineColPos Identity AReturn
parseReturn = forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> MExprList -> AReturn
AReturn (Token -> AParser MToken
pMTok Token
Return forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Token -> AParser MToken
pMTok Token
Semicolon) forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"return statement")

-- | Label
parseLabel :: AParser MToken
parseLabel :: AParser MToken
parseLabel = (MToken -> Bool) -> AParser MToken
pMSatisfy MToken -> Bool
isLabel forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"label"
    where
        isLabel :: MToken -> Bool
        isLabel :: MToken -> Bool
isLabel (MToken Region
_ (Label SourceName
_)) = Bool
True
        isLabel MToken
_ = Bool
False

-- | Parse a single statement
parseStat :: AParser Stat
parseStat :: AParser Stat
parseStat = MToken -> Stat
ALabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
parseLabel forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            Stat
ABreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Break forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            Stat
AContinue forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Continue forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            Block -> Stat
ADo forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Do forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            MExpr -> Block -> Stat
AWhile forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
While forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Do forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            Block -> MExpr -> Stat
ARepeat forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Repeat forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Until forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            AParser Stat
parseIf forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            AParser Stat
parseFunction forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            AParser Stat
parseFor forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (MToken -> Stat
AGoto forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok (SourceName -> Token
Identifier SourceName
"goto") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MToken
pName) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            AParser Stat
parseDefinition forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            PrefixExp -> Stat
AFuncCall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser PrefixExp
pFunctionCall forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            Token -> AParser MToken
pMTok Token
Local forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                (AParser Stat
parseLocalDefinition forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                AParser Stat
parseLocalFunction)


-- | Global definition
-- Note: Uses try to avoid conflicts with function calls
parseDefinition :: AParser Stat
parseDefinition :: AParser Stat
parseDefinition = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
(<?>) SourceName
"variable definition" forall a b. (a -> b) -> a -> b
$ do
    [PrefixExp]
vars <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
        [PrefixExp]
vs <- ParsecT [MToken] LineColPos Identity [PrefixExp]
parseVarList
        MToken
_ <- Token -> AParser MToken
pMTok Token
Equals
        forall (m :: * -> *) a. Monad m => a -> m a
return [PrefixExp]
vs

    MExprList
exprs <- ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ VarsList -> Stat
Def (forall a b. [a] -> [b] -> [(a, b)]
zip [PrefixExp]
vars (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just MExprList
exprs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing))

-- | Local definition
parseLocalDefinition :: AParser Stat
parseLocalDefinition :: AParser Stat
parseLocalDefinition = [PrefixExp] -> MExprList -> Stat
def forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [MToken] LineColPos Identity [PrefixExp]
parseLocalVarList forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (Token -> AParser MToken
pMTok Token
Equals forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList) forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"variable declaration"
    where
        def :: [PrefixExp] -> [MExpr] -> Stat
        def :: [PrefixExp] -> MExprList -> Stat
def [PrefixExp]
ps MExprList
exs = VarsList -> Stat
LocDef forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [PrefixExp]
ps (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just MExprList
exs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing)

-- | Global function definition
parseFunction :: AParser Stat
parseFunction :: AParser Stat
parseFunction = FuncName -> [MToken] -> Block -> Stat
AFunc forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Function forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser FuncName
parseFuncName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                     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 (Token -> AParser MToken
pMTok Token
LRound) (Token -> AParser MToken
pMTok Token
RRound) AParser [MToken]
parseParList forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                     AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                     Token -> AParser MToken
pMTok Token
End forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function definition"

-- | Local function definition
parseLocalFunction :: AParser Stat
parseLocalFunction :: AParser Stat
parseLocalFunction = FuncName -> [MToken] -> Block -> Stat
ALocFunc forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Function forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser FuncName
parseLocFuncName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                     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 (Token -> AParser MToken
pMTok Token
LRound) (Token -> AParser MToken
pMTok Token
RRound) AParser [MToken]
parseParList forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                     AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                     Token -> AParser MToken
pMTok Token
End forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"local function definition"

-- | Parse if then elseif then else end expressions
parseIf :: AParser Stat
parseIf :: AParser Stat
parseIf = MExpr -> Block -> ElseIfList -> Else -> Stat
AIf forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
If forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Then forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
            AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
            -- elseif
            forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> ElseIf -> MElseIf
MElseIf forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Elseif forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Then forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
            -- else
            forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Block -> MElse
MElse forall a b. (a -> b) -> a -> b
$ Token -> AParser MToken
pMTok Token
Else forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser Block
parseBlock) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
            Token -> AParser MToken
pMTok Token
End forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"if statement"

parseFor :: AParser Stat
parseFor :: AParser Stat
parseFor = AParser Stat
parseNFor forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser Stat
parseGFor

-- | Parse numeric for loop
parseNFor :: AParser Stat
parseNFor :: AParser Stat
parseNFor = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
(<?>) SourceName
"numeric for loop" forall a b. (a -> b) -> a -> b
$
    do
        MToken
name <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
            MToken
_ <- Token -> AParser MToken
pMTok Token
For
            MToken
name <- AParser MToken
pName
            MToken
_ <- Token -> AParser MToken
pMTok Token
Equals
            forall (m :: * -> *) a. Monad m => a -> m a
return MToken
name

        MExpr
start <- AParser MExpr
parseExpression
        MToken
_ <- Token -> AParser MToken
pMTok Token
Comma
        MExpr
to <- AParser MExpr
parseExpression
        MExpr
st <- AParser MExpr
step
        MToken
_ <- Token -> AParser MToken
pMTok Token
Do
        Block
blk <- AParser Block
parseBlock
        MToken
_ <- Token -> AParser MToken
pMTok Token
End

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MToken -> MExpr -> MExpr -> MExpr -> Block -> Stat
ANFor MToken
name MExpr
start MExpr
to MExpr
st Block
blk
    where
        step :: AParser MExpr
        step :: AParser MExpr
step = Token -> AParser MToken
pMTok Token
Comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser MExpr
parseExpression forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Expr -> MExpr
MExpr (forall (m :: * -> *) a. Monad m => a -> m a
return (SourceName -> Expr
ANumber SourceName
"1"))

-- | Generic for loop
parseGFor :: AParser Stat
parseGFor :: AParser Stat
parseGFor = [MToken] -> MExprList -> Block -> Stat
AGFor forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
For forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser [MToken]
parseNameList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
In forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Do forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"generic for loop"

-- | Function name (includes dot indices and meta indices)
parseFuncName :: AParser FuncName
parseFuncName :: AParser FuncName
parseFuncName = (\MToken
a [MToken]
b Maybe MToken
c -> [MToken] -> Maybe MToken -> FuncName
FuncName (MToken
aforall a. a -> [a] -> [a]
:[MToken]
b) Maybe MToken
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Token -> AParser MToken
pMTok Token
Dot forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser MToken
pName) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Colon forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MToken
pName) forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function name"

-- | Local function name: cannot be a meta function nor indexed
parseLocFuncName :: AParser FuncName
parseLocFuncName :: AParser FuncName
parseLocFuncName = (\MToken
name -> [MToken] -> Maybe MToken -> FuncName
FuncName [MToken
name] forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function name"

-- | Parse a number into an expression
parseNumber :: AParser Expr
parseNumber :: AParser Expr
parseNumber = forall a. (MToken -> Maybe a) -> AParser a
pMToken MToken -> Maybe Expr
isNumber forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"number"
    where
        isNumber :: MToken -> Maybe Expr
        isNumber :: MToken -> Maybe Expr
isNumber = \case
            MToken Region
_ (TNumber SourceName
str) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SourceName -> Expr
ANumber SourceName
str
            MToken
_ -> forall a. Maybe a
Nothing

-- | Parse any kind of string
parseString :: AParser MToken
parseString :: AParser MToken
parseString = (MToken -> Bool) -> AParser MToken
pMSatisfy MToken -> Bool
isString forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"string"
    where
        isString :: MToken -> Bool
        isString :: MToken -> Bool
isString (MToken Region
_ (DQString SourceName
_)) = Bool
True
        isString (MToken Region
_ (SQString SourceName
_)) = Bool
True
        isString (MToken Region
_ (MLString SourceName
_)) = Bool
True
        isString MToken
_ = Bool
False

-- | Parse an identifier
pName :: AParser MToken
pName :: AParser MToken
pName = (MToken -> Bool) -> AParser MToken
pMSatisfy MToken -> Bool
isName forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"identifier"
    where
        isName :: MToken -> Bool
        isName :: MToken -> Bool
isName (MToken Region
_ (Identifier SourceName
_)) = Bool
True
        isName MToken
_ = Bool
False

-- | Parse a list of identifiers
parseNameList :: AParser [MToken]
parseNameList :: AParser [MToken]
parseNameList = 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]
sepBy1 AParser MToken
pName (Token -> AParser MToken
pMTok Token
Comma)

-- | Parse variable list (var1, var2, var3)
parseVarList :: AParser [PrefixExp]
parseVarList :: ParsecT [MToken] LineColPos Identity [PrefixExp]
parseVarList = 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]
sepBy1 AParser PrefixExp
parseVar (Token -> AParser MToken
pMTok Token
Comma)

-- | Parse local variable list (var1, var2, var3)
parseLocalVarList :: AParser [PrefixExp]
parseLocalVarList :: ParsecT [MToken] LineColPos Identity [PrefixExp]
parseLocalVarList = 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]
sepBy1 (MToken -> ExprSuffixList -> PrefixExp
PFVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Token -> AParser MToken
pMTok Token
Comma)

-- | Parse list of function parameters
parseParList :: AParser [MToken]
parseParList :: AParser [MToken]
parseParList = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ AParser [MToken]
nameParam forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser [MToken]
vararg
    where
        vararg :: AParser [MToken]
vararg = (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> AParser MToken
pMTok Token
VarArg forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"..."
        nameParam :: AParser [MToken]
nameParam = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser [MToken]
moreParams forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"parameter"
        moreParams :: AParser [MToken]
moreParams = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ Token -> AParser MToken
pMTok Token
Comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AParser [MToken]
nameParam forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser [MToken]
vararg)

-- | list of expressions
parseExpressionList :: AParser [MExpr]
parseExpressionList :: ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList = 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]
sepBy1 AParser MExpr
parseExpression (Token -> AParser MToken
pMTok Token
Comma)

-- | Subexpressions, i.e. without operators
parseSubExpression :: AParser Expr
parseSubExpression :: AParser Expr
parseSubExpression = Expr
ANil forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Nil forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  Expr
AFalse forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TFalse forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  Expr
ATrue forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TTrue forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  AParser Expr
parseNumber forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  MToken -> Expr
AString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
parseString forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  Expr
AVarArg forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
VarArg forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  AParser Expr
parseAnonymFunc forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  PrefixExp -> Expr
APrefixExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser PrefixExp
parsePrefixExp forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                  FieldList -> Expr
ATableConstructor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser FieldList
parseTableConstructor forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"expression"


-- | Separate parser for anonymous function subexpression
parseAnonymFunc :: AParser Expr
parseAnonymFunc :: AParser Expr
parseAnonymFunc = [MToken] -> Block -> Expr
AnonymousFunc forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
                   Token -> AParser MToken
pMTok Token
Function forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                   Token -> AParser MToken
pMTok Token
LRound forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser [MToken]
parseParList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RRound forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                   AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                   Token -> AParser MToken
pMTok Token
End forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"anonymous function"

-- | Parse operators of the same precedence in a chain
samePrioL :: [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL :: [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
ops AParser MExpr
pr = 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 AParser MExpr
pr (forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (forall a b. (a -> b) -> [a] -> [b]
map (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f [(Token, BinOp)]
ops))
  where
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f (Token
t, BinOp
at) = forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated (\Region
p MToken
_ MExpr
e1 MExpr
e2 -> Region -> Expr -> MExpr
MExpr Region
p (BinOp -> MExpr -> MExpr -> Expr
BinOpExpr BinOp
at MExpr
e1 MExpr
e2)) (Token -> AParser MToken
pMTok Token
t)

samePrioR :: [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioR :: [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioR [(Token, BinOp)]
ops AParser MExpr
pr = 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 AParser MExpr
pr (forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (forall a b. (a -> b) -> [a] -> [b]
map (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f [(Token, BinOp)]
ops))
  where
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f (Token
t, BinOp
at) = forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated (\Region
p MToken
_ MExpr
e1 MExpr
e2 -> Region -> Expr -> MExpr
MExpr Region
p (BinOp -> MExpr -> MExpr -> Expr
BinOpExpr BinOp
at MExpr
e1 MExpr
e2)) (Token -> AParser MToken
pMTok Token
t)

-- | Parse unary operator (-, not, #)
parseUnOp :: AParser UnOp
parseUnOp :: AParser UnOp
parseUnOp = UnOp
UnMinus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Minus forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            UnOp
ANot    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Not   forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            UnOp
ANot    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
CNot  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            UnOp
AHash   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Hash

-- | Parses a binary operator
parseBinOp :: AParser BinOp
parseBinOp :: AParser BinOp
parseBinOp = BinOp
AOr          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Or           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
AOr          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
COr          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
AAnd         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
And          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
AAnd         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
CAnd         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
ALT          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TLT          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
AGT          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TGT          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
ALEQ         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TLEQ         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
AGEQ         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TGEQ         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
ANEq         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TNEq         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
ANEq         forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TCNEq        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
AEq          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TEq          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
AConcatenate forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Concatenate  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
APlus        forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Plus         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
BinMinus     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Minus        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
AMultiply    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Multiply     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
ADivide      forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Divide       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
AModulus     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Modulus      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             BinOp
APower       forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Power

-- | Operators, sorted by priority
-- Priority from: http://www.lua.org/manual/5.2/manual.html#3.4.7
lvl1, lvl2, lvl3, lvl4, lvl5, lvl6, lvl8 :: [(Token, BinOp)]
lvl1 :: [(Token, BinOp)]
lvl1 = [(Token
Or, BinOp
AOr), (Token
COr, BinOp
AOr)]
lvl2 :: [(Token, BinOp)]
lvl2 = [(Token
And, BinOp
AAnd), (Token
CAnd, BinOp
AAnd)]
lvl3 :: [(Token, BinOp)]
lvl3 = [(Token
TLT, BinOp
ALT), (Token
TGT, BinOp
AGT), (Token
TLEQ, BinOp
ALEQ), (Token
TGEQ, BinOp
AGEQ), (Token
TNEq, BinOp
ANEq), (Token
TCNEq, BinOp
ANEq), (Token
TEq, BinOp
AEq)]
lvl4 :: [(Token, BinOp)]
lvl4 = [(Token
Concatenate, BinOp
AConcatenate)]
lvl5 :: [(Token, BinOp)]
lvl5 = [(Token
Plus, BinOp
APlus), (Token
Minus, BinOp
BinMinus)]
lvl6 :: [(Token, BinOp)]
lvl6 = [(Token
Multiply, BinOp
AMultiply), (Token
Divide, BinOp
ADivide), (Token
Modulus, BinOp
AModulus)]
-- lvl7 is unary operators
lvl8 :: [(Token, BinOp)]
lvl8 = [(Token
Power, BinOp
APower)]


-- | Parse chains of binary and unary operators
parseExpression :: AParser MExpr
parseExpression :: AParser MExpr
parseExpression =  [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
lvl1
                  ([(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
lvl2 forall a b. (a -> b) -> a -> b
$
                   [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
lvl3 forall a b. (a -> b) -> a -> b
$
                   [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioR [(Token, BinOp)]
lvl4 forall a b. (a -> b) -> a -> b
$
                   [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
lvl5 forall a b. (a -> b) -> a -> b
$
                   [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
lvl6 forall a b. (a -> b) -> a -> b
$
                   forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Expr -> MExpr
MExpr (UnOp -> MExpr -> Expr
UnOpExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser UnOp
parseUnOp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> -- lvl7
                   [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioR [(Token, BinOp)]
lvl8 (forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Expr -> MExpr
MExpr (AParser Expr
parseSubExpression forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> UnOp -> MExpr -> Expr
UnOpExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser UnOp
parseUnOp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression))) forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"expression"

-- | Prefix expressions
-- can have any arbitrary list of expression suffixes
parsePrefixExp :: AParser PrefixExp
parsePrefixExp :: AParser PrefixExp
parsePrefixExp = AParser ExprSuffixList -> AParser PrefixExp
pPrefixExp (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many AParser PFExprSuffix
pPFExprSuffix)

-- | Prefix expressions
-- The suffixes define rules on the allowed suffixes
pPrefixExp :: AParser [PFExprSuffix] -> AParser PrefixExp
pPrefixExp :: AParser ExprSuffixList -> AParser PrefixExp
pPrefixExp AParser ExprSuffixList
suffixes = MToken -> ExprSuffixList -> PrefixExp
PFVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser ExprSuffixList
suffixes forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                      MExpr -> ExprSuffixList -> PrefixExp
ExprVar forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
LRound forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RRound forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser ExprSuffixList
suffixes

-- | Parse any expression suffix
pPFExprSuffix :: AParser PFExprSuffix
pPFExprSuffix :: AParser PFExprSuffix
pPFExprSuffix = AParser PFExprSuffix
pPFExprCallSuffix forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser PFExprSuffix
pPFExprIndexSuffix

-- | Parse an indexing expression suffix
pPFExprCallSuffix :: AParser PFExprSuffix
pPFExprCallSuffix :: AParser PFExprSuffix
pPFExprCallSuffix = Args -> PFExprSuffix
Call forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Args
parseArgs forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                    MToken -> Args -> PFExprSuffix
MetaCall forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Colon forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MToken
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Args
parseArgs forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function call"

-- | Parse an indexing expression suffix
pPFExprIndexSuffix :: AParser PFExprSuffix
pPFExprIndexSuffix :: AParser PFExprSuffix
pPFExprIndexSuffix = MExpr -> PFExprSuffix
ExprIndex forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
LSquare forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RSquare forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                     MToken -> PFExprSuffix
DotIndex forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Dot forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MToken
pName forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"indexation"

-- | Function calls are prefix expressions, but the last suffix MUST be either a function call or a metafunction call
pFunctionCall :: AParser PrefixExp
pFunctionCall :: AParser PrefixExp
pFunctionCall = AParser ExprSuffixList -> AParser PrefixExp
pPrefixExp AParser ExprSuffixList
suffixes forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function call"
    where
        suffixes :: AParser ExprSuffixList
suffixes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((\ExprSuffixList
ix PFExprSuffix
c -> ExprSuffixList
ix forall a. [a] -> [a] -> [a]
++ [PFExprSuffix
c]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 AParser PFExprSuffix
pPFExprIndexSuffix forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser PFExprSuffix
pPFExprCallSuffix forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                     (forall a. a -> [a] -> [a]
:[])                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser PFExprSuffix
pPFExprCallSuffix)

-- | single variable. Note: definition differs from reference to circumvent the left recursion
-- var ::= Name [{PFExprSuffix}* indexation] | '(' exp ')' {PFExprSuffix}* indexation
-- where "{PFExprSuffix}* indexation" is any arbitrary sequence of prefix expression suffixes that end with an indexation
parseVar :: AParser PrefixExp
parseVar :: AParser PrefixExp
parseVar = AParser ExprSuffixList -> AParser PrefixExp
pPrefixExp AParser ExprSuffixList
suffixes forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"variable"
    where
        suffixes :: AParser ExprSuffixList
suffixes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((\ExprSuffixList
c PFExprSuffix
ix -> ExprSuffixList
c forall a. [a] -> [a] -> [a]
++ [PFExprSuffix
ix]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 AParser PFExprSuffix
pPFExprCallSuffix forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser PFExprSuffix
pPFExprIndexSuffix forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                                    (forall a. a -> [a] -> [a]
:[])                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser PFExprSuffix
pPFExprIndexSuffix)

-- | Arguments of a function call (including brackets)
parseArgs :: AParser Args
parseArgs :: AParser Args
parseArgs = MExprList -> Args
ListArgs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
LRound forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RRound forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            FieldList -> Args
TableArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser FieldList
parseTableConstructor forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            MToken -> Args
StringArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
parseString forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function arguments"

-- | Table constructor
parseTableConstructor :: AParser [Field]
parseTableConstructor :: AParser FieldList
parseTableConstructor = Token -> AParser MToken
pMTok Token
LCurly forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser FieldList
parseFieldList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RCurly forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"table"

-- | A list of table entries
-- Grammar: field {separator field} [separator]
parseFieldList :: AParser [Field]
parseFieldList :: AParser FieldList
parseFieldList = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ do
    FieldSep -> Field
field <- AParser (FieldSep -> Field)
parseField
    FieldSep
sep <- AParser FieldSep
parseOptionalFieldSep
    case FieldSep
sep of
        FieldSep
NoSep -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [FieldSep -> Field
field FieldSep
NoSep]
        FieldSep
_ -> (FieldSep -> Field
field FieldSep
sep forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser FieldList
parseFieldList

-- | Parse a named field (e.g. {named = field})
-- Contains try to avoid conflict with unnamed fields
parseNamedField :: AParser (FieldSep -> Field)
parseNamedField :: AParser (FieldSep -> Field)
parseNamedField = do
    MToken
name <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
        MToken
n <- AParser MToken
pName
        MToken
_ <- Token -> AParser MToken
pMTok Token
Equals
        forall (m :: * -> *) a. Monad m => a -> m a
return MToken
n

    MToken -> MExpr -> FieldSep -> Field
NamedField MToken
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MExpr
parseExpression

-- | A field in a table
parseField :: AParser (FieldSep -> Field)
parseField :: AParser (FieldSep -> Field)
parseField = MExpr -> MExpr -> FieldSep -> Field
ExprField forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
LSquare forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RSquare forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Equals forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             AParser (FieldSep -> Field)
parseNamedField forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             MExpr -> FieldSep -> Field
UnnamedField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MExpr
parseExpression forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"field"

-- | Field separator, either comma or semicolon
parseFieldSep :: AParser FieldSep
parseFieldSep :: AParser FieldSep
parseFieldSep =
    FieldSep
CommaSep forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Comma forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
    FieldSep
SemicolonSep forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Semicolon

-- | Optional field separator, returns NoSep when no separator is found
-- Used at the end of a field list
parseOptionalFieldSep :: AParser FieldSep
parseOptionalFieldSep :: AParser FieldSep
parseOptionalFieldSep = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option FieldSep
NoSep AParser FieldSep
parseFieldSep