{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}

-- | Parser based on <http://www.lua.org/manual/5.2/manual.html#9>
module GLua.Parser where

import GLua.TokenTypes
import GLua.AG.Token
import GLua.AG.AST
import qualified GLua.Lexer as Lex

import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.BasicInstances

-- | MTokens with the positions of the next MToken (used in the advance of parser)
data MTokenPos = MTokenPos MToken Region

data RegionProgression =
  RegionProgression {RegionProgression -> Region
lastRegion :: Region, RegionProgression -> Region
nextRegion :: Region}
  deriving (Int -> RegionProgression -> ShowS
[RegionProgression] -> ShowS
RegionProgression -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegionProgression] -> ShowS
$cshowList :: [RegionProgression] -> ShowS
show :: RegionProgression -> String
$cshow :: RegionProgression -> String
showsPrec :: Int -> RegionProgression -> ShowS
$cshowsPrec :: Int -> RegionProgression -> ShowS
Show)

emptyRgPrgs :: RegionProgression
emptyRgPrgs :: RegionProgression
emptyRgPrgs = Region -> Region -> RegionProgression
RegionProgression Region
emptyRg Region
emptyRg

instance Show MTokenPos where
  show :: MTokenPos -> String
show (MTokenPos MToken
tok Region
_) = forall a. Show a => a -> String
show MToken
tok

-- | Custom parser that parses MTokens
type AParser a = P (Str MTokenPos [MTokenPos] RegionProgression) a

-- | RegionProgression is a location that can be updated by MTokens
instance IsLocationUpdatedBy RegionProgression MTokenPos where
    -- advance :: RegionProgression -> MToken -> RegionProgression
    -- Assume the position of the next MToken
    advance :: RegionProgression -> MTokenPos -> RegionProgression
advance RegionProgression
_ (MTokenPos MToken
mt Region
p) = Region -> Region -> RegionProgression
RegionProgression (MToken -> Region
mpos MToken
mt) Region
p

resultsToRegion :: (a, [Error RegionProgression]) -> (a, [Error Region])
resultsToRegion :: forall a. (a, [Error RegionProgression]) -> (a, [Error Region])
resultsToRegion (a
a, [Error RegionProgression]
errs) = (a
a, forall a b. (a -> b) -> [a] -> [b]
map Error RegionProgression -> Error Region
errorToRegion [Error RegionProgression]
errs)

-- | Parse Garry's mod Lua tokens to an abstract syntax tree.
-- Also returns parse errors
parseGLua :: [MToken] -> (AST, [Error Region])
parseGLua :: [MToken] -> (AST, [Error Region])
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. (a, [Error RegionProgression]) -> (a, [Error Region])
resultsToRegion forall a b. (a -> b) -> a -> b
$ forall a. AParser a -> [MToken] -> (a, [Error RegionProgression])
execAParser ([MToken] -> AParser AST
parseChunk [MToken]
cms) [MToken]
ts

-- | Parse a string directly into an AST
parseGLuaFromString :: String -> (AST, [Error Region])
parseGLuaFromString :: String -> (AST, [Error Region])
parseGLuaFromString = [MToken] -> (AST, [Error Region])
parseGLua 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
. String -> ([MToken], [Error LineColPos])
Lex.execParseTokens

-- | Parse a string directly
parseFromString :: AParser a -> String -> (a, [Error Region])
parseFromString :: forall a. AParser a -> String -> (a, [Error Region])
parseFromString AParser a
p = forall a. (a, [Error RegionProgression]) -> (a, [Error Region])
resultsToRegion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AParser a -> [MToken] -> (a, [Error RegionProgression])
execAParser 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
. String -> ([MToken], [Error LineColPos])
Lex.execParseTokens

-- | Create a parsable string from MTokens
createString :: [MToken] -> Str MTokenPos [MTokenPos] RegionProgression
createString :: [MToken] -> Str MTokenPos [MTokenPos] RegionProgression
createString [] = forall s a loc. ListLike s a => loc -> s -> Str a s loc
createStr RegionProgression
emptyRgPrgs []
createString mts :: [MToken]
mts@(MToken Region
p Token
_ : [MToken]
xs) = forall s a loc. ListLike s a => loc -> s -> Str a s loc
createStr (Region -> Region -> RegionProgression
RegionProgression Region
p ([MToken] -> Region
nextRg [MToken]
mts')) [MTokenPos]
mtpos where
    mts' :: [MToken]
mts' = [MToken]
xs forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [MToken]
mts] -- Repeat last element of mts
    mkMtPos :: MToken -> MToken -> MTokenPos
mkMtPos MToken
mt (MToken Region
p' Token
_) = MToken -> Region -> MTokenPos
MTokenPos MToken
mt Region
p'
    mtpos :: [MTokenPos]
mtpos = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MToken -> MToken -> MTokenPos
mkMtPos [MToken]
mts [MToken]
mts'

    nextRg :: [MToken] -> Region
nextRg (MToken Region
p' Token
_ : [MToken]
_) = Region
p'
    nextRg [] = forall a. HasCallStack => a
undefined


errorToRegion :: Error RegionProgression -> Error Region
errorToRegion :: Error RegionProgression -> Error Region
errorToRegion (Inserted String
a RegionProgression
p Strings
b) = forall pos. String -> pos -> Strings -> Error pos
Inserted String
a (RegionProgression -> Region
nextRegion RegionProgression
p) Strings
b
errorToRegion (Deleted String
a RegionProgression
p Strings
b) = forall pos. String -> pos -> Strings -> Error pos
Deleted String
a (RegionProgression -> Region
nextRegion RegionProgression
p) Strings
b
errorToRegion (Replaced String
a String
b RegionProgression
p Strings
c) = forall pos. String -> String -> pos -> Strings -> Error pos
Replaced String
a String
b (RegionProgression -> Region
nextRegion RegionProgression
p) Strings
c
errorToRegion (DeletedAtEnd String
s) = forall pos. String -> Error pos
DeletedAtEnd String
s

-- | Position in Region (as opposed to RegionProgression)
pPos' :: AParser Region
pPos' :: AParser Region
pPos' = RegionProgression -> Region
nextRegion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st pos. HasPosition st pos => P st pos
pPos

-- | Text.ParserCombinators.UU.Utils.execParser modified to parse MTokens
-- The first MToken might not be on the first line, so use the first MToken's position to start
execAParser :: AParser a -> [MToken] -> (a, [Error RegionProgression])
execAParser :: forall a. AParser a -> [MToken] -> (a, [Error RegionProgression])
execAParser AParser a
p mts :: [MToken]
mts@[] = forall t a. Eof t => P t a -> t -> a
parse_h ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall st error. (StoresErrors st error, Eof st) => P st [error]
pEnd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MToken] -> Str MTokenPos [MTokenPos] RegionProgression
createString forall a b. (a -> b) -> a -> b
$ [MToken]
mts
execAParser AParser a
p mts :: [MToken]
mts@(MToken
_ : [MToken]
_) = forall t a. Eof t => P t a -> t -> a
parse_h ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall st error. (StoresErrors st error, Eof st) => P st [error]
pEnd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MToken] -> Str MTokenPos [MTokenPos] RegionProgression
createString forall a b. (a -> b) -> a -> b
$ [MToken]
mts -- createStr (mpos m) $ mts


pMSatisfy :: (MToken -> Bool) -> Token -> String -> AParser MToken
pMSatisfy :: (MToken -> Bool) -> Token -> String -> AParser MToken
pMSatisfy MToken -> Bool
f Token
t String
ins = MTokenPos -> MToken
getToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> Insertion a -> P (Str a state loc) a
pSatisfy MTokenPos -> Bool
f' (forall a. String -> a -> Int -> Insertion a
Insertion String
ins (MToken -> Region -> MTokenPos
MTokenPos (Region -> Token -> MToken
MToken Region
ep Token
t) Region
ep) Int
5) where
    f' :: MTokenPos -> Bool
    f' :: MTokenPos -> Bool
f' (MTokenPos MToken
tok Region
_) = MToken -> Bool
f MToken
tok

    getToken :: MTokenPos -> MToken
    getToken :: MTokenPos -> MToken
getToken (MTokenPos MToken
t' Region
_) = MToken
t'

    ep :: Region
ep = LineColPos -> LineColPos -> Region
Region (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0) (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0)

-- | Parse a single Metatoken, based on a positionless token (much like pSym)
pMTok :: Token -> AParser MToken
pMTok :: Token -> AParser MToken
pMTok Token
t = (MToken -> Bool) -> Token -> String -> AParser MToken
pMSatisfy MToken -> Bool
isToken Token
t forall a b. (a -> b) -> a -> b
$ String
"'" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Token
t forall a. [a] -> [a] -> [a]
++ String
"'"
    where
        isToken :: MToken -> Bool
        isToken :: MToken -> Bool
isToken (MToken Region
_ Token
tok) = Token
t forall a. Eq a => a -> a -> Bool
== Token
tok

-- | Parse a list of identifiers
parseNameList :: AParser [MToken]
parseNameList :: AParser [MToken]
parseNameList = (:) 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 (p :: * -> *) a. IsParser p => p a -> p [a]
pMany (Token -> AParser MToken
pMTok Token
Comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser MToken
pName)

-- | Parse list of function parameters
parseParList :: AParser [MToken]
parseParList :: AParser [MToken]
parseParList = (Token -> AParser MToken
pMTok Token
VarArg forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> AParser MToken
pName) forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (
                    Token -> AParser MToken
pMTok Token
Comma forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (
                        (\MToken
a MToken
_ MToken
c -> [MToken
c, MToken
a]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> AParser MToken
pMTok Token
VarArg forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                        (\[MToken]
a MToken
_ MToken
c -> MToken
c forall a. a -> [a] -> [a]
: [MToken]
a)  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser [MToken]
parseParList
                    ) forall (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
`opt` (forall a. a -> [a] -> [a]
: [])
               ) forall (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
`opt` []

-- | 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

-- | 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
<*> (P (Str MTokenPos [MTokenPos] RegionProgression) AReturn
parseReturn forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> forall (p :: * -> *) a. Applicative p => a -> p a
pReturn AReturn
NoReturn)


-- | 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 = (\Region
s a
t Str MTokenPos [MTokenPos] RegionProgression
e -> Region -> a -> b
f (LineColPos -> LineColPos -> Region
Region (Region -> LineColPos
rgStart Region
s) (Region -> LineColPos
rgEnd forall a b. (a -> b) -> a -> b
$ RegionProgression -> Region
lastRegion forall a b. (a -> b) -> a -> b
$ forall a s loc. Str a s loc -> loc
pos forall a b. (a -> b) -> a -> b
$ Str MTokenPos [MTokenPos] RegionProgression
e)) a
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Region
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
<*> forall st. P st st
pState

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 (p :: * -> *) a. IsParser p => p a -> p [a]
pMany AParser a
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (p :: * -> *) a. IsParser p => p a -> p [a]
pMany (AParser b
q forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (p :: * -> *) a. IsParser p => p a -> p [a]
pMany AParser a
sep)

-- | Behemoth parser that parses either function call statements or global declaration statements
-- Big in size and complexity because prefix expressions are BITCHES
-- The problem lies in the complexity of prefix expressions:
-- hotten.totten["tenten"](tentoonstelling) -- This is a function call
-- hotten.totten["tenten"] = tentoonstelling -- This is a declaration.
-- hotten.totten["tenten"], tentoonstelling = 1, 2 -- This is also a declaration.
-- One may find an arbitrary amount of expression suffixes (indexations/calls) before
-- finding a comma or equals sign that proves that it is a declaration.
-- Also, goto can be an identifier
parseCallDef :: AParser Stat
parseCallDef :: AParser Stat
parseCallDef = AParser Stat
parseGoto forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
               (MToken -> ExprSuffixList -> PrefixExp
PFVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> -- Statemens begin with either a simple name or parenthesised expression
                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 -> f (a -> b) -> f b
<**> (
                  -- Either there are more suffixes yet to be found (contSearch)
                  -- or there aren't and we will find either a comma or =-sign (varDecl namedVarDecl)
                  P (Str MTokenPos [MTokenPos] RegionProgression)
  ((ExprSuffixList -> PrefixExp) -> Stat)
contSearch forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                  forall b. ([PrefixExp] -> [MExpr] -> b) -> AParser b
varDecl [PrefixExp] -> [MExpr] -> (ExprSuffixList -> PrefixExp) -> Stat
namedVarDecl
                )
  where
    -- Try to parse a goto statement
    parseGoto :: AParser Stat
    parseGoto :: AParser Stat
parseGoto = (MToken -> ExprSuffixList -> PrefixExp
PFVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> AParser MToken
pMTok (String -> Token
Identifier String
"goto")) forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**>
                  ((\MToken
n ExprSuffixList -> PrefixExp
_ -> MToken -> Stat
AGoto MToken
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                    P (Str MTokenPos [MTokenPos] RegionProgression)
  ((ExprSuffixList -> PrefixExp) -> Stat)
contSearch forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                    forall b. ([PrefixExp] -> [MExpr] -> b) -> AParser b
varDecl [PrefixExp] -> [MExpr] -> (ExprSuffixList -> PrefixExp) -> Stat
namedVarDecl)

    -- Simple direct declaration: varName, ... = 1, ...
    namedVarDecl :: [PrefixExp] -> [MExpr] -> (ExprSuffixList -> PrefixExp) -> Stat
    namedVarDecl :: [PrefixExp] -> [MExpr] -> (ExprSuffixList -> PrefixExp) -> Stat
namedVarDecl [PrefixExp]
vars [MExpr]
exprs ExprSuffixList -> PrefixExp
pfe = let pfes :: [PrefixExp]
pfes = (ExprSuffixList -> PrefixExp
pfe []) forall a. a -> [a] -> [a]
: [PrefixExp]
vars in VarsList -> Stat
Def (forall a b. [a] -> [b] -> [(a, b)]
zip [PrefixExp]
pfes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [MExpr]
exprs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing)

    -- This is where we know it's a variable declaration
    -- Takes a function that turns it into a proper Def Stat
    varDecl :: ([PrefixExp] -> [MExpr] -> b) -> AParser b
    varDecl :: forall b. ([PrefixExp] -> [MExpr] -> b) -> AParser b
varDecl [PrefixExp] -> [MExpr] -> b
f = [PrefixExp] -> [MExpr] -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
opt (Token -> AParser MToken
pMTok Token
Comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P (Str MTokenPos [MTokenPos] RegionProgression) [PrefixExp]
parseVarList) [] 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]
parseExpressionList

    -- We know that there is at least one suffix (indexation or call).
    -- Search for more suffixes and make either a call or declaration from it
    contSearch :: AParser ((ExprSuffixList -> PrefixExp) -> Stat)
    contSearch :: P (Str MTokenPos [MTokenPos] RegionProgression)
  ((ExprSuffixList -> PrefixExp) -> Stat)
contSearch = (\(ExprSuffixList
ss, PrefixExp -> Stat
mkStat) ExprSuffixList -> PrefixExp
pfe -> PrefixExp -> Stat
mkStat forall a b. (a -> b) -> a -> b
$ ExprSuffixList -> PrefixExp
pfe ExprSuffixList
ss) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser (ExprSuffixList, PrefixExp -> Stat)
searchDeeper

    -- We either find a call suffix or an indexation suffix
    -- When it's a function call, try searching for more suffixes, if that doesn't work, it's a function call.
    -- When it's an indexation suffix, search for more suffixes or know that it's a declaration.
    searchDeeper :: AParser ([PFExprSuffix], PrefixExp -> Stat)
    searchDeeper :: AParser (ExprSuffixList, PrefixExp -> Stat)
searchDeeper = (AParser PFExprSuffix
pPFExprCallSuffix forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> ((ExprSuffixList, PrefixExp -> Stat)
-> PFExprSuffix -> (ExprSuffixList, PrefixExp -> Stat)
mergeDeeperSearch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser (ExprSuffixList, PrefixExp -> Stat)
searchDeeper forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> forall (p :: * -> *) a. Applicative p => a -> p a
pReturn (\PFExprSuffix
s -> ([PFExprSuffix
s], PrefixExp -> Stat
AFuncCall)))) forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                   (AParser PFExprSuffix
pPFExprIndexSuffix forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> ((ExprSuffixList, PrefixExp -> Stat)
-> PFExprSuffix -> (ExprSuffixList, PrefixExp -> Stat)
mergeDeeperSearch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser (ExprSuffixList, PrefixExp -> Stat)
searchDeeper forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> forall b. ([PrefixExp] -> [MExpr] -> b) -> AParser b
varDecl [PrefixExp]
-> [MExpr] -> PFExprSuffix -> (ExprSuffixList, PrefixExp -> Stat)
complexDecl))

    -- Merge the finding of more suffixes with the currently found suffix
    mergeDeeperSearch :: ([PFExprSuffix], PrefixExp -> Stat) -> PFExprSuffix -> ([PFExprSuffix], PrefixExp -> Stat)
    mergeDeeperSearch :: (ExprSuffixList, PrefixExp -> Stat)
-> PFExprSuffix -> (ExprSuffixList, PrefixExp -> Stat)
mergeDeeperSearch (ExprSuffixList
ss, PrefixExp -> Stat
f) PFExprSuffix
s = (PFExprSuffix
s forall a. a -> [a] -> [a]
: ExprSuffixList
ss, PrefixExp -> Stat
f)

    -- Multiple suffixes have been found, and proof has been found that this must be a declaration.
    -- Now to give all the collected suffixes and a function that creates the declaration
    complexDecl :: [PrefixExp] -> [MExpr] -> PFExprSuffix -> ([PFExprSuffix], PrefixExp -> Stat)
    complexDecl :: [PrefixExp]
-> [MExpr] -> PFExprSuffix -> (ExprSuffixList, PrefixExp -> Stat)
complexDecl [PrefixExp]
vars [MExpr]
exprs PFExprSuffix
s = ([PFExprSuffix
s], \PrefixExp
pf -> VarsList -> Stat
Def (forall a b. [a] -> [b] -> [(a, b)]
zip (PrefixExp
pf forall a. a -> [a] -> [a]
: [PrefixExp]
vars) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [MExpr]
exprs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing))


-- | Parse a single statement
parseStat :: AParser Stat
parseStat :: AParser Stat
parseStat = AParser Stat
parseCallDef forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            MToken -> Stat
ALabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
parseLabel forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            Stat
ABreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Break forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            Stat
AContinue forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Continue forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            --AGoto <$ pMTok (Identifier "goto") <*> pName <|>
            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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            AParser Stat
parseIf forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            AParser Stat
parseFor forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            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 (p :: * -> *) b1 b2 a.
IsParser p =>
p b1 -> p b2 -> p a -> p a
pPacked (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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            -- local function and local vars both begin with "local"
            Token -> AParser MToken
pMTok Token
Local forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (
              -- local function
              (\FuncName
n [MToken]
p Block
b MToken
_l -> FuncName -> [MToken] -> Block -> Stat
ALocFunc FuncName
n [MToken]
p Block
b) 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 (p :: * -> *) b1 b2 a.
IsParser p =>
p b1 -> p b2 -> p a -> p a
pPacked (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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
              -- local variables
              (\[PrefixExp]
v (Region
_p, [MExpr]
e) MToken
_l -> VarsList -> Stat
LocDef (forall a b. [a] -> [b] -> [(a, b)]
zip [PrefixExp]
v forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [MExpr]
e forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str MTokenPos [MTokenPos] RegionProgression) [PrefixExp]
parseLocalVarList forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) forall (f :: * -> *) a b. Functor 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 Region
pPos' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser [MExpr]
parseExpressionList forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Region
pPos' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> *) a. Applicative p => a -> p a
pReturn [])
            )


-- | 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 (p :: * -> *) a. IsParser p => p a -> p [a]
pMany (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 (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (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

-- | Parse numeric and generic for loops
parseFor :: AParser Stat
parseFor :: AParser Stat
parseFor = do
  Token -> AParser MToken
pMTok Token
For
  MToken
firstName <- AParser MToken
pName
  -- If you see an =-sign, it's a numeric for loop. It'll be a generic for loop otherwise
  Bool
isNumericLoop <- (forall a b. a -> b -> a
const Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> AParser MToken
pMTok Token
Equals forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> forall a b. a -> b -> a
const Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *) a. Applicative p => a -> p a
pReturn ())
  if Bool
isNumericLoop then do
      MExpr
startExp <- AParser MExpr
parseExpression
      Token -> AParser MToken
pMTok Token
Comma
      MExpr
toExp <- AParser MExpr
parseExpression
      MExpr
step <- Token -> AParser MToken
pMTok Token
Comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser MExpr
parseExpression forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> Region -> Expr -> MExpr
MExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Region
pPos' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> *) a. Applicative p => a -> p a
pReturn (String -> Expr
ANumber String
"1")
      Token -> AParser MToken
pMTok Token
Do
      Block
block <- AParser Block
parseBlock
      Token -> AParser MToken
pMTok Token
End
      forall (p :: * -> *) a. Applicative p => a -> p a
pReturn forall a b. (a -> b) -> a -> b
$ MToken -> MExpr -> MExpr -> MExpr -> Block -> Stat
ANFor MToken
firstName MExpr
startExp MExpr
toExp MExpr
step Block
block
  else do
     [MToken]
vars <- (:) MToken
firstName forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Comma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser [MToken]
parseNameList forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> forall (p :: * -> *) a. Applicative p => a -> p a
pReturn [MToken
firstName]
     Token -> AParser MToken
pMTok Token
In
     [MExpr]
exprs <- AParser [MExpr]
parseExpressionList
     Token -> AParser MToken
pMTok Token
Do
     Block
block <- AParser Block
parseBlock
     Token -> AParser MToken
pMTok Token
End
     forall (p :: * -> *) a. Applicative p => a -> p a
pReturn forall a b. (a -> b) -> a -> b
$ [MToken] -> [MExpr] -> Block -> Stat
AGFor [MToken]
vars [MExpr]
exprs Block
block


-- | Parse a return value
parseReturn :: AParser AReturn
parseReturn :: P (Str MTokenPos [MTokenPos] RegionProgression) AReturn
parseReturn = Region -> [MExpr] -> AReturn
AReturn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Region
pPos' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Return forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
opt AParser [MExpr]
parseExpressionList [] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (p :: * -> *) a. IsParser p => p a -> p [a]
pMany (Token -> AParser MToken
pMTok Token
Semicolon)

-- | Label
parseLabel :: AParser MToken
parseLabel :: AParser MToken
parseLabel = (MToken -> Bool) -> Token -> String -> AParser MToken
pMSatisfy MToken -> Bool
isLabel (String -> Token
Label String
"someLabel") String
"Some label"
    where
        isLabel :: MToken -> Bool
        isLabel :: MToken -> Bool
isLabel (MToken Region
_ (Label String
_)) = Bool
True
        isLabel MToken
_ = Bool
False

-- | 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 (p :: * -> *) a. IsParser p => p a -> p [a]
pMany (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 (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
opt (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 a. Maybe a
Nothing

-- | Local function name. Does not include dot and meta indices, since they're not allowed in meta functions
parseLocFuncName :: AParser FuncName
parseLocFuncName :: AParser FuncName
parseLocFuncName = (\MToken
a -> [MToken] -> Maybe MToken -> FuncName
FuncName [MToken
a] forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName

-- | Parse a number into an expression
parseNumber :: AParser Expr
parseNumber :: AParser Expr
parseNumber = MToken -> Expr
toAnumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MToken -> Bool) -> Token -> String -> AParser MToken
pMSatisfy MToken -> Bool
isNumber (String -> Token
TNumber String
"0") String
"Number"
    where
        isNumber :: MToken -> Bool
        isNumber :: MToken -> Bool
isNumber (MToken Region
_ (TNumber String
_)) = Bool
True
        isNumber MToken
_ = Bool
False

        -- A better solution would be to have a single `MToken -> Maybe Expr` function, but I am too
        -- lazy to write that.
        toAnumber :: MToken -> Expr
        toAnumber :: MToken -> Expr
toAnumber = \case
          (MToken Region
_ (TNumber String
str)) -> String -> Expr
ANumber String
str
          MToken
_ -> forall a. HasCallStack => String -> a
error String
"unreachable"

-- | Parse any kind of string
parseString :: AParser MToken
parseString :: AParser MToken
parseString = (MToken -> Bool) -> Token -> String -> AParser MToken
pMSatisfy MToken -> Bool
isString (String -> Token
DQString String
"someString") String
"String"
    where
        isString :: MToken -> Bool
        isString :: MToken -> Bool
isString (MToken Region
_ (DQString String
_)) = Bool
True
        isString (MToken Region
_ (SQString String
_)) = Bool
True
        isString (MToken Region
_ (MLString String
_)) = Bool
True
        isString MToken
_ = Bool
False

-- | Parse an identifier
pName :: AParser MToken
pName :: AParser MToken
pName = (MToken -> Bool) -> Token -> String -> AParser MToken
pMSatisfy MToken -> Bool
isName (String -> Token
Identifier String
"someVariable") String
"Variable"
    where
        isName :: MToken -> Bool
        isName :: MToken -> Bool
isName (MToken Region
_ (Identifier String
_)) = Bool
True
        isName MToken
_ = Bool
False

-- | Parse variable list (var1, var2, var3)
parseVarList :: AParser [PrefixExp]
parseVarList :: P (Str MTokenPos [MTokenPos] RegionProgression) [PrefixExp]
parseVarList = forall (p :: * -> *) a1 a. IsParser p => p a1 -> p a -> p [a]
pList1Sep (Token -> AParser MToken
pMTok Token
Comma) AParser PrefixExp
parseVar

-- | Parse local variable list (var1, var2, var3), without suffixes
parseLocalVarList :: AParser [PrefixExp]
parseLocalVarList :: P (Str MTokenPos [MTokenPos] RegionProgression) [PrefixExp]
parseLocalVarList = forall (p :: * -> *) a1 a. IsParser p => p a1 -> p a -> p [a]
pList1Sep (Token -> AParser MToken
pMTok Token
Comma) (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 [])

-- | list of expressions
parseExpressionList :: AParser [MExpr]
parseExpressionList :: AParser [MExpr]
parseExpressionList = forall (p :: * -> *) a1 a. IsParser p => p a1 -> p a -> p [a]
pList1Sep (Token -> AParser MToken
pMTok Token
Comma) AParser MExpr
parseExpression

-- | 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                  Expr
AFalse forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TFalse forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                  Expr
ATrue forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TTrue forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                  AParser Expr
parseNumber forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                  MToken -> Expr
AString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
parseString forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                  Expr
AVarArg forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
VarArg forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                  AParser Expr
parseAnonymFunc forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                  PrefixExp -> Expr
APrefixExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser PrefixExp
parsePrefixExp forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                  FieldList -> Expr
ATableConstructor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser FieldList
parseTableConstructor

-- | 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 -> b) -> f a -> f b
<*>
                   forall (p :: * -> *) b1 b2 a.
IsParser p =>
p b1 -> p b2 -> p a -> p a
pPacked (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

-- | 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 (p :: * -> *) c. IsParser p => p (c -> c -> c) -> p c -> p c
pChainl (forall {t :: * -> *} {p :: * -> *} {a}.
(Foldable t, ExtAlternative p) =>
t (p a) -> p a
choice (forall a b. (a -> b) -> [a] -> [b]
map (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f [(Token, BinOp)]
ops)) AParser MExpr
pr
  where
    choice :: t (p a) -> p a
choice = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
(<<|>) forall (p :: * -> *) a. Alternative p => p a
pFail
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f (Token
t, BinOp
at) = (\Region
p MExpr
e1 MExpr
e2 -> Region -> Expr -> MExpr
MExpr Region
p (BinOp -> MExpr -> MExpr -> Expr
BinOpExpr BinOp
at MExpr
e1 MExpr
e2)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Region
pPos' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 (p :: * -> *) c. IsParser p => p (c -> c -> c) -> p c -> p c
pChainr (forall {t :: * -> *} {p :: * -> *} {a}.
(Foldable t, ExtAlternative p) =>
t (p a) -> p a
choice (forall a b. (a -> b) -> [a] -> [b]
map (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f [(Token, BinOp)]
ops)) AParser MExpr
pr
  where
    choice :: t (p a) -> p a
choice = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
(<<|>) forall (p :: * -> *) a. Alternative p => p a
pFail
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f (Token
t, BinOp
at) = (\Region
p MExpr
e1 MExpr
e2 -> Region -> Expr -> MExpr
MExpr Region
p (BinOp -> MExpr -> MExpr -> Expr
BinOpExpr BinOp
at MExpr
e1 MExpr
e2)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Region
pPos' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            UnOp
ANot    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Not   forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            UnOp
ANot    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
CNot  forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            UnOp
AHash   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Hash

-- | 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 forall a b. (a -> b) -> a -> b
$
                  [(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
$
                  Region -> Expr -> MExpr
MExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Region
pPos' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> -- lvl7
                  [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioR [(Token, BinOp)]
lvl8 (Region -> Expr -> MExpr
MExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Region
pPos' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (AParser Expr
parseSubExpression forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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))

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


-- | Prefix expressions
-- can have any arbitrary list of expression suffixes
parsePrefixExp :: AParser PrefixExp
parsePrefixExp :: AParser PrefixExp
parsePrefixExp = AParser ExprSuffixList -> AParser PrefixExp
pPrefixExp (forall (p :: * -> *) a. IsParser p => p a -> p [a]
pMany 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p 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

-- | 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p 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

-- | 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
    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 (p :: * -> *) a. IsParser p => p a -> p [a]
pSome ((\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 (p :: * -> *) a. IsParser p => p a -> p [a]
pSome AParser PFExprSuffix
pPFExprIndexSuffix forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser PFExprSuffix
pPFExprCallSuffix forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p 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
    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 (p :: * -> *) a. IsParser p => p a -> p [a]
pMany ((\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 (p :: * -> *) a. IsParser p => p a -> p [a]
pSome AParser PFExprSuffix
pPFExprCallSuffix forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser PFExprSuffix
pPFExprIndexSuffix forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p 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 = [MExpr] -> 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 (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
opt AParser [MExpr]
parseExpressionList [] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RRound forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            FieldList -> Args
TableArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser FieldList
parseTableConstructor forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
            MToken -> Args
StringArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
parseString

-- | 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

-- | A list of table entries
-- Grammar: field {separator field} [separator]
parseFieldList :: AParser [Field]
parseFieldList :: AParser FieldList
parseFieldList =
    AParser (FieldSep -> Field)
parseField forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**>
      ( AParser FieldSep
parseFieldSep forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**>
          ((\FieldList
rest FieldSep
sep FieldSep -> Field
field -> FieldSep -> Field
field FieldSep
sep forall a. a -> [a] -> [a]
: FieldList
rest) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AParser FieldList
parseFieldList forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure [])) forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (\FieldSep -> Field
field -> [FieldSep -> Field
field FieldSep
NoSep])
      ) forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
    forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Makes an unnamed field out of a list of suffixes, a position and a name.
-- This function gets called when we know a field is unnamed and contains an expression that
-- starts with a PrefixExp
-- See the parseField parser where it is used
makeUnNamedField :: Maybe (BinOp, MExpr) -> ExprSuffixList -> (Region, MToken) -> (FieldSep -> Field)
makeUnNamedField :: Maybe (BinOp, MExpr)
-> ExprSuffixList -> (Region, MToken) -> FieldSep -> Field
makeUnNamedField Maybe (BinOp, MExpr)
Nothing ExprSuffixList
sfs (Region
p, MToken
nm) = MExpr -> FieldSep -> Field
UnnamedField forall a b. (a -> b) -> a -> b
$ Region -> Expr -> MExpr
MExpr Region
p forall a b. (a -> b) -> a -> b
$ PrefixExp -> Expr
APrefixExpr forall a b. (a -> b) -> a -> b
$ MToken -> ExprSuffixList -> PrefixExp
PFVar MToken
nm ExprSuffixList
sfs
makeUnNamedField (Just (BinOp
op, MExpr
mexpr)) ExprSuffixList
sfs (Region
p, MToken
nm) = MExpr -> FieldSep -> Field
UnnamedField forall a b. (a -> b) -> a -> b
$ Region -> Expr -> MExpr
MExpr Region
p forall a b. (a -> b) -> a -> b
$ (Expr -> MExpr -> Expr
merge (PrefixExp -> Expr
APrefixExpr forall a b. (a -> b) -> a -> b
$ MToken -> ExprSuffixList -> PrefixExp
PFVar MToken
nm ExprSuffixList
sfs) MExpr
mexpr)
  where
    -- Merge the first prefixExpr into the expression tree
    merge :: Expr -> MExpr -> Expr
    merge :: Expr -> MExpr -> Expr
merge Expr
pf e :: MExpr
e@(MExpr Region
_ (BinOpExpr BinOp
op' MExpr
l MExpr
r)) =  if BinOp
op forall a. Ord a => a -> a -> Bool
> BinOp
op' then
                                                  BinOp -> MExpr -> MExpr -> Expr
BinOpExpr BinOp
op' (Region -> Expr -> MExpr
MExpr Region
p forall a b. (a -> b) -> a -> b
$ (Expr -> MExpr -> Expr
merge Expr
pf MExpr
l)) MExpr
r
                                                else
                                                  BinOp -> MExpr -> MExpr -> Expr
BinOpExpr BinOp
op (Region -> Expr -> MExpr
MExpr Region
p Expr
pf) MExpr
e
    merge Expr
pf MExpr
e = BinOp -> MExpr -> MExpr -> Expr
BinOpExpr BinOp
op (Region -> Expr -> MExpr
MExpr Region
p Expr
pf) MExpr
e

-- | 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
              ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Region
pPos' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MToken
pName forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**>
                -- Named field has equals sign immediately after the name
                (((\MExpr
e (Region
_, MToken
n) -> MToken -> MExpr -> FieldSep -> Field
NamedField MToken
n MExpr
e) forall (f :: * -> *) a b. Functor 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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>

                -- The lack of equals sign means it's an unnamed field.
                -- The expression of the unnamed field must be starting with a PFVar Prefix expression
                forall (p :: * -> *) a. IsParser p => p a -> p [a]
pMany AParser PFExprSuffix
pPFExprSuffix forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**>
                  ( Maybe (BinOp, MExpr)
-> ExprSuffixList -> (Region, MToken) -> FieldSep -> Field
makeUnNamedField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    (
                      -- There are operators, so the expression goes on beyond the prefixExpression
                      forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser BinOp
parseBinOp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
                      -- There are no operators after the prefix expression
                      forall (p :: * -> *) a. Applicative p => a -> p a
pReturn forall a. Maybe a
Nothing
                    )
                  )
                )
              ) forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
              MExpr -> FieldSep -> Field
UnnamedField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MExpr
parseExpression

-- | Field separator
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 (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|>
    FieldSep
SemicolonSep forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Semicolon