content: {-# LANGUAGE TupleSections #-}
  {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
  
  {-# HLINT ignore "Use id" #-}
  {-# HLINT ignore "Use <$>" #-}
  module Puppet.Parser.Internal where
  
  import Control.Monad.Combinators.Expr
  import qualified Data.Char as Char
  import qualified Data.List as List
  import qualified Data.List.NonEmpty as NE
  import qualified Data.Maybe.Strict as S
  import qualified Data.Scientific as Scientific
  import qualified Data.Text as Text
  import qualified Data.Vector as V
  import Puppet.Language
  import Puppet.Parser.Types
  import Text.Megaparsec
  import Text.Megaparsec.Char
  import qualified Text.Megaparsec.Char.Lexer as Lexer
  import qualified Text.Regex.PCRE.ByteString.Utils as Regex
  import XPrelude.Extra hiding (key, many, some, try)
  
  -- | Space consumer
  sc :: Parser ()
  sc = Lexer.space space1 (Lexer.skipLineComment "#") (Lexer.skipBlockComment "/*" "*/")
  
  -- | Lexeme consumes spaces after the input parser
  lexeme :: Parser a -> Parser a
  lexeme = Lexer.lexeme sc
  
  -- | Consumes a text then consumes spaces
  symbol :: Text -> Parser ()
  symbol = void . Lexer.symbol sc
  
  -- | Consumes a character then consumes spaces
  symbolic :: Char -> Parser ()
  symbolic = lexeme . void . single
  
  braces :: Parser a -> Parser a
  braces = between (symbolic '{') (symbolic '}')
  
  parens :: Parser a -> Parser a
  parens = between (symbolic '(') (symbolic ')')
  
  brackets :: Parser a -> Parser a
  brackets = between (symbolic '[') (symbolic ']')
  
  comma :: Parser ()
  comma = symbolic ','
  
  sepComma :: Parser a -> Parser [a]
  sepComma p = p `sepEndBy` comma
  
  sepComma1 :: Parser a -> Parser [a]
  sepComma1 p = p `sepEndBy1` comma
  
  -- | Parses an 'Expression'.
  expression :: Parser Expression
  expression = do
    expr <- makeExprParser (lexeme terminal) expressionTable
    ms <- optional $ do
      symbolic '?'
      let case_expr = do
            c <-
              SelectorDefault <$ symbol "default" -- default case
                <|> SelectorType <$> try datatype
                <|> fmap
                  SelectorValue
                  ( UVariableReference <$> variableReference
                      <|> UBoolean <$> puppetBool
                      <|> UUndef <$ symbol "undef"
                      <|> literalValue
                      <|> UInterpolable <$> interpolableString
                      <|> URegexp <$> termRegexp
                  )
            symbol "=>"
            e <- expression
            pure (c :!: e)
      cases <- braces (sepComma1 case_expr)
      pure (ConditionalValue expr (V.fromList cases))
    case ms of
      Nothing -> pure expr
      Just cv -> pure cv
  
  stringLiteral' :: Parser Text
  stringLiteral' = between (char '\'') (symbolic '\'') interior
    where
      interior = Text.pack . concat <$> many (some (noneOf ['\'', '\\']) <|> (char '\\' *> fmap escape anySingle))
      escape '\'' = "'"
      escape x = ['\\', x]
  
  identifier :: Parser (Tokens Text)
  identifier = takeWhile1P Nothing isIdentifierChar
  
  -- | Only Ascii, hyphens (-) are not allowed.
  isIdentifierChar :: Char -> Bool
  isIdentifierChar x = Char.isAsciiLower x || Char.isAsciiUpper x || Char.isDigit x || (x == '_')
  
  -- | Like 'indentifier' but hyphens (-) are allowed.
  bareword :: Parser Text
  bareword = Text.cons <$> satisfy Char.isAsciiLower <*> takeWhileP Nothing isBarewordChar
    where
      isBarewordChar :: Char -> Bool
      isBarewordChar x = isIdentifierChar x || (x == '-')
  
  reserved :: Text -> Parser ()
  reserved s =
    try $ do
      void (chunk s)
      notFollowedBy (satisfy isIdentifierChar)
      sc
  
  qualif :: Parser Text -> Parser Text
  qualif p = do
    header <- option "" (chunk "::")
    (header <>) . Text.intercalate "::" <$> p `sepBy1` chunk "::"
  
  qualif1 :: Parser Text -> Parser Text
  qualif1 p = do
    r <- qualif p
    unless ("::" `Text.isInfixOf` r) (fail "This parser is not qualified")
    pure r
  
  -- | Consumes a var $foo and then spaces
  variableReference :: Parser Text
  variableReference = do
    v <- char '$' *> lexeme variableName
    when (Text.all Char.isDigit v) (fail "Can't assign fully numeric variables")
    pure v
  
  variableName :: Parser Text
  variableName = qualif identifier
  
  -- yay with reserved words
  typeName :: Parser Text
  typeName = className
  
  className :: Parser Text
  className = lexeme $ qualif $ genericModuleName False
  
  funcName :: Parser Text
  funcName = lexeme $ qualif $ genericModuleName False
  
  moduleName :: Parser Text
  moduleName = lexeme $ genericModuleName False
  
  parameterName :: Parser Text
  parameterName = moduleName
  
  resourceNameRef :: Parser Text
  resourceNameRef = lexeme $ qualif (genericModuleName True)
  
  genericModuleName :: Bool -> Parser Text
  genericModuleName isReference = do
    let acceptable x = Char.isAsciiLower x || Char.isDigit x || (x == '_')
        firstletter =
          if isReference
            then fmap Char.toLower (satisfy Char.isAsciiUpper)
            else satisfy Char.isAsciiLower
    Text.cons <$> firstletter <*> takeWhileP Nothing acceptable
  
  -- | Variable expression
  varExpression :: Parser Expression
  varExpression = Terminal . UVariableReference <$> variableReference
  
  -- | String interpolation
  interpolableString :: Parser (Vector Expression)
  interpolableString =
    V.fromList
      <$> between
        (char '"')
        (symbolic '"')
        (many (interpolableVariableReference <|> doubleQuotedStringContent <|> fmap (Terminal . UString . Text.singleton) (char '$')))
    where
      doubleQuotedStringContent =
        Terminal . UString . Text.pack . concat
          <$> some ((char '\\' *> fmap escaper anySingle) <|> some (noneOf ['"', '\\', '$']))
      escaper :: Char -> String
      escaper 'n' = "\n"
      escaper 't' = "\t"
      escaper 'r' = "\r"
      escaper '"' = "\""
      escaper '\\' = "\\"
      escaper '$' = "$"
      escaper x = ['\\', x]
      -- this is specialized because we can't be "tokenized" here
      varname = Text.concat <$> some (chunk "::" <|> identifier)
      varexpr = Terminal . UVariableReference <$> varname
      indexchain = makeExprParser varexpr [[Postfix indexLookupChain]] -- e.g: os['release']['major']
      interpolableVariableReference = do
        void (char '$')
        let fenced =
              try (indexchain <* char '}')
                <|> try (varexpr <* char '}')
                <|> (expression <* char '}')
        (symbolic '{' *> fenced) <|> try varexpr <|> pure (Terminal (UString (Text.singleton '$')))
  
  integerOrDouble :: Parser (Either Integer Double)
  integerOrDouble = Left <$> hex <|> (either Right Left . Scientific.floatingOrInteger <$> Lexer.scientific)
    where
      hex = chunk "0x" *> Lexer.hexadecimal
  
  puppetArray :: Parser UnresolvedValue
  puppetArray = fmap (UArray . V.fromList) (brackets (sepComma expression)) <?> "Array"
  
  puppetHash :: Parser UnresolvedValue
  puppetHash = fmap (UHash . V.fromList) (braces (sepComma hashPart)) <?> "Hash"
    where
      hashPart = (:!:) <$> (expression <* symbol "=>") <*> expression
  
  puppetBool :: Parser Bool
  puppetBool =
    (reserved "true" >> pure True)
      <|> (reserved "false" >> pure False)
      <?> "Boolean"
  
  resourceReferenceRaw :: Parser (Text, [Expression])
  resourceReferenceRaw = do
    let restype_parser = qualif (genericModuleName True)
        resnames_parser = brackets (expression `sepBy1` comma)
    (,) <$> restype_parser <*> resnames_parser <?> "Resource reference"
  
  resourceReference :: Parser UnresolvedValue
  resourceReference = do
    (restype, resnames) <- resourceReferenceRaw
    pure $ UResourceReference restype $ case resnames of
      [x] -> x
      _ -> Terminal $ UArray (V.fromList resnames)
  
  -- | Functions that have named that are not valid ...
  specialFunctions :: Parser Text
  specialFunctions =
    chunk "Integer"
      <|> chunk "Numeric"
      <|> chunk "Sensitive"
  
  -- The first argument defines if non-parenthesized arguments are acceptable
  genFunctionCall :: Bool -> Parser (Text, Vector Expression)
  genFunctionCall nonparens = do
    fname <- (specialFunctions <|> funcName) <?> "Function name"
    let -- first check if the function arg is not a qualified name (ex.: include foo::bar)
        -- if it is not, then we expect an expression
        qualif_param = Terminal . UString <$> qualif1 moduleName <* notFollowedBy (single '(') -- <* lookAhead (anySingleBut '(')
        func_arg expr = try qualif_param <|> expr <?> "Function argument"
        terminalF = terminalG FunctionWithoutParens
        expressionF = makeExprParser (lexeme terminalF) expressionTable <?> "Function expression"
        withparens = parens (func_arg expression `sepEndBy` comma)
        withoutparens =
          if nonparens
            then func_arg expressionF `sepEndBy1` comma
            else fail "Not an argument list allowed with function without parentheses"
    args <- withparens <|> withoutparens
    pure (fname, V.fromList args)
  
  literalValue :: Parser UnresolvedValue
  literalValue = lexeme (fmap UString stringLiteral' <|> fmap UString bareword <|> fmap UNumber numericalvalue <?> "Literal Value")
    where
      signed :: (Num n) => Parser (n -> n)
      signed = (negate <$ char '-') <|> pure (\x -> x)
      numericalvalue =
        ((,) <$> signed <*> integerOrDouble) >>= \case
          (s, Left x) -> pure (s (fromIntegral x))
          (s, Right y) -> pure (s (Scientific.fromFloatDigits y))
  
  data TerminalMode
    = FunctionWithoutParens
    | StandardMode
  
  -- this is a hack for functions :(
  terminalG :: TerminalMode -> Parser Expression
  terminalG mode =
    parens expression
      <|> fmap (Terminal . UInterpolable) interpolableString
      <|> (Terminal UUndef <$ reserved "undef")
      <|> fmap (Terminal . URegexp) termRegexp
      <|> varExpression
      <|> fmap Terminal puppetArray
      <|> fmap Terminal puppetHash
      <|> fmap (Terminal . UBoolean) puppetBool
      <|> case mode of
        FunctionWithoutParens -> remaining
        StandardMode -> lambda <|> remaining
    where
      lambda = fmap Terminal (fmap UHOLambdaCall (try lambdaCall) <|> try funcCall)
      remaining =
        fmap (Terminal . UDataType) datatype
          <|> fmap Terminal resourceReference
          <|> fmap Terminal literalValue
      funcCall :: Parser UnresolvedValue
      funcCall = uncurry UFunctionCall <$> genFunctionCall False
  
  regexp :: Parser Text
  regexp = do
    void (single '/')
    Text.pack . concat
      <$> many (do { void (char '\\'); x <- anySingle; return ['\\', x] } <|> some (noneOf ['/', '\\']))
      <* symbolic '/'
  
  compileRegexp :: Text -> Parser CompRegex
  compileRegexp p = case Regex.compile' Regex.compBlank Regex.execBlank (encodeUtf8 p) of
    Right r -> pure $ CompRegex p r
    Left ms -> fail ("Can't parse regexp /" <> Text.unpack p <> "/ : " ++ show ms)
  
  termRegexp :: Parser CompRegex
  termRegexp = regexp >>= compileRegexp
  
  terminal :: Parser Expression
  terminal = terminalG StandardMode
  
  expressionTable :: [[Operator Parser Expression]]
  expressionTable =
    [ [Postfix indexLookupChain], -- http://stackoverflow.com/questions/10475337/parsec-expr-repeated-prefix-postfix-operator-not-supported
      [Prefix (symbolic '-' $> Negate)],
      [Prefix (symbolic '!' $> Not)],
      [InfixL (symbolic '.' $> FunctionApplication)],
      [InfixL (reserved "in" $> Contains)],
      [ InfixL (symbolic '/' $> Division),
        InfixL (symbolic '*' $> Multiplication)
      ],
      [ InfixL (symbolic '+' $> Addition),
        InfixL (symbolic '-' $> Substraction)
      ],
      [ InfixL (symbol "<<" $> LeftShift),
        InfixL (symbol ">>" $> RightShift)
      ],
      [ InfixL (symbol "==" $> Equal),
        InfixL (symbol "!=" $> Different)
      ],
      [ InfixL (symbol "=~" $> RegexMatch),
        InfixL (symbol "!~" $> NotRegexMatch)
      ],
      [ InfixL (symbol ">=" $> MoreEqualThan),
        InfixL (symbol "<=" $> LessEqualThan),
        InfixL (symbol ">" $> MoreThan),
        InfixL (symbol "<" $> LessThan)
      ],
      [ InfixL (reserved "and" $> And),
        InfixL (reserved "or" $> Or)
      ]
    ]
  
  -- | Postfix of a chain of lookup indexes such as "['release']['major']"
  indexLookupChain :: Parser (Expression -> Expression)
  indexLookupChain = List.foldr1 (flip (.)) <$> some checkLookup
    where
      checkLookup = flip Lookup <$> brackets expression
  
  stringExpression :: Parser Expression
  stringExpression =
    Terminal . UInterpolable <$> interpolableString
      <|> (reserved "undef" $> Terminal UUndef)
      <|> Terminal . UBoolean <$> puppetBool
      <|> varExpression
      <|> Terminal <$> literalValue
  
  -- | a = b = 0
  chainedVariableReferences :: Parser [Text]
  chainedVariableReferences = do
    h <- variableReference
    t <- many (try next)
    pure (h : t)
    where
      next = symbolic '=' *> variableReference <* lookAhead (single '=' *> space1)
  
  varAssign :: Parser VarAssignDecl
  varAssign = do
    p <- getSourcePos
    mt <- optional datatype
    vs <- chainedVariableReferences
    void $ symbolic '='
    expr <- expression
    pe <- getSourcePos
    pure (VarAssignDecl mt vs expr (p :!: pe))
  
  nodeDecl :: Parser [NodeDecl]
  nodeDecl = do
    p <- getSourcePos
    reserved "node"
    let toString (UString s) = s
        toString (UNumber n) = scientific2text n
        toString _ = panic "Can't happen at nodeDecl"
        nodename = (reserved "default" >> pure 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 <- getSourcePos
    pure [NodeDecl n st inheritance (p :!: pe) | n <- ns]
  
  defineDecl :: Parser DefineDecl
  defineDecl = do
    p <- getSourcePos
    reserved "define"
    name <- typeName
    -- TODO check native type
    params <- option V.empty puppetClassParameters
    st <- braces statementList
    pe <- getSourcePos
    pure (DefineDecl name params st (p :!: pe))
  
  puppetClassParameters :: Parser Parameters
  puppetClassParameters = V.fromList <$> parens (sepComma var)
    where
      toStrictMaybe (Just x) = S.Just x
      toStrictMaybe Nothing = S.Nothing
      var :: Parser (Pair (Pair Text (S.Maybe UDataType)) (S.Maybe Expression))
      var = do
        tp <- toStrictMaybe <$> optional datatype
        n <- variableReference
        df <- toStrictMaybe <$> optional (symbolic '=' *> expression)
        pure ((n :!: tp) :!: df)
  
  puppetIfStyleCondition :: Parser (Pair Expression (Vector Statement))
  puppetIfStyleCondition = (:!:) <$> expression <*> braces statementList
  
  unlessCondition :: Parser ConditionalDecl
  unlessCondition = do
    p <- getSourcePos
    reserved "unless"
    (cond :!: stmts) <- puppetIfStyleCondition
    elsecond <- option V.empty (reserved "else" *> braces statementList)
    let ec = [Terminal (UBoolean True) :!: elsecond | not (V.null elsecond)]
    pe <- getSourcePos
    pure (ConditionalDecl (V.fromList ((Not cond :!: stmts) : ec)) (p :!: pe))
  
  ifCondition :: Parser ConditionalDecl
  ifCondition = do
    p <- getSourcePos
    reserved "if"
    maincond <- puppetIfStyleCondition
    others <- many (reserved "elsif" *> puppetIfStyleCondition)
    elsecond <- option V.empty (reserved "else" *> braces statementList)
    let ec = [Terminal (UBoolean True) :!: elsecond | not (V.null elsecond)]
    pe <- getSourcePos
    pure (ConditionalDecl (V.fromList (maincond : others ++ ec)) (p :!: pe))
  
  caseCondition :: Parser ConditionalDecl
  caseCondition = do
    let puppetRegexpCase = Terminal . URegexp <$> termRegexp
        defaultCase = Terminal (UBoolean True) <$ reserved "default"
        matchesToExpression e (x, stmts) = f x :!: stmts
          where
            f = case x of
              (Terminal (UBoolean _)) -> identity
              (Terminal (URegexp _)) -> RegexMatch e
              _ -> Equal e
        cases = do
          matches <- (puppetRegexpCase <|> defaultCase <|> expression) `sepBy1` comma
          void $ symbolic ':'
          stmts <- braces statementList
          pure $ map (,stmts) matches
    p <- getSourcePos
    reserved "case"
    expr1 <- expression
    condlist <- concat <$> braces (some cases)
    pe <- getSourcePos
    pure (ConditionalDecl (V.fromList (map (matchesToExpression expr1) condlist)) (p :!: pe))
  
  data OperatorChain a
    = OperatorChain a LinkType (OperatorChain a)
    | EndOfChain a
  
  instance Foldable OperatorChain where
    foldMap f (EndOfChain x) = f x
    foldMap f (OperatorChain a _ nx) = f a <> 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 =
    (RBefore <$ symbol "->")
      <|> (RNotify <$ symbol "~>")
  
  assignment :: Parser AttributeDecl
  assignment =
    (AttributeDecl <$> lexeme key <*> arrowOp <*> expression)
      <|> (AttributeWildcard <$> (symbolic '*' *> symbol "=>" *> expression))
    where
      key = bareword <?> "Assignment key"
      arrowOp =
        (AssignArrow <$ symbol "=>")
          <|> (AppendArrow <$ symbol "+>")
  
  -- | Resource Collector
  resCollDecl :: Position -> Text -> Parser ResCollDecl
  resCollDecl 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 '>'))
    sc
    overrides <- option [] $ braces (sepComma assignment)
    let collectortype =
          if length openchev == 1
            then Collector
            else ExportedCollector
    pe <- getSourcePos
    pure (ResCollDecl collectortype restype e (V.fromList overrides) (p :!: pe))
    where
      searchExpression :: Parser SearchExpression
      searchExpression =
        let searchTable :: [[Operator Parser SearchExpression]]
            searchTable =
              [ [ InfixL (reserved "and" $> AndSearch),
                  InfixL (reserved "or" $> OrSearch)
                ]
              ]
            searchterm = parens searchExpression <|> check
            check = do
              attrib <- parameterName
              opr <-
                (EqualitySearch <$ symbol "==")
                  <|> (NonEqualitySearch <$ symbol "!=")
              term <- stringExpression
              pure (opr attrib term)
         in makeExprParser (lexeme searchterm) searchTable
  
  classDecl :: Parser ClassDecl
  classDecl = do
    p <- getSourcePos
    reserved "class"
    ClassDecl
      <$> className
      <*> option V.empty puppetClassParameters
      <*> option S.Nothing (fmap S.Just (reserved "inherits" *> className))
      <*> braces statementList
      <*> ((p :!:) <$> getSourcePos)
  
  mainFuncDecl :: Parser MainFuncDecl
  mainFuncDecl = do
    p <- getSourcePos
    (fname, args) <- genFunctionCall True
    pe <- getSourcePos
    pure (MainFuncDecl fname args (p :!: pe))
  
  hoLambdaDecl :: Parser HigherOrderLambdaDecl
  hoLambdaDecl = do
    p <- getSourcePos
    fc <- lambdaCall
    pe <- getSourcePos
    pure (HigherOrderLambdaDecl fc (p :!: pe))
  
  dotLambdaDecl :: Parser HigherOrderLambdaDecl
  dotLambdaDecl = do
    p <- getSourcePos
    ex <- expression
    pe <- getSourcePos
    hf <- case ex of
      FunctionApplication e (Terminal (UHOLambdaCall hf)) -> do
        unless (null (hf ^. hoLambdaExpr)) (fail "Can't call a function with . and ()")
        pure (hf & hoLambdaExpr .~ V.singleton e)
      Terminal (UHOLambdaCall hf) -> do
        when (null (hf ^. hoLambdaExpr)) (fail "This function needs data to operate on")
        pure hf
      _ -> fail "A method chained by dots."
    pure (HigherOrderLambdaDecl hf (p :!: pe))
  
  resDefaultDecl :: Parser ResDefaultDecl
  resDefaultDecl = do
    p <- getSourcePos
    rnd <- resourceNameRef
    let assignmentList = V.fromList <$> sepComma1 assignment
    asl <- braces assignmentList
    pe <- getSourcePos
    pure (ResDefaultDecl rnd asl (p :!: pe))
  
  resOverrideDecl :: Parser [ResOverrideDecl]
  resOverrideDecl = do
    p <- getSourcePos
    restype <- resourceNameRef
    names <- brackets (expression `sepBy1` comma) <?> "Resource reference values"
    assignments <- V.fromList <$> braces (sepComma assignment)
    pe <- getSourcePos
    pure [ResOverrideDecl restype n assignments (p :!: pe) | n <- names]
  
  arrayof :: Parser p -> Parser [p]
  arrayof p = symbolic '[' *> sepBy p comma <* symbolic ']'
  
  -- | Heterogeneous chain (interleaving resource declarations with
  -- resource references) needs to be supported:
  --
  --    class { 'docker::service': } ->
  --    Class['docker']
  chainableResources :: Parser [Statement]
  chainableResources = do
    let withresname = do
          p <- getSourcePos
          restype <- resourceNameRef
          lookAhead anySingle >>= \case
            '[' -> do
              resnames <- brackets (expression `sepBy1` comma)
              pe <- getSourcePos
              pure (ChainResRefr restype resnames (p :!: pe))
            _ -> ChainResColl <$> resCollDecl p restype
    let oneresource = pure <$> try withresname <|> map ChainResDecl <$> resDeclGroup
    chain <- parseRelationships (oneresource <|> concat <$> arrayof oneresource)
    let relations = do
          (g1, g2, lt) <- zipChain chain
          (rt1, rn1, _ :!: pe1) <- concatMap extractResRef g1
          (rt2, rn2, ps2 :!: _) <- concatMap extractResRef g2
          pure (DepDecl (rt1 :!: rn1) (rt2 :!: rn2) lt (pe1 :!: ps2))
    pure $ map DependencyDeclaration relations <> (chain ^.. folded . folded . to extractChainStatement . folded)
    where
      extractResRef :: ChainableRes -> [(Text, Expression, PPosition)]
      extractResRef (ChainResColl _) = []
      extractResRef (ChainResDecl (ResDecl rt rn _ _ pp)) = [(rt, rn, pp)]
      extractResRef (ChainResRefr rt rns pp) = [(rt, rn, pp) | rn <- rns]
  
      extractChainStatement :: ChainableRes -> [Statement]
      extractChainStatement (ChainResColl r) = [ResourceCollectionDeclaration r]
      extractChainStatement (ChainResDecl d) = [ResourceDeclaration d]
      extractChainStatement ChainResRefr {} = []
  
      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)
  
      resDeclGroup :: Parser [ResDecl]
      resDeclGroup = do
        let resourceName = expression
            resourceDeclaration = do
              p <- getSourcePos
              names <- brackets (sepComma1 resourceName) <|> fmap pure resourceName
              void $ symbolic ':'
              vals <- fmap V.fromList (sepComma assignment)
              pe <- getSourcePos
              pure [(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
          "" -> pure Normal
          "@" -> pure Virtual
          "@@" -> pure Exported
          _ -> fail "Invalid virtuality"
        return [ResDecl rtype rname conts virtuality pos | (rname, conts, pos) <- concat x]
  
  statement :: Parser [Statement]
  statement =
    (pure . HigherOrderLambdaDeclaration <$> try dotLambdaDecl)
      <|> (pure . VarAssignmentDeclaration <$> varAssign)
      <|> (map NodeDeclaration <$> nodeDecl)
      <|> (pure . DefineDeclaration <$> defineDecl)
      <|> (pure . ConditionalDeclaration <$> unlessCondition)
      <|> (pure . ConditionalDeclaration <$> ifCondition)
      <|> (pure . ConditionalDeclaration <$> caseCondition)
      <|> (pure . ResourceDefaultDeclaration <$> try resDefaultDecl)
      <|> (map ResourceOverrideDeclaration <$> try resOverrideDecl)
      <|> chainableResources
      <|> (pure . ClassDeclaration <$> classDecl)
      <|> (pure . HigherOrderLambdaDeclaration <$> try hoLambdaDecl)
      <|> (pure . MainFunctionDeclaration <$> mainFuncDecl)
      <?> "Statement"
  
  datatype :: Parser UDataType
  datatype =
    dtString
      <|> dtInteger
      <|> dtFloat
      <|> dtNumeric
      <|> (UDTBoolean <$ reserved "Boolean")
      <|> (UDTScalar <$ reserved "Scalar")
      <|> (UDTData <$ reserved "Data")
      <|> (UDTAny <$ reserved "Any")
      <|> (UDTCollection <$ reserved "Collection")
      <|> dtArray
      <|> dtHash
      <|> (UDTUndef <$ reserved "Undef")
      <|> (reserved "Optional" *> (UDTOptional <$> brackets datatype))
      <|> (UNotUndef <$ reserved "NotUndef")
      <|> (reserved "Variant" *> (UDTVariant . NE.fromList <$> brackets (datatype `sepBy1` symbolic ',')))
      <|> (reserved "Regexp" *> (UDTRegexp <$> optional (brackets termRegexp)))
      <|> (UDTDeferred <$ reserved "Deferred")
      <|> (reserved "Sensitive" *> (UDTSensitive <$> brackets datatype))
      -- while all the other cases are straightforward, it seems that the
      -- following syntax is a valid regexp for puppet:
      --   '^dqsqsdqs$'
      -- instead of:
      --   /^dqsqsdqs$/
      --
      -- That is the reason there is a "quotedRegexp" case
      <|> (reserved "Pattern" *> (UDTPattern . NE.fromList <$> brackets ((termRegexp <|> quotedRegexp) `sepBy1` symbolic ',')))
      <|> (reserved "Enum" *> (UDTEnum . NE.fromList <$> brackets (expression `sepBy1` symbolic ',')))
      <|> dtExternal
      <?> "UDataType"
    where
      quotedRegexp = stringLiteral' >>= compileRegexp
      integer = integerOrDouble >>= either (return . fromIntegral) (\d -> fail ("Integer value expected, instead of " ++ show d))
      float = either fromIntegral identity <$> integerOrDouble
      dtArgs str def parseArgs = do
        void $ reserved str
        fromMaybe def <$> optional (brackets parseArgs)
      dtbounded s constructor parser = dtArgs s (constructor Nothing Nothing) $ do
        lst <- parser `sepBy1` symbolic ','
        case lst of
          [minlen] -> return $ constructor (Just minlen) Nothing
          [minlen, maxlen] -> return $ constructor (Just minlen) (Just maxlen)
          _ -> fail ("Too many arguments to datatype " ++ Text.unpack s)
      dtString = dtbounded "String" UDTString integer
      dtInteger = dtbounded "Integer" UDTInteger integer
      dtFloat = dtbounded "Float" UDTFloat float
      dtNumeric = dtbounded "Numeric" (\ma mb -> UDTVariant (UDTFloat ma mb :| [UDTInteger (truncate <$> ma) (truncate <$> mb)])) float
      dtArray = do
        reserved "Array"
        ml <- optional $ brackets $ do
          tp <- datatype
          rst <- optional (symbolic ',' *> integer `sepBy1` symbolic ',')
          return (tp, rst)
        case ml of
          Nothing -> return (UDTArray UDTData 0 Nothing)
          Just (t, Nothing) -> return (UDTArray t 0 Nothing)
          Just (t, Just [mi]) -> return (UDTArray t mi Nothing)
          Just (t, Just [mi, mx]) -> return (UDTArray t mi (Just mx))
          Just (_, Just _) -> fail "Too many arguments to datatype Array"
      dtHash = do
        reserved "Hash"
        ml <- optional $ brackets $ do
          tk <- datatype
          symbolic ','
          tv <- datatype
          rst <- optional (symbolic ',' *> integer `sepBy1` symbolic ',')
          return (tk, tv, rst)
        case ml of
          Nothing -> return (UDTHash UDTScalar UDTData 0 Nothing)
          Just (tk, tv, Nothing) -> return (UDTHash tk tv 0 Nothing)
          Just (tk, tv, Just [mi]) -> return (UDTHash tk tv mi Nothing)
          Just (tk, tv, Just [mi, mx]) -> return (UDTHash tk tv mi (Just mx))
          Just (_, _, Just _) -> fail "Too many arguments to datatype Hash"
      dtExternal =
        choice
          [ reserved "Stdlib::Absolutepath" $> UDTData,
            reserved "Stdlib::Base32" $> UDTData,
            reserved "Stdlib::Base64" $> UDTData,
            reserved "Stdlib::Compat::Absolute_path" $> UDTData,
            reserved "Stdlib::Compat::Array" $> UDTData,
            reserved "Stdlib::Compat::Bool" $> UDTData,
            reserved "Stdlib::Compat::Float" $> UDTData,
            reserved "Stdlib::Compat::Hash" $> UDTData,
            reserved "Stdlib::Compat::Integer" $> UDTData,
            reserved "Stdlib::Compat::Ip_address" $> UDTData,
            reserved "Stdlib::Compat::Ipv4" $> UDTData,
            reserved "Stdlib::Compat::Ipv6" $> UDTData,
            reserved "Stdlib::Compat::Numeric" $> UDTData,
            reserved "Stdlib::Compat::String" $> UDTData,
            reserved "Stdlib::Ensure::Service" $> UDTData,
            reserved "Stdlib::Filemode" $> UDTData,
            reserved "Stdlib::Filesource" $> UDTData,
            reserved "Stdlib::Fqdn" $> UDTData,
            reserved "Stdlib::Host" $> UDTData,
            reserved "Stdlib::HTTPSUrl" $> UDTData,
            reserved "Stdlib::HTTPUrl" $> UDTData,
            reserved "Stdlib::IP::Address::Nosubnet" $> UDTData,
            reserved "Stdlib::Ip_address" $> UDTData,
            reserved "Stdlib::IP::Address" $> UDTData,
            reserved "Stdlib::IP::Address::V4::CIDR" $> UDTData,
            reserved "Stdlib::IP::Address::V4::Nosubnet" $> UDTData,
            reserved "Stdlib::IP::Address::V4" $> UDTData,
            reserved "Stdlib::IP::Address::V6::Alternative" $> UDTData,
            reserved "Stdlib::IP::Address::V6::Compressed" $> UDTData,
            reserved "Stdlib::IP::Address::V6::Full" $> UDTData,
            reserved "Stdlib::IP::Address::V6::Nosubnet::Alternative" $> UDTData,
            reserved "Stdlib::IP::Address::V6::Nosubnet::Compressed" $> UDTData,
            reserved "Stdlib::IP::Address::V6::Nosubnet::Full" $> UDTData,
            reserved "Stdlib::IP::Address::V6::Nosubnet" $> UDTData,
            reserved "Stdlib::IP::Address::V6" $> UDTData,
            reserved "Stdlib::Ipv4" $> UDTData,
            reserved "Stdlib::Ipv6" $> UDTData,
            reserved "Stdlib::MAC" $> UDTData,
            reserved "Stdlib::Port::Privileged" $> UDTData,
            reserved "Stdlib::Port" $> UDTData,
            reserved "Stdlib::Port::Unprivileged" $> UDTData,
            reserved "Stdlib::Unixpath" $> UDTData,
            reserved "Stdlib::Windowspath" $> UDTData,
            reserved "Nginx::ErrorLogSeverity" $> UDTData,
            reserved "Jenkins::Tunnel" $> UDTData,
            reserved "Systemd::Unit" $> UDTData,
            reserved "Systemd::ServiceLimits" $> UDTData,
            reserved "Systemd::Dropin" $> UDTData,
            reserved "Systemd::JournaldSettings" $> UDTData,
            reserved "Systemd::JournaldSettings::Ensure" $> UDTData,
            reserved "Systemd::LogindSettings" $> UDTData,
            reserved "Systemd::LogindSettings::Ensure" $> UDTData,
            reserved "Systemd::CoredumpSettings" $> UDTData
          ]
  
  statementList :: Parser (Vector Statement)
  statementList = V.fromList . concat <$> many statement
  
  lambdaCall :: Parser HOLambdaCall
  lambdaCall = do
    let tostrict (Just x) = S.Just x
        tostrict Nothing = S.Nothing
    HOLambdaCall
      <$> lambFunc
      <*> parameters
      <*> lambParams
      <*> (symbolic '{' *> fmap (V.fromList . concat) (many (try statement)))
      <*> fmap tostrict (optional expression)
      <* symbolic '}'
    where
      parameters :: Parser (V.Vector Expression)
      parameters = maybe V.empty V.fromList <$> optional (parens (expression `sepBy` comma))
      lambFunc :: Parser LambdaFunc
      lambFunc = LambdaFunc <$> moduleName
      lambParams :: Parser LambdaParameters
      lambParams = between (symbolic '|') (symbolic '|') hp
        where
          lambdaParameter :: Parser LambdaParameter
          lambdaParameter = LambdaParam <$> optional datatype <*> lexeme (char '$' *> identifier)
          hp = V.fromList <$> lambdaParameter `sepBy1` comma
  