content: {-# LANGUAGE DataKinds #-}
  module Parse.Pattern (term, expr) where
  
  import Parse.ParsecAdapter ((<|>), (<?>), char, choice, optionMaybe, try)
  
  import AST.V0_16
  import AST.Structure
  import qualified Data.Indexed as I
  import ElmVersion
  import Parse.Helpers
  import qualified Parse.Literal as Literal
  import Reporting.Annotation (Located)
  import qualified Reporting.Annotation as A
  import Parse.IParser
  import Parse.Whitespace
  import qualified Parse.ParsecAdapter as Parsec
  
  
  basic :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
  basic elmVersion =
    fmap I.Fix $ addLocation $
      choice
        [ char '_' >> return Anything
        , VarPattern <$> lowVar elmVersion
        , chunksToPattern <$> dotSep1 (capVar elmVersion)
        , LiteralPattern <$> Literal.literal
        ]
    where
      chunksToPattern chunks =
          case reverse chunks of
            [UppercaseIdentifier "True"] ->
                LiteralPattern (Boolean True)
  
            [UppercaseIdentifier "False"] ->
                LiteralPattern (Boolean False)
  
            (last:rest) ->
                DataPattern (reverse rest, last) []
  
            [] -> error "dotSep1 returned empty list"
  
  
  asPattern :: ElmVersion -> IParser (FixAST Located typeRef ctorRef varRef 'PatternNK) -> IParser (FixAST Located typeRef ctorRef varRef 'PatternNK)
  asPattern elmVersion patternParser =
    do  (start, pattern, _) <- located patternParser
  
        maybeAlias <- optionMaybe asAlias
  
        case maybeAlias of
          Just (postPattern, alias) ->
              do  end <- Parsec.getPosition
                  return $ I.Fix $ A.at start end $ Alias (C postPattern pattern) alias
  
          Nothing ->
              return pattern
    where
      asAlias =
        do  preAs <- try (whitespace <* reserved elmVersion "as")
            postAs <- whitespace
            var <- lowVar elmVersion
            return (preAs, C postAs var)
  
  
  record :: ElmVersion -> IParser (FixAST Located typeRef ctorRef varRef 'PatternNK)
  record elmVersion =
    fmap I.Fix $ addLocation $
    do
        result <- surround'' '{' '}' (lowVar elmVersion)
        return $
            case result of
                Left comments ->
                    EmptyRecordPattern comments
                Right fields ->
                    RecordPattern fields
  
  
  tuple :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
  tuple elmVersion =
    do  (start, patterns, end) <- located $ parens'' (expr elmVersion)
  
        return $
          case patterns of
            Left comments ->
              I.Fix $ A.at start end $ UnitPattern comments
  
            Right [] ->
              I.Fix $ A.at start end $ UnitPattern []
  
            Right [C ([], []) pattern] ->
              pattern
  
            Right [pattern] ->
              I.Fix $ A.at start end $ PatternParens pattern
  
            Right patterns ->
              I.Fix $ A.at start end $ TuplePattern patterns
  
  
  list :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
  list elmVersion =
    fmap I.Fix $ addLocation $
    do
      result <- braces'' (expr elmVersion)
      return $
        case result of
          Left comments ->
            EmptyListPattern comments
          Right patterns ->
            ListPattern patterns
  
  
  term :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
  term elmVersion =
    choice [ record elmVersion, tuple elmVersion, list elmVersion, basic elmVersion ]
      <?> "a pattern"
  
  
  patternConstructor :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
  patternConstructor elmVersion =
    fmap I.Fix $ addLocation $
      do  v <- dotSep1 (capVar elmVersion)
          case reverse v of
            [UppercaseIdentifier "True"]  -> return $ LiteralPattern (Boolean True)
            [UppercaseIdentifier "False"] -> return $ LiteralPattern (Boolean False)
            (last:rest) -> DataPattern (reverse rest, last) <$> spacePrefix (term elmVersion)
            [] -> error "dotSep1 returned empty list"
  
  
  expr :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
  expr elmVersion =
      asPattern elmVersion subPattern <?> "a pattern"
    where
      subPattern =
        do
          result <- separated cons (patternConstructor elmVersion <|> term elmVersion)
          return $
            case result of
              Left pattern ->
                pattern
              Right (region, first, rest, _) ->
                I.Fix $ A.At region $ ConsPattern first rest
  