{-# LANGUAGE TupleSections #-}
{-| Parse puppet source code from text. -}
module Puppet.Parser (
  -- * Runner
    runPParser
  -- * Parsers
  , puppetParser
  , expression
) where

import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V
import qualified Data.Maybe.Strict as S
import qualified Data.Foldable as F
import           Data.Tuple.Strict hiding (fst,zip)
import           Text.Regex.PCRE.ByteString.Utils

import           Data.Char
import           Control.Monad
import           Control.Applicative
import           Control.Lens hiding (noneOf)

import           Puppet.Parser.Types
import           Puppet.Utils

import           Data.Scientific

import           Text.Megaparsec hiding (token)
import           Text.Megaparsec.Expr
import           Text.Megaparsec.Text
import qualified Text.Megaparsec.Lexer as L

-- | Run a puppet parser against some 'T.Text' input.
runPParser :: String -> T.Text -> Either ParseError (V.Vector Statement)
runPParser = parse puppetParser

someSpace :: Parser ()
someSpace = L.space (skipSome spaceChar) (L.skipLineComment "#") (L.skipBlockComment "/*" "*/")

token :: Parser a -> Parser a
token = L.lexeme someSpace

integerOrDouble :: Parser (Either Integer Double)
integerOrDouble = fmap Right (try (L.signed someSpace L.float)) <|> fmap Left (hex <|> dec)
    where
        dec = L.signed someSpace L.integer
        hex = try (string "0x") *> L.hexadecimal


symbol :: String -> Parser ()
symbol = void . try . L.symbol someSpace

symbolic :: Char -> Parser ()
symbolic = symbol . pure

braces :: Parser a -> Parser a
braces = between (symbol "{") (symbol "}")

parens :: Parser a -> Parser a
parens = between (symbol "(") (symbol ")")

brackets :: Parser a -> Parser a
brackets = between (symbol "[") (symbol "]")

comma :: Parser ()
comma = symbol ","

sepComma :: Parser a -> Parser [a]
sepComma p = p `sepEndBy` comma

sepComma1 :: Parser a -> Parser [a]
sepComma1 p = p `sepEndBy1` comma

-- | Parse a collection of puppet 'Statement'.
puppetParser :: Parser (V.Vector Statement)
puppetParser = optional someSpace >> statementList

-- | Parse a puppet 'Expression'.
expression :: Parser Expression
expression = condExpression
             <|> makeExprParser (token terminal) expressionTable
             <?> "expression"
    where
        condExpression = do
            selectedExpression <- try $ do
                trm <- token terminal
                lookups <- optional indexLookupChain
                symbolic '?'
                return $ maybe trm ($ trm) lookups
            let cas = do
                c <- (SelectorDefault <$ symbol "default") -- default case
                        <|> fmap SelectorValue (fmap UVariableReference variableReference
                                                 <|> fmap UBoolean puppetBool
                                                 <|> (UUndef <$ symbol "undef")
                                                 <|> literalValue
                                                 <|> fmap UInterpolable interpolableString
                                                 <|> (URegexp <$> termRegexp))
                void $ symbol "=>"
                e <- expression
                return (c :!: e)
            cases <- braces (sepComma1 cas)
            return (ConditionalValue selectedExpression (V.fromList cases))

variable :: Parser Expression
variable = Terminal . UVariableReference <$> variableReference

stringLiteral' :: Parser T.Text
stringLiteral' = char '\'' *> interior <* symbolic '\''
    where
        interior = T.pack . concat <$> many (some (noneOf "'\\") <|> (char '\\' *> fmap escape anyChar))
        escape '\'' = "'"
        escape x = ['\\',x]

identifier :: Parser String
identifier = some (satisfy identifierPart)

identifierPart :: Char -> Bool
identifierPart x = isAsciiLower x || isAsciiUpper x || isDigit x || (x == '_')

identl :: Parser Char -> Parser Char -> Parser T.Text
identl fstl nxtl = do
        f   <- fstl
        nxt <- token $ many nxtl
        return $ T.pack $ f : nxt

operator :: String -> Parser ()
operator = void . try . symbol

reserved :: String -> Parser ()
reserved s = try $ do
    void (string s)
    notFollowedBy (satisfy identifierPart)
    someSpace

variableName :: Parser T.Text
variableName = do
    let acceptablePart = T.pack <$> many (satisfy identifierAcceptable)
        identifierAcceptable x = isAsciiLower x || isAsciiUpper x || isDigit x || (x == '_')
    out <- qualif acceptablePart
    when (out == "string") (fail "The special variable $string should never be used")
    return out

qualif :: Parser T.Text -> Parser T.Text
qualif p = token $ do
    header <- T.pack <$> option "" (try (string "::"))
    ( header <> ) . T.intercalate "::" <$> p `sepBy1` try (string "::")

qualif1 :: Parser T.Text -> Parser T.Text
qualif1 p = try $ do
    r <- qualif p
    unless ("::" `T.isInfixOf` r) (fail "This parser is not qualified")
    return r

className :: Parser T.Text
className = qualif moduleName

-- yay with reserved words
typeName :: Parser T.Text
typeName = className

moduleName :: Parser T.Text
moduleName = genericModuleName False

resourceNameRef :: Parser T.Text
resourceNameRef = qualif (genericModuleName True)

genericModuleName :: Bool -> Parser T.Text
genericModuleName isReference = do
    let acceptable x = isAsciiLower x || isDigit x || (x == '_')
        firstletter = if isReference
                          then fmap toLower (satisfy isAsciiUpper)
                          else satisfy isAsciiLower
    identl firstletter (satisfy acceptable)

parameterName :: Parser T.Text
parameterName = moduleName

variableReference :: Parser T.Text
variableReference = char '$' *> variableName

interpolableString :: Parser (V.Vector Expression)
interpolableString = V.fromList <$> between (char '"') (symbolic '"')
     ( many (interpolableVariableReference <|> doubleQuotedStringContent <|> fmap (Terminal . UString . T.singleton) (char '$')) )
    where
        doubleQuotedStringContent = Terminal . UString . T.pack . concat <$>
            some ((char '\\' *> fmap stringEscape anyChar) <|> some (noneOf "\"\\$"))
        stringEscape :: Char -> String
        stringEscape 'n'  = "\n"
        stringEscape 't'  = "\t"
        stringEscape 'r'  = "\r"
        stringEscape '"'  = "\""
        stringEscape '\\' = "\\"
        stringEscape '$'  = "$"
        stringEscape x    = ['\\',x]
        -- this is specialized because we can't be "tokenized" here
        variableAccept x = isAsciiLower x || isAsciiUpper x || isDigit x || x == '_'
        rvariableName = do
            v <- T.pack . concat <$> some (string "::" <|> some (satisfy variableAccept))
            when (v == "string") (fail "The special variable $string must not be used")
            return v
        rvariable = Terminal . UVariableReference <$> rvariableName
        simpleIndexing = Lookup <$> rvariable <*> between (symbolic '[') (symbolic ']') expression
        interpolableVariableReference = try $ do
            void (char '$')
            lookAhead anyChar >>= \c -> case c of
                 '{' -> between (symbolic '{') (char '}') (   try simpleIndexing
                                                          <|> rvariable
                                                          )
                 -- This is not as robust as the "qualif"
                 -- implementation, but considerably shorter.
                 --
                 -- This needs refactoring.
                 _   -> rvariable

regexp :: Parser T.Text
regexp = do
    void (char '/')
    T.pack . concat <$> many ( do { void (char '\\') ; x <- anyChar; return ['\\', x] } <|> some (noneOf "/\\") )
        <* symbolic '/'

puppetArray :: Parser UValue
puppetArray = fmap (UArray . V.fromList) (brackets (sepComma expression)) <?> "Array"

puppetHash :: Parser UValue
puppetHash = fmap (UHash . V.fromList) (braces (sepComma hashPart)) <?> "Hash"
    where
        hashPart = (:!:) <$> (expression <* operator "=>")
                         <*> expression

puppetBool :: Parser Bool
puppetBool =  (reserved "true" >> return True)
          <|> (reserved "false" >> return False)
          <?> "Boolean"

resourceReferenceRaw :: Parser (T.Text, [Expression])
resourceReferenceRaw = do
    restype  <- resourceNameRef <?> "Resource reference type"
    resnames <- brackets (expression `sepBy1` comma) <?> "Resource reference values"
    return (restype, resnames)

resourceReference :: Parser UValue
resourceReference = do
    (restype, resnames) <- resourceReferenceRaw
    return $ UResourceReference restype $ case resnames of
                 [x] -> x
                 _   -> Terminal $ UArray (V.fromList resnames)

bareword :: Parser T.Text
bareword = identl (satisfy isAsciiLower) (satisfy acceptable) <?> "Bare word"
    where
        acceptable x = isAsciiLower x || isAsciiUpper x || isDigit x || (x == '_') || (x == '-')

-- The first argument defines if non-parenthesized arguments are acceptable
genFunctionCall :: Bool -> Parser (T.Text, V.Vector Expression)
genFunctionCall nonparens = do
    fname <- moduleName <?> "Function name"
    -- this is a hack. Contrary to what the documentation says,
    -- a "bareword" can perfectly be a qualified name :
    -- include foo::bar
    let argsc sep e = (fmap (Terminal . UString) (qualif1 className) <|> e <?> "Function argument A") `sep` comma
        terminalF = terminalG (fail "function hack")
        expressionF = makeExprParser (token terminalF) expressionTable <?> "function expression"
        withparens = parens (argsc sepEndBy expression)
        withoutparens = argsc sepEndBy1 expressionF
    args  <- withparens <|> if nonparens
                                then withoutparens <?> "Function arguments B"
                                else fail "Function arguments C"
    return (fname, V.fromList args)

functionCall :: Parser UValue
functionCall = do
    (fname, args) <- genFunctionCall False
    return $ UFunctionCall fname args

literalValue :: Parser UValue
literalValue = token (fmap UString stringLiteral' <|> fmap UString bareword <|> fmap UNumber numericalvalue <?> "Literal Value")
    where
        numericalvalue = integerOrDouble >>= \i -> case i of
            Left x -> return (fromIntegral x)
            Right y -> return (fromFloatDigits y)

-- this is a hack for functions :(
terminalG :: Parser Expression -> Parser Expression
terminalG g = parens expression
         <|> fmap (Terminal . UInterpolable) interpolableString
         <|> (reserved "undef" *> return (Terminal UUndef))
         <|> fmap (Terminal . URegexp) termRegexp
         <|> variable
         <|> fmap Terminal puppetArray
         <|> fmap Terminal puppetHash
         <|> fmap (Terminal . UBoolean) puppetBool
         <|> fmap Terminal resourceReference
         <|> g
         <|> fmap Terminal literalValue

compileRegexp :: T.Text -> Parser CompRegex
compileRegexp p = case compile' compBlank execBlank (T.encodeUtf8 p) of
    Right r -> return $ CompRegex p r
    Left ms -> fail ("Can't parse regexp /" ++ T.unpack p ++ "/ : " ++ show ms)

termRegexp :: Parser CompRegex
termRegexp = regexp >>= compileRegexp

terminal :: Parser Expression
terminal = terminalG (fmap Terminal (fmap UHFunctionCall (try hfunctionCall) <|> try functionCall))

expressionTable :: [[Operator Parser Expression]]
expressionTable = [ [ Postfix indexLookupChain ] -- http://stackoverflow.com/questions/10475337/parsec-expr-repeated-prefix-postfix-operator-not-supported
                  , [ Prefix ( operator "-"   >> return Negate           ) ]
                  , [ Prefix ( operator "!"   >> return Not              ) ]
                  , [ InfixL  ( operator "."   >> return FunctionApplication ) ]
                  , [ InfixL  ( reserved "in"  >> return Contains         ) ]
                  , [ InfixL  ( operator "/"   >> return Division         )
                    , InfixL  ( operator "*"   >> return Multiplication   )
                    ]
                  , [ InfixL  ( operator "+"   >> return Addition     )
                    , InfixL  ( operator "-"   >> return Substraction )
                    ]
                  , [ InfixL  ( operator "<<"  >> return LeftShift  )
                    , InfixL  ( operator ">>"  >> return RightShift )
                    ]
                  , [ InfixL  ( operator "=="  >> return Equal     )
                    , InfixL  ( operator "!="  >> return Different )
                    ]
                  , [ InfixL  ( operator "=~"  >> return RegexMatch    )
                    , InfixL  ( operator "!~"  >> return NotRegexMatch )
                    ]
                  , [ InfixL  ( operator ">="  >> return MoreEqualThan )
                    , InfixL  ( operator "<="  >> return LessEqualThan )
                    , InfixL  ( operator ">"   >> return MoreThan      )
                    , InfixL  ( operator "<"   >> return LessThan      )
                    ]
                  , [ InfixL  ( reserved "and" >> return And )
                    , InfixL  ( reserved "or"  >> return Or  )
                    ]
                  ]

indexLookupChain :: Parser (Expression -> Expression)
indexLookupChain = chainl1 checkLookup (return (flip (.)))
    where
        checkLookup = flip Lookup <$> between (operator "[") (operator "]") expression

stringExpression :: Parser Expression
stringExpression = fmap (Terminal . UInterpolable) interpolableString <|> (reserved "undef" *> return (Terminal UUndef)) <|> fmap (Terminal . UBoolean) puppetBool <|> variable <|> fmap Terminal literalValue

variableAssignment :: Parser VarAss
variableAssignment = do
    p <- getPosition
    v <- variableReference
    void $ symbolic '='
    e <- expression
    when (T.all isDigit v) (fail "Can't assign fully numeric variables")
    pe <- getPosition
    return (VarAss v e (p :!: pe))

nodeStmt :: Parser [Nd]
nodeStmt = do
    p <- getPosition
    reserved "node"
    let toString (UString s) = s
        toString (UNumber n) = scientific2text n
        toString _ = error "Can't happen at nodeStmt"
        nodename = (reserved "default" >> return NodeDefault) <|> fmap (NodeName . toString) literalValue
    ns <- (fmap NodeMatch termRegexp <|> nodename) `sepBy1` comma
    inheritance <- option S.Nothing (fmap S.Just (reserved "inherits" *> nodename))
    st <- braces statementList
    pe <- getPosition
    return [Nd n st inheritance (p :!: pe) | n <- ns]

puppetClassParameters :: Parser (V.Vector (Pair T.Text (S.Maybe Expression)))
puppetClassParameters = V.fromList <$> parens (sepComma var)
    where
        toStrictMaybe (Just x) = S.Just x
        toStrictMaybe Nothing  = S.Nothing
        var :: Parser (Pair T.Text (S.Maybe Expression))
        var = (:!:)
                <$> variableReference
                <*> (toStrictMaybe <$> optional (symbolic '=' *> expression))

defineStmt :: Parser DefineDec
defineStmt = do
    p <- getPosition
    reserved "define"
    name <- typeName
    -- TODO check native type
    params <- option V.empty puppetClassParameters
    st <- braces statementList
    pe <- getPosition
    return (DefineDec name params st (p :!: pe))

puppetIfStyleCondition :: Parser (Pair Expression (V.Vector Statement))
puppetIfStyleCondition = (:!:) <$> expression <*> braces statementList

unlessCondition :: Parser CondStatement
unlessCondition = do
    p <- getPosition
    reserved "unless"
    (cond :!: stmts) <- puppetIfStyleCondition
    pe <- getPosition
    return (CondStatement (V.singleton (Not cond :!: stmts)) (p :!: pe))

ifCondition :: Parser CondStatement
ifCondition = do
    p <- getPosition
    reserved "if"
    maincond <- puppetIfStyleCondition
    others   <- many (reserved "elsif" *> puppetIfStyleCondition)
    elsecond <- option V.empty (reserved "else" *> braces statementList)
    let ec = if V.null elsecond
                 then []
                 else [Terminal (UBoolean True) :!: elsecond]
    pe <- getPosition
    return (CondStatement (V.fromList (maincond : others ++ ec)) (p :!: pe))

caseCondition :: Parser CondStatement
caseCondition = do
    let puppetRegexpCase = do
            reg <- termRegexp
            void $ symbolic ':'
            stmts <- braces statementList
            return [ (Terminal (URegexp reg), stmts) ]
        defaultCase = do
            try (reserved "default")
            void $ symbolic ':'
            stmts <- braces statementList
            return [ (Terminal (UBoolean True), stmts) ]
        puppetCase = do
            compares <- expression `sepBy1` comma
            void $ symbolic ':'
            stmts <- braces statementList
            return $ map (,stmts) compares
        condsToExpression e (x, stmts) = f x :!: stmts
            where f = case x of
                          (Terminal (UBoolean _))-> id
                          (Terminal (URegexp _)) -> RegexMatch e
                          _                      -> Equal e
    p <- getPosition
    reserved "case"
    expr1 <- expression
    condlist <- braces (some (puppetRegexpCase <|> defaultCase <|> puppetCase))
    pe <- getPosition
    return (CondStatement (V.fromList (map (condsToExpression expr1) (concat condlist))) (p :!: pe) )

data OperatorChain a = OperatorChain a LinkType (OperatorChain a)
                     | EndOfChain a

instance F.Foldable OperatorChain where
    foldMap f (EndOfChain x) = f x
    foldMap f (OperatorChain a _ nx) = f a <> F.foldMap f nx

operatorChainStatement :: OperatorChain a -> a
operatorChainStatement (OperatorChain a _ _) = a
operatorChainStatement (EndOfChain x) = x

zipChain :: OperatorChain a -> [ ( a, a, LinkType ) ]
zipChain (OperatorChain a d nx) = (a, operatorChainStatement nx, d) : zipChain nx
zipChain (EndOfChain _) = []

depOperator :: Parser LinkType
depOperator =   (operator "->" *> pure RBefore)
            <|> (operator "~>" *> pure RNotify)

-- | Used to parse chains of resource relations
parseRelationships :: Parser a -> Parser (OperatorChain a)
parseRelationships p = do
    g <- p
    o <- optional depOperator
    case o of
        Just o' -> OperatorChain g o' <$> parseRelationships p
        Nothing -> pure (EndOfChain g)

resourceGroup :: Parser [ResDec]
resourceGroup = do
    let resourceName = token stringExpression
        resourceDeclaration = do
            p <- getPosition
            names <- brackets (sepComma1 resourceName) <|> fmap return resourceName
            void $ symbolic ':'
            vals  <- fmap V.fromList (sepComma assignment)
            pe <- getPosition
            return [(n, vals, p :!: pe) | n <- names ]
        groupDeclaration = (,) <$> many (char '@') <*> typeName <* symbolic '{'
    (virts, rtype) <- try groupDeclaration -- for matching reasons, this gets a try until the opening brace
    let sep = symbolic ';' <|> comma
    x <- resourceDeclaration `sepEndBy1` sep
    void $ symbolic '}'
    virtuality <- case virts of
                      ""   -> return Normal
                      "@"  -> return Virtual
                      "@@" -> return Exported
                      _    -> fail "Invalid virtuality"
    return [ ResDec rtype rname conts virtuality pos | (rname, conts, pos) <- concat x ]

assignment :: Parser (Pair T.Text Expression)
assignment = (:!:) <$> bw <*> (symbol "=>" *> expression)
    where
        bw = identl (satisfy isAsciiLower) (satisfy acceptable) <?> "Assignment key"
        acceptable x = isAsciiLower x || isAsciiUpper x || isDigit x || (x == '_') || (x == '-')

searchExpression :: Parser SearchExpression
searchExpression = makeExprParser (token searchterm) searchTable
    where
        searchTable :: [[Operator Parser SearchExpression]]
        searchTable = [ [ InfixL ( reserved "and"   >> return AndSearch )
                        , InfixL ( reserved "or"    >> return OrSearch  )
                        ] ]
        searchterm = parens searchExpression <|> check
        check = do
            attrib <- parameterName
            opr    <- (operator "==" *> return EqualitySearch) <|> (operator "!=" *> return NonEqualitySearch)
            term   <- stringExpression
            return (opr attrib term)

resourceCollection :: Position -> T.Text -> Parser RColl
resourceCollection p restype = do
    openchev <- some (char '<')
    when (length openchev > 2) (fail "Too many brackets")
    void $ symbolic '|'
    e <- option AlwaysTrue searchExpression
    void (char '|')
    void (count (length openchev) (char '>'))
    someSpace
    overrides <- option [] $ braces (sepComma assignment)
    let collectortype = if length openchev == 1
                            then Collector
                            else ExportedCollector
    pe <- getPosition
    return (RColl collectortype restype e (V.fromList overrides) (p :!: pe) )

classDefinition :: Parser ClassDecl
classDefinition = do
    p <- getPosition
    reserved "class"
    ClassDecl <$> className
              <*> option V.empty puppetClassParameters
              <*> option S.Nothing (fmap S.Just (reserved "inherits" *> className))
              <*> braces statementList
              <*> ( (p :!:) <$> getPosition )

mainFunctionCall :: Parser MFC
mainFunctionCall = do
    p <- getPosition
    (fname, args) <- genFunctionCall True
    pe <- getPosition
    return (MFC fname args (p :!: pe))

mainHFunctionCall :: Parser SFC
mainHFunctionCall = do
    p <- getPosition
    fc <- try hfunctionCall
    pe <- getPosition
    return (SFC fc (p :!: pe))

dotCall :: Parser SFC
dotCall = do
    p <- getPosition
    ex <- expression
    pe <- getPosition
    hf <- case ex of
              FunctionApplication e (Terminal (UHFunctionCall hf)) -> do
                  unless (S.isNothing (hf ^. hfexpr)) (fail "Can't call a function with . and ()")
                  return (hf & hfexpr .~ S.Just e)
              Terminal (UHFunctionCall hf) -> do
                  when (S.isNothing (hf ^. hfexpr)) (fail "This function needs data to operate on")
                  return hf
              _ -> fail "A method chained by dots."
    unless (hf ^. hftype == HFEach) (fail "Expected 'each', the other types of method calls are not supported by language-puppet at the statement level.")
    return (SFC hf (p :!: pe))

data ChainableStuff = ChainResColl RColl
                    | ChainResDecl ResDec
                    | ChainResRefr T.Text [Expression] PPosition

resourceDefaults :: Parser DefaultDec
resourceDefaults = do
    p <- getPosition
    rnd  <- resourceNameRef
    let assignmentList = V.fromList <$> sepComma1 assignment
    asl <- braces assignmentList
    pe <- getPosition
    return (DefaultDec rnd asl (p :!: pe))

resourceOverride :: Parser [ResOver]
resourceOverride = do
    p <- getPosition
    restype  <- resourceNameRef
    names <- brackets (expression `sepBy1` comma) <?> "Resource reference values"
    assignments <- V.fromList <$> braces (sepComma assignment)
    pe <- getPosition
    return [ ResOver restype n assignments (p :!: pe) | n <- names ]

extractResRef :: ChainableStuff -> [(T.Text, Expression, PPosition)]
extractResRef (ChainResColl _) = []
extractResRef (ChainResDecl (ResDec rt rn _ _ pp)) = [(rt,rn,pp)]
extractResRef (ChainResRefr rt rns pp) = [(rt,rn,pp) | rn <- rns]

extractChainStatement :: ChainableStuff -> [Statement]
extractChainStatement (ChainResColl r) = [ResourceCollection r]
extractChainStatement (ChainResDecl d) = [ResourceDeclaration d]
extractChainStatement ChainResRefr{} = []

chainableStuff :: Parser [Statement]
chainableStuff = do
    let withresname = do
            p <- getPosition
            restype  <- resourceNameRef
            lookAhead anyChar >>= \x -> case x of
                '[' -> do
                    resnames <- brackets (expression `sepBy1` comma)
                    pe <- getPosition
                    pure (ChainResRefr restype resnames (p :!: pe))
                _ -> ChainResColl <$> resourceCollection p restype
    chain <- parseRelationships $ pure <$> try withresname <|> map ChainResDecl <$> resourceGroup
    let relations = do
            (g1, g2, lt) <- zipChain chain
            (rt1, rn1, _   :!: pe1) <- concatMap extractResRef g1
            (rt2, rn2, ps2 :!: _  ) <- concatMap extractResRef g2
            return (Dep (rt1 :!: rn1) (rt2 :!: rn2) lt (pe1 :!: ps2))
    return $ map Dependency relations <> (chain ^.. folded . folded . to extractChainStatement . folded)

statement :: Parser [Statement]
statement =
        (pure . SHFunctionCall <$> try dotCall)
    <|> (pure . VariableAssignment <$> variableAssignment)
    <|> (map Node <$> nodeStmt)
    <|> (pure . DefineDeclaration <$> defineStmt)
    <|> (pure . ConditionalStatement <$> unlessCondition)
    <|> (pure . ConditionalStatement <$> ifCondition)
    <|> (pure . ConditionalStatement <$> caseCondition)
    <|> (pure . DefaultDeclaration <$> try resourceDefaults)
    <|> (map ResourceOverride <$> try resourceOverride)
    <|> chainableStuff
    {-
    <|> resourceGroup
    <|> rrGroup
    -}
    <|> (pure . ClassDeclaration <$> classDefinition)
    <|> (pure . SHFunctionCall <$> mainHFunctionCall)
    <|> (pure . MainFunctionCall <$> mainFunctionCall)
    <?> "Statement"

statementList :: Parser (V.Vector Statement)
statementList = fmap (V.fromList . concat) (many statement)

{-
- Stuff related to the new functions with "lambdas"
-}

parseHFunction :: Parser HigherFuncType
parseHFunction =   (reserved "each"   *> pure HFEach)
               <|> (reserved "map"    *> pure HFMap )
               <|> (reserved "reduce" *> pure HFReduce)
               <|> (reserved "filter" *> pure HFFilter)
               <|> (reserved "slice"  *> pure HFSlice)

parseHParams :: Parser BlockParameters
parseHParams = between (symbolic '|') (symbolic '|') hp
    where
        acceptablePart = T.pack <$> identifier
        hp = do
            vars <- (char '$' *> acceptablePart) `sepBy1` comma
            case vars of
                [a]   -> return (BPSingle a)
                [a,b] -> return (BPPair a b)
                _     -> fail "Invalid number of variables between the pipes"

hfunctionCall :: Parser HFunctionCall
hfunctionCall = do
    let toStrict (Just x) = S.Just x
        toStrict Nothing  = S.Nothing
    HFunctionCall <$> parseHFunction
                  <*> fmap (toStrict . join) (optional (parens (optional expression)))
                  <*> parseHParams
                  <*> (symbolic '{' *> fmap (V.fromList . concat) (many (try statement)))
                  <*> fmap toStrict (optional expression) <* symbolic '}'