packages feed

queryparser-presto (empty) → 0.1.0.0

raw patch · 8 files changed

+2866/−0 lines, 8 filesdep +QuickCheckdep +aesondep +base

Dependencies added: QuickCheck, aeson, base, bytestring, containers, fixed-list, hashable, mtl, parsec, predicate-class, pretty, queryparser, regex-tdfa, semigroups, text, unordered-containers, yaml

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Uber Technologies, Inc.++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ queryparser-presto.cabal view
@@ -0,0 +1,103 @@+name:                queryparser-presto++-- The package version.  See the Haskell package versioning policy (PVP)+-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            Parsing for Presto SQL queries++-- A longer description of the package.+description:+            A library for parsing Presto SQL queries into analyzable ASTs.+            .+            This library is to be used with the queryparser library, which+            provides the common type definitions and analyses across the+            different SQL dialects.++-- The license under which the package is released.+license:             MIT++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Heli Wang, David Thomas, Matt Halverson++-- An email address to which users can send suggestions, bug reports, and+-- patches.+maintainer:          heli@uber.com++-- A copyright notice.+-- copyright:++category:            Database++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a+-- README.+-- extra-source-files:++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10++flag development {+    description: Enable development level of strictness+    default: False+    manual: True+}++library+  -- Modules exported by the library.+  exposed-modules:     Database.Sql.Presto.Parser+                     , Database.Sql.Presto.Parser.Token+                     , Database.Sql.Presto.Scanner+                     , Database.Sql.Presto.Token+                     , Database.Sql.Presto.Type+                     , Database.Sql.Presto.Parser.Internal++  -- Modules included in this library but not exported.+  -- other-modules:     ++  default-extensions:  OverloadedStrings+                     , LambdaCase+                     , RecordWildCards+                     , TupleSections+                     , ConstraintKinds+                     , FlexibleInstances++  -- Other library packages from which modules are imported.+  build-depends:       base >=4.8 && <4.9+                     , text >=1.2 && <1.3+                     , bytestring+                     , queryparser+                     , containers+                     , semigroups >= 0.16+                     , mtl >= 2.2 && < 2.3+                     , parsec >= 3.1 && < 3.2+                     , pretty >= 1.1 && < 1.2+                     , aeson >= 0.8+                     , yaml >= 0.8 && < 0.9+                     , unordered-containers+                     , hashable+                     , QuickCheck+                     , regex-tdfa+                     , fixed-list+                     , predicate-class++  -- Directories containing source files.+  hs-source-dirs:      src+++  ghc-options:         -Wall++  if flag(development)+    ghc-options:       -Werror++  -- Base language which the package is written in.+  default-language:    Haskell2010
+ src/Database/Sql/Presto/Parser.hs view
@@ -0,0 +1,1553 @@+-- Copyright (c) 2017 Uber Technologies, Inc.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+-- THE SOFTWARE.++{-# LANGUAGE TypeFamilies #-}++module Database.Sql.Presto.Parser where++import Database.Sql.Type+import Database.Sql.Position+import Database.Sql.Helpers+import Database.Sql.Info+import Database.Sql.Presto.Type+import Database.Sql.Presto.Scanner+import Database.Sql.Presto.Parser.Internal++import qualified Database.Sql.Presto.Parser.Token as Tok++import qualified Text.Parsec as P+import           Text.Parsec ( chainl1, choice, many+                             , option, optional, optionMaybe+                             , sepBy, sepBy1, try, (<|>), (<?>))++import           Data.Char (isDigit)+import           Data.Foldable (fold)+import qualified Data.List as L+import           Data.List.NonEmpty (NonEmpty ((:|)))+import           Data.Maybe (catMaybes)+import           Data.Monoid (Endo (..))+import           Data.Semigroup (Semigroup (..), sconcat)+import           Data.Set (Set)+import qualified Data.Set as S+import           Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++import Control.Arrow (first)+import Control.Monad (when)+import Control.Monad.Reader (runReader, local, asks)+++statementParser :: Parser (PrestoStatement RawNames Range)+statementParser = do+    maybeStmt <- optionMaybe $ choice+        [ try $ PrestoStandardSqlStatement <$> statementP+        , PrestoUnhandledStatement <$> explainP+        , PrestoUnhandledStatement <$> showP+        , PrestoUnhandledStatement <$> callP+        , PrestoUnhandledStatement <$> describeP+        ]+    case maybeStmt of+        Just stmt -> terminator >> return stmt+        Nothing -> PrestoStandardSqlStatement <$> emptyStatementP+  where+    terminator = (Tok.semicolonP <|> eof) -- normal statements may be terminated by `;` or eof+    emptyStatementP = EmptyStmt <$> Tok.semicolonP  -- but we don't allow eof here. `;` is the+    -- only way to write the empty statement, i.e. `` (empty string) is not allowed.++emptyParserScope :: ParserScope+emptyParserScope = ParserScope+    { selectTableAliases = Nothing }++-- | parse consumes a statement, or fails+parse :: Text -> Either P.ParseError (PrestoStatement RawNames Range)+parse text = runReader (P.runParserT statementParser 0 "-"  . tokenize $ text) emptyParserScope++-- | parseAll consumes all input as a single statement, or fails+parseAll :: Text -> Either P.ParseError (PrestoStatement RawNames Range)+parseAll text = runReader (P.runParserT (statementParser <* P.eof) 0 "-"  . tokenize $ text) emptyParserScope++-- | parseMany consumes multiple statements, or fails+parseMany :: Text -> Either P.ParseError [PrestoStatement RawNames Range]+parseMany text = runReader (P.runParserT (P.many1 statementParser) 0 "-"  . tokenize $ text) emptyParserScope++-- | parseManyAll consumes all input multiple statements, or fails+parseManyAll :: Text -> Either P.ParseError [PrestoStatement RawNames Range]+parseManyAll text = runReader (P.runParserT (P.many1 statementParser <* P.eof) 0 "-"  . tokenize $ text) emptyParserScope++-- | parseManyEithers consumes all input as multiple (statements or failures)+-- it should never fail+parseManyEithers :: Text -> Either P.ParseError [Either (Unparsed Range) (PrestoStatement RawNames Range)]+parseManyEithers text = runReader (P.runParserT parser 0 "-"  . tokenize $ text) emptyParserScope+  where+    parser = do+        statements <- P.many1 $ P.setState 0 >> choice+            [ try $ Right <$> statementParser+            , try $ Left <$> do+                ss  <- many Tok.notSemicolonP+                e <- Tok.semicolonP+                pure $ case ss of+                    [] -> Unparsed e+                    s:_ -> Unparsed (s <> e)+            ]++        locs <- many Tok.notSemicolonP+        P.eof+        pure $ case locs of+            [] -> statements+            s:es -> statements ++ [Left $ Unparsed $ sconcat (s:|es)]+++statementP :: Parser (Statement Presto RawNames Range)+statementP = choice+    [ QueryStmt <$> queryP+    , DeleteStmt <$> deleteP+    , do+          _ <- try $ P.lookAhead dropViewPrefixP+          DropViewStmt <$> dropViewP+    , DropTableStmt <$> dropTableP+    , GrantStmt <$> grantP+    , RevokeStmt <$> revokeP+    , InsertStmt <$> insertP+    ]++queryP :: Parser (Query RawNames Range)+queryP = do+    with <- option id withP+    queryNoWith <- queryNoWithP+    return $ with queryNoWith+  where+    withP :: Parser (Query RawNames Range -> Query RawNames Range)+    withP = do+        r <- Tok.withP+        withs <- cteP `sepBy1` Tok.commaP++        return $ \ query ->+            let r' = sconcat $ r :| getInfo query : map cteInfo withs+             in QueryWith r' withs query++    cteP :: Parser (CTE RawNames Range)+    cteP = do+        alias <- tableAliasP+        columns <- option [] $ P.between Tok.openP Tok.closeP $ columnAliasP `sepBy1` Tok.commaP+        _ <- Tok.asP+        _ <- Tok.openP+        query <- queryP+        r' <- Tok.closeP++        return $ CTE (getInfo alias <> r') alias columns query++queryNoWithP :: Parser (Query RawNames Range)+queryNoWithP = do+    queryTerm <- queryTermP+    order <- option id (orderWrapperP queryTerm)+    limit <- option id limitP+    return $ limit $ order queryTerm+  where+    queryTermP = (queryPrimaryP `chainl1` (exceptP <|> unionP))+                `chainl1` intersectP++    queryPrimaryP = choice+        [ querySelectP+        -- TODO table+        -- TODO values+        , P.between Tok.openP Tok.closeP queryNoWithP+        ]++    exceptP = do+        r <- Tok.exceptP+        optional Tok.distinctP+        return $ QueryExcept r Unused++    unionP = do+        r <- Tok.unionP+        distinct <- option (Distinct True) distinctP+        return $ QueryUnion r distinct Unused++    intersectP = do+        r <- Tok.intersectP+        optional Tok.distinctP+        return $ QueryIntersect r Unused+++    orderWrapperP query = do+        let aliases = aliasesForOrders query+        (r, orders) <- local (introduceAliases aliases) orderTopLevelP+        return $ \ query' -> QueryOrder (getInfo query' <> r) orders query'++    aliasesForOrders query = case query of+        QuerySelect _ s -> tableAliases $ selectFrom s+        _ -> S.empty++    limitP = do+        r <- Tok.limitP+        choice+            [ do+                  (NumericConstant r' num) <- numberConstantP+                  let limit = Limit (r <> r') num+                  return $ \ query -> QueryLimit (getInfo query <> r') limit query++            , Tok.allP >> return id+            ]++querySelectP :: Parser (Query RawNames Range)+querySelectP = do+    select <- selectP+    return $ QuerySelect (selectInfo select) select++selectP :: Parser (Select RawNames Range)+selectP = do+    r <- Tok.selectP++    selectDistinct <- option notDistinct distinctP++    aliases <- try selectScopeLookAhead++    selectCols <- do+        selections <- local (introduceAliases aliases) $ selectionP `countingSepBy1` Tok.commaP+        let r' = foldl1 (<>) $ map getInfo selections+        return $ SelectColumns r' selections++    selectFrom <- optionMaybe fromP+    selectWhere <- optionMaybe $ local (introduceAliases aliases) whereP+    let selectTimeseries = Nothing+    selectGroup <- optionMaybe $ local (introduceAliases aliases) groupP+    selectHaving <- optionMaybe $ local (introduceAliases aliases) havingP+    let selectNamedWindow = Nothing+        Just selectInfo = sconcat $ Just r :|+            [ Just $ getInfo selectCols+            , getInfo <$> selectFrom+            , getInfo <$> selectWhere+            , getInfo <$> selectGroup+            , getInfo <$> selectHaving+            ]++    pure Select{..}++  where+    selectScopeLookAhead :: Parser (Set Text)+    selectScopeLookAhead = P.lookAhead $ do+        _ <- selectionP (-1) `sepBy1` Tok.commaP+        from <- optionMaybe fromP+        return $ tableAliases from+++distinctP :: Parser Distinct+distinctP = choice $+    [ Tok.allP >> return (Distinct False)+    , Tok.distinctP >> return (Distinct True)+    ]+++tableAliases :: Maybe (SelectFrom RawNames Range) -> Set Text+tableAliases from =+    let tablishes = case from of+            Just (SelectFrom _ ts) -> ts+            Nothing -> []+      in L.foldl' S.union S.empty $ map tablishToTableAlias tablishes+  where+    tablishToTableAlias :: Tablish RawNames Range -> Set Text+    tablishToTableAlias (TablishTable _ aliases tableName) = case aliases of+        TablishAliasesNone -> tableNameToTableAlias tableName+        TablishAliasesT (TableAlias _ name _) -> S.singleton name+        TablishAliasesTC (TableAlias _ name _) _ -> S.singleton name+    tablishToTableAlias (TablishSubQuery _ aliases _) = case aliases of+        TablishAliasesNone -> S.empty+        TablishAliasesT (TableAlias _ name _) -> S.singleton name+        TablishAliasesTC (TableAlias _ name _) _ -> S.singleton name+    tablishToTableAlias (TablishLateralView _ LateralView{..} _) = case lateralViewAliases of+        TablishAliasesNone -> S.empty+        TablishAliasesT (TableAlias _ name _) -> S.singleton name+        TablishAliasesTC (TableAlias _ name _) _ -> S.singleton name+    tablishToTableAlias (TablishJoin _ (JoinSemi _) _ _ _) =+        error "this shouldn't happen: no SEMI JOIN in Presto"+    tablishToTableAlias (TablishJoin _ _ _ lTablish rTablish) =+        tablishToTableAlias lTablish `S.union` tablishToTableAlias rTablish++tableNameToTableAlias :: OQTableName Range -> Set Text+tableNameToTableAlias (QTableName _ Nothing tname) = S.singleton tname+tableNameToTableAlias (QTableName _ (Just (QSchemaName _ _ _ SessionSchema)) _) =+    error "this shouldn't happen: no SessionSchema in Presto"+tableNameToTableAlias (QTableName _ (Just (QSchemaName _ Nothing sname _)) tname) =+    S.fromList [ tname+               , sname <> "." <> tname+               ]+tableNameToTableAlias (QTableName _ (Just (QSchemaName _ (Just (DatabaseName _ dname)) sname _)) tname) =+    S.fromList [ tname+               , sname <> "." <> tname+               , dname <> "." <> sname <> "." <> tname+               ]++introduceAliases :: Set Text -> ParserScope -> ParserScope+introduceAliases aliases = \ scope ->+    let unioned = case selectTableAliases scope of+            Nothing -> aliases+            Just existing -> S.union existing aliases+    in scope { selectTableAliases = Just unioned }+++fromP :: Parser (SelectFrom RawNames Range)+fromP = do+    r <- Tok.fromP+    relations <- relationP `sepBy1` Tok.commaP++    let r' = foldl (<>) r $ fmap getInfo relations+    return $ SelectFrom r' relations++relationP :: Parser (Tablish RawNames Range)+relationP = do+    table <- sampledRelationP+    joins <- fmap (appEndo . fold . reverse) $ many $ Endo <$> joinP+    return $ joins table++sampledRelationP :: Parser (Tablish RawNames Range)+sampledRelationP = do+    table <- aliasedRelationP+    _ <- optional tableSampleP+    return table+  where+    tableSampleP :: Parser Range+    tableSampleP = do+        s <- Tok.tableSampleP+        _ <- sampleTypeP+        _ <- Tok.openP+        _ <- numberExprP -- T655130+        e <- Tok.closeP+        return $ s <> e++    sampleTypeP :: Parser Range+    sampleTypeP = choice [ Tok.bernoulliP, Tok.systemP, Tok.poissonizedP ]++    aliasedRelationP :: Parser (Tablish RawNames Range)+    aliasedRelationP = do+        let placeholder = error "placeholder aliases never got replaced!"+        t <- choice $+            [ do+                  name <- tableNameP+                  return $ TablishTable (getInfo name) placeholder name++            , do+                  r1 <- Tok.unnestP+                  _ <- Tok.openP+                  let lateralViewOuter = Nothing -- not an option in Presto+                  args <- exprP `sepBy1` Tok.commaP+                  r2 <- Tok.closeP+                  let lateralViewExprs = [FunctionExpr (r1 <> r2) (QFunctionName r1 Nothing "unnest") notDistinct args [] Nothing Nothing]+                  (lateralViewWithOrdinality, r3) <- option (False, r2) $ do+                      _ <- Tok.withP+                      (True, ) <$> Tok.ordinalityP++                  let lateralViewInfo = r1 <> r3+                      lateralViewAliases = placeholder+                  return $ TablishLateralView lateralViewInfo LateralView{..} Nothing++            , P.between Tok.openP Tok.closeP $ choice+                [ relationP+                , do+                      q <- queryP+                      return $ TablishSubQuery (getInfo q) placeholder q+                ]+            ]+        as <- tablishAliasesP+        let withAliases = case t of+                TablishTable info _ tableRef -> TablishTable info as tableRef+                TablishSubQuery info _ query -> TablishSubQuery info as query+                TablishJoin _ _ _ _ _ -> error "shouldn't happen"+                TablishLateralView info LateralView{..} lhs -> TablishLateralView info LateralView{lateralViewAliases = as, ..} lhs+        return withAliases++    tablishAliasesP :: Parser (TablishAliases Range)+    tablishAliasesP = do+        option TablishAliasesNone $ try $ do+            -- the try is because TABLESAMPLE may either be a table alias OR+            -- the start of a tablesample clause+            _ <- optional Tok.asP+            tAlias@(TableAlias _ name _) <- tableAliasP+            when (TL.toLower name == "tablesample") $ P.lookAhead $ P.notFollowedBy sampleTypeP++            option (TablishAliasesT tAlias) $ do+                cAliases <- P.between Tok.openP Tok.closeP $ columnAliasP `sepBy1` Tok.commaP+                return $ TablishAliasesTC tAlias cAliases+++tableAliasP :: Parser (TableAlias Range)+tableAliasP = do+    (name, r) <- Tok.tableNameP+    makeTableAlias r name++columnAliasP :: Parser (ColumnAlias Range)+columnAliasP = do+    (name, r) <- Tok.columnNameP+    makeColumnAlias r name++joinP :: Parser (Tablish RawNames Range -> Tablish RawNames Range)+joinP = crossJoinP <|> regularJoinP <|> naturalJoinP+  where+    crossJoinP :: Parser (Tablish RawNames Range -> Tablish RawNames Range)+    crossJoinP = do+        r <- Tok.crossP+        r'<- Tok.joinP+        rhs <- sampledRelationP+        let info = r <> r'+            joinType = JoinInner info+            condition = JoinOn $ ConstantExpr info $ BooleanConstant info True+        return $ \ lhs ->+            TablishJoin (getInfo lhs <> getInfo rhs) joinType condition lhs rhs++    regularJoinP :: Parser (Tablish RawNames Range -> Tablish RawNames Range)+    regularJoinP = do+        joinType <- joinTypeP+        rhs <- relationP+        condition <- choice+            [ do+                _ <- Tok.onP <?> "condition in join clause"+                JoinOn <$> exprP+            , do+                s <- Tok.usingP <?> "using in join clause"+                _ <- Tok.openP+                names <- flip sepBy1 Tok.commaP $ do+                    (name, r) <- Tok.columnNameP+                    pure $ QColumnName r None name+                e <- Tok.closeP+                return $ JoinUsing (s <> e) names+            ]+        return $ \ lhs ->+            TablishJoin (getInfo rhs <> getInfo lhs) joinType condition lhs rhs++    naturalJoinP :: Parser (Tablish RawNames Range -> Tablish RawNames Range)+    naturalJoinP = do+        r <- Tok.naturalP+        joinType <- joinTypeP+        rhs <- sampledRelationP+        let condition = JoinNatural r Unused+        return $ \ lhs ->+            TablishJoin (getInfo rhs <> getInfo lhs) joinType condition lhs rhs++    joinTypeP :: Parser (JoinType Range)+    joinTypeP = do+        maybeJoinType <- optionMaybe $ innerJoinTypeP <|> outerJoinTypeP+        Tok.joinP >>= \ r -> return $ case maybeJoinType of+            Nothing -> JoinInner r+            Just joinType -> (<> r) <$> joinType++    innerJoinTypeP :: Parser (JoinType Range)+    innerJoinTypeP = JoinInner <$> Tok.innerP++    outerJoinTypeP :: Parser (JoinType Range)+    outerJoinTypeP = do+        joinType <- choice+            [ JoinLeft <$> Tok.leftP+            , JoinRight <$> Tok.rightP+            , JoinFull <$> Tok.fullP+            ]+        optional Tok.outerP+        return joinType++databaseNameP :: Parser (DatabaseName Range)+databaseNameP = do+    (db, r) <- Tok.databaseNameP+    return $ DatabaseName r db++unqualifiedSchemaNameP :: Parser (UQSchemaName Range)+unqualifiedSchemaNameP = uncurry mkNormalSchema <$> Tok.schemaNameP++-- schemaNameP is greedy: it will consume the largest chunk of text that looks+-- like a schema name.+schemaNameP :: Parser (SchemaName RawNames Range)+schemaNameP = choice+    [ try qualifiedSchemaNameP+    , do+        uqsn <- unqualifiedSchemaNameP+        pure uqsn { schemaNameDatabase = Nothing }+    ]+  where+    qualifiedSchemaNameP :: Parser (SchemaName RawNames Range)+    qualifiedSchemaNameP = do+        db <- databaseNameP+        _ <- Tok.dotP+        s <- unqualifiedSchemaNameP+        return s { schemaNameDatabase = Just db }++unqualifiedTableNameP :: Parser (UQTableName Range)+unqualifiedTableNameP = do+    (t, r) <- Tok.tableNameP+    return $ QTableName r None t++-- tableNameP is also greedy+tableNameP :: Parser (TableRef RawNames Range)+tableNameP = choice+    [ try qualifiedTableNameP+    , do+        uqtn <- unqualifiedTableNameP+        pure uqtn { tableNameSchema = Nothing }+    ]+  where+    qualifiedTableNameP :: Parser (TableRef RawNames Range)+    qualifiedTableNameP = choice+        [ try $ do+              d <- databaseNameP+              _ <- Tok.dotP+              s <- unqualifiedSchemaNameP+              _ <- Tok.dotP+              t <- unqualifiedTableNameP+              return t { tableNameSchema = Just s { schemaNameDatabase = Just d } }+        , do+              s <- unqualifiedSchemaNameP+              _ <- Tok.dotP+              t <- unqualifiedTableNameP+              return $ t { tableNameSchema = Just s { schemaNameDatabase = Nothing } }+        ]++unqualifiedColumnNameP :: Parser (UQColumnName Range)+unqualifiedColumnNameP = do+    (c, r) <- Tok.columnNameP+    return $ QColumnName r None c++-- | parsing of qualified columnNames respects the following rules:+--+-- 1) you need to know what tablishes are in scope when parsing a column ref+-- 2) column refs may only be as qualified as the table that introduced them+-- 3) column refs are greedy w.r.t. dots (if a qualified table name and a CTE+--    have the same prefix, a qualified column ref prefers the table)+--+-- If a scope is present (i.e. while parsing selections), the table name must be+-- a member of the tableAlias list for the parser to succeed. Otherwise,+-- the column parser fails and execution tries the next parser choice.+--+-- Should the scope not be set, e.g. when selectP is performing lookahead+-- to build scope, this check is skipped.+columnNameP :: Parser (ColumnRef RawNames Range)+columnNameP = choice+    [ try qualifiedColumnNameP+    , do+        uqcn <- unqualifiedColumnNameP+        pure uqcn { columnNameTable = Nothing }+    ]+  where+    qualifiedColumnNameP :: Parser (ColumnRef RawNames Range)+    qualifiedColumnNameP = choice+        [ try $ do+              d@(DatabaseName _ dName) <- databaseNameP+              _ <- Tok.dotP+              s@(QSchemaName _ _ sName _) <- unqualifiedSchemaNameP+              _ <- Tok.dotP+              t@(QTableName _ _ tName) <- unqualifiedTableNameP++              checkTableNameInScopeP $ dName <> "." <> sName <> "." <> tName++              _ <- Tok.dotP+              c <- unqualifiedColumnNameP+              return c { columnNameTable = Just t { tableNameSchema = Just s { schemaNameDatabase = Just d } } }++        , try $ do+              s@(QSchemaName _ _ sName _) <- unqualifiedSchemaNameP+              _ <- Tok.dotP+              t@(QTableName _ _ tName) <- unqualifiedTableNameP++              checkTableNameInScopeP $ sName <> "." <> tName++              _ <- Tok.dotP+              c <- unqualifiedColumnNameP+              return c { columnNameTable = Just t { tableNameSchema = Just s { schemaNameDatabase = Nothing } } }++        , do+              t@(QTableName _ _ tName) <- unqualifiedTableNameP++              checkTableNameInScopeP tName++              _ <- Tok.dotP+              c <- unqualifiedColumnNameP+              return c { columnNameTable = Just t { tableNameSchema = Nothing } }+        ]++    checkTableNameInScopeP :: Text -> Parser ()+    checkTableNameInScopeP name = do+        maybeScope <- asks selectTableAliases+        case maybeScope of+            Just scope ->+                case L.find (==name) scope of+                    Just _  -> return ()+                    Nothing -> fail $ "Table " ++ (show name) +++                        " doesn't exist in table scope " ++ show maybeScope+            Nothing -> return ()+++-- functionNameP is also greedy+functionNameP :: Parser (FunctionName Range)+functionNameP = choice+    [ try $ do+          d <- databaseNameP+          _ <- Tok.dotP+          s <- unqualifiedSchemaNameP+          _ <- Tok.dotP+          (f, r) <- Tok.functionNameP+          return $ QFunctionName (getInfo d <> r) (Just s { schemaNameDatabase = Just d }) f+    , try $ do+          s <- unqualifiedSchemaNameP+          _ <- Tok.dotP+          (f, r) <- Tok.functionNameP+          return $ QFunctionName (getInfo s <> r) (Just s { schemaNameDatabase = Nothing }) f+    , do+          (f, r) <- Tok.functionNameP+          return $ QFunctionName r Nothing f+    ]++-- selectStarP is also greedy+selectStarP :: Parser (Selection RawNames Range)+selectStarP = choice+    [ do+        r <- Tok.starP+        return $ SelectStar r Nothing Unused++    , try $ do+        t <- unqualifiedTableNameP+        _ <- Tok.dotP+        r' <- Tok.starP+        return $ SelectStar (getInfo t <> r') (Just t { tableNameSchema = Nothing }) Unused++    , try $ do+        s <- unqualifiedSchemaNameP+        _ <- Tok.dotP+        t <- unqualifiedTableNameP+        _ <- Tok.dotP+        r'' <- Tok.starP+        return $ SelectStar (getInfo s <> r'') (Just t { tableNameSchema = Just s { schemaNameDatabase = Nothing }}) Unused++    , try $ do+        d <- databaseNameP+        _ <- Tok.dotP+        s <- unqualifiedSchemaNameP+        _ <- Tok.dotP+        t <- unqualifiedTableNameP+        _ <- Tok.dotP+        r'' <- Tok.starP+        return $ SelectStar (getInfo d <> r'') (Just t { tableNameSchema = Just s { schemaNameDatabase = Just d }}) Unused+    ]+++selectionP :: Integer -> Parser (Selection RawNames Range)+selectionP idx = try selectStarP <|> do+    expr <- exprP+    alias <- aliasP expr idx+    return $ SelectExpr (getInfo alias <> getInfo expr) [alias] expr+  where+    aliasP :: Expr RawNames Range -> Integer -> Parser (ColumnAlias Range)+    aliasP expr idx' = choice+        [ do+            optional Tok.asP+            (name, r) <- Tok.columnNameP+            makeColumnAlias r name++        , makeExprAlias expr idx'+        ]++countingSepBy1 :: (Integer -> Parser b) -> Parser c -> Parser [b]+countingSepBy1 f sep = do+    x <- f 0+    xs <- rest 1+    pure (x:xs)+  where+    rest n = choice+        [ do+            _ <- sep+            x <- f n+            xs <- rest (n + 1)+            pure (x:xs)+        , pure []+        ]++makeTableAlias :: Range -> Text -> Parser (TableAlias Range)+makeTableAlias r alias = TableAlias r alias . TableAliasId <$> getNextCounter++makeColumnAlias :: Range -> Text -> Parser (ColumnAlias Range)+makeColumnAlias r alias = ColumnAlias r alias . ColumnAliasId <$> getNextCounter++makeDummyAlias :: Range -> Integer -> Parser (ColumnAlias Range)+makeDummyAlias r idx = makeColumnAlias r $ TL.pack $ "_col" ++ show idx++makeExprAlias :: Expr RawNames Range -> Integer -> Parser (ColumnAlias Range)+makeExprAlias (BinOpExpr info _ _ _) idx = makeDummyAlias info idx+makeExprAlias (UnOpExpr info _ _) idx = makeDummyAlias info idx+makeExprAlias (LikeExpr info _ _ _ _) idx = makeDummyAlias info idx+makeExprAlias (CaseExpr info _ _) idx = makeDummyAlias info idx+makeExprAlias (ColumnExpr info (QColumnName _ _ name)) _ = makeColumnAlias info name+makeExprAlias (ConstantExpr info _) idx = makeDummyAlias info idx+makeExprAlias (InListExpr info _ _) idx = makeDummyAlias info idx+makeExprAlias (InSubqueryExpr info _ _) idx = makeDummyAlias info idx+makeExprAlias (BetweenExpr info _ _ _) idx = makeDummyAlias info idx+makeExprAlias (OverlapsExpr _ _ _) _ = fail "Unsupported overlaps expr in Presto: unused expr-type in this dialect"+makeExprAlias (AtTimeZoneExpr info _ _) idx = makeDummyAlias info idx+makeExprAlias (FunctionExpr info _ _ _ _ _ _) idx = makeDummyAlias info idx+makeExprAlias (SubqueryExpr info _) idx = makeDummyAlias info idx+makeExprAlias (ArrayExpr info _) idx = makeDummyAlias info idx+makeExprAlias (ExistsExpr info _) idx = makeDummyAlias info idx+makeExprAlias (FieldAccessExpr info _ _) idx = makeDummyAlias info idx+makeExprAlias (ArrayAccessExpr info _ _) idx = makeDummyAlias info idx+makeExprAlias (TypeCastExpr _ _ expr _) idx = makeExprAlias expr idx+makeExprAlias (VariableSubstitutionExpr _) _ = fail "Unsupported variable substitution in Presto: unused expr-type in this dialect"+++unOpP :: Text -> Parser (Expr RawNames Range -> Expr RawNames Range)+unOpP op = do+    r <- Tok.symbolP op+    return $ \ expr -> UnOpExpr (r <> getInfo expr) (Operator op) expr++binOpP :: Text -> Parser (Expr RawNames Range -> Expr RawNames Range -> Expr RawNames Range)+binOpP op = do+    r <- Tok.symbolP op+    let r' lhs rhs = sconcat $ r :| map getInfo [lhs, rhs]+    return $ \ lhs rhs -> BinOpExpr (r' lhs rhs) (Operator op) lhs rhs+++exprP :: Parser (Expr RawNames Range)+exprP = orExprP++orExprP :: Parser (Expr RawNames Range)+orExprP = andExprP `chainl1` (Tok.orP >>= \ r -> return (BinOpExpr r "OR"))++andExprP :: Parser (Expr RawNames Range)+andExprP = notExprP `chainl1`+    (Tok.andP >>= \ r -> return $ BinOpExpr r "AND")++notP :: Parser (Expr RawNames Range -> Expr RawNames Range)+notP = (\ r -> UnOpExpr r "NOT") <$> Tok.notP++notExprP :: Parser (Expr RawNames Range)+notExprP = do+    nots <- appEndo . fold . reverse . map Endo <$> many notP+    expr <- predicatedExprP+    return $ nots expr+++predicatedExprP :: Parser (Expr RawNames Range)+predicatedExprP = do+    value <- valueExprP+    predicate <- option id predicateP+    return $ predicate value++valueExprP :: Parser (Expr RawNames Range)+valueExprP = concatExprP++concatExprP :: Parser (Expr RawNames Range)+concatExprP = sumExprP `chainl1` binOpP "||"++sumExprP :: Parser (Expr RawNames Range)+sumExprP = productExprP `chainl1` opP+  where+    opP = choice $ map binOpP ["+", "-"]++productExprP :: Parser (Expr RawNames Range)+productExprP = negateExprP `chainl1` opP+  where+    opP = choice $ map binOpP ["*", "/", "%"]++negateExprP :: Parser (Expr RawNames Range)+negateExprP = do+    neg <- option id $ choice $ map unOpP ["+", "-"]+    expr <- atTimeZoneExprP+    return $ neg expr++intervalP :: Parser (Expr RawNames Range)+intervalP = do+    r <- Tok.intervalP+    sign <- option [] $ pure <$> signP+    str <- stringConstantP+    from <- intervalFieldP+    maybeTo <- optionMaybe $ Tok.toP >> intervalFieldP++    let (info, attrs) =+            case maybeTo of+                Nothing -> (r <> getInfo from, sign ++ [from])+                Just to -> (r <> getInfo to, sign ++ [from, to])++    return $ TypeCastExpr info CastFailureError str $ PrimitiveDataType info "interval" attrs+  where+    signP :: Parser (DataTypeParam Range)+    signP = do+        (sign, r) <- choice [ ("+",) <$> Tok.symbolP "+"+                            , ("-",) <$> Tok.symbolP "-"+                            ]+        pure $ DataTypeParamConstant $ StringConstant r sign++    intervalFieldP :: Parser (DataTypeParam Range)+    intervalFieldP = do+        (field, r) <- Tok.intervalFieldP+        pure $ DataTypeParamConstant $ StringConstant r $ TL.encodeUtf8 field++atTimeZoneExprP :: Parser (Expr RawNames Range)+atTimeZoneExprP = foldl (flip ($)) <$> primaryExprP <*> many atTimeZoneP+  where+    atTimeZoneP :: Parser (Expr RawNames Range -> Expr RawNames Range)+    atTimeZoneP = do+        _ <- Tok.atP+        _ <- Tok.timezoneP+        tz <- choice [stringConstantP, intervalP]++        return $ \ expr ->+            AtTimeZoneExpr (getInfo expr <> getInfo tz) expr tz++stringConstantP :: Parser (Expr RawNames Range)+stringConstantP = do+    (str, r) <- Tok.stringP+    return $ ConstantExpr r (StringConstant r str)+++primaryExprP :: Parser (Expr RawNames Range)+primaryExprP = foldl (flip ($)) <$> baseP <*> many (arrayAccessP <|> structAccessP)+  where+    baseP = choice+        [ extractPrimaryExprP+        , normalizePrimaryExprP+        , try substringPrimaryExprP -- try is because `substring` is both a special-form function and a regular function+        , try positionPrimaryExprP -- try is because `position` could be a column name / UDF function name+        , bareFuncPrimaryExprP+        , arrayPrimaryExprP+        , castPrimaryExprP+        , casePrimaryExprP+        , existsPrimaryExprP+        , try subqueryPrimaryExprP -- try is for the parens (for implicitRow)+        , implicitRowPrimaryExprP+        , try rowPrimaryExprP -- try is for the identifier+        , try functionCallPrimaryExprP -- try is for the identifier (for columnRef)+        , parameterPrimaryExprP+        , binaryLiteralPrimaryExprP+        , intervalP+        , try $ constantPrimaryExprP+        , columnRefPrimaryExprP+        ]++extractPrimaryExprP :: Parser (Expr RawNames Range)+extractPrimaryExprP = do+    -- https://prestodb.io/docs/current/functions/datetime.html+    r <- Tok.extractP+    _ <- Tok.openP+    unit <- unitP+    _ <- Tok.fromP+    expr <- valueExprP+    r' <- Tok.closeP+    return $ FunctionExpr (r <> r') (QFunctionName r Nothing "extract") notDistinct [unit, expr] [] Nothing Nothing+  where+    unitP = do+        (unit, r) <- Tok.extractUnitP+        return $ ConstantExpr r $ StringConstant r $ TL.encodeUtf8 unit++normalizePrimaryExprP :: Parser (Expr RawNames Range)+normalizePrimaryExprP = do+    -- https://prestodb.io/docs/current/functions/string.html+    r <- Tok.normalizeP+    _ <- Tok.openP+    strExpr <- valueExprP+    (form, formR) <- option ("nfc", getInfo strExpr) $ Tok.commaP >> Tok.normalFormP+    r' <- Tok.closeP++    let formExpr = ConstantExpr formR $ StringConstant formR $ TL.encodeUtf8 form+    return $ FunctionExpr (r <> r') (QFunctionName r Nothing "normalize") notDistinct [strExpr, formExpr] [] Nothing Nothing++substringPrimaryExprP :: Parser (Expr RawNames Range)+substringPrimaryExprP = do+    r <- Tok.substringP+    _ <- Tok.openP+    str <- valueExprP+    _ <- Tok.fromP+    start <- valueExprP+    maybeLen <- optionMaybe $ Tok.forP >> valueExprP+    r' <- Tok.closeP++    let args = catMaybes [Just str, Just start, maybeLen]+    return $ FunctionExpr (r <> r') (QFunctionName r Nothing "substring") notDistinct args [] Nothing Nothing++bareFuncPrimaryExprP :: Parser (Expr RawNames Range)+bareFuncPrimaryExprP = do+    (func, r, alwaysBare) <- Tok.possiblyBareFuncP+    let name = QFunctionName r Nothing func+    (args, r') <- if alwaysBare+                  then pure ([], r)+                  else option ([], r) precisionP+    return $ FunctionExpr (r <> r') name notDistinct args [] Nothing Nothing++  where+    precisionP = do+        s <- Tok.openP+        numExpr <- numberExprP+        e <- Tok.closeP+        return ([numExpr], s <> e)++arrayPrimaryExprP :: Parser (Expr RawNames Range)+arrayPrimaryExprP = do+    r <- Tok.arrayP+    _ <- Tok.openBracketP+    exprs <- exprP `sepBy1` Tok.commaP+    r' <- Tok.closeBracketP+    return $ ArrayExpr (r <> r') exprs++dataTypeP :: Parser (DataType Range)+dataTypeP = foldl (flip ($)) <$> typeP <*> many arraySuffixP+  where+    typeP :: Parser (DataType Range)+    typeP = choice [ arrayTypeP+                   , mapTypeP+                   , rowTypeP+                   , baseTypeP+                   ]++    arraySuffixP :: Parser (DataType Range -> DataType Range)+    arraySuffixP = ArrayDataType <$> Tok.arrayP++    baseTypeP = do+        (name, r) <- Tok.typeNameP+        let typeParameterP = choice+                [ DataTypeParamConstant <$> numberConstantP+                , DataTypeParamType <$> dataTypeP+                ]+        args <- option [] $ P.between Tok.openP Tok.closeP $ typeParameterP `sepBy1` Tok.commaP+        return $ PrimitiveDataType r name args++    arrayTypeP = do+        s <- Tok.arrayP+        _ <- Tok.openAngleP+        itemType <- dataTypeP+        e <- Tok.closeAngleP+        return $ ArrayDataType (s <> e) itemType++    mapTypeP = do+        s <- Tok.mapP+        _ <- Tok.openAngleP+        keyType <- dataTypeP+        _ <- Tok.commaP+        valueType <- dataTypeP+        e <- Tok.closeAngleP+        return $ MapDataType (s <> e) keyType valueType++    rowTypeP = do+        s <- Tok.rowP+        _ <- Tok.openP+        let fieldP = do+              (name, _) <- Tok.structFieldNameP+              type_ <- dataTypeP+              return (name, type_)+        fields <- fieldP `sepBy1` Tok.commaP+        e <- Tok.closeP+        return $ StructDataType (s <> e) fields+++castPrimaryExprP :: Parser (Expr RawNames Range)+castPrimaryExprP = do+    (onFail, r) <- Tok.castFuncP+    _ <- Tok.openP+    e <- exprP+    _ <- Tok.asP+    t <- dataTypeP+    r' <- Tok.closeP++    return $ TypeCastExpr (r <> r') onFail e t++casePrimaryExprP :: Parser (Expr RawNames Range)+casePrimaryExprP = do+    r <- Tok.caseP+    whens <- choice+        [ P.many1 $ do+            _ <- Tok.whenP+            condition <- exprP+            _ <- Tok.thenP+            result <- exprP+            return (condition, result)++        , do+            value <- valueExprP+            P.many1 $ do+                whenr <- Tok.whenP+                condition <- BinOpExpr whenr "=" value <$> exprP+                _ <- Tok.thenP+                result <- exprP+                return (condition, result)+        ]++    melse <- optionMaybe $ do+        _ <- Tok.elseP+        exprP++    r' <- Tok.endP++    return $ CaseExpr (r <> r') whens melse++existsPrimaryExprP :: Parser (Expr RawNames Range)+existsPrimaryExprP = do+    r <- Tok.existsP+    _ <- Tok.openP+    query <- queryP+    r' <- Tok.closeP+    return $ ExistsExpr (r <> r') query++subqueryPrimaryExprP :: Parser (Expr RawNames Range)+subqueryPrimaryExprP = P.between Tok.openP Tok.closeP $ do+    query <- queryP+    return $ SubqueryExpr (getInfo query) query++functionCallPrimaryExprP :: Parser (Expr RawNames Range)+functionCallPrimaryExprP = do+    name@(QFunctionName r _ _) <- functionNameP+    (distinct, args) <- P.between Tok.openP Tok.closeP $ choice+        [ do+              r' <- Tok.starP+              return (notDistinct, [ConstantExpr r' $ NumericConstant r' "1"])+        , do+              isDistinct <- option notDistinct distinctP+              exprs <- exprP `sepBy` Tok.commaP+              return (isDistinct, exprs)+        ]+    let params = []+    filter' <- optionMaybe filterP+    over <- optionMaybe overP++    let info :: Range+        info = sconcat $ r :| concat [ maybe r getInfo filter' : []+                                     , maybe r getInfo over : []+                                     , map getInfo args+                                     ]+    return $ FunctionExpr info name distinct args params filter' over+  where+    filterP = do+        r <- Tok.filterP+        _ <- Tok.openP+        _ <- Tok.whereP+        expr <- exprP+        r' <- Tok.closeP+        return $ Filter (r <> r') expr++overP :: Parser (OverSubExpr RawNames Range)+overP = do+    start <- Tok.overP+    _ <- Tok.openP+    partition <- optionMaybe partitionP+    order <- option [] orderInWindowClauseP+    frame <- optionMaybe frameP+    end <- Tok.closeP+    let info = start <> end+    return $ OverWindowExpr info $ WindowExpr info partition order frame+  where+    partitionP :: Parser (Partition RawNames Range)+    partitionP = do+        r <- Tok.partitionP+        _ <- Tok.byP+        exprs <- exprP `sepBy1` Tok.commaP+        return $ PartitionBy (sconcat $ r :| map getInfo exprs) exprs++    frameP :: Parser (Frame Range)+    frameP = do+        ftype <- choice+            [ RowFrame <$> Tok.rowsP+            , RangeFrame <$> Tok.rangeP+            ]++        choice+            [ do+                _ <- Tok.betweenP+                start <- frameBoundP+                _ <- Tok.andP+                end <- frameBoundP++                let r = getInfo ftype <> getInfo end+                return $ Frame r ftype start (Just end)++            , do+                start <- frameBoundP++                let r = getInfo ftype <> getInfo start+                return $ Frame r ftype start Nothing+            ]++    frameBoundP :: Parser (FrameBound Range)+    frameBoundP = choice+        [ fmap Unbounded $ (<>)+            <$> Tok.unboundedP+            <*> choice [ Tok.precedingP, Tok.followingP ]++        , fmap CurrentRow $ (<>) <$> Tok.currentP <*> Tok.rowP++        , numberConstantP >>= \ expr -> choice+            [ Tok.precedingP >>= \ r ->+                return $ Preceding (getInfo expr <> r) expr++            , Tok.followingP >>= \ r ->+                return $ Following (getInfo expr <> r) expr+            ]+        ]++orderTopLevelP :: Parser (Range, [Order RawNames Range])+orderTopLevelP = orderExprP False True++orderInWindowClauseP :: Parser [Order RawNames Range]+orderInWindowClauseP = snd <$> orderExprP True False++orderExprP :: Bool -> Bool -> Parser (Range, [Order RawNames Range])+orderExprP nullsClausePermitted positionalReferencesPermitted = do+    r <- Tok.orderP+    _ <- Tok.byP+    orders <- helperP `sepBy1` Tok.commaP+    let r' = getInfo $ last orders+    return (r <> r', orders)+  where+    helperP :: Parser (Order RawNames Range)+    helperP = do+        expr <- exprP+        let posOrExpr = if positionalReferencesPermitted+                        then handlePositionalReferences expr+                        else PositionOrExprExpr expr+        dir <- directionP+        nulls <- case (nullsClausePermitted, dir) of+            (False, _) -> return $ NullsAuto Nothing+            (True, OrderAsc _) -> option (NullsLast Nothing) nullsP+            (True, OrderDesc _) -> option (NullsFirst Nothing) nullsP+        let info = (getInfo expr) ?<> (getInfo dir) <> (getInfo nulls)+        return $ Order info posOrExpr dir nulls++    directionP :: Parser (OrderDirection (Maybe Range))+    directionP = option (OrderAsc Nothing) $ choice+        [ OrderAsc . Just <$> Tok.ascP+        , OrderDesc . Just <$> Tok.descP+        ]++    nullsP :: Parser (NullPosition (Maybe Range))+    nullsP = do+        r <- Tok.nullsP+        choice+            [ Tok.firstP >>= \ r' -> return $ NullsFirst $ Just $ r <> r'+            , Tok.lastP >>= \ r' -> return $ NullsLast $ Just $ r <> r'+            ]++rowPrimaryExprP :: Parser (Expr RawNames Range)+rowPrimaryExprP = do+    r <- Tok.rowP+    _ <- Tok.openP+    exprs <- exprP `sepBy1` Tok.commaP+    r' <- Tok.closeP++    let name = QFunctionName r Nothing "row"+    return $ FunctionExpr (r <> r') name notDistinct exprs [] Nothing Nothing++implicitRowPrimaryExprP :: Parser (Expr RawNames Range)+implicitRowPrimaryExprP = do+    r <- Tok.openP+    exprs <- exprP `sepBy1` Tok.commaP+    r' <- Tok.closeP++    case exprs of+        [] -> error "this shouldn't happen with sepBy1"+        [e] -> return e+        es -> let name = QFunctionName r Nothing "implicit row"+               in return $ FunctionExpr (r <> r') name notDistinct es [] Nothing Nothing++positionPrimaryExprP :: Parser (Expr RawNames Range)+positionPrimaryExprP = do+    r <- Tok.positionP+    _ <- Tok.openP+    substring <- valueExprP+    _ <- Tok.inP+    string <- valueExprP+    r' <- Tok.closeP+    return $ FunctionExpr (r <> r') (QFunctionName r Nothing "position") notDistinct [substring, string] [] Nothing Nothing++parameterPrimaryExprP :: Parser (Expr RawNames Range)+parameterPrimaryExprP = do+    r <- Tok.questionMarkP+    return $ ConstantExpr r $ ParameterConstant r++binaryLiteralPrimaryExprP :: Parser (Expr RawNames Range)+binaryLiteralPrimaryExprP = do+    (bytes, r) <- Tok.binaryLiteralP+    return $ ConstantExpr r $ StringConstant r bytes++constantPrimaryExprP :: Parser (Expr RawNames Range)+constantPrimaryExprP = do+  val <- choice [ stringP+                , booleanP+                , numberConstantP+                , typedConstantP+                , nullP+                ]+  return $ ConstantExpr (getInfo val) val+  where+    stringP = uncurry (flip StringConstant) <$> Tok.stringP++    booleanP = uncurry (flip BooleanConstant) <$> choice+        [ Tok.trueP >>= \ r -> return (True, r)+        , Tok.falseP >>= \ r -> return (False, r)+        ]++    typedConstantP = do+        (typeStr, r) <- Tok.typedConstantTypeP+        let dataType = PrimitiveDataType r typeStr []+        (string, r') <- first TL.decodeUtf8 <$> Tok.stringP+        pure $ TypedConstant (r <> r') string dataType++    nullP = NullConstant <$> Tok.nullP++numberExprP :: Parser (Expr RawNames Range)+numberExprP = do+    num <- numberConstantP+    return $ ConstantExpr (getInfo num) num++numberConstantP :: Parser (Constant Range)+numberConstantP = uncurry (flip NumericConstant) <$> Tok.numberP++columnRefPrimaryExprP :: Parser (Expr RawNames Range)+columnRefPrimaryExprP = do+    name <- columnNameP+    return $ ColumnExpr (getInfo name) name++structAccessP :: Parser (Expr RawNames Range -> Expr RawNames Range)+structAccessP = do+    _ <- Tok.dotP+    field <- structFieldNameP+    return $ \ struct ->+        let r = getInfo struct <> getInfo field+         in FieldAccessExpr r struct field+  where+    structFieldNameP :: Parser (StructFieldName Range)+    structFieldNameP = uncurry (flip StructFieldName) <$> Tok.structFieldNameP++arrayAccessP :: Parser (Expr RawNames Range -> Expr RawNames Range)+arrayAccessP = do+    _ <- Tok.openBracketP+    index <- valueExprP+    e <- Tok.closeBracketP+    return $ \ expr ->+        let exprR = getInfo expr <> e+        in ArrayAccessExpr exprR expr index+++predicateP :: Parser (Expr RawNames Range -> Expr RawNames Range)+predicateP = choice+    [ isPredicateP+    , try likePredicateP  -- the try is for the optional NOT+    , try inPredicateP  -- the try is for the optional NOT+    , betweenPredicateP+    , try quantifiedComparisonPredicateP -- the try is for the comparison operator+    , unquantifiedComparisonPredicateP+    ]++optionalNotWrapper :: Parser (Expr RawNames Range -> Expr RawNames Range)+optionalNotWrapper = do+    maybeNot <- optionMaybe Tok.notP+    return $ maybe id (\ r -> UnOpExpr r "NOT") maybeNot++isPredicateP :: Parser (Expr RawNames Range -> Expr RawNames Range)+isPredicateP = do+    r <- Tok.isP++    notWrapper <- optionalNotWrapper+    predicate <- choice [ Left <$> (Tok.distinctP >> Tok.fromP >> valueExprP)+                        , Right <$> Tok.nullP+                        ]+    return $ case predicate of+        Left expr ->+            \ expr' -> notWrapper $ BinOpExpr (r <> getInfo expr) "IS DISTINCT FROM" expr expr'+        Right nullKeyword ->+            \ expr' -> notWrapper $ UnOpExpr (r <> nullKeyword) "ISNULL" expr'++likePredicateP :: Parser (Expr RawNames Range -> Expr RawNames Range)+likePredicateP = do+    notWrapper <- optionalNotWrapper+    r <- Tok.likeP+    pattern <- Pattern <$> valueExprP+    escape <- optionMaybe $ do+        _ <- Tok.escapeP+        Escape <$> valueExprP+    return $ \ expr -> notWrapper $ LikeExpr r "LIKE" escape pattern expr++inPredicateP :: Parser (Expr RawNames Range -> Expr RawNames Range)+inPredicateP = do+    notWrapper <- optionalNotWrapper+    r <- Tok.inP+    _ <- Tok.openP+    predicate <- choice+        [ Left <$> queryP+        , Right <$> exprP `sepBy1` Tok.commaP+        ]+    r' <- Tok.closeP++    return $ case predicate of+        Left query ->+            \ expr -> notWrapper $ InSubqueryExpr (r <> r') query expr+        Right exprs ->+            \ expr -> notWrapper $ InListExpr (r <> r') exprs expr++betweenPredicateP :: Parser (Expr RawNames Range -> Expr RawNames Range)+betweenPredicateP = do+    notWrapper <- optionalNotWrapper+    _ <- Tok.betweenP+    lower <- valueExprP+    _ <- Tok.andP+    upper <- valueExprP+    return $ \ expr -> notWrapper $ BetweenExpr (getInfo expr <> getInfo upper) lower upper expr+++quantifiedComparisonPredicateP :: Parser (Expr RawNames Range -> Expr RawNames Range)+quantifiedComparisonPredicateP = do+    (op, _) <- Tok.comparisonOperatorP+    (quantifier, _) <- Tok.comparisonQuantifierP+    _ <- Tok.openP+    query <- queryP+    r <- Tok.closeP++    let op' = Operator $ TL.unwords [op, quantifier]+        subquery = SubqueryExpr (getInfo query) query+    return $ \ expr -> BinOpExpr (getInfo expr <> r) op' expr subquery++unquantifiedComparisonPredicateP :: Parser (Expr RawNames Range -> Expr RawNames Range)+unquantifiedComparisonPredicateP = do+    (op, _) <- Tok.comparisonOperatorP+    rhs <- valueExprP+    return $ \ lhs -> BinOpExpr (getInfo lhs <> getInfo rhs) (Operator op) lhs rhs+++whereP :: Parser (SelectWhere RawNames Range)+whereP = do+    r <- Tok.whereP+    condition <- exprP+    return $ SelectWhere (r <> getInfo condition) condition+++handlePositionalReferences :: Expr RawNames Range -> PositionOrExpr RawNames Range+handlePositionalReferences e = case e of+    ConstantExpr _ (NumericConstant _ n) | TL.all isDigit n -> PositionOrExprPosition (getInfo e) (read $ TL.unpack n) Unused+    _ -> PositionOrExprExpr e++groupP :: Parser (SelectGroup RawNames Range)+groupP = do+    r <- Tok.groupP+    _ <- Tok.byP+    optional distinctP++    selectGroupGroupingElements <- concat <$> groupingElementP `sepBy1` Tok.commaP+    let selectGroupInfo = foldl (<>) r $ fmap getInfo selectGroupGroupingElements++    return SelectGroup{..}+  where+    toGroupingElement :: PositionOrExpr RawNames Range -> GroupingElement RawNames Range+    toGroupingElement posOrExpr = GroupingElementExpr (getInfo posOrExpr) posOrExpr++    groupingElementP :: Parser [GroupingElement RawNames Range]+    groupingElementP = choice+        [ singleExprP+        , parenExprsP+        , rollupP+        , cubeP+        , groupingSetsP+        ]++    singleExprP = do+        e <- exprP+        return [toGroupingElement $ handlePositionalReferences e]++    parenExprsP = do+        _ <- Tok.openP+        es <- exprP `sepBy` Tok.commaP+        _ <- Tok.closeP+        return $ map (toGroupingElement . handlePositionalReferences) es++    toGroupingSet :: Range -> [Expr RawNames Range] -> GroupingElement RawNames Range+    toGroupingSet r [] = GroupingElementSet r []+    toGroupingSet _ exprs =+        let s = getInfo $ head exprs+            e = getInfo $ last exprs+         in GroupingElementSet (s <> e) exprs++    rollupP = do+        _ <- Tok.rollupP+        _ <- Tok.openP+        cols <- columnRefPrimaryExprP `sepBy1` Tok.commaP+        _ <- Tok.closeP+        let dimensions = L.reverse $ L.inits cols+            defaultRange = (getInfo $ head cols) <> (getInfo $ last cols)+        return $ map (toGroupingSet defaultRange) dimensions++    cubeP = do+        _ <- Tok.cubeP+        _ <- Tok.openP+        cols <- columnRefPrimaryExprP `sepBy1` Tok.commaP+        _ <- Tok.closeP+        let dimensions = L.subsequences cols+            defaultRange = (getInfo $ head cols) <> (getInfo $ last cols)+        return $ map (toGroupingSet defaultRange) dimensions++    groupingSetP = choice $+        [ do+              s <- Tok.openP+              sets <- columnRefPrimaryExprP `sepBy1` Tok.commaP+              e <- Tok.closeP+              return $ GroupingElementSet (s <> e) sets+        , do+              -- if no parens, it will be the singleton list.+              col <- columnRefPrimaryExprP+              return $ GroupingElementSet (getInfo col) [col]+        ]++    groupingSetsP = do+        _ <- Tok.groupingP+        _ <- Tok.setsP+        _ <- Tok.openP+        sets <- groupingSetP `sepBy1` Tok.commaP+        _ <- Tok.closeP+        return sets+++havingP :: Parser (SelectHaving RawNames Range)+havingP = do+    r <- Tok.havingP+    condition <- exprP+    return $ SelectHaving (r <> getInfo condition) [condition]+++deleteP :: Parser (Delete RawNames Range)+deleteP = do+    r <- Tok.deleteP++    _ <- Tok.fromP+    table <- tableNameP++    maybeExpr <- optionMaybe $ do+        _ <- Tok.whereP+        local (introduceAliases $ tableNameToTableAlias table) exprP++    let r' = case maybeExpr of+          Nothing -> getInfo table+          Just expr -> getInfo expr+        info = r <> r'++    pure $ Delete info table maybeExpr+++dropViewPrefixP :: Parser Range+dropViewPrefixP = do+    s <- Tok.dropP+    e <- Tok.viewP+    pure $ s <> e++dropViewP :: Parser (DropView RawNames Range)+dropViewP = do+    s <- dropViewPrefixP+    dropViewIfExists <- optionMaybe ifExistsP+    dropViewName <- tableNameP++    let dropViewInfo = s <> getInfo dropViewName+    pure DropView{..}+++dropTableP :: Parser (DropTable RawNames Range)+dropTableP = do+    s <- Tok.dropP+    _ <- Tok.tableP+    dropTableIfExists <- optionMaybe ifExistsP+    table <- tableNameP++    let dropTableInfo = s <> getInfo table+        dropTableNames = table :| []+    pure DropTable{..}++ifExistsP :: Parser Range+ifExistsP = do+    s <- Tok.ifP+    e <- Tok.existsP+    pure $ s <> e+++grantP :: Parser (Grant Range)+grantP = do+    s <- Tok.grantP+    e <- P.many1 Tok.notSemicolonP+    return $ Grant (s <> (last e))+++revokeP :: Parser (Revoke Range)+revokeP = do+    s <- Tok.revokeP+    e <- P.many1 Tok.notSemicolonP+    return $ Revoke (s <> (last e))+++insertP :: Parser (Insert RawNames Range)+insertP = do+    r <- Tok.insertP+    insertBehavior <- InsertAppend <$> Tok.intoP++    insertTable <- tableNameP++    insertColumns <- optionMaybe $ try $ do+        _ <- Tok.openP+        let oqColumnNameP = (\ (c, r') -> QColumnName r' Nothing c) <$> Tok.columnNameP+        c:cs <- oqColumnNameP `sepBy1` Tok.commaP+        _ <- Tok.closeP+        pure (c :| cs)++    insertValues <- choice+        [ do+            s <- Tok.valuesP+            (e, rows) <- rowsOfValuesP+            pure $ InsertExprValues (s <> e) rows+        , InsertSelectValues <$> queryP+        ]++    let insertInfo = r <> getInfo insertValues++    pure Insert{..}+  where+    valueP :: Parser (DefaultExpr RawNames Range)+    valueP = ExprValue <$> exprP++    rowOfValuesP = do+        s <- Tok.openP+        x:xs <- valueP `sepBy1` Tok.commaP+        e <- Tok.closeP+        pure $ (s <> e, x :| xs)++    rowsOfValuesP = do+        rows <- rowOfValuesP `sepBy1` Tok.commaP+        let infos = map fst rows+            r:rs = map snd rows+        pure $ (head infos <> last infos, r :| rs)+++explainP :: Parser Range+explainP = do+    s <- Tok.explainP+    e <- getInfo <$> queryP+    return $ s <> e+++showP :: Parser Range+showP = do+    s <- Tok.showP+    e <- P.many1 Tok.notSemicolonP+    return $ s <> (last e)+++callP :: Parser Range+callP = do+    s <- Tok.callP+    e <- P.many1 Tok.notSemicolonP+    return $ s <> (last e)+++describeP :: Parser Range+describeP = do+    s <- Tok.describeP+    e <- P.many1 Tok.notSemicolonP+    return $ s <> last e
+ src/Database/Sql/Presto/Parser/Internal.hs view
@@ -0,0 +1,40 @@+-- Copyright (c) 2017 Uber Technologies, Inc.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+-- THE SOFTWARE.++module Database.Sql.Presto.Parser.Internal where++import qualified Text.Parsec as P++import Database.Sql.Presto.Token+import Database.Sql.Position+import Control.Monad.Reader+import Data.Text.Lazy (Text)+import Data.Set (Set)++type ScopeTableRef = Text++data ParserScope = ParserScope+    { selectTableAliases :: Maybe (Set ScopeTableRef) }+    deriving (Eq, Ord, Show)++type Parser = P.ParsecT [(Token, Position, Position)] Integer (Reader ParserScope)++getNextCounter :: Parser Integer+getNextCounter = P.modifyState (+1) >> P.getState
+ src/Database/Sql/Presto/Parser/Token.hs view
@@ -0,0 +1,638 @@+-- Copyright (c) 2017 Uber Technologies, Inc.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+-- THE SOFTWARE.++module Database.Sql.Presto.Parser.Token where++import Database.Sql.Type.Query (CastFailureAction(..))+import Database.Sql.Presto.Token+import Database.Sql.Presto.Parser.Internal++import Database.Sql.Position++import qualified Text.Parsec as P+import qualified Text.Parsec.Pos as P++import           Data.ByteString.Lazy (ByteString)+import           Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as TL++import qualified Data.Map as M+import Data.Semigroup ((<>))+++-- helpers++showTok :: (Token, Position, Position) -> String+showTok (t, _, _) = show t++posFromTok :: P.SourcePos ->+              (Token, Position, Position) ->+              [(Token, Position, Position)] ->+              P.SourcePos+posFromTok _ (_, pos, _) _ = flip P.setSourceLine (fromEnum $ positionLine pos)+                           $ flip P.setSourceColumn (fromEnum $ positionColumn pos)+                           $ P.initialPos "-"++tokEqualsP :: Token -> Parser Range+tokEqualsP tok = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok', s, e) =+        if tok == tok'+         then Just $ Range s e+         else Nothing++tokNotEqualsP :: Token -> Parser Range+tokNotEqualsP tok = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok', s, e) =+        if tok /= tok'+         then Just $ Range s e+         else Nothing++testNameTok :: (Token, Position, Position) -> Maybe (Text, Range)+testNameTok (tok, s, e) =+  case tok of+    TokWord _ name -> Just (name, Range s e)+    _ -> Nothing++symbolP :: Text -> Parser Range+symbolP op = tokEqualsP $ TokSymbol op++keywordP :: Text -> Parser Range+keywordP keyword = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord False name+            | name == keyword -> Just (Range s e)++        _ -> Nothing++-- onto the actual parsers++dotP :: Parser Range+dotP = symbolP "."++starP :: Parser Range+starP = symbolP "*"++plusP :: Parser Range+plusP = symbolP "+"++minusP :: Parser Range+minusP = symbolP "-"++commaP :: Parser Range+commaP = symbolP ","++openP :: Parser Range+openP = symbolP "("++closeP :: Parser Range+closeP = symbolP ")"++openBracketP :: Parser Range+openBracketP = symbolP "["++closeBracketP :: Parser Range+closeBracketP = symbolP "]"++openAngleP :: Parser Range+openAngleP = symbolP "<"++closeAngleP :: Parser Range+closeAngleP = symbolP ">"++questionMarkP :: Parser Range+questionMarkP = symbolP "?"++stringP :: Parser (ByteString, Range)+stringP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokString string -> Just (string, Range s e)+        _ -> Nothing++binaryLiteralP :: Parser (ByteString, Range)+binaryLiteralP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokBinary bytes -> Just (bytes, Range s e)+        _ -> Nothing++numberP :: Parser (Text, Range)+numberP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokNumber number -> Just (number, Range s e)+        _ -> Nothing++typeNameP :: Parser (Text, Range)+typeNameP = P.choice+    [ P.try $ multiWordTypeP -- the try is for plain old `double`, `time`, or `timestamp`+    , singleWordTypeP+    ]+  where+    multiWordTypeP = P.choice+        [ do+              s <- doubleP+              e <- precisionP+              return ("double precision", s <> e)+        , do+              r <- Left <$> timeP P.<|> Right <$> timestampP+              _ <- withP+              e <- timezoneP+              case r of+                  Left s -> return ("time with time zone", s <> e)+                  Right s -> return ("timestamp with time zone", s <> e)+        ]++    singleWordTypeP = P.tokenPrim showTok posFromTok testNameTok++intervalFieldP :: Parser (Text, Range)+intervalFieldP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord _ name | TL.toLower name `elem` fields -> Just (TL.toLower name, Range s e)+        _ -> Nothing++    fields = ["year", "month", "day", "hour", "minute", "second"]++comparisonOperatorP :: Parser (Text, Range)+comparisonOperatorP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (TokSymbol op, s, e)+        | op `elem` ["=", "<>", "!=", "<", "<=", ">", ">="] = Just (op, Range s e)++    testTok _ = Nothing++comparisonQuantifierP :: Parser (Text, Range)+comparisonQuantifierP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord _ name | TL.toLower name `elem` quantifiers -> Just (TL.toLower name, Range s e)+        _ -> Nothing++    quantifiers = ["all", "some", "any"]++extractUnitP :: Parser (Text, Range)+extractUnitP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord _ name | TL.toLower name `elem` units -> Just (TL.toLower name, Range s e)+        _ -> Nothing++    units = [ "year", "quarter", "month", "week"+            , "day", "day_of_month", "day_of_week", "dow", "day_of_year", "doy"+            , "year_of_week", "yow"+            , "hour", "minute", "second"+            , "timezone_hour", "timezone_minute"+            ]++typedConstantTypeP :: Parser (Text, Range)+typedConstantTypeP = P.choice+    [ P.try $ multiWordTypeP -- the try is for plain old `double`+    , singleWordTypeP+    ]+  where+    multiWordTypeP = do+        s <- doubleP+        e <- precisionP+        return ("double precision", s <> e)++    singleWordTypeP = P.tokenPrim showTok posFromTok testTok++    testTok (tok, s, e) = case tok of+        TokWord _ name | TL.toLower name `elem` types -> Just (TL.toLower name, Range s e)+        _ -> Nothing++    -- generated with some trial and error (and guesswork) based on+    -- https://github.com/prestodb/presto/blob/master/presto-main/src/main/java/com/facebook/presto/type/TypeRegistry.java+    types = [ "boolean", "bigint", "integer", "smallint", "tinyint"+            , "double", "real", "varbinary", "date", "time", "timestamp"+            , "hyperloglog", "p4hyperloglog", "joniregexp", "re2jregexp"+            , "likepattern", "jsonpath", "color", "json", "codepoints"+            , "varchar", "char", "decimal"+            ]++normalFormP :: Parser (Text, Range)+normalFormP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord _ name | TL.toLower name `elem` forms -> Just (TL.toLower name, Range s e)+        _ -> Nothing++    forms = [ "nfc", "nfd", "nfkc", "nfkd" ]++possiblyBareFuncP :: Parser (Text, Range, Bool)+possiblyBareFuncP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord _ name | TL.toLower name `M.member` funcs ->+                           let name' = TL.toLower name+                               r = Range s e+                               Just alwaysBare = M.lookup name' funcs+                            in Just (name', r, alwaysBare)+        _ -> Nothing++    funcs = M.fromList [ ("current_date",      True)+                       , ("current_time",      False)+                       , ("current_timestamp", False)+                       , ("localtime",         False)+                       , ("localtimestamp",    False)+                       ]++castFuncP :: Parser (CastFailureAction, Range)+castFuncP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord _ name | TL.toLower name == "cast" -> Just (CastFailureError, Range s e)+        TokWord _ name | TL.toLower name == "try_cast" -> Just (CastFailureToNull, Range s e)+        _ -> Nothing+++-- In presto, databases are called "catalogs".+-- Notionally they are "one coarser than schema"+databaseNameP :: Parser (Text, Range)+databaseNameP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord True name -> Just (name, Range s e)+        TokWord False name+            | wordCanBeSchemaName (wordInfo name) -> Just (name, Range s e)++        _ -> Nothing++schemaNameP :: Parser (Text, Range)+schemaNameP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord True name -> Just (name, Range s e)+        TokWord False name+            | wordCanBeSchemaName (wordInfo name) -> Just (name, Range s e)++        _ -> Nothing++tableNameP :: Parser (Text, Range)+tableNameP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord True name -> Just (name, Range s e)+        TokWord False name+            | wordCanBeTableName (wordInfo name) -> Just (name, Range s e)++        _ -> Nothing++columnNameP :: Parser (Text, Range)+columnNameP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord True name -> Just (name, Range s e)+        TokWord False name+            | wordCanBeColumnName (wordInfo name) -> Just (name, Range s e)++        _ -> Nothing++structFieldNameP :: Parser (Text, Range)+structFieldNameP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord True name -> Just (name, Range s e)+        TokWord False name+            | wordCanBeColumnName (wordInfo name) -> Just (name, Range s e)++        _ -> Nothing++paramNameP :: Parser (Text, Range)+paramNameP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord True name -> Just (name, Range s e)+        TokWord False name+            | wordCanBeColumnName (wordInfo name) -> Just (name, Range s e)++        _ -> Nothing++functionNameP :: Parser (Text, Range)+functionNameP = P.tokenPrim showTok posFromTok testTok+  where+    testTok (tok, s, e) = case tok of+        TokWord True name -> Just (name, Range s e)+        TokWord False name+            | wordCanBeFunctionName (wordInfo name) ->+                Just (name, Range s e)++        _ -> Nothing++allP :: Parser Range+allP = keywordP "all"++andP :: Parser Range+andP = keywordP "and"++arrayP :: Parser Range+arrayP = keywordP "array"++asP :: Parser Range+asP = keywordP "as"++ascP :: Parser Range+ascP = keywordP "asc"++atP :: Parser Range+atP = keywordP "at"++bernoulliP :: Parser Range+bernoulliP = keywordP "bernoulli"++betweenP :: Parser Range+betweenP = keywordP "between"++byP :: Parser Range+byP = keywordP "by"++callP :: Parser Range+callP = keywordP "call"++caseP :: Parser Range+caseP = keywordP "case"++crossP :: Parser Range+crossP = keywordP "cross"++cubeP :: Parser Range+cubeP = keywordP "cube"++currentP :: Parser Range+currentP = keywordP "current"++deleteP :: Parser Range+deleteP = keywordP "delete"++descP :: Parser Range+descP = keywordP "desc"++describeP :: Parser Range+describeP = keywordP "describe" P.<|> keywordP "desc"++distinctP :: Parser Range+distinctP = keywordP "distinct"++doubleP :: Parser Range+doubleP = keywordP "double"++dropP :: Parser Range+dropP = keywordP "drop"++elseP :: Parser Range+elseP = keywordP "else"++endP :: Parser Range+endP = keywordP "end"++escapeP :: Parser Range+escapeP = keywordP "escape"++exceptP :: Parser Range+exceptP = keywordP "except"++existsP :: Parser Range+existsP = keywordP "exists"++explainP :: Parser Range+explainP = keywordP "explain"++extractP :: Parser Range+extractP = keywordP "extract"++falseP :: Parser Range+falseP = keywordP "false"++filterP :: Parser Range+filterP = keywordP "filter"++firstP :: Parser Range+firstP = keywordP "first"++followingP :: Parser Range+followingP = keywordP "following"++forP :: Parser Range+forP = keywordP "for"++fromP :: Parser Range+fromP = keywordP "from"++fullP :: Parser Range+fullP = keywordP "full"++grantP :: Parser Range+grantP = keywordP "grant"++groupP :: Parser Range+groupP = keywordP "group"++groupingP :: Parser Range+groupingP = keywordP "grouping"++havingP :: Parser Range+havingP = keywordP "having"++ifP :: Parser Range+ifP = keywordP "if"++intervalP :: Parser Range+intervalP = keywordP "interval"++inP :: Parser Range+inP = keywordP "in"++innerP :: Parser Range+innerP = keywordP "inner"++insertP :: Parser Range+insertP = keywordP "insert"++intersectP :: Parser Range+intersectP = keywordP "intersect"++intoP :: Parser Range+intoP = keywordP "into"++isP :: Parser Range+isP = keywordP "is"++joinP :: Parser Range+joinP = keywordP "join"++lastP :: Parser Range+lastP = keywordP "last"++leftP :: Parser Range+leftP = keywordP "left"++likeP :: Parser Range+likeP = keywordP "like"++limitP :: Parser Range+limitP = keywordP "limit"++mapP :: Parser Range+mapP = keywordP "map"++naturalP :: Parser Range+naturalP = keywordP "natural"++normalizeP :: Parser Range+normalizeP = keywordP "normalize"++notP :: Parser Range+notP = keywordP "not"++nullP :: Parser Range+nullP = keywordP "null"++nullsP :: Parser Range+nullsP = keywordP "nulls"++onP :: Parser Range+onP = keywordP "on"++orP :: Parser Range+orP = keywordP "or"++orderP :: Parser Range+orderP = keywordP "order"++ordinalityP :: Parser Range+ordinalityP = keywordP "ordinality"++outerP :: Parser Range+outerP = keywordP "outer"++overP :: Parser Range+overP = keywordP "over"++partitionP :: Parser Range+partitionP = keywordP "partition"++poissonizedP :: Parser Range+poissonizedP = keywordP "poissonized"++positionP :: Parser Range+positionP = keywordP "position"++precedingP :: Parser Range+precedingP = keywordP "preceding"++precisionP :: Parser Range+precisionP = keywordP "precision"++rangeP :: Parser Range+rangeP = keywordP "range"++revokeP :: Parser Range+revokeP = keywordP "revoke"++rightP :: Parser Range+rightP = keywordP "right"++rollupP :: Parser Range+rollupP = keywordP "rollup"++rowP :: Parser Range+rowP = keywordP "row"++rowsP :: Parser Range+rowsP = keywordP "rows"++selectP :: Parser Range+selectP = keywordP "select"++semicolonP :: Parser Range+semicolonP = symbolP ";"++notSemicolonP :: Parser Range+notSemicolonP = tokNotEqualsP $ TokSymbol ";"++setsP :: Parser Range+setsP = keywordP "sets"++showP :: Parser Range+showP = keywordP "show"++substringP :: Parser Range+substringP = keywordP "substring"++systemP :: Parser Range+systemP = keywordP "system"++tableP :: Parser Range+tableP = keywordP "table"++tableSampleP :: Parser Range+tableSampleP = keywordP "tablesample"++thenP :: Parser Range+thenP = keywordP "then"++timeP :: Parser Range+timeP = keywordP "time"++timestampP :: Parser Range+timestampP = keywordP "timestamp"++timezoneP :: Parser Range+timezoneP = do+    s <- keywordP "time"+    e <- keywordP "zone"+    pure $ s <> e++toP :: Parser Range+toP = keywordP "to"++trueP :: Parser Range+trueP = keywordP "true"++unboundedP :: Parser Range+unboundedP = keywordP "unbounded"++unionP :: Parser Range+unionP = keywordP "union"++unnestP :: Parser Range+unnestP = keywordP "unnest"++usingP :: Parser Range+usingP = keywordP "using"++valuesP :: Parser Range+valuesP = keywordP "values"++viewP :: Parser Range+viewP = keywordP "view"++whenP :: Parser Range+whenP = keywordP "when"++whereP :: Parser Range+whereP = keywordP "where"++withP :: Parser Range+withP = keywordP "with"
+ src/Database/Sql/Presto/Scanner.hs view
@@ -0,0 +1,264 @@+-- Copyright (c) 2017 Uber Technologies, Inc.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+-- THE SOFTWARE.++module Database.Sql.Presto.Scanner where++import Prelude hiding ((&&), (||), not)++import Control.Monad.State++import           Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import           Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Builder as BB++import Data.List (sortBy)+import Data.Foldable (asum)+import Data.Char (isAlphaNum, isAlpha, isSpace, isDigit, isHexDigit)+import Data.Int (Int64)++import Database.Sql.Position+import Database.Sql.Presto.Token++import Data.Predicate.Class++import Numeric (readHex)+++isWordHead :: Char -> Bool+isWordHead = isAlpha || (== '_')++isWordBody :: Char -> Bool+isWordBody = isAlphaNum || (== '_')++isHSpace :: Char -> Bool+isHSpace = isSpace && not (== '\n')++operators :: [Text]+operators = sortBy (flip compare)+    [ "+", "-", "*", "/", "%"+    , "!=", "<>", ">", "<", ">=", "<=", "="+    , "||"+    , "(", ")", "[", "]", ",", ";"+    , "?"+    ]++isOperator :: Char -> Bool+isOperator c = elem c $ map TL.head operators++tokenize :: Text -> [(Token, Position, Position)]+tokenize = go (Position 1 0 0)+  where+    go :: Position -> Text -> [(Token, Position, Position)]+    go _ "" = []+    go p t = case TL.head t of+        c | c `elem` ['x', 'X'] && TL.length t >= 2 && TL.index t 1 == '\'' ->+            case tokBinaryLiteral p $ TL.drop 2 t of+                Left (err, p') -> [(TokError err, p, p')]+                Right (bytes, rest, p') -> (TokBinary bytes, p, p') : go p' rest+++        c | isWordHead c || c == '"' ->+            case tokName p t of+                Left token -> [token]+                Right (name, quoted, rest, p') -> (TokWord quoted name, p, p') : go p' rest++        c | (== '\n') c -> let (newlines, rest) = TL.span (== '\n') t+                               p' = advanceVertical (TL.length newlines) p+                            in go p' rest++        c | isHSpace c -> let (spaces, rest) = TL.span isHSpace t+                              p' = advanceHorizontal (TL.length spaces) p+                           in go p' rest++        '-' | "--" `TL.isPrefixOf` t ->+            let (comment, rest) = TL.span (/= '\n') t+                p' = advanceVertical 1+                        (advanceHorizontal (TL.length comment) p)++             in go p' (TL.drop 1 rest)++        '/' | "/*" `TL.isPrefixOf` t ->+            case TL.breakOn "*/" t of+                (comment, "") ->+                    let p' = advance comment p+                     in [(TokError "unterminated comment", p, p')]+                (comment, rest) ->+                    let p' = advance (TL.append comment "*/") p+                     in go p' $ TL.drop 2 rest++        '\'' ->+            case tokString p '\'' t of+                Left p' -> [(TokError "end of input inside string", p, p')]+                Right (string, rest, p') -> (TokString $ TL.encodeUtf8 string, p, p') : go p' rest++        '.' ->+            case TL.span isDigit (TL.tail t) of+                ("", _) ->+                    let p' = advanceHorizontal 1 p+                     in (TokSymbol ".", p, p') : go p' (TL.tail t)++                _ ->+                    let ((tok, len), _) = tokNumber t+                        p' = advanceHorizontal len p+                        rest = TL.drop len t+                     in (tok, p, p') : go p' rest++        c | isDigit c ->+            let ((tok, len), _) = tokNumber t+                p' = advanceHorizontal len p+                rest = TL.drop len t+             in (tok, p, p') : go p' rest++        c | isOperator c -> case readOperator t of++            Just (sym, rest) -> let p' = advanceHorizontal (TL.length sym) p+                                 in (TokSymbol sym, p, p') : go p' rest++            Nothing ->+                let opchars = TL.take 5 t+                    p' = advance opchars p+                    message = unwords+                        [ "unrecognized operator starting with"+                        , show opchars+                        ]+                 in [(TokError message, p, p')]++        c ->+            let message = unwords+                    [ "unmatched character (" ++ show c ++ ") at position"+                    , show p+                    ]++             in [(TokError message, p, advanceHorizontal 1 p)]++    readOperator t = asum+        $ map (\ op -> (op,) <$> TL.stripPrefix op t) operators+++tokString :: Position -> Char -> Text -> Either Position (Text, Text, Position)+tokString pos d = go (advanceHorizontal 1 pos) [] . TL.tail+  where+    go p _ "" = Left p+    go p ts input = case TL.head input of+         c | c == d ->+            let (quotes, rest) = TL.span (== d) input+                len = TL.length quotes+                t = TL.take (len `div` 2) quotes+            in if len `mod` 2 == 0+                then go (advanceHorizontal len p) (t:ts) rest++                else let str = TL.concat $ reverse $ t:ts+                         p' = advanceHorizontal len p+                      in Right (str, rest, p')++         _ -> let (t, rest) = TL.span (/= d) input+               in go (advance t p) (t:ts) rest+++tokBinaryLiteral :: Position -> Text -> Either (String, Position) (ByteString, Text, Position)+tokBinaryLiteral p "" = Left ("end of input inside binary literal", p)+tokBinaryLiteral p t =+    let (body, rest) = TL.span (/= '\'')t+        collapsed = TL.filter (not . isSpace) body+        bad_digits = TL.filter (not . isHexDigit) collapsed+        good_digits = TL.filter isHexDigit collapsed+        has_even_num_digits = (TL.length good_digits) `mod` 2 == 0+        p' = advanceHorizontal 2 $ advance body $ advanceHorizontal 1 p+     in case () of+          _ | TL.null rest -> Left ("end of input inside binary literal", p)+          _ | not $ TL.null bad_digits -> Left ("binary literal must only have hex-digits", p')+          _ | not has_even_num_digits -> Left ("binary literal must contain an even number of hex-digits", p')+          _ -> Right (toByteString good_digits, TL.drop 1 rest, p')+  where+    toByteString :: Text -> ByteString+    toByteString "" = ""+    toByteString t' = let [(num, _)] = (readHex $ TL.unpack t') :: [(Int, String)]+                      in BB.toLazyByteString $ BB.word8 $ fromIntegral num++tokName :: Position -> Text -> Either (Token, Position, Position) (Text, Bool, Text, Position)+tokName pos = go pos+  where+    go :: Position -> Text -> Either (Token, Position, Position) (Text, Bool, Text, Position)+    go p ""  = error $ "unexpected call to tokName (at EOF) at " ++ show p+    go p input = case TL.head input of+      c | isWordHead c ->+        let (body, rest) = TL.span isWordBody $ TL.tail input+            word = TL.toLower $ TL.cons c body+            p' = advanceHorizontal (TL.length word) p+         in Right (word, False, rest, p')++      c | c == '"' ->+        case tokString p '"' input of+            Left p' -> Left (TokError "end of input inside quoted name", p, p')+            Right (quoted, rest, p') -> Right (quoted, True, rest, p')++      _ -> error $ "unexpected call to tokName (not at word head) at " ++ show p++tokNumber :: Text -> ((Token, Int64), Text)+tokNumber = runState $ do+    ipart <- state $ TL.span isDigit+    gets (TL.take 1) >>= \case+        "" -> pure (TokNumber ipart, TL.length ipart)+        "." -> do+            modify $ TL.drop 1+            fpart <- state $ TL.span isDigit+            gets (TL.take 1) >>= \case+                "e" -> do+                    modify $ TL.drop 1+                    sign <- gets (TL.take 1) >>= \case+                        s | isPlusOrMinus s -> modify (TL.drop 1) >> pure s+                        _ -> pure ""+                    state (TL.span isDigit) >>= \ epart ->+                        let number = case True of+                                       _ | TL.null fpart -> TL.concat [ipart, ".", fpart]+                                       _ | TL.null epart -> TL.concat [ipart, ".", fpart]+                                       _ -> TL.concat [ipart, ".", fpart, "e", sign, epart]+                         in pure ( TokNumber number, TL.length number )++                _ ->+                    let number = TL.concat [ipart, ".", fpart]+                     in pure ( TokNumber number, TL.length number )+        "e" -> do+            modify $ TL.drop 1+            sign <- gets (TL.take 1) >>= \case+                s | isPlusOrMinus s -> modify (TL.drop 1) >> pure s+                _ -> pure ""+            epart <- state $ TL.span isDigit+            gets (TL.take 1) >>= \case+                c | (not . TL.null && isWordBody . TL.head) c || TL.null epart -> do+                    rest <- state $ TL.span isWordBody+                    let word = TL.concat [ipart, "e", sign, epart, rest]+                    pure (TokError "identifiers must not start with a digit", TL.length word)+                  | otherwise ->+                    let number = TL.concat [ipart, "e", sign, epart]+                     in pure (TokNumber number, TL.length number)++        c | (isAlpha || (== '_')) (TL.head c) -> do+            rest <- state $ TL.span (isAlpha || (== '_'))+            let word = TL.concat [ipart, rest]+            pure (TokError "identifiers must not start with a digit", TL.length word)++        _ -> pure (TokNumber ipart, TL.length ipart)++  where+    isPlusOrMinus :: Text -> Bool+    isPlusOrMinus s = elem s ["+", "-"]
+ src/Database/Sql/Presto/Token.hs view
@@ -0,0 +1,125 @@+-- Copyright (c) 2017 Uber Technologies, Inc.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+-- THE SOFTWARE.++module Database.Sql.Presto.Token where++import           Data.Text.Lazy (Text)+import           Data.ByteString.Lazy (ByteString)+import qualified Data.Map as M++data Token = TokWord !Bool !Text+           | TokString !ByteString+           | TokBinary !ByteString+           | TokNumber !Text+           | TokSymbol !Text+           | TokError !String+             deriving (Show, Eq)++data WordInfo = WordInfo+              { wordCanBeSchemaName :: !Bool+              , wordCanBeTableName :: !Bool+              , wordCanBeColumnName :: !Bool+              , wordCanBeFunctionName :: !Bool+              }++wordInfo :: Text -> WordInfo+wordInfo word = maybe (WordInfo True True True True) id $ M.lookup word $ M.fromList+    [ ("all",               WordInfo False False False False)+    , ("alter",             WordInfo False False False False)+    , ("and",               WordInfo False False False False)+    , ("any",               WordInfo False False False False)+    , ("as",                WordInfo False False False False)+    , ("asc",               WordInfo False False False False)+    , ("between",           WordInfo False False False False)+    , ("by",                WordInfo False False False False)+    , ("case",              WordInfo False False False False)+    , ("cast",              WordInfo False False False False)+    , ("constraint",        WordInfo False False False False)+    , ("create",            WordInfo False False False False)+    , ("cross",             WordInfo False False False False)+    , ("cube",              WordInfo False False False False)+    , ("current_date",      WordInfo False False False False)+    , ("current_time",      WordInfo False False False False)+    , ("current_timestamp", WordInfo False False False False)+    , ("deallocate",        WordInfo False False False False)+    , ("delete",            WordInfo False False False False)+    , ("desc",              WordInfo False False False False)+    , ("describe",          WordInfo False False False False)+    , ("distinct",          WordInfo False False False False)+    , ("drop",              WordInfo False False False False)+    , ("else",              WordInfo False False False False)+    , ("end",               WordInfo False False False False)+    , ("escape",            WordInfo False False False False)+    , ("except",            WordInfo False False False False)+    , ("execute",           WordInfo False False False False)+    , ("exists",            WordInfo False False False False)+    , ("extract",           WordInfo False False False False)+    , ("false",             WordInfo False False False False)+    , ("first",             WordInfo False False False False)+    , ("for",               WordInfo False False False False)+    , ("from",              WordInfo False False False False)+    , ("full",              WordInfo False False False False)+    , ("group",             WordInfo False False False False)+    , ("grouping",          WordInfo False False False False)+    , ("having",            WordInfo False False False False)+    , ("in",                WordInfo False False False False)+    , ("inner",             WordInfo False False False False)+    , ("insert",            WordInfo False False False False)+    , ("intersect",         WordInfo False False False False)+    , ("into",              WordInfo False False False False)+    , ("is",                WordInfo False False False False)+    , ("join",              WordInfo False False False False)+    , ("last",              WordInfo False False False False)+    , ("left",              WordInfo False False False False)+    , ("like",              WordInfo False False False False)+    , ("limit",             WordInfo False False False False)+    , ("localtime",         WordInfo False False False False)+    , ("localtimestamp",    WordInfo False False False False)+    , ("natural",           WordInfo False False False False)+    , ("normalize",         WordInfo False False False False)+    , ("not",               WordInfo False False False False)+    , ("null",              WordInfo False False False False)+    , ("nulls",             WordInfo False False False False)+    , ("on",                WordInfo False False False False)+    , ("or",                WordInfo False False False False)+    , ("order",             WordInfo False False False False)+    , ("ordinality",        WordInfo False False False False)+    , ("outer",             WordInfo False False False False)+    , ("prepare",           WordInfo False False False False)+    , ("recursive",         WordInfo False False False False)+    , ("rename",            WordInfo False False False False)+    , ("right",             WordInfo False False False False)+    , ("rollup",            WordInfo False False False False)+    , ("select",            WordInfo False False False False)+    , ("sets",              WordInfo False False False False)+    , ("some",              WordInfo False False False False)+    , ("table",             WordInfo False False False False)+    , ("then",              WordInfo False False False False)+    , ("true",              WordInfo False False False False)+    , ("try_cast",          WordInfo False False False False)+    , ("unbounded",         WordInfo False False False False)+    , ("union",             WordInfo False False False False)+    , ("unnest",            WordInfo False False False False)+    , ("using",             WordInfo False False False False)+    , ("values",            WordInfo False False False False)+    , ("when",              WordInfo False False False False)+    , ("where",             WordInfo False False False False)+    , ("with",              WordInfo False False False False)+    ]
+ src/Database/Sql/Presto/Type.hs view
@@ -0,0 +1,122 @@+-- Copyright (c) 2017 Uber Technologies, Inc.+--+-- Permission is hereby granted, free of charge, to any person obtaining a copy+-- of this software and associated documentation files (the "Software"), to deal+-- in the Software without restriction, including without limitation the rights+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+-- copies of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be included in+-- all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+-- THE SOFTWARE.++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}++module Database.Sql.Presto.Type where++import Database.Sql.Type+import Database.Sql.Position (Range)+import Database.Sql.Util.Columns+import Database.Sql.Util.Joins+import Database.Sql.Util.Lineage.Table+import Database.Sql.Util.Lineage.ColumnPlus+import Database.Sql.Util.Schema+import Database.Sql.Util.Scope+import Database.Sql.Util.Tables++import Data.Aeson as JSON+import Data.Proxy (Proxy (..))++import qualified Data.Set as S+import qualified Data.Map as M++import Data.Data (Data)+import GHC.Generics (Generic)++data Presto++deriving instance Data Presto++dialectProxy :: Proxy Presto+dialectProxy = Proxy++instance Dialect Presto where++    shouldCTEsShadowTables _ = True++    resolveCreateTableExtra _ Unused = pure Unused++    getSelectScope _ fromColumns selectionAliases = SelectScope+        { bindForWhere = bindFromColumns fromColumns+        , bindForGroup = bindFromColumns fromColumns+        , bindForHaving = bindFromColumns fromColumns+        , bindForOrder = bindBothColumns fromColumns selectionAliases+        , bindForNamedWindow = bindColumns [] -- Presto doesn't have this language feature+        }++    areLcolumnsVisibleInLateralViews _ = True++data PrestoStatement r a = PrestoStandardSqlStatement (Statement Presto r a)+                           | PrestoUnhandledStatement a++deriving instance (ConstrainSNames Data r a, Data r) => Data (PrestoStatement r a)+deriving instance Generic (PrestoStatement r a)+deriving instance ConstrainSNames Eq r a => Eq (PrestoStatement r a)+deriving instance ConstrainSNames Show r a => Show (PrestoStatement r a)+deriving instance ConstrainSASNames Functor r => Functor (PrestoStatement r)+deriving instance ConstrainSASNames Foldable r => Foldable (PrestoStatement r)+deriving instance ConstrainSASNames Traversable r => Traversable (PrestoStatement r)+++instance HasJoins (PrestoStatement ResolvedNames a) where+    getJoins (PrestoStandardSqlStatement stmt) = getJoins stmt+    getJoins (PrestoUnhandledStatement _) = S.empty++instance HasTableLineage (PrestoStatement ResolvedNames a) where+    getTableLineage (PrestoStandardSqlStatement stmt) = tableLineage stmt+    getTableLineage (PrestoUnhandledStatement _) = M.empty++instance HasColumnLineage (PrestoStatement ResolvedNames Range) where+    getColumnLineage (PrestoStandardSqlStatement stmt) = columnLineage stmt+    getColumnLineage (PrestoUnhandledStatement _) = returnNothing M.empty++resolvePrestoStatement :: PrestoStatement RawNames a -> Resolver (PrestoStatement ResolvedNames) a+resolvePrestoStatement (PrestoStandardSqlStatement stmt) =+    PrestoStandardSqlStatement <$> resolveStatement stmt+resolvePrestoStatement (PrestoUnhandledStatement info) = pure $ PrestoUnhandledStatement info++instance HasSchemaChange (PrestoStatement ResolvedNames a) where+    getSchemaChange (PrestoStandardSqlStatement stmt) = getSchemaChange stmt+    getSchemaChange (PrestoUnhandledStatement _) = []++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (PrestoStatement r a) where+    toJSON (PrestoStandardSqlStatement stmt) = toJSON stmt+    toJSON (PrestoUnhandledStatement info) = JSON.object+        [ "tag" .= JSON.String "PrestoUnhandledStatement"+        , "info" .= info+        ]++typeExample :: ()+typeExample = const () $ toJSON (undefined :: PrestoStatement ResolvedNames Range)++instance HasTables (PrestoStatement ResolvedNames a) where+    goTables (PrestoStandardSqlStatement s) = goTables s+    goTables (PrestoUnhandledStatement _) = return ()++instance HasColumns (PrestoStatement ResolvedNames a) where+    goColumns (PrestoStandardSqlStatement s) = goColumns s+    goColumns (PrestoUnhandledStatement _) = return ()