queryparser-vertica (empty) → 0.1.0.0
raw patch · 10 files changed
+5147/−0 lines, 10 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 +21/−0
- queryparser-vertica.cabal +106/−0
- src/Database/Sql/Vertica/Parser.hs +2326/−0
- src/Database/Sql/Vertica/Parser/IngestionOptions.hs +221/−0
- src/Database/Sql/Vertica/Parser/Internal.hs +31/−0
- src/Database/Sql/Vertica/Parser/Shared.hs +185/−0
- src/Database/Sql/Vertica/Parser/Token.hs +1012/−0
- src/Database/Sql/Vertica/Scanner.hs +273/−0
- src/Database/Sql/Vertica/Token.hs +113/−0
- src/Database/Sql/Vertica/Type.hs +859/−0
+ 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-vertica.cabal view
@@ -0,0 +1,106 @@+name: queryparser-vertica++-- 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 Vertica SQL queries++-- A longer description of the package.+description:+ A library for parsing Vertica 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.Vertica.Parser+ , Database.Sql.Vertica.Parser.Token+ , Database.Sql.Vertica.Scanner+ , Database.Sql.Vertica.Token+ , Database.Sql.Vertica.Type+ , Database.Sql.Vertica.Parser.Internal+ , Database.Sql.Vertica.Parser.IngestionOptions+ , Database.Sql.Vertica.Parser.Shared++ -- 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/Vertica/Parser.hs view
@@ -0,0 +1,2326 @@+-- 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 FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++module Database.Sql.Vertica.Parser where++import Database.Sql.Type+import Database.Sql.Info+import Database.Sql.Helpers+import Database.Sql.Vertica.Type++import Database.Sql.Vertica.Scanner+import Database.Sql.Vertica.Parser.Internal+import Database.Sql.Position++import qualified Database.Sql.Vertica.Parser.Token as Tok+import Database.Sql.Vertica.Parser.IngestionOptions+import Database.Sql.Vertica.Parser.Shared++import Data.Char (isDigit)+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.List as L++import Data.Maybe (catMaybes, fromMaybe)+import Data.Monoid (Endo (..))+import Data.Semigroup (Option (..))+import qualified Text.Parsec as P+import Text.Parsec ( chainl1, choice, many, many1+ , option, optional, optionMaybe+ , sepBy, sepBy1, try, (<|>), (<?>))++import Control.Arrow (first)+import Control.Monad (void, (>=>), when)+++import Data.Semigroup (Semigroup (..), sconcat)+import Data.List.NonEmpty (NonEmpty ((:|)))+import qualified Data.List.NonEmpty as NE (last, fromList)+import Data.Foldable (fold)++statementParser :: Parser (VerticaStatement RawNames Range)+statementParser = do+ maybeStmt <- optionMaybe $ choice+ [ try $ VerticaStandardSqlStatement <$> statementP+ , do+ _ <- try $ P.lookAhead createProjectionPrefixP+ VerticaCreateProjectionStatement <$> createProjectionP+ , try $ VerticaMultipleRenameStatement <$> multipleRenameP+ , try $ VerticaSetSchemaStatement <$> setSchemaP+ , try $ VerticaUnhandledStatement <$> renameProjectionP+ , do+ _ <- try $ P.lookAhead alterResourcePoolPrefixP+ VerticaUnhandledStatement <$> alterResourcePoolP+ , do+ _ <- try $ P.lookAhead createResourcePoolPrefixP+ VerticaUnhandledStatement <$> createResourcePoolP+ , do+ _ <- try $ P.lookAhead dropResourcePoolPrefixP+ VerticaUnhandledStatement <$> dropResourcePoolP+ , do+ _ <- try $ P.lookAhead createFunctionPrefixP+ VerticaUnhandledStatement <$> createFunctionP+ , VerticaUnhandledStatement <$> alterTableAddConstraintP+ , VerticaUnhandledStatement <$> exportToStdoutP+ , do+ _ <- try $ P.lookAhead setSessionPrefixP+ VerticaUnhandledStatement <$> setSessionP+ , VerticaUnhandledStatement <$> setTimeZoneP+ , VerticaUnhandledStatement <$> connectP+ , VerticaUnhandledStatement <$> disconnectP+ , VerticaUnhandledStatement <$> createAccessPolicyP+ , VerticaUnhandledStatement <$> copyFromP+ , VerticaUnhandledStatement <$> showP+ , VerticaMergeStatement <$> mergeP+ ]+ case maybeStmt of+ Just stmt -> terminator >> return stmt+ Nothing -> VerticaStandardSqlStatement <$> 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.+++-- | parse consumes a statement, or fails+parse :: Text -> Either P.ParseError (VerticaStatement RawNames Range)+parse = P.runParser statementParser 0 "-" . tokenize++-- | parseAll consumes all input as a single statement, or fails+parseAll :: Text -> Either P.ParseError (VerticaStatement RawNames Range)+parseAll = P.runParser (statementParser <* P.eof) 0 "-" . tokenize++-- | parseMany consumes multiple statements, or fails+parseMany :: Text -> Either P.ParseError [VerticaStatement RawNames Range]+parseMany = P.runParser (P.many1 statementParser) 0 "-" . tokenize++-- | parseManyAll consumes all input multiple statements, or fails+parseManyAll :: Text -> Either P.ParseError [VerticaStatement RawNames Range]+parseManyAll text = P.runParser (P.many1 statementParser <* P.eof) 0 "-" . tokenize $ text++-- | parseManyEithers consumes all input as multiple (statements or failures)+-- it should never fail+parseManyEithers :: Text -> Either P.ParseError [Either (Unparsed Range) (VerticaStatement RawNames Range)]+parseManyEithers text = P.runParser parser 0 "-" . tokenize $ text+ 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)]++optionBool :: Parser a -> Parser Bool+optionBool p = option False $ p >> pure True++statementP :: Parser (Statement Vertica RawNames Range)+statementP = choice+ [ InsertStmt <$> insertP+ , DeleteStmt <$> deleteP+ , QueryStmt <$> queryP+ , explainP+ , TruncateStmt <$> truncateP+ , AlterTableStmt <$> alterTableP+ , do+ _ <- try $ P.lookAhead createSchemaPrefixP+ CreateSchemaStmt <$> createSchemaP+ , do+ _ <- try $ P.lookAhead createExternalTablePrefixP+ CreateTableStmt <$> createExternalTableP+ , do+ _ <- try $ P.lookAhead createViewPrefixP+ CreateViewStmt <$> createViewP+ , CreateTableStmt <$> createTableP+ , do+ _ <- try $ P.lookAhead dropViewPrefixP+ DropViewStmt <$> dropViewP+ , DropTableStmt <$> dropTableP+ , GrantStmt <$> grantP+ , RevokeStmt <$> revokeP+ , BeginStmt <$> beginP+ , CommitStmt <$> commitP+ , RollbackStmt <$> rollbackP+ ]++oqColumnNameP :: Parser (OQColumnName Range)+oqColumnNameP = (\ (c, r') -> QColumnName r' Nothing c) <$> Tok.columnNameP++insertP :: Parser (Insert RawNames Range)+insertP = do+ r <- Tok.insertP+ insertBehavior <- InsertAppend <$> Tok.intoP++ insertTable <- tableNameP++ insertColumns <- optionMaybe $ try $ do+ _ <- Tok.openP+ c:cs <- oqColumnNameP `sepBy1` Tok.commaP+ _ <- Tok.closeP+ pure (c :| cs)++ insertValues <- choice+ [ do+ s <- Tok.defaultP+ e <- Tok.valuesP+ pure $ InsertDefaultValues (s <> e)++ , do+ s <- Tok.valuesP+ _ <- Tok.openP++ x:xs <- defaultExprP `sepBy1` Tok.commaP++ e <- Tok.closeP++ let row = x :| xs+ rows = row :| [] -- there can only be one++ pure $ InsertExprValues (s <> e) rows+ , InsertSelectValues <$> queryP+ ]++ let insertInfo = r <> getInfo insertValues++ pure Insert{..}++defaultExprP :: Parser (DefaultExpr RawNames Range)+defaultExprP = choice+ [ DefaultValue <$> Tok.defaultP+ , ExprValue <$> exprP+ ]+++deleteP :: Parser (Delete RawNames Range)+deleteP = do+ r <- Tok.deleteP++ _ <- Tok.fromP+ table <- tableNameP++ maybeExpr <- optionMaybe $ do+ _ <- Tok.whereP+ exprP++ let r' = case maybeExpr of+ Nothing -> getInfo table+ Just expr -> getInfo expr+ info = r <> r'++ pure $ Delete info table maybeExpr+++truncateP :: Parser (Truncate RawNames Range)+truncateP = do+ s <- Tok.truncateP+ _ <- Tok.tableP+ table <- tableNameP++ pure $ Truncate (s <> getInfo table) table+++querySelectP :: Parser (Query RawNames Range)+querySelectP = do+ select <- selectP+ return $ QuerySelect (selectInfo select) select++queryP :: Parser (Query RawNames Range)+queryP = manyParensP $ do+ with <- option id withP++ query <- ((querySelectP <|> P.between Tok.openP Tok.closeP queryP) `chainl1` (exceptP <|> unionP))+ `chainl1` intersectP++ order <- option id orderP+ limit <- option id limitP+ offset <- option id offsetP++ return $ with $ limit $ offset $ order $ query+ where+ exceptP = do+ r <- Tok.exceptP+ return $ QueryExcept r Unused++ unionP = do+ r <- Tok.unionP+ distinct <- option (Distinct True) distinctP+ return $ QueryUnion r distinct Unused++ intersectP = do+ r <- Tok.intersectP+ return $ QueryIntersect r Unused++ 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 = do+ (name, r) <- Tok.tableNameP+ alias <- makeTableAlias r name++ columns <- option []+ $ P.between Tok.openP Tok.closeP $ columnAliasP `sepBy1` Tok.commaP++ _ <- Tok.asP++ (query, r') <- do+ _ <- Tok.openP+ q <- queryP+ r' <- Tok.closeP+ return (q, r')++ return $ CTE (r <> r') alias columns query++ orderP = do+ (r, orders) <- orderTopLevelP+ return $ \ query -> QueryOrder (getInfo query <> r) orders query++ limitP = do+ r <- Tok.limitP+ choice+ [ Tok.numberP >>= \ (v, r') ->+ let limit = Limit (r <> r') v+ in return $ \ query -> QueryLimit (getInfo query <> r') limit query++ , Tok.nullP >> return id+ ]++ offsetP = do+ r <- Tok.offsetP+ Tok.numberP >>= \ (v, r') ->+ let offset = Offset (r <> r') v+ in return $ \ query -> QueryOffset (getInfo query <> r') offset query+++distinctP :: Parser Distinct+distinctP = choice $+ [ Tok.allP >> return (Distinct False)+ , Tok.distinctP >> return (Distinct True)+ ]+++explainP :: Parser (Statement Vertica RawNames Range)+explainP = do+ s <- Tok.explainP+ stmt <- choice+ [ InsertStmt <$> insertP+ , DeleteStmt <$> deleteP+ , QueryStmt <$> queryP+ ]++ pure $ ExplainStmt (s <> getInfo stmt) stmt+++columnAliasP :: Parser (ColumnAlias Range)+columnAliasP = do+ (name, r) <- Tok.columnNameP+ makeColumnAlias r name+++alterTableP :: Parser (AlterTable RawNames Range)+alterTableP = do+ s <- Tok.alterP+ _ <- Tok.tableP+ from <- tableNameP+ _ <- Tok.renameP+ _ <- Tok.toP+ to <- (\ uqtn -> uqtn { tableNameSchema = Nothing }) <$> unqualifiedTableNameP++ pure $ AlterTableRenameTable (s <> getInfo to) from to+++createSchemaPrefixP :: Parser Range+createSchemaPrefixP = do+ s <- Tok.createP+ e <- Tok.schemaP+ return $ s <> e++ifNotExistsP :: Parser (Maybe Range)+ifNotExistsP = optionMaybe $ do+ s <- Tok.ifP+ _ <- Tok.notP+ e <- Tok.existsP+ pure $ s <> e++ifExistsP :: Parser Range+ifExistsP = do+ s <- Tok.ifP+ e <- Tok.existsP+ pure $ s <> e++createSchemaP :: Parser (CreateSchema RawNames Range)+createSchemaP = do+ s <- createSchemaPrefixP+ createSchemaIfNotExists <- ifNotExistsP++ (name, r) <- Tok.schemaNameP+ let createSchemaName = mkNormalSchema name r++ e <- option r (Tok.authorizationP >> snd <$> Tok.userNameP)+ let createSchemaInfo = s <> e++ return $ CreateSchema{..}+++createTableColumnsP :: Parser (TableDefinition Vertica RawNames Range)+createTableColumnsP = do+ s <- Tok.openP+ c:cs <- columnOrConstraintP `sepBy1` Tok.commaP+ e <- Tok.closeP+ pure $ TableColumns (s <> e) (c:|cs)+ where+ columnOrConstraintP :: Parser (ColumnOrConstraint Vertica RawNames Range)+ columnOrConstraintP = choice+ [ try $ ColumnOrConstraintColumn <$> columnDefinitionP+ , ColumnOrConstraintConstraint <$> constraintDefinitionP+ ]++ columnDefinitionP = do+ (name, s) <- Tok.columnNameP+ columnDefinitionType <- dataTypeP++ updates <- many $ choice [ notNullUpdateP, nullUpdateP, defaultUpdateP ]++ let columnDefinitionInfo = s <> getInfo columnDefinitionType+ columnDefinitionExtra = Nothing -- TODO+ -- set when applying updates+ columnDefinitionNull = Nothing+ columnDefinitionDefault = Nothing+ columnDefinitionName = QColumnName s None name++ foldr (>=>) pure updates ColumnDefinition{..}++ notNullUpdateP :: Parser (ColumnDefinition d r Range -> Parser (ColumnDefinition d r Range))+ notNullUpdateP = do+ r <- (<>) <$> Tok.notP <*> Tok.nullP++ pure $ \ d -> case columnDefinitionNull d of+ Nothing -> pure $ d { columnDefinitionNull = Just $ NotNull r }+ Just (Nullable _) -> fail "conflicting NULL/NOT NULL specifications on column"+ Just (NotNull _) -> pure d++ nullUpdateP :: Parser (ColumnDefinition d r Range -> Parser (ColumnDefinition d r Range))+ nullUpdateP = do+ r <- Tok.nullP++ pure $ \ d -> case columnDefinitionNull d of+ Nothing -> pure $ d { columnDefinitionNull = Just $ Nullable r }+ Just (NotNull _) -> fail "conflicting NULL/NOT NULL specifications on column"+ Just (Nullable _) -> pure d++ defaultUpdateP :: Parser (ColumnDefinition d RawNames Range -> Parser (ColumnDefinition d RawNames Range))+ defaultUpdateP = do+ _ <- Tok.defaultP+ expr <- exprP++ pure $ \ d -> case columnDefinitionDefault d of+ Nothing -> pure $ d { columnDefinitionDefault = Just expr }+ Just _ -> fail "multiple defaults for column"++ constraintDefinitionP :: Parser (ConstraintDefinition Range)+ constraintDefinitionP = ConstraintDefinition <$> tableConstraintP+++createExternalTablePrefixP :: Parser (Range, Externality Range)+createExternalTablePrefixP = do+ s <- Tok.createP+ r <- Tok.externalP+ _ <- Tok.tableP+ return (s, External r)+++createExternalTableP :: Parser (CreateTable Vertica RawNames Range)+createExternalTableP = do+ (s, createTableExternality) <- createExternalTablePrefixP+ let createTablePersistence = Persistent+ createTableIfNotExists <- ifNotExistsP+ createTableName <- tableNameP++ createTableDefinition <- createTableColumnsP -- TODO allow for column-name-list syntax++ _ <- optional $ do+ _ <- optional $ Tok.includeP <|> Tok.excludeP+ _ <- Tok.schemaP+ Tok.privilegesP++ _ <- Tok.asP+ e <- Tok.copyP++ e' <- consumeOrderedOptions e $+ [ ingestionColumnListP (getInfo <$> exprP)+ , ingestionColumnOptionP+ , fromP -- you need **either** a FROM or a SOURCE clause, but let's not be fussy+ , fileStorageFormatP+ ]++ e'' <- consumeUnorderedOptions e' $+ [ Tok.withP+ , abortOnErrorP+ , delimiterAsP+ , enclosedByP+ , Tok.enforceLengthP+ , errorToleranceP+ , escapeFormatP+ , exceptionsOnNodeP+ , fileFilterP+ , nullAsP+ , fileParserP+ , recordTerminatorP+ , rejectedDataOnNodeP+ , rejectMaxP+ , skipRecordsP+ , skipBytesP+ , fileSourceP+ , trailingNullColsP+ , trimByteP+ ]++ let createTableInfo = s <> e''+ createTableExtra = Nothing++ pure CreateTable{..}++ where+ stringP :: Parser Range+ stringP = snd <$> Tok.stringP++ fromP :: Parser Range+ fromP = do+ s <- Tok.fromP+ let fileP = do+ r <- stringP+ consumeOrderedOptions r [nodeLocationP, compressionP]+ rs <- fileP `sepBy1` Tok.commaP+ return $ s <> last rs++ nodeLocationP = choice $+ [ Tok.onP >> snd <$> Tok.nodeNameP+ , Tok.onP >> Tok.anyP >> Tok.nodeP+ ]++createViewPrefixP :: Parser (Range, Maybe Range, Persistence Range)+createViewPrefixP = do+ s <- Tok.createP+ ifNotExists <- optionMaybe $ do+ s' <- Tok.orP+ e' <- Tok.replaceP+ pure $ s' <> e'+ persistence <- option Persistent $ Temporary <$> do+ s' <- Tok.localP+ e' <- Tok.temporaryP+ pure $ s' <> e'++ e <- Tok.viewP+ pure (s <> e, ifNotExists, persistence)++schemaPrivilegesP :: Parser Range+schemaPrivilegesP = do+ s <- choice [ Tok.includeP, Tok.excludeP ]+ optional Tok.schemaP+ e <- Tok.privilegesP+ return $ s <> e++createViewP :: Parser (CreateView RawNames Range)+createViewP = do+ (s, createViewIfNotExists, createViewPersistence) <- createViewPrefixP++ createViewName <- tableNameP >>= \case+ QTableName info Nothing view ->+ case createViewPersistence of+ Persistent -> pure $ QTableName info Nothing view+ Temporary _ -> pure $ QTableName info (pure $ QSchemaName info Nothing "<session>" SessionSchema) view+ qualifiedTableName ->+ case createViewPersistence of+ Persistent -> pure $ qualifiedTableName+ Temporary _ -> fail $ "cannot specify schema on a local temporary view"++ createViewColumns <- optionMaybe $ do+ _ <- Tok.openP+ c:cs <- unqualifiedColumnNameP `sepBy1` Tok.commaP+ _ <- Tok.closeP+ return (c:|cs)++ case createViewPersistence of+ Persistent -> optional schemaPrivilegesP+ Temporary _ -> pure ()++ _ <- Tok.asP+ createViewQuery <- querySelectP++ let createViewInfo = s <> getInfo createViewQuery+ pure CreateView{..}+ where+ unqualifiedColumnNameP = do+ (name, r) <- Tok.columnNameP+ pure $ QColumnName r None name+++createTableP :: Parser (CreateTable Vertica RawNames Range)+createTableP = do+ s <- Tok.createP++ (createTablePersistence, isLocal) <- option (Persistent, False) $ do+ isLocal <- option False $ choice+ [ Tok.localP >> pure True+ , Tok.globalP >> pure False+ ]++ createTablePersistence <- Temporary <$> Tok.temporaryP+ pure (createTablePersistence, isLocal)++ let createTableExternality = Internal++ _ <- Tok.tableP++ createTableIfNotExists <- ifNotExistsP++ createTableName <- tableNameP >>= \case+ QTableName info Nothing table ->+ if isLocal+ then pure $ QTableName info (pure $ QSchemaName info Nothing "<session>" SessionSchema) table+ else pure $ QTableName info (pure $ QSchemaName info Nothing "public" NormalSchema) table+ qualifiedTableName ->+ if isLocal+ then fail "cannot specify schema on a local temporary table"+ else pure $ qualifiedTableName++ let onCommitP = case createTablePersistence of+ Persistent -> pure ()+ Temporary _ -> do+ -- TODO (T374141): do something with this+ _ <- Tok.onP+ _ <- Tok.commitP+ _ <- Tok.deleteP <|> Tok.preserveP+ void Tok.rowsP++ createTableDefinition <- choice+ [ createTableColumnsP <* optional onCommitP <* optional schemaPrivilegesP+ , try $ optional onCommitP *> optional schemaPrivilegesP *> createTableAsP+ , optional schemaPrivilegesP *> createTableLikeP+ ]++ createTableExtra <- tableInfoP++ case createTablePersistence of+ Persistent -> pure ()+ Temporary _ -> optional $ do+ _ <- Tok.noP+ void Tok.projectionP++ let e = maybe (getInfo createTableDefinition) getInfo createTableExtra+ createTableInfo = s <> e++ pure CreateTable{..}++ where+ columnListP :: Parser (NonEmpty (UQColumnName Range))+ columnListP = do+ _ <- Tok.openP+ c:cs <- (`sepBy1` Tok.commaP) $ do+ (name, r) <- Tok.columnNameP+ pure $ QColumnName r None name+ _ <- Tok.closeP+ pure (c:|cs)++ createTableLikeP = do+ s <- Tok.likeP+ table <- tableNameP+ e <- option (getInfo table) $ do+ -- TODO - include projection info in createTableExtra+ _ <- Tok.includingP <|> Tok.excludingP+ Tok.projectionsP++ pure $ TableLike (s <> e) table++ createTableAsP = do+ s <- Tok.asP+ columns <- optionMaybe $ try columnListP+ query <- optionalParensP $ queryP+ pure $ TableAs (s <> getInfo query) columns query++ tableInfoP :: Parser (Maybe (TableInfo RawNames Range))+ tableInfoP = do+ mOrdering <- optionMaybe orderTopLevelP+ let tableInfoOrdering = snd <$> mOrdering++ let tableInfoEncoding :: Maybe (TableEncoding RawNames Range)+ tableInfoEncoding = Nothing -- TODO++ tableInfoSegmentation <- optionMaybe $ choice+ [ do+ s <- Tok.unsegmentedP+ choice+ [ do+ _ <- Tok.nodeP+ node <- nodeNameP+ let e = getInfo node+ pure $ UnsegmentedOneNode (s <> e) node+ , do+ _ <- Tok.allP+ e <- Tok.nodesP+ pure $ UnsegmentedAllNodes (s <> e)+ ]+ , do+ s <- Tok.segmentedP+ _ <- Tok.byP+ expr <- exprP+ list <- nodeListP++ pure $ SegmentedBy (s <> getInfo list) expr list+ ]++ tableInfoKSafety <- optionMaybe $ do+ s <- Tok.ksafeP+ choice+ [ do+ (n, e) <- integerP+ pure $ KSafety (s <> e) (Just n)++ , pure $ KSafety s Nothing+ ]++ tableInfoPartitioning <- optionMaybe $ do+ s <- Tok.partitionP+ _ <- Tok.byP+ expr <- exprP+ pure $ Partitioning (s <> getInfo expr) expr++ let infos = [ fst <$> mOrdering+ , getInfo <$> tableInfoEncoding+ , getInfo <$> tableInfoSegmentation+ , getInfo <$> tableInfoKSafety+ , getInfo <$> tableInfoPartitioning+ ]++ case getOption $ mconcat $ map Option infos of+ Nothing -> pure Nothing+ Just tableInfoInfo -> pure $ Just TableInfo{..}+++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+ (dropTableName:rest) <- tableNameP `sepBy1` Tok.commaP+ cascade <- optionMaybe Tok.cascadeP++ let dropTableNames = dropTableName :| rest+ dropTableInfo = s <> (fromMaybe (getInfo $ NE.last dropTableNames) cascade)+ pure DropTable{..}+++grantP :: Parser (Grant Range)+grantP = do+ s <- Tok.grantP+ e <- many1 Tok.notSemicolonP+ return $ Grant (s <> (last e))++revokeP :: Parser (Revoke Range)+revokeP = do+ s <- Tok.revokeP+ e <- many1 Tok.notSemicolonP+ return $ Revoke (s <> (last e))+++beginP :: Parser Range+beginP = do+ s <- choice [ do+ s <- Tok.beginP+ e <- option s (Tok.workP <|> Tok.transactionP)+ return $ s <> e+ , do+ s <- Tok.startP+ e <- Tok.transactionP+ return $ s <> e+ ]+ e <- consumeOrderedOptions s [isolationLevelP, transactionModeP]+ return $ s <> e+ where+ isolationLevelP :: Parser Range+ isolationLevelP = do+ s <- Tok.isolationP+ _ <- Tok.levelP+ e <- choice [ Tok.serializableP+ , Tok.repeatableP >> Tok.readP+ , Tok.readP >> (Tok.committedP <|> Tok.uncommittedP)+ ]+ return $ s <> e++ transactionModeP :: Parser Range+ transactionModeP = do+ s <- Tok.readP+ e <- Tok.onlyP <|> Tok.writeP+ return $ s <> e++commitP :: Parser Range+commitP = do+ s <- Tok.commitP <|> Tok.endP+ e <- option s (Tok.workP <|> Tok.transactionP)+ return $ s <> e++rollbackP :: Parser Range+rollbackP = do+ s <- Tok.rollbackP <|> Tok.abortP+ e <- option s (Tok.workP <|> Tok.transactionP)+ return $ s <> e++nodeListP :: Parser (NodeList Range)+nodeListP = choice+ [ do+ s <- Tok.allP+ e <- Tok.nodesP+ offset <- optionMaybe nodeListOffsetP++ let e' = maybe e getInfo offset++ pure $ AllNodes (s <> e') offset++ , do+ s <- Tok.nodesP+ n:ns <- nodeNameP `sepBy1` Tok.commaP+ let e = getInfo $ last (n:ns)+ pure $ Nodes (s <> e) (n:|ns)+ ]++nodeListOffsetP :: Parser (NodeListOffset Range)+nodeListOffsetP = do+ s <- Tok.offsetP+ (n, e) <- integerP+ pure $ NodeListOffset (s <> e) n++nodeNameP :: Parser (Node Range)+nodeNameP = do+ (node, e) <- Tok.nodeNameP+ pure $ Node e node++integerP :: Parser (Int, Range)+integerP = do+ (n, e) <- Tok.numberP+ case reads $ TL.unpack n of+ [(n', "")] -> pure (n', e)+ _ -> fail $ unwords ["unable to parse", show n, "as integer"]+++selectP :: Parser (Select RawNames Range)+selectP = do+ r <- Tok.selectP++ selectDistinct <- option notDistinct distinctP++ selectCols <- do+ selections <- selectionP `sepBy1` Tok.commaP+ let r' = foldl1 (<>) $ map getInfo selections+ return $ SelectColumns r' selections++ selectFrom <- optionMaybe fromP+ selectWhere <- optionMaybe whereP+ selectTimeseries <- optionMaybe timeseriesP+ selectGroup <- optionMaybe groupP+ selectHaving <- optionMaybe havingP+ selectNamedWindow <- optionMaybe namedWindowP++ let (Just selectInfo) = sconcat $ Just r :|+ [ Just $ getInfo selectCols+ , getInfo <$> selectFrom+ , getInfo <$> selectWhere+ , getInfo <$> selectTimeseries+ , getInfo <$> selectGroup+ , getInfo <$> selectHaving+ , getInfo <$> selectNamedWindow+ ]+ return Select{..}++ where+ fromP = do+ r <- Tok.fromP+ tablishes <- tablishP `sepBy1` Tok.commaP++ let r' = foldl (<>) r $ fmap getInfo tablishes+ return $ SelectFrom r' tablishes++ whereP = do+ r <- Tok.whereP+ condition <- exprP+ return $ SelectWhere (r <> getInfo condition) condition++ timeseriesP = do+ s <- Tok.timeseriesP++ selectTimeseriesSliceName <- columnAliasP++ _ <- Tok.asP++ selectTimeseriesInterval <- do+ (c, r) <- Tok.stringP+ pure $ StringConstant r c++ _ <- Tok.overP+ _ <- Tok.openP+ selectTimeseriesPartition <- optionMaybe partitionP+ selectTimeseriesOrder <- do+ _ <- Tok.orderP+ _ <- Tok.byP+ exprP+ e <- Tok.closeP++ let selectTimeseriesInfo = s <> e+ pure $ SelectTimeseries {..}++ toGroupingElement :: PositionOrExpr RawNames Range -> GroupingElement RawNames Range+ toGroupingElement posOrExpr = GroupingElementExpr (getInfo posOrExpr) posOrExpr++ groupP = do+ r <- Tok.groupP+ _ <- Tok.byP+ exprs <- exprP `sepBy1` Tok.commaP++ let selectGroupGroupingElements = map (toGroupingElement . handlePositionalReferences) exprs+ selectGroupInfo = foldl (<>) r $ fmap getInfo selectGroupGroupingElements+ return SelectGroup{..}++ havingP = do+ r <- Tok.havingP+ conditions <- exprP `sepBy1` Tok.commaP++ let r' = foldl (<>) r $ fmap getInfo conditions+ return $ SelectHaving r' conditions++ namedWindowP =+ do+ r <- Tok.windowP+ windows <- (flip sepBy1) Tok.commaP $ do+ name <- windowNameP+ _ <- Tok.asP+ _ <- Tok.openP+ window <- choice+ [ do+ partition@(Just p) <- Just <$> partitionP+ order <- option [] orderInWindowClauseP+ let orderInfos = map getInfo order -- better way?+ info = L.foldl' (<>) (getInfo p) orderInfos+ return $ Left $ WindowExpr info partition order Nothing+ , do+ inherit <- windowNameP+ order <- option [] orderInWindowClauseP+ let orderInfo = map getInfo order -- better way?+ info = L.foldl' (<>) (getInfo inherit) orderInfo+ return $ Right $ PartialWindowExpr info inherit Nothing order Nothing+ ]+ e <- Tok.closeP+ let info = getInfo name <> e+ return $ case window of+ Left w -> NamedWindowExpr info name w+ Right pw -> NamedPartialWindowExpr info name pw+ let info = L.foldl' (<>) r $ fmap getInfo windows+ return $ SelectNamedWindow info windows++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+++selectStarP :: Parser (Selection RawNames Range)+selectStarP = choice+ [ do+ r <- Tok.starP+ return $ SelectStar r Nothing Unused++ , try $ do+ (t, r) <- Tok.tableNameP+ _ <- Tok.dotP+ r' <- Tok.starP++ return $ SelectStar (r <> r') (Just $ QTableName r Nothing t) Unused++ , try $ do+ (s, t, r, r') <- qualifiedTableNameP+ _ <- Tok.dotP+ r'' <- Tok.starP++ return $ SelectStar (r <> r'')+ (Just $ QTableName r' (Just $ mkNormalSchema s r) t) Unused+ ]+++selectionP :: Parser (Selection RawNames Range)+selectionP = try selectStarP <|> do+ expr <- exprP+ alias <- aliasP expr++ return $ SelectExpr (getInfo alias <> getInfo expr) [alias] expr++makeColumnAlias :: Range -> Text -> Parser (ColumnAlias Range)+makeColumnAlias r alias = ColumnAlias r alias . ColumnAliasId <$> getNextCounter++makeTableAlias :: Range -> Text -> Parser (TableAlias Range)+makeTableAlias r alias = TableAlias r alias . TableAliasId <$> getNextCounter++makeDummyAlias :: Range -> Parser (ColumnAlias Range)+makeDummyAlias r = makeColumnAlias r "?column?"+++makeExprAlias :: Expr RawNames Range -> Parser (ColumnAlias Range)+makeExprAlias (BinOpExpr info _ _ _) = makeDummyAlias info+makeExprAlias (UnOpExpr info _ _) = makeDummyAlias info+makeExprAlias (LikeExpr info _ _ _ _) = makeDummyAlias info+makeExprAlias (CaseExpr info _ _) = makeDummyAlias info+makeExprAlias (ColumnExpr info (QColumnName _ _ name)) = makeColumnAlias info name+makeExprAlias (ConstantExpr info _) = makeDummyAlias info+makeExprAlias (InListExpr info _ _) = makeDummyAlias info+makeExprAlias (InSubqueryExpr info _ _) = makeDummyAlias info+makeExprAlias (BetweenExpr info _ _ _) = makeDummyAlias info+makeExprAlias (OverlapsExpr info _ _) = makeDummyAlias info+makeExprAlias (AtTimeZoneExpr info _ _) = makeColumnAlias info "timezone" -- because reasons++-- function expressions get the name of the function+makeExprAlias (FunctionExpr info (QFunctionName _ _ name) _ _ _ _ _) = makeColumnAlias info name+makeExprAlias (SubqueryExpr info _) = makeDummyAlias info+makeExprAlias (ArrayExpr info _) = makeDummyAlias info -- might actually be "array", but I'm not sure how to check+makeExprAlias (ExistsExpr info _) = makeDummyAlias info+makeExprAlias (FieldAccessExpr _ _ _) = fail "Unsupported struct access in Vertica: unused datatype in this dialect"+makeExprAlias (ArrayAccessExpr _ _ _) = fail "Unsupported array access in Vertica: unused datatype in this dialect"+makeExprAlias (TypeCastExpr _ _ expr _) = makeExprAlias expr+makeExprAlias (VariableSubstitutionExpr _) = fail "Unsupported variable substitution in Vertica: unused datatype in this dialect"+++aliasP :: Expr RawNames Range -> Parser (ColumnAlias Range)+aliasP expr = choice+ [ try $ do+ optional Tok.asP+ (name, r) <- choice+ [ Tok.columnNameP+ , first TL.decodeUtf8 <$> Tok.stringP+ ]+ makeColumnAlias r name++ , do+ _ <- Tok.asP+ _ <- P.between Tok.openP Tok.closeP $ Tok.columnNameP `sepBy1` Tok.commaP+ makeExprAlias expr++ , makeExprAlias expr+ ]+++exprP :: Parser (Expr RawNames Range)+exprP = orExprP++parenExprP :: Parser (Expr RawNames Range)+parenExprP = P.between Tok.openP Tok.closeP $ choice+ [ try subqueryExprP+ , exprP+ ]++subqueryExprP :: Parser (Expr RawNames Range)+subqueryExprP = do+ query <- queryP+ return $ SubqueryExpr (getInfo query) query++caseExprP :: Parser (Expr RawNames Range)+caseExprP = do+ r <- Tok.caseP+ whens <- choice+ [ P.many1 $ do+ _ <- Tok.whenP+ condition <- exprP+ _ <- Tok.thenP+ result <- exprP+ return (condition, result)++ , do+ expr <- exprP+ P.many1 $ do+ whenr <- Tok.whenP+ nullseq <- optionMaybe Tok.nullsequalP++ condition <- case nullseq of+ Nothing -> BinOpExpr whenr "=" expr <$> exprP+ Just nullseqr -> BinOpExpr (whenr <> nullseqr) "<=>" expr <$> exprP++ _ <- Tok.thenP+ result <- exprP+ return (condition, result)+ ]++ melse <- optionMaybe $ do+ _ <- Tok.elseP+ exprP++ r' <- Tok.endP++ return $ CaseExpr (r <> r') whens melse+++fieldTypeP :: Parser (Expr RawNames Range)+fieldTypeP = do+ (ftype, r) <- Tok.fieldTypeP+ return $ ConstantExpr r $ StringConstant r $ TL.encodeUtf8 ftype++functionExprP :: Parser (Expr RawNames Range)+functionExprP = choice+ [ castFuncP+ , dateDiffFuncP+ , extractFuncP+ , try regularFuncP+ , bareFuncP+ ]+ where+ castFuncP = do+ r <- Tok.castP+ _ <- Tok.openP+ e <- exprP+ _ <- Tok.asP+ t <- choice+ [ try $ do+ i <- Tok.intervalP+ (unit, u) <- Tok.datePartP+ pure $ PrimitiveDataType (i <> u) ("INTERVAL " <> TL.toUpper unit) []+ , dataTypeP+ ]+ r' <- Tok.closeP++ return $ TypeCastExpr (r <> r') CastFailureError e t++ dateDiffFuncP = do+ r <- Tok.dateDiffP+ _ <- Tok.openP+ datepart <- choice+ [ do+ _ <- Tok.openP+ expr <- exprP+ _ <- Tok.closeP++ pure expr++ , do+ (string, r') <- Tok.stringP+ pure $ ConstantExpr r' $ StringConstant r' string++ , do+ (string, r') <- Tok.datePartP+ pure $ ConstantExpr r' $ StringConstant r' $ TL.encodeUtf8 string+ ]+ _ <- Tok.commaP+ startExp <- exprP+ _ <- Tok.commaP+ endExp <- exprP+ r' <- Tok.closeP++ return $ FunctionExpr (r <> r') (QFunctionName r Nothing "datediff") notDistinct [datepart, startExp, endExp] [] Nothing Nothing++ extractFuncP = do+ r <- Tok.extractP+ _ <- Tok.openP+ ftype <- fieldTypeP+ _ <- Tok.fromP+ expr <- exprP+ r' <- Tok.closeP++ return $ FunctionExpr (r <> r') (QFunctionName r Nothing "extract") notDistinct [ftype, expr] [] Nothing Nothing++ regularFuncP = do+ name <- choice+ [ try $ do+ (s, r) <- Tok.schemaNameP+ _ <- Tok.dotP+ (f, r') <- Tok.functionNameP+ return $ QFunctionName (r <> r') (Just $ mkNormalSchema s r) f++ , do+ (f, r) <- Tok.functionNameP+ return $ QFunctionName r Nothing f+ ]++ (distinct, arguments, parameters, r') <- do+ _ <- Tok.openP+ (distinct, arguments) <- choice+ [ case name of+ QFunctionName _ Nothing "count" -> do+ r' <- Tok.starP+ return ( notDistinct+ , [ConstantExpr r' $ NumericConstant r' "1"]+ )++ QFunctionName _ Nothing "substring" -> do+ arg1 <- exprP+ word <- (const True <$> Tok.fromP)+ <|> (const False <$> Tok.commaP)+ arg2 <- exprP+ arg3 <- optionMaybe $ do+ _ <- if word then Tok.forP else Tok.commaP+ exprP+ return ( notDistinct+ , arg1 : arg2 : maybe [] pure arg3+ )++ _ -> fail "no special case for function"++ , do+ isDistinct <- distinctP+ (isDistinct,) . (:[]) <$> exprP++ , (notDistinct,) <$> exprP `sepBy` Tok.commaP+ ]++ parameters <- option [] $ do+ _ <- Tok.usingP+ _ <- Tok.parametersP++ flip sepBy1 Tok.commaP $ do+ (param, paramr) <- Tok.paramNameP+ _ <- Tok.equalP+ expr <- exprP+ pure (ParamName paramr param, expr)++ optional $ Tok.ignoreP >> Tok.nullsP++ r' <- Tok.closeP+ return (distinct, arguments, parameters, r')++ over <- optionMaybe $ try $ overP++ let r'' = maybe r' getInfo over <> getInfo name++ return $ FunctionExpr r'' name distinct arguments parameters Nothing over++ bareFuncP = do+ (v, r) <- choice+ [ Tok.currentDatabaseP+ , Tok.currentSchemaP+ , Tok.userP+ , Tok.currentUserP+ , Tok.sessionUserP+ , Tok.currentDateP+ , Tok.currentTimeP+ , Tok.currentTimestampP+ , Tok.localTimeP+ , Tok.localTimestampP+ , Tok.sysDateP+ ]++ pure $ FunctionExpr r (QFunctionName r Nothing v) notDistinct [] [] Nothing Nothing++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'+ , Tok.autoP >>= \ r' -> return $ NullsAuto $ Just $ r <> r'+ ]++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+ , constantP >>= \ expr -> choice+ [ Tok.precedingP >>= \ r ->+ return $ Preceding (getInfo expr <> r) expr++ , Tok.followingP >>= \ r ->+ return $ Following (getInfo expr <> r) expr+ ]+ ]+++overP :: Parser (OverSubExpr RawNames Range)+overP = do+ start <- Tok.overP+ subExpr <- choice+ [ Left <$> windowP+ , Right <$> windowNameP+ ]+ return $ case subExpr of+ Left w -> mergeWindowInfo start w+ Right wn -> OverWindowName (start <> getInfo wn) wn+ where+ windowP :: Parser (OverSubExpr RawNames Range)+ windowP = do+ start' <- Tok.openP+ expr <- choice+ [ Left <$> windowExprP start'+ , Right <$> partialWindowExprP start'+ ]+ return $ case expr of+ Left w -> OverWindowExpr (start' <> getInfo w) w+ Right pw -> OverPartialWindowExpr (start' <> getInfo pw) pw++ mergeWindowInfo :: Range -> OverSubExpr RawNames Range -> OverSubExpr RawNames Range+ mergeWindowInfo r = \case+ OverWindowExpr r' WindowExpr{..} ->+ OverWindowExpr (r <> r') $ WindowExpr { windowExprInfo = windowExprInfo <> r , ..}+ OverWindowName r' n -> OverWindowName (r <> r') n+ OverPartialWindowExpr r' PartialWindowExpr{..} ->+ OverPartialWindowExpr (r <> r') $ PartialWindowExpr { partWindowExprInfo = partWindowExprInfo <> r , ..}++windowExprP :: Range -> Parser (WindowExpr RawNames Range)+windowExprP start =+ do+ partition <- optionMaybe partitionP+ order <- option [] orderInWindowClauseP+ frame <- optionMaybe frameP+ end <- Tok.closeP+ let info = start <> end+ return (WindowExpr info partition order frame)++partialWindowExprP :: Range -> Parser (PartialWindowExpr RawNames Range)+partialWindowExprP start =+ do+ inherit <- windowNameP+ order <- option [] orderInWindowClauseP+ frame <- optionMaybe frameP+ end <- Tok.closeP+ let info = start <> end+ return (PartialWindowExpr info inherit Nothing order frame)++windowNameP :: Parser (WindowName Range)+windowNameP =+ do+ (name, r) <- Tok.windowNameP+ return $ WindowName r name++partitionP :: Parser (Partition RawNames Range)+partitionP = do+ r <- Tok.partitionP+ choice+ [ Tok.byP >> (exprP `sepBy1` Tok.commaP) >>= \ exprs ->+ return $ PartitionBy+ (sconcat $ r :| map getInfo exprs) exprs++ , Tok.bestP >>= \ r' -> return $ PartitionBest (r <> r')+ , Tok.nodesP >>= \ r' -> return $ PartitionNodes (r <> r')+ ]+++existsExprP :: Parser (Expr RawNames Range)+existsExprP = do+ r <- Tok.existsP+ _ <- Tok.openP+ query <- queryP+ r' <- Tok.closeP++ return $ ExistsExpr (r <> r') query+++arrayExprP :: Parser (Expr RawNames Range)+arrayExprP = do+ s <- Tok.arrayP+ _ <- Tok.openBracketP+ cs <- exprP `sepBy` Tok.commaP+ e <- Tok.closeBracketP+ pure $ ArrayExpr (s <> e) cs+++castExprP :: Parser (Expr RawNames Range)+castExprP = foldl (flip ($)) <$> castedP <*> many castP+ where+ castedP :: Parser (Expr RawNames Range)+ castedP = choice+ [ try parenExprP+ , try existsExprP+ , try arrayExprP+ , try functionExprP+ , caseExprP+ , try $ do+ constant <- constantP+ return $ ConstantExpr (getInfo constant) constant++ , do+ name <- columnNameP+ return $ ColumnExpr (getInfo name) name+ ]++ castP :: Parser (Expr RawNames Range -> Expr RawNames Range)+ castP = do+ _ <- Tok.castOpP+ typeName <- dataTypeP++ let r expr = getInfo expr <> getInfo typeName+ return (\ expr -> TypeCastExpr (r expr) CastFailureError expr typeName)+++atTimeZoneExprP :: Parser (Expr RawNames Range)+atTimeZoneExprP = foldl (flip ($)) <$> castExprP <*> many atTimeZoneP+ where+ atTimeZoneP :: Parser (Expr RawNames Range -> Expr RawNames Range)+ atTimeZoneP = do+ _ <- Tok.atP+ _ <- Tok.timezoneP+ tz <- castExprP++ return $ \ expr ->+ AtTimeZoneExpr (getInfo expr <> getInfo tz) expr tz+++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+++negateExprP :: Parser (Expr RawNames Range)+negateExprP = do+ neg <- option id $ choice $ map unOpP [ "+", "-", "@" ]+ expr <- atTimeZoneExprP+ return $ neg 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+++exponentExprP :: Parser (Expr RawNames Range)+exponentExprP = negateExprP `chainl1` binOpP "^"+++productExprP :: Parser (Expr RawNames Range)+productExprP = exponentExprP `chainl1` opP+ where+ opP = choice $ map binOpP [ "*", "//", "/", "%" ]+++sumExprP :: Parser (Expr RawNames Range)+sumExprP = productExprP `chainl1` opP+ where+ opP = choice $ map binOpP [ "+", "-" ]+++notP :: Parser (Expr RawNames Range -> Expr RawNames Range)+notP = (\ r -> UnOpExpr r "NOT") <$> Tok.notP++isExprP :: Parser (Expr RawNames Range)+isExprP = do+ expr <- sumExprP+ is <- fmap (foldl (.) id) $ many $ choice+ [ do+ _ <- Tok.isP++ not_ <- option id notP++ (not_ .) <$> choice+ [ Tok.trueP >>= \ r -> return (UnOpExpr r "ISTRUE")+ , Tok.falseP >>= \ r -> return (UnOpExpr r "ISFALSE")+ , Tok.nullP >>= \ r -> return (UnOpExpr r "ISNULL")+ , Tok.unknownP >>= \ r -> return (UnOpExpr r "ISUNKNOWN")+ ]+ , Tok.isnullP >>= \ r -> return (UnOpExpr r "ISNULL")+ , Tok.notnullP >>= \ r -> return (UnOpExpr r "NOT" . UnOpExpr r "ISNULL")+ ]++ return $ is expr+++appendExprP :: Parser (Expr RawNames Range)+appendExprP = isExprP `chainl1` binOpP "||"+++inExprP :: Parser (Expr RawNames Range)+inExprP = do+ expr <- appendExprP+ not_ <- option id notP+ in_ <- foldl (.) id <$> many inP++ return $ not_ $ in_ expr++ where+ inP = do+ _ <- Tok.inP+ _ <- Tok.openP+ list <- choice+ [ Left <$> queryP+ , Right <$> exprP `sepBy1` Tok.commaP+ ]++ r <- Tok.closeP++ return $ case list of+ Left query ->+ \ expr -> InSubqueryExpr (getInfo expr <> r) query expr++ Right constants ->+ \ expr -> InListExpr (getInfo expr <> r) constants expr++betweenExprP :: Parser (Expr RawNames Range)+betweenExprP = do+ expr <- inExprP+ between <- foldl (.) id <$> many betweenP++ return $ between expr+ where+ betweenP = do+ _ <- Tok.betweenP+ start <- sumExprP+ _ <- Tok.andP+ end <- sumExprP++ let r expr = getInfo expr <> getInfo end+ return $ \ expr -> BetweenExpr (r expr) start end expr+++overlapsExprP :: Parser (Expr RawNames Range)+overlapsExprP = try overlapsP <|> betweenExprP+ where+ overlapsP = do+ let pair :: Parser a -> Parser ((a, a), Range)+ pair p = do+ r <- Tok.openP+ s <- p+ _ <- Tok.commaP+ e <- p+ r' <- Tok.closeP+ return ((s, e), r <> r')++ (lhs, r) <- pair exprP+ _ <- Tok.overlapsP+ (rhs, r') <- pair exprP+ return $ OverlapsExpr (r <> r') lhs rhs+++likeExprP :: Parser (Expr RawNames Range)+likeExprP = do+ expr <- overlapsExprP+ like <- option id comparisonP+ return $ like expr+ where+ comparisonP :: Parser (Expr RawNames Range -> Expr RawNames Range)+ comparisonP = choice+ [ do+ comparison <- symbolComparisonP+ pattern <- Pattern <$> overlapsExprP+ return $ comparison pattern+ , do+ comparison <- textComparisonP+ pattern <- Pattern <$> overlapsExprP+ escape <- optionMaybe $ do+ _ <- Tok.escapeP+ Escape <$> exprP++ return $ comparison escape pattern+ ]+++ symbolComparisonP :: Parser (Pattern RawNames Range -> Expr RawNames Range -> Expr RawNames Range)+ symbolComparisonP = choice $+ let r expr pattern = getInfo expr <> getInfo pattern+ in [ do+ _ <- Tok.likeOpP+ return $ \ pattern expr -> LikeExpr (r pattern expr) "LIKE" Nothing pattern expr++ , do+ _ <- Tok.iLikeOpP+ return $ \ pattern expr -> LikeExpr (r pattern expr) "ILIKE" Nothing pattern expr++ , do+ _ <- Tok.notLikeOpP+ return $ \ pattern expr ->+ UnOpExpr (r pattern expr) "NOT" $ LikeExpr (r pattern expr) "LIKE" Nothing pattern expr++ , do+ _ <- Tok.notILikeOpP+ return $ \ pattern expr ->+ UnOpExpr (r pattern expr) "NOT" $ LikeExpr (r pattern expr) "ILIKE" Nothing pattern expr+ , do+ _ <- Tok.regexMatchesP+ return $ \ pattern expr ->+ BinOpExpr (r pattern expr) "REGEX MATCHES" expr $ patternExpr pattern++ , do+ _ <- Tok.regexIgnoreCaseMatchesP+ return $ \ pattern expr ->+ BinOpExpr (r pattern expr) "REGEX IGNORE-CASE MATCHES" expr $ patternExpr pattern++ , do+ _ <- Tok.notRegexMatchesP+ return $ \ pattern expr ->+ UnOpExpr (r pattern expr) "NOT" $+ BinOpExpr (r pattern expr) "REGEX MATCHES" expr $ patternExpr pattern++ , do+ _ <- Tok.notRegexIgnoreCaseMatchesP+ return $ \ pattern expr ->+ UnOpExpr (r pattern expr) "NOT" $+ BinOpExpr (r pattern expr) "REGEX IGNORE-CASE MATCHES" expr $ patternExpr pattern++ ]++ textComparisonP :: Parser (Maybe (Escape RawNames Range) -> Pattern RawNames Range -> Expr RawNames Range -> Expr RawNames Range)+ textComparisonP = do+ not_ <- option id notP++ like <- choice+ [ Tok.likeP >>= \ r -> return $ LikeExpr r "LIKE"+ , Tok.iLikeP >>= \ r -> return $ LikeExpr r "ILIKE"+ , Tok.likeBP >>= \ r -> return $ LikeExpr r "LIKE"+ , Tok.iLikeBP >>= \ r -> return $ LikeExpr r "ILIKE"+ ]++ return $ \ escape pattern expr -> not_ $ like escape pattern expr+++mkBinOp :: (Text, a) -> Expr r a -> Expr r a -> Expr r a+mkBinOp (op, r) = BinOpExpr r (Operator op)++inequalityExprP :: Parser (Expr RawNames Range)+inequalityExprP = likeExprP `chainl1` (mkBinOp <$> Tok.inequalityOpP)+++equalityExprP :: Parser (Expr RawNames Range)+equalityExprP = inequalityExprP `chainl1` (mkBinOp <$> Tok.equalityOpP)+++notExprP :: Parser (Expr RawNames Range)+notExprP = do+ nots <- appEndo . fold . reverse . map Endo <$> many notP+ expr <- equalityExprP+ return $ nots expr+++andExprP :: Parser (Expr RawNames Range)+andExprP = notExprP `chainl1`+ (Tok.andP >>= \ r -> return $ BinOpExpr r "AND")+++orExprP :: Parser (Expr RawNames Range)+orExprP = andExprP `chainl1` (Tok.orP >>= \ r -> return (BinOpExpr r "OR"))+++singleTableP :: Parser (Tablish RawNames Range)+singleTableP = try subqueryP <|> try tableP <|> parenthesizedJoinP+ where+ subqueryP = do+ r <- Tok.openP+ query <- queryP+ _ <- Tok.closeP+ optional Tok.asP+ (name, r') <- Tok.tableNameP++ alias <- makeTableAlias r' name+ return $ TablishSubQuery (r <> r')+ (TablishAliasesT alias)+ query++ tableP = do+ name <- tableNameP+ maybe_alias <- optionMaybe $ do+ optional Tok.asP+ (alias, r) <- Tok.tableNameP+ makeTableAlias r alias++ let r = case maybe_alias of+ Nothing -> getInfo name+ Just alias -> getInfo alias <> getInfo name+ aliases = maybe TablishAliasesNone TablishAliasesT maybe_alias++ return $ TablishTable r aliases name++ parenthesizedJoinP = do+ tablish <- P.between Tok.openP Tok.closeP $ do+ table <- singleTableP+ joins <- fmap (appEndo . fold . reverse) $ many1 $ Endo <$> joinP+ return $ joins table++ optional $ do+ optional Tok.asP+ void Tok.tableNameP++ pure tablish+++optionalParensP :: Parser a -> Parser a+optionalParensP p = try p <|> P.between Tok.openP Tok.closeP p++manyParensP :: Parser a -> Parser a+manyParensP p = try p <|> P.between Tok.openP Tok.closeP (manyParensP p)++tablishP :: Parser (Tablish RawNames Range)+tablishP = do+ table <- singleTableP+ joins <- fmap (appEndo . fold . reverse) $ many $ Endo <$> joinP+ return $ joins table++joinP :: Parser (Tablish RawNames Range -> Tablish RawNames Range)+joinP = regularJoinP <|> naturalJoinP <|> crossJoinP++regularJoinP :: Parser (Tablish RawNames Range -> Tablish RawNames Range)+regularJoinP = do+ maybeJoinType <- optionMaybe $ innerJoinTypeP <|> outerJoinTypeP+ joinType <- Tok.joinP >>= \ r -> return $ case maybeJoinType of+ Nothing -> JoinInner r+ Just joinType -> (<> r) <$> joinType++ rhs <- singleTableP+ 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+ ]++ let r lhs = getInfo lhs <> getInfo rhs <> getInfo condition+ return $ \ lhs ->+ TablishJoin (r lhs) joinType condition lhs rhs++outerJoinTypeP :: Parser (JoinType Range)+outerJoinTypeP = do+ joinType <- choice+ [ Tok.leftP >>= \ r -> return $ JoinLeft r+ , Tok.rightP >>= \ r -> return $ JoinRight r+ , Tok.fullP >>= \ r -> return $ JoinFull r+ ]++ optional Tok.outerP++ return joinType++innerJoinTypeP :: Parser (JoinType Range)+innerJoinTypeP = Tok.innerP >>= \ r -> return $ JoinInner r++naturalJoinP :: Parser (Tablish RawNames Range -> Tablish RawNames Range)+naturalJoinP = do+ r <- Tok.naturalP+ maybeJoinType <- optionMaybe $ innerJoinTypeP <|> outerJoinTypeP+ joinType <- Tok.joinP >>= \ r' -> return $ case maybeJoinType of+ Nothing -> JoinInner r+ Just joinType -> (const $ r <> r') <$> joinType++ rhs <- singleTableP++ let r' lhs = getInfo lhs <> getInfo rhs+ return $ \ lhs -> TablishJoin (r' lhs) joinType (JoinNatural r Unused) lhs rhs++crossJoinP :: Parser (Tablish RawNames Range -> Tablish RawNames Range)+crossJoinP = do+ r <- Tok.crossP+ r'<- Tok.joinP+ rhs <- singleTableP++ let r'' lhs = getInfo lhs <> getInfo rhs+ joinInfo = r <> r'+ true' = JoinOn $ ConstantExpr joinInfo $ BooleanConstant joinInfo True+ return $ \ lhs ->+ TablishJoin (r'' lhs) (JoinInner joinInfo) true' lhs rhs+++createProjectionPrefixP :: Parser Range+createProjectionPrefixP = do+ s <- Tok.createP+ e <- Tok.projectionP+ pure $ s <> e+++createProjectionP :: Parser (CreateProjection RawNames Range)+createProjectionP = do+ s <- createProjectionPrefixP++ createProjectionIfNotExists <- ifNotExistsP+ createProjectionName <- projectionNameP+ createProjectionColumns <- optionMaybe $ try columnListP+ _ <- Tok.asP+ createProjectionQuery <- queryP++ createProjectionSegmentation <- optionMaybe $ choice+ [ do+ s' <- Tok.unsegmentedP+ choice+ [ do+ _ <- Tok.nodeP+ node <- nodeNameP+ let e' = getInfo node+ pure $ UnsegmentedOneNode (s' <> e') node+ , do+ _ <- Tok.allP+ e' <- Tok.nodesP+ pure $ UnsegmentedAllNodes (s' <> e')+ ]+ , do+ s' <- Tok.segmentedP+ _ <- Tok.byP+ expr <- exprP+ list <- nodeListP++ pure $ SegmentedBy (s' <> getInfo list) expr list+ ]++ createProjectionKSafety <- optionMaybe $ do+ s' <- Tok.ksafeP+ choice+ [ do+ (n, e') <- integerP+ pure $ KSafety (s' <> e') (Just n)++ , pure $ KSafety s' Nothing+ ]++ let createProjectionInfo =+ sconcat $ s :| catMaybes [ Just $ getInfo createProjectionQuery+ , getInfo <$> createProjectionSegmentation+ , getInfo <$> createProjectionKSafety+ ]++ pure CreateProjection{..}++ where+ columnListP :: Parser (NonEmpty (ProjectionColumn Range))+ columnListP = do+ _ <- Tok.openP+ c:cs <- flip sepBy1 Tok.commaP $ do+ (projectionColumnName, s) <- Tok.columnNameP+ projectionColumnAccessRank <- optionMaybe $ do+ s' <- Tok.accessRankP+ (n, e') <- integerP+ pure $ AccessRank (s' <> e') n++ projectionColumnEncoding <- optionMaybe $ do+ _ <- Tok.encodingP+ Tok.encodingTypeP++ let projectionColumnInfo =+ sconcat $ s :| catMaybes [ getInfo <$> projectionColumnAccessRank+ , getInfo <$> projectionColumnEncoding ]++ pure ProjectionColumn{..}++ _ <- Tok.closeP+ pure (c:|cs)+++multipleRenameP :: Parser (MultipleRename RawNames Range)+multipleRenameP = do+ s <- Tok.alterP+ _ <- Tok.tableP++ sources <- tableNameP `sepBy1` Tok.commaP++ _ <- Tok.renameP+ _ <- Tok.toP++ targets <- map (\ uqtn -> uqtn { tableNameSchema = Nothing }) <$> unqualifiedTableNameP `sepBy1` Tok.commaP++ when (length sources /= length targets) $ fail "multi-renames require the same number of sources and targets"++ let e = getInfo $ last targets+ pairs = zip sources targets+ toAlterTableRename = \ (from, to) ->+ AlterTableRenameTable (getInfo from <> getInfo to) from to+ renames = map toAlterTableRename pairs+ pure $ MultipleRename (s <> e) renames+++setSchemaP :: Parser (SetSchema RawNames Range)+setSchemaP = do+ s <- Tok.alterP+ _ <- Tok.tableP++ table <- tableNameP++ _ <- Tok.setP+ _ <- Tok.schemaP++ (schema, r) <- Tok.schemaNameP++ e <- option r $ choice [Tok.restrictP, Tok.cascadeP]++ pure $ SetSchema (s <> e) table $ mkNormalSchema schema r+++renameProjectionP :: Parser Range+renameProjectionP = do+ s <- Tok.alterP+ _ <- Tok.projectionP++ _ <- projectionNameP++ _ <- Tok.renameP+ _ <- Tok.toP++ to <- projectionNameP++ pure $ s <> getInfo to+++alterResourcePoolPrefixP :: Parser Range+alterResourcePoolPrefixP = do+ s <- Tok.alterP+ _ <- Tok.resourceP+ e <- Tok.poolP+ pure $ s <> e++alterResourcePoolP :: Parser Range+alterResourcePoolP = do+ s <- alterResourcePoolPrefixP+ ts <- P.many Tok.notSemicolonP+ pure $ case reverse ts of+ [] -> s+ e:_ -> s <> e+++createResourcePoolPrefixP :: Parser Range+createResourcePoolPrefixP = do+ s <- Tok.createP+ _ <- Tok.resourceP+ e <- Tok.poolP+ pure $ s <> e++createResourcePoolP :: Parser Range+createResourcePoolP = do+ s <- createResourcePoolPrefixP+ ts <- P.many Tok.notSemicolonP+ pure $ case reverse ts of+ [] -> s+ e:_ -> s <> e+++dropResourcePoolPrefixP :: Parser Range+dropResourcePoolPrefixP = do+ s <- Tok.dropP+ _ <- Tok.resourceP+ e <- Tok.poolP+ pure $ s <> e++dropResourcePoolP :: Parser Range+dropResourcePoolP = do+ s <- dropResourcePoolPrefixP+ e <- Tok.notSemicolonP -- the pool's name+ pure $ s <> e+++createFunctionPrefixP :: Parser Range+createFunctionPrefixP = do+ s <- Tok.createP+ _ <- optional $ Tok.orP >> Tok.replaceP+ e <- choice+ [ do+ _ <- optional $ Tok.transformP <|> Tok.analyticP <|> Tok.aggregateP+ Tok.functionP+ , Tok.filterP+ , Tok.parserP+ , Tok.sourceP+ ]+ pure $ s <> e+++createFunctionP :: Parser Range+createFunctionP = do+ s <- createFunctionPrefixP+ ts <- P.many Tok.notSemicolonP+ pure $ case reverse ts of+ [] -> s+ e:_ -> s <> e+++alterTableAddConstraintP :: Parser Range+alterTableAddConstraintP = do+ s <- Tok.alterP+ _ <- Tok.tableP++ _ <- tableNameP++ _ <- Tok.addP+ e <- tableConstraintP++ pure $ s <> e++tableConstraintP :: Parser Range+tableConstraintP = do+ s <- optionMaybe $ do+ s <- Tok.constraintP+ _ <- Tok.constraintNameP+ return s++ e <- choice+ [ do+ _ <- Tok.primaryP+ _ <- Tok.keyP+ e <- columnListP+ option e (Tok.enabledP <|> Tok.disabledP)+ , do+ _ <- Tok.uniqueP+ e <- columnListP+ option e (Tok.enabledP <|> Tok.disabledP)+ , do+ _ <- Tok.foreignP+ _ <- Tok.keyP+ _ <- columnListP+ _ <- Tok.referencesP+ e <- getInfo <$> tableNameP+ option e columnListP+ , do+ _ <- Tok.checkP+ e <- getInfo <$> exprP+ option e (Tok.enabledP <|> Tok.disabledP)+ ]++ return (maybe e id s <> e)+ where+ columnListP :: Parser Range+ columnListP = do+ s <- Tok.openP+ _ <- Tok.columnNameP `sepBy1` Tok.commaP+ e <- Tok.closeP+ return (s <> e)+++exportToStdoutP :: Parser Range+exportToStdoutP = do+ s <- Tok.exportP+ _ <- Tok.toP+ _ <- Tok.stdoutP+ _ <- Tok.fromP+ _ <- tableNameP+ _ <- Tok.openP+ _ <- Tok.columnNameP `sepBy1` Tok.commaP+ e <- Tok.closeP++ pure $ s <> e+++setSessionPrefixP :: Parser Range+setSessionPrefixP = do+ s <- Tok.setP+ e <- Tok.sessionP+ return $ s <> e+++setSessionP :: Parser Range+setSessionP = do+ s <- setSessionPrefixP+ ts <- P.many Tok.notSemicolonP+ pure $ case reverse ts of+ [] -> s+ e:_ -> s <> e+++setTimeZoneP :: Parser Range+setTimeZoneP = do+ s <- Tok.setP+ _ <- Tok.timezoneP+ _ <- Tok.toP+ e <- choice [ Tok.defaultP+ , snd <$> Tok.stringP+ , Tok.intervalP >> snd <$> Tok.stringP+ ]+ return $ s <> e+++connectP :: Parser Range+connectP = do+ s <- Tok.connectP+ _ <- Tok.toP+ _ <- Tok.verticaP+ _ <- Tok.databaseNameP+ _ <- Tok.userP+ _ <- Tok.userNameP+ _ <- Tok.passwordP+ e <- snd <$> Tok.stringP <|> snd <$> starsP+ e' <- option e $ do+ _ <- Tok.onP+ _ <- Tok.stringP+ _ <- Tok.commaP+ snd <$> Tok.numberP+ pure $ s <> e'+ where+ starsP = do+ rs <- P.many1 Tok.starP+ let text = TL.take (fromIntegral $ length rs) $ TL.repeat '*'+ r = head rs <> last rs+ pure (text, r)+++disconnectP :: Parser Range+disconnectP = do+ s <- Tok.disconnectP+ (_, e) <- Tok.databaseNameP+ pure $ s <> e++createAccessPolicyP :: Parser Range+createAccessPolicyP = do+ s <- Tok.createP+ _ <- Tok.accessP+ _ <- Tok.policyP+ _ <- Tok.onP+ _ <- tableNameP+ _ <- Tok.forP+ _ <- Tok.columnP+ _ <- Tok.columnNameP+ _ <- exprP+ e <- choice [ Tok.enableP, Tok.disableP ]+ pure $ s <> e+++copyFromP :: Parser Range+copyFromP = do+ s <- Tok.copyP+ e <- getInfo <$> tableNameP++ e' <- consumeOrderedOptions e $+ [ ingestionColumnListP (getInfo <$> exprP)+ , ingestionColumnOptionP+ , fromP -- you need **either** a FROM or a SOURCE clause, but let's not be fussy+ , fileStorageFormatP+ ]+ e'' <- consumeUnorderedOptions e' $+ [ do+ _ <- optional Tok.withP+ choice [ fileSourceP+ , fileFilterP+ , fileParserP+ ]+ , delimiterAsP+ , trailingNullColsP+ , nullAsP+ , escapeFormatP+ , enclosedByP+ , recordTerminatorP+ , try $ skipRecordsP+ , try $ skipBytesP+ , trimByteP+ , rejectMaxP+ , rejectedDataOnNodeP+ , exceptionsOnNodeP+ , Tok.enforceLengthP+ , errorToleranceP+ , abortOnErrorP+ , optional Tok.storageP >> loadMethodP+ , streamNameP+ , noCommitP+ ]++ return $ s <> e''++ where+ onNodeP :: Range -> Parser Range+ onNodeP r = do+ s <- option r $ choice+ [ try $ Tok.onP >> snd <$> Tok.nodeNameP+ , Tok.onP >> Tok.anyP >> Tok.nodeP+ ]+ e <- option s compressionP+ return $ s <> e++ fromP :: Parser Range+ fromP = do+ outerS <- Tok.fromP+ outerE <- choice $+ [ do+ s <- Tok.stdinP+ e <- option s compressionP+ return $ s <> e+ , do+ (_, s) <- Tok.stringP+ e <- last <$> ((onNodeP s) `sepBy1` Tok.commaP)+ return $ s <> e+ , do+ s <- Tok.localP+ e' <- choice [ do+ e <- Tok.stdinP+ option e compressionP+ , let pathToDataP = do+ e <- snd <$> Tok.stringP+ option e compressionP+ in last <$> (pathToDataP `sepBy1` Tok.commaP)+ ]+ return $ s <> e'+ , do+ s <- Tok.verticaP+ _ <- Tok.databaseNameP+ _ <- Tok.dotP+ e <- getInfo <$> tableNameP+ e' <- option e $ do+ _ <- Tok.openP+ _ <- Tok.columnNameP `sepBy1` Tok.commaP+ Tok.closeP+ return $ s <> e'+ ]+ return $ outerS <> outerE+++showP :: Parser Range+showP = do+ s <- Tok.showP+ es <- many1 Tok.notSemicolonP+ return $ s <> last es+++mergeP :: Parser (Merge RawNames Range)+mergeP = do+ r1 <- Tok.mergeP++ _ <- Tok.intoP+ mergeTargetTable <- tableNameP+ mergeTargetAlias <- optionMaybe tableAliasP++ _ <- Tok.usingP+ mergeSourceTable <- tableNameP+ mergeSourceAlias <- optionMaybe tableAliasP++ _ <- Tok.onP+ mergeCondition <- exprP++ -- lookahead+ mergeUpdateDirective <- optionMaybe $ do+ _ <- try $ P.lookAhead $ Tok.whenP >> Tok.matchedP+ _ <- Tok.whenP+ _ <- Tok.matchedP+ _ <- Tok.thenP+ _ <- Tok.updateP+ _ <- Tok.setP+ NE.fromList <$> colValP `sepBy1` Tok.commaP++ (mergeInsertDirectiveColumns, mergeInsertDirectiveValues, r2) <- option (Nothing, Nothing, Just r1) $ do+ _ <- Tok.whenP+ _ <- Tok.notP+ _ <- Tok.matchedP+ _ <- Tok.thenP+ _ <- Tok.insertP+ cols <- optionMaybe $ NE.fromList <$> P.between Tok.openP Tok.closeP (oqColumnNameP `sepBy1` Tok.commaP)+ _ <- Tok.valuesP+ _ <- Tok.openP+ vals <- NE.fromList <$> defaultExprP `sepBy1` Tok.commaP+ e <- Tok.closeP+ return (cols, Just vals, Just e)++ when ((mergeUpdateDirective, mergeInsertDirectiveValues) == (Nothing, Nothing)) $+ fail "MERGE requires at least one of UPDATE and INSERT"++ let mLastUpdate = fmap (getInfo . snd . NE.last) mergeUpdateDirective+ mLastInsert = r2+ r3 = sconcat $ NE.fromList $ catMaybes [mLastUpdate, mLastInsert]+ mergeInfo = r1 <> r3++ return Merge{..}++ where+ tableAliasP :: Parser (TableAlias Range)+ tableAliasP = do+ (name, r) <- Tok.tableNameP+ makeTableAlias r name++ colValP :: Parser (ColumnRef RawNames Range, DefaultExpr RawNames Range)+ colValP = do+ col <- oqColumnNameP+ _ <- Tok.equalP+ val <- defaultExprP+ return (col { columnNameTable = Nothing }, val)
+ src/Database/Sql/Vertica/Parser/IngestionOptions.hs view
@@ -0,0 +1,221 @@+-- 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.Vertica.Parser.IngestionOptions where++import Database.Sql.Info+import Database.Sql.Helpers++import Database.Sql.Vertica.Parser.Internal+import Database.Sql.Position++import qualified Database.Sql.Vertica.Parser.Token as Tok+import Database.Sql.Vertica.Parser.Shared++import Text.Parsec ( choice+ , option, optional+ , sepBy, sepBy1, (<|>))++import Data.Semigroup (Semigroup (..))+++ingestionColumnListP :: Parser Range -> Parser Range+ingestionColumnListP exprP = do+ s <- Tok.openP+ _ <- columnSpecP `sepBy1` Tok.commaP+ e <- Tok.closeP+ return $ s <> e+ where+ columnSpecP = do+ (_, s) <- Tok.columnNameP+ e <- consumeOrderedOptions s $+ [ Tok.asP >> exprP+ , delimiterAsP+ , enclosedByP+ , Tok.enforceLengthP+ , escapeFormatP+ , fillerP+ , columnStorageFormatP+ , nullAsP+ , trimByteP+ ]+ return $ s <> e++ingestionColumnOptionP :: Parser Range+ingestionColumnOptionP = do+ s <- Tok.columnP+ _ <- Tok.optionP+ _ <- Tok.openP+ _ <- optionSpecP `sepBy1` Tok.commaP+ e <- Tok.closeP+ return $ s <> e+ where+ optionSpecP = do+ (_, s) <- Tok.columnNameP+ consumeOrderedOptions s $+ [ delimiterAsP+ , enclosedByP+ , Tok.enforceLengthP+ , escapeFormatP+ , columnStorageFormatP+ , nullAsP+ , trimByteP+ ]++fileStorageFormatP :: Parser Range+fileStorageFormatP = choice $+ [ do+ r <- Tok.nativeP+ option r (snd <$> Tok.varCharP)+ , do+ s <- Tok.fixedWidthP+ _ <- Tok.colSizesP+ _ <- Tok.openP+ _ <- Tok.numberP `sepBy1` Tok.commaP+ e <- Tok.closeP+ return $ s <> e+ , Tok.orcP+ , Tok.parquetP+ ]++abortOnErrorP :: Parser Range+abortOnErrorP = Tok.abortP >> Tok.onP >> Tok.errorP++delimiterAsP :: Parser Range+delimiterAsP = Tok.delimiterP >> optional Tok.asP >> snd <$> Tok.stringP++enclosedByP :: Parser Range+enclosedByP = Tok.enclosedP >> optional Tok.byP >> snd <$> Tok.stringP++errorToleranceP :: Parser Range+errorToleranceP = Tok.errorP >> Tok.toleranceP++escapeFormatP :: Parser Range+escapeFormatP = choice $+ [ Tok.escapeP >> Tok.asP >> snd <$> Tok.stringP+ , Tok.noP >> Tok.escapeP+ ]++exceptionsOnNodeP :: Parser Range+exceptionsOnNodeP = do+ s <- Tok.exceptionsP+ e <- snd <$> Tok.stringP+ let onNodeP = Tok.onP >> snd <$> Tok.nodeNameP+ e' <- option e $ last <$> (onNodeP `sepBy1` Tok.commaP)+ return $ s <> e'++fileFilterP :: Parser Range+fileFilterP = do+ s <- Tok.filterP+ _ <- Tok.functionNameP+ _ <- Tok.openP+ let argP = do+ _ <- Tok.paramNameP+ _ <- Tok.equalP+ getInfo <$> constantP+ _ <- argP `sepBy` Tok.commaP+ e <- Tok.closeP+ return $ s <> e++fileParserP :: Parser Range+fileParserP = do+ s <- Tok.parserP+ _ <- Tok.functionNameP+ _ <- Tok.openP+ let argP = do+ _ <- Tok.paramNameP+ _ <- Tok.equalP+ snd <$> Tok.parserNameP+ _ <- argP `sepBy` Tok.commaP+ e <- Tok.closeP+ return $ s <> e++fileSourceP :: Parser Range+fileSourceP = do+ s <- Tok.sourceP+ _ <- Tok.functionNameP+ _ <- Tok.openP+ let argP = do+ _ <- Tok.paramNameP+ _ <- Tok.equalP+ snd <$> Tok.stringP+ _ <- argP `sepBy` Tok.commaP+ e <- Tok.closeP+ return $ s <> e++fillerP :: Parser Range+fillerP = Tok.fillerP >> getInfo <$> dataTypeP++columnStorageFormatP :: Parser Range+columnStorageFormatP = Tok.formatP >> snd <$> Tok.stringP++noCommitP :: Parser Range+noCommitP = Tok.noP >> Tok.commitP++nullAsP :: Parser Range+nullAsP = Tok.nullP >> optional Tok.asP >> snd <$> Tok.stringP++recordTerminatorP :: Parser Range+recordTerminatorP = Tok.recordP >> Tok.terminatorP >> snd <$> Tok.stringP++rejectedDataOnNodeP :: Parser Range+rejectedDataOnNodeP = do+ s <- Tok.rejectedP+ _ <- Tok.dataP+ e <- choice $+ [ do+ e' <- snd <$> Tok.stringP+ let onNodeP = Tok.onP >> snd <$> Tok.nodeNameP+ option e' $ last <$> (onNodeP `sepBy1` Tok.commaP)+ , do+ _ <- Tok.asP+ _ <- Tok.tableP+ getInfo <$> tableNameP+ ]+ return $ s <> e++rejectMaxP :: Parser Range+rejectMaxP = Tok.rejectMaxP >> snd <$> Tok.numberP++skipBytesP :: Parser Range+skipBytesP = Tok.skipP >> Tok.bytesP >> snd <$> Tok.numberP++skipRecordsP :: Parser Range+skipRecordsP = Tok.skipP >> snd <$> Tok.numberP++streamNameP :: Parser Range+streamNameP = Tok.streamP >> Tok.nameP >> snd <$> Tok.stringP++trailingNullColsP :: Parser Range+trailingNullColsP = Tok.trailingP >> Tok.nullColsP++trimByteP :: Parser Range+trimByteP = Tok.trimP >> snd <$> Tok.stringP++compressionP :: Parser Range+compressionP = choice $+ [ Tok.bzipP+ , Tok.gzipP+ , Tok.lzoP+ , Tok.uncompressedP+ ]++loadMethodP :: Parser Range+loadMethodP = Tok.autoP <|> Tok.directP <|> Tok.trickleP
+ src/Database/Sql/Vertica/Parser/Internal.hs view
@@ -0,0 +1,31 @@+-- 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.Vertica.Parser.Internal where++import qualified Text.Parsec as P++import Database.Sql.Vertica.Token+import Database.Sql.Position++type Parser = P.Parsec [(Token, Position, Position)] Integer++getNextCounter :: Parser Integer+getNextCounter = P.modifyState (+1) >> P.getState
@@ -0,0 +1,185 @@+-- 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.Vertica.Parser.Shared where++-- This module exists to prevent cyclic dependencies: parsers that are needed+-- in both Vertica.Parser and Vertica.Parser.IngestionOptions should go in+-- here.++import Database.Sql.Type+import Database.Sql.Info+import Database.Sql.Position++import Database.Sql.Vertica.Type+import Database.Sql.Vertica.Parser.Internal++import qualified Database.Sql.Vertica.Parser.Token as Tok++import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++import qualified Text.Parsec as P+import Text.Parsec ( choice+ , option, optional, optionMaybe+ , sepBy1, try )++import Control.Arrow (first)+import Data.Semigroup ((<>))+++dataTypeP :: Parser (DataType Range)+dataTypeP = choice+ [ try $ do+ r <- Tok.timestampP+ args <- option [] $ do+ arg <- P.between Tok.openP Tok.closeP constantP+ return $ [DataTypeParamConstant arg]+ choice [ do+ _ <- Tok.withP+ r' <- Tok.timezoneP+ return $ PrimitiveDataType (r <> r') "TIMESTAMP WITH TIMEZONE" args+ , do+ _ <- Tok.withoutP+ r' <- Tok.timezoneP+ return $ PrimitiveDataType (r <> r') "TIMESTAMP WITHOUT TIMEZONE" args+ , return $ PrimitiveDataType r "TIMESTAMP" args+ ]+ , try $ do+ r1 <- Tok.longP+ (name, r2) <- Tok.varBinaryP P.<|> Tok.varCharP+ args <- map DataTypeParamConstant <$> argsP+ let r = r1 <> r2+ name' = TL.append "LONG " $ TL.toUpper name+ return $ PrimitiveDataType r name' args+ , do+ r <- Tok.doubleP+ optionMaybe Tok.precisionP >>= \case+ Just r' -> return $ PrimitiveDataType (r <> r') "DOUBLE PRECISION" []+ Nothing -> return $ PrimitiveDataType (r) "DOUBLE" []+ , do+ (name, r) <- Tok.typeNameP+ args <- map DataTypeParamConstant <$> option [] argsP+ return $ PrimitiveDataType r name args+ ]+ where+ argsP = P.between Tok.openP Tok.closeP $ constantP `sepBy1` Tok.commaP+++periodP :: Parser (DataType Range)+periodP = do+ (period, r) <- Tok.periodP+ pure $ PrimitiveDataType r period []+++constantP :: Parser (Constant Range)+constantP = choice+ [ uncurry (flip StringConstant)+ <$> (try (optional Tok.timestampP) >> Tok.stringP)++ , uncurry (flip NumericConstant) <$> Tok.numberP+ , NullConstant <$> Tok.nullP+ , uncurry (flip BooleanConstant) <$> choice+ [ Tok.trueP >>= \ r -> return (True, r)+ , Tok.falseP >>= \ r -> return (False, r)+ ]++ , try $ do+ dataType <- dataTypeP+ (string, r') <- first TL.decodeUtf8 <$> Tok.stringP+ case dataType of+ PrimitiveDataType _ "interval" [] -> do+ choice+ [ do+ period <- periodP+ pure $ TypedConstant (getInfo dataType <> getInfo period) string period+ , pure $ TypedConstant (getInfo dataType <> r') string dataType+ ]+ _ -> pure $ TypedConstant (getInfo dataType <> r') string dataType+ ]+++unqualifiedTableNameP :: Parser (UQTableName Range)+unqualifiedTableNameP = do+ (t, r) <- Tok.tableNameP+ return $ QTableName r None t+++qualifiedTableNameP :: Parser (Text, Text, Range, Range)+qualifiedTableNameP = do+ (s, r) <- Tok.schemaNameP+ _ <- Tok.dotP+ (t, r') <- Tok.tableNameP++ return (s, t, r, r')+++tableNameP :: Parser (TableRef RawNames Range)+tableNameP = choice+ [ try $ do+ (s, t, r, r') <- qualifiedTableNameP+ return $ QTableName r' (Just $ mkNormalSchema s r) t++ , do+ (t, r) <- Tok.tableNameP+ return $ QTableName r Nothing t+ ]+++projectionNameP :: Parser (ProjectionName Range)+projectionNameP = choice+ [ try $ do+ (s, r) <- Tok.schemaNameP+ _ <- Tok.dotP+ (p, r') <- Tok.projectionNameP++ return $ ProjectionName (r <> r') (Just $ mkNormalSchema s r) p++ , do+ (p, r) <- Tok.projectionNameP+ return $ ProjectionName r Nothing p+ ]+++columnNameP :: Parser (ColumnRef RawNames Range)+columnNameP = choice+ [ try $ do+ t <- tableNameP+ _ <- Tok.dotP+ (c, r) <- choice+ [ Tok.columnNameP+ , first TL.decodeUtf8 <$> Tok.stringP+ ]++ return $ QColumnName r (Just t) c++ , try $ do+ (t, r) <- Tok.tableNameP+ _ <- Tok.dotP+ (c, r') <- Tok.columnNameP++ return $ QColumnName r' (Just $ QTableName r Nothing t) c++ , do+ (c, r) <- Tok.columnNameP++ return $ QColumnName r Nothing c+ ]
+ src/Database/Sql/Vertica/Parser/Token.hs view
@@ -0,0 +1,1012 @@+-- 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.Vertica.Parser.Token where+++import Database.Sql.Vertica.Token+import Database.Sql.Vertica.Type+import Database.Sql.Vertica.Parser.Internal++import Database.Sql.Position++import qualified Text.Parsec as P+import qualified Text.Parsec.Pos as P++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 Data.String++import Data.Semigroup ((<>))+++showTok :: (Token, Position, Position) -> String+showTok (t, _, _) = show t++posFromTok :: (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.token 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.token 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++typeNameP :: Parser (Text, Range)+typeNameP = P.token showTok posFromTok testNameTok++nodeNameP :: Parser (Text, Range)+nodeNameP = P.token showTok posFromTok testNameTok++databaseNameP :: Parser (Text, Range)+databaseNameP = P.token showTok posFromTok testNameTok++userNameP :: Parser (Text, Range)+userNameP = P.token showTok posFromTok testNameTok++paramNameP :: Parser (Text, Range)+paramNameP = P.token showTok posFromTok testNameTok++windowNameP :: Parser (Text, Range)+windowNameP = P.token showTok posFromTok testNameTok++parserNameP :: Parser (Text, Range)+parserNameP = P.token showTok posFromTok testNameTok++datePartP :: Parser (Text, Range)+datePartP = P.token showTok posFromTok testTok+ where+ testTok (tok, s, e) = case tok of+ TokWord _ name | TL.toLower name `elem` parts -> Just (TL.toLower name, Range s e)+ _ -> Nothing++ parts = [ "year", "yy", "yyyy"+ , "quarter", "qq", "q"+ , "month", "mm", "m"+ , "day", "dd", "d", "dy", "dayofyear", "y"+ , "week", "wk", "ww"+ , "hour", "hh"+ , "minute", "mi", "n"+ , "second", "ss", "s"+ , "millisecond", "ms"+ , "microsecond", "mcs", "us"+ ]++schemaNameP :: Parser (Text, Range)+schemaNameP = P.token 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.token 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+++projectionNameP :: Parser (Text, Range)+projectionNameP = P.token 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.token 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.token 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++constraintNameP :: Parser (Text, Range)+constraintNameP = P.token showTok posFromTok testTok+ where+ testTok (tok, s, e) = case tok of+ -- constraint names MAY be quoted.+ TokWord _ name -> Just (name, Range s e)+ _ -> Nothing++keywordP :: Text -> Parser Range+keywordP keyword = P.token showTok posFromTok testTok+ where+ testTok (tok, s, e) = case tok of+ TokWord False name+ | name == keyword -> Just (Range s e)++ _ -> Nothing++fieldTypeP :: Parser (Text, Range)+fieldTypeP = P.token showTok posFromTok testTok+ where+ isField :: (Eq s, IsString s) => s -> Bool+ isField = flip elem+ [ "century", "day", "decade", "doq", "dow", "doy", "epoch"+ , "hour", "isodow", "isoweek", "isoyear", "microseconds"+ , "millennium", "milliseconds", "minute", "month", "quarter"+ , "second", "time zone", "timezone_hour", "timezone_minute"+ , "week", "year"+ ]++ testTok (tok, s, e) = case tok of+ TokWord _ field | isField field -> Just (field, Range s e)+ TokString field | isField field -> Just (TL.decodeUtf8 field, Range s e)+ _ -> Nothing++periodP :: Parser (Text, Range)+periodP = P.token showTok posFromTok testTok+ where+ isPeriod :: (Eq s, IsString s) => s -> Bool+ isPeriod = flip elem [ "day", "hour", "minute", "month", "second", "year" ]++ testTok (tok, s, e) = case tok of+ TokWord _ period | isPeriod period -> Just (period, Range s e)+ TokString period | isPeriod period -> Just (TL.decodeUtf8 period, Range s e)+ _ -> Nothing++stringP :: Parser (ByteString, Range)+stringP = P.token showTok posFromTok testTok+ where+ testTok (tok, s, e) = case tok of+ TokString string -> Just (string, Range s e)+ _ -> Nothing++numberP :: Parser (Text, Range)+numberP = P.token showTok posFromTok testTok+ where+ testTok (tok, s, e) = case tok of+ TokNumber number -> Just (number, Range s e)+ _ -> Nothing++encodingTypeP :: Parser (Encoding Range)+encodingTypeP = P.token showTok posFromTok testTok+ where+ testTok (tok, s, e) =+ let r = Range s e+ in case tok of+ TokWord False "auto" -> Just (EncodingAuto r)+ TokWord False "block_dict" -> Just (EncodingBlockDict r)+ TokWord False "blockdict_comp" -> Just (EncodingBlockDictComp r)+ TokWord False "bzip_comp" -> Just (EncodingBZipComp r)+ TokWord False "commondelta_comp" -> Just (EncodingCommonDeltaComp r)+ TokWord False "deltarange_comp" -> Just (EncodingDeltaRangeComp r)+ TokWord False "deltaval" -> Just (EncodingDeltaVal r)+ TokWord False "gcddelta" -> Just (EncodingGCDDelta r)+ TokWord False "gzip_comp" -> Just (EncodingGZipComp r)+ TokWord False "rle" -> Just (EncodingRLE r)+ TokWord False "none" -> Just (EncodingNone r)++ _ -> Nothing++dotP :: Parser Range+dotP = symbolP "."++equalP :: Parser Range+equalP = symbolP "="++symbolP :: Text -> Parser Range+symbolP op = tokEqualsP $ TokSymbol op++starP :: Parser Range+starP = symbolP "*"++openP :: Parser Range+openP = symbolP "("++closeP :: Parser Range+closeP = symbolP ")"++openBracketP :: Parser Range+openBracketP = symbolP "["++closeBracketP :: Parser Range+closeBracketP = symbolP "]"++castP :: Parser Range+castP = keywordP "cast"++castOpP :: Parser Range+castOpP = symbolP "::"++minusP :: Parser Range+minusP = symbolP "-"++abortP :: Parser Range+abortP = keywordP "abort"++accessP :: Parser Range+accessP = keywordP "access"++accessRankP :: Parser Range+accessRankP = keywordP "accessrank"++addP :: Parser Range+addP = keywordP "add"++aggregateP :: Parser Range+aggregateP = keywordP "aggregate"++allP :: Parser Range+allP = keywordP "all"++alterP :: Parser Range+alterP = keywordP "alter"++analyticP :: Parser Range+analyticP = keywordP "analytic"++andP :: Parser Range+andP = keywordP "and"++anyP :: Parser Range+anyP = keywordP "any"++arrayP :: Parser Range+arrayP = keywordP "array"++asP :: Parser Range+asP = keywordP "as"++ascP :: Parser Range+ascP = keywordP "asc"++atP :: Parser Range+atP = keywordP "at"++authorizationP :: Parser Range+authorizationP = keywordP "authorization"++autoP :: Parser Range+autoP = keywordP "auto"++beginP :: Parser Range+beginP = keywordP "begin"++bestP :: Parser Range+bestP = keywordP "best"++betweenP :: Parser Range+betweenP = keywordP "between"++byP :: Parser Range+byP = keywordP "by"++bytesP :: Parser Range+bytesP = keywordP "bytes"++bzipP :: Parser Range+bzipP = keywordP "bzip"++cascadeP :: Parser Range+cascadeP = keywordP "cascade"++caseP :: Parser Range+caseP = keywordP "case"++checkP :: Parser Range+checkP = keywordP "check"++colSizesP :: Parser Range+colSizesP = keywordP "colsizes"++columnP :: Parser Range+columnP = keywordP "column"++commaP :: Parser Range+commaP = symbolP ","++commitP :: Parser Range+commitP = keywordP "commit"++committedP :: Parser Range+committedP = keywordP "committed"++connectP :: Parser Range+connectP = keywordP "connect"++constraintP :: Parser Range+constraintP = keywordP "constraint"++copyP :: Parser Range+copyP = keywordP "copy"++createP :: Parser Range+createP = keywordP "create"++crossP :: Parser Range+crossP = keywordP "cross"++currentP :: Parser Range+currentP = keywordP "current"++currentDatabaseP :: Parser (Text, Range)+currentDatabaseP = ("current_database",) <$> keywordP "current_database"++currentDateP :: Parser (Text, Range)+currentDateP = ("current_date",) <$> keywordP "current_date"++currentSchemaP :: Parser (Text, Range)+currentSchemaP = ("current_schema",) <$> keywordP "current_schema"++currentTimeP :: Parser (Text, Range)+currentTimeP = ("current_time",) <$> keywordP "current_time"++currentTimestampP :: Parser (Text, Range)+currentTimestampP = ("current_timestamp",) <$> keywordP "current_timestamp"++currentUserP :: Parser (Text, Range)+currentUserP = ("current_user",) <$> keywordP "current_user"++dataP :: Parser Range+dataP = keywordP "data"++dateDiffP :: Parser Range+dateDiffP = keywordP "datediff"++defaultP :: Parser Range+defaultP = keywordP "default"++deleteP :: Parser Range+deleteP = keywordP "delete"++delimiterP :: Parser Range+delimiterP = keywordP "delimiter"++descP :: Parser Range+descP = keywordP "desc"++directP :: Parser Range+directP = keywordP "direct"++disableP :: Parser Range+disableP = keywordP "disable"++disabledP :: Parser Range+disabledP = keywordP "disabled"++disconnectP :: Parser Range+disconnectP = keywordP "disconnect"++distinctP :: Parser Range+distinctP = keywordP "distinct"++doubleP :: Parser Range+doubleP = keywordP "double"++dropP :: Parser Range+dropP = keywordP "drop"++elseP :: Parser Range+elseP = keywordP "else"++enableP :: Parser Range+enableP = keywordP "enable"++enabledP :: Parser Range+enabledP = keywordP "enabled"++enclosedP :: Parser Range+enclosedP = keywordP "enclosed"++encodingP :: Parser Range+encodingP = keywordP "encoding"++endP :: Parser Range+endP = keywordP "end"++enforceLengthP :: Parser Range+enforceLengthP = keywordP "enforcelength"++errorP :: Parser Range+errorP = keywordP "error"++escapeP :: Parser Range+escapeP = keywordP "escape"++exceptP :: Parser Range+exceptP = keywordP "except"++exceptionsP :: Parser Range+exceptionsP = keywordP "exceptions"++excludeP :: Parser Range+excludeP = keywordP "exclude"++excludingP :: Parser Range+excludingP = keywordP "excluding"++existsP :: Parser Range+existsP = keywordP "exists"++explainP :: Parser Range+explainP = keywordP "explain"++exportP :: Parser Range+exportP = keywordP "export"++externalP :: Parser Range+externalP = keywordP "external"++extractP :: Parser Range+extractP = keywordP "extract"++falseP :: Parser Range+falseP = keywordP "false"++fillerP :: Parser Range+fillerP = keywordP "filler"++filterP :: Parser Range+filterP = keywordP "filter"++firstP :: Parser Range+firstP = keywordP "first"++fixedWidthP :: Parser Range+fixedWidthP = keywordP "fixedwidth"++followingP :: Parser Range+followingP = keywordP "following"++forP :: Parser Range+forP = keywordP "for"++foreignP :: Parser Range+foreignP = keywordP "foreign"++formatP :: Parser Range+formatP = keywordP "format"++fromP :: Parser Range+fromP = keywordP "from"++fullP :: Parser Range+fullP = keywordP "full"++functionP :: Parser Range+functionP = keywordP "function"++globalP :: Parser Range+globalP = keywordP "global"++grantP :: Parser Range+grantP = keywordP "grant"++groupP :: Parser Range+groupP = keywordP "group"++gzipP :: Parser Range+gzipP = keywordP "gzip"++havingP :: Parser Range+havingP = keywordP "having"++ifP :: Parser Range+ifP = keywordP "if"++ignoreP :: Parser Range+ignoreP = keywordP "ignore"++iLikeP :: Parser Range+iLikeP = keywordP "ilike"++iLikeBP :: Parser Range+iLikeBP = keywordP "ilikeb"++inP :: Parser Range+inP = keywordP "in"++includeP :: Parser Range+includeP = keywordP "include"++includingP :: Parser Range+includingP = keywordP "including"++innerP :: Parser Range+innerP = keywordP "inner"++insertP :: Parser Range+insertP = keywordP "insert"++intersectP :: Parser Range+intersectP = keywordP "intersect"++intervalP :: Parser Range+intervalP = keywordP "interval"++intoP :: Parser Range+intoP = keywordP "into"++isP :: Parser Range+isP = keywordP "is"++isnullP :: Parser Range+isnullP = keywordP "isnull"++isolationP :: Parser Range+isolationP = keywordP "isolation"++joinP :: Parser Range+joinP = keywordP "join"++keyP :: Parser Range+keyP = keywordP "key"++ksafeP :: Parser Range+ksafeP = keywordP "ksafe"++lastP :: Parser Range+lastP = keywordP "last"++leftP :: Parser Range+leftP = keywordP "left"++levelP :: Parser Range+levelP = keywordP "level"++likeP :: Parser Range+likeP = keywordP "like"++likeBP :: Parser Range+likeBP = keywordP "likeB"++limitP :: Parser Range+limitP = keywordP "limit"++localP :: Parser Range+localP = keywordP "local"++localTimeP :: Parser (Text, Range)+localTimeP = ("localtime",) <$> keywordP "localtime"++localTimestampP :: Parser (Text, Range)+localTimestampP = ("localtimestamp",) <$> keywordP "localtimestamp"++longP :: Parser Range+longP = keywordP "long"++lzoP :: Parser Range+lzoP = keywordP "lzo"++matchedP :: Parser Range+matchedP = keywordP "matched"++mergeP :: Parser Range+mergeP = keywordP "merge"++nameP :: Parser Range+nameP = keywordP "name"++nativeP :: Parser Range+nativeP = keywordP "native"++naturalP :: Parser Range+naturalP = keywordP "natural"++noP :: Parser Range+noP = keywordP "no"++nodeP :: Parser Range+nodeP = keywordP "node"++nodesP :: Parser Range+nodesP = keywordP "nodes"++notP :: Parser Range+notP = keywordP "not"++notnullP :: Parser Range+notnullP = keywordP "notnull"++nullsP :: Parser Range+nullsP = keywordP "nulls"++nullsequalP :: Parser Range+nullsequalP = keywordP "nullsequal"++nullP :: Parser Range+nullP = keywordP "null"++nullColsP :: Parser Range+nullColsP = keywordP "nullcols"++offsetP :: Parser Range+offsetP = keywordP "offset"++onP :: Parser Range+onP = keywordP "on"++onlyP :: Parser Range+onlyP = keywordP "only"++optionP :: Parser Range+optionP = keywordP "option"++orP :: Parser Range+orP = keywordP "or"++orcP :: Parser Range+orcP = keywordP "orc"++orderP :: Parser Range+orderP = keywordP "order"++overlapsP :: Parser Range+overlapsP = keywordP "overlaps"++outerP :: Parser Range+outerP = keywordP "outer"++overP :: Parser Range+overP = keywordP "over"++parametersP :: Parser Range+parametersP = keywordP "parameters"++parquetP :: Parser Range+parquetP = keywordP "parquet"++parserP :: Parser Range+parserP = keywordP "parser"++partitionP :: Parser Range+partitionP = keywordP "partition"++passwordP :: Parser Range+passwordP = keywordP "password"++poolP :: Parser Range+poolP = keywordP "pool"++policyP :: Parser Range+policyP = keywordP "policy"++precedingP :: Parser Range+precedingP = keywordP "preceding"++precisionP :: Parser Range+precisionP = keywordP "precision"++preserveP :: Parser Range+preserveP = keywordP "preserve"++primaryP :: Parser Range+primaryP = keywordP "primary"++privilegesP :: Parser Range+privilegesP = keywordP "privileges"++projectionP :: Parser Range+projectionP = keywordP "projection"++projectionsP :: Parser Range+projectionsP = keywordP "projections"++rangeP :: Parser Range+rangeP = keywordP "range"++readP :: Parser Range+readP = keywordP "read"++recordP :: Parser Range+recordP = keywordP "record"++referencesP :: Parser Range+referencesP = keywordP "references"++rejectedP :: Parser Range+rejectedP = keywordP "rejected"++rejectMaxP :: Parser Range+rejectMaxP = keywordP "rejectmax"++renameP :: Parser Range+renameP = keywordP "rename"++repeatableP :: Parser Range+repeatableP = keywordP "repeatable"++replaceP :: Parser Range+replaceP = keywordP "replace"++resourceP :: Parser Range+resourceP = keywordP "resource"++restrictP :: Parser Range+restrictP = keywordP "restrict"++revokeP :: Parser Range+revokeP = keywordP "revoke"++rightP :: Parser Range+rightP = keywordP "right"++rollbackP :: Parser Range+rollbackP = keywordP "rollback"++rowP :: Parser Range+rowP = keywordP "row"++rowsP :: Parser Range+rowsP = keywordP "rows"++schemaP :: Parser Range+schemaP = keywordP "schema"++segmentedP :: Parser Range+segmentedP = keywordP "segmented"++selectP :: Parser Range+selectP = keywordP "select"++semicolonP :: Parser Range+semicolonP = symbolP ";"++notSemicolonP :: Parser Range+notSemicolonP = tokNotEqualsP $ TokSymbol ";"++setP :: Parser Range+setP = keywordP "set"++serializableP :: Parser Range+serializableP = keywordP "serializable"++sessionP :: Parser Range+sessionP = keywordP "session"++sessionUserP :: Parser (Text, Range)+sessionUserP = ("session_user",) <$> keywordP "session_user"++showP :: Parser Range+showP = keywordP "show"++skipP :: Parser Range+skipP = keywordP "skip"++sourceP :: Parser Range+sourceP = keywordP "source"++startP :: Parser Range+startP = keywordP "start"++stdinP :: Parser Range+stdinP = keywordP "stdin"++stdoutP :: Parser Range+stdoutP = keywordP "stdout"++storageP :: Parser Range+storageP = keywordP "storage"++streamP :: Parser Range+streamP = keywordP "stream"++sysDateP :: Parser (Text, Range)+sysDateP = ("sysdate",) <$> keywordP "sysdate"++tableP :: Parser Range+tableP = keywordP "table"++temporaryP :: Parser Range+temporaryP = keywordP "temporary" P.<|> keywordP "temp"++terminatorP :: Parser Range+terminatorP = keywordP "terminator"++thenP :: Parser Range+thenP = keywordP "then"++timeseriesP :: Parser Range+timeseriesP = keywordP "timeseries"++timestampP :: Parser Range+timestampP = keywordP "timestamp" P.<|> do+ r <- keywordP "time"+ r' <- keywordP "stamp"+ return $ r <> r'++timezoneP :: Parser Range+timezoneP = keywordP "timezone" P.<|> do+ r <- keywordP "time"+ r' <- keywordP "zone"+ return $ r <> r'++toleranceP :: Parser Range+toleranceP = keywordP "tolerance"++trailingP :: Parser Range+trailingP = keywordP "trailing"++transactionP :: Parser Range+transactionP = keywordP "transaction"++transformP :: Parser Range+transformP = keywordP "transform"++trickleP :: Parser Range+trickleP = keywordP "trickle"++trimP :: Parser Range+trimP = keywordP "trim"++trueP :: Parser Range+trueP = keywordP "true"++truncateP :: Parser Range+truncateP = keywordP "truncate"++toP :: Parser Range+toP = keywordP "to"++unboundedP :: Parser Range+unboundedP = keywordP "unbounded"++uncommittedP :: Parser Range+uncommittedP = keywordP "uncommitted"++uncompressedP :: Parser Range+uncompressedP = keywordP "uncompressed"++unionP :: Parser Range+unionP = keywordP "union"++uniqueP :: Parser Range+uniqueP = keywordP "unique"++unknownP :: Parser Range+unknownP = keywordP "unknown"++unsegmentedP :: Parser Range+unsegmentedP = keywordP "unsegmented"++updateP :: Parser Range+updateP = keywordP "update"++userP :: Parser (Text, Range)+userP = ("user",) <$> keywordP "user"++usingP :: Parser Range+usingP = keywordP "using"++valuesP :: Parser Range+valuesP = keywordP "values"++varBinaryP :: Parser (Text, Range)+varBinaryP = ("varbinary", ) <$> keywordP "varbinary"++varCharP :: Parser (Text, Range)+varCharP = ("varchar", ) <$> keywordP "varchar"++verticaP :: Parser Range+verticaP = keywordP "vertica"++viewP :: Parser Range+viewP = keywordP "view"++whenP :: Parser Range+whenP = keywordP "when"++whereP :: Parser Range+whereP = keywordP "where"++windowP :: Parser Range+windowP = keywordP "window"++withP :: Parser Range+withP = keywordP "with"++withoutP :: Parser Range+withoutP = keywordP "without"++workP :: Parser Range+workP = keywordP "work"++writeP :: Parser Range+writeP = keywordP "write"++likeOpP :: Parser Range+likeOpP = symbolP "~~"++iLikeOpP :: Parser Range+iLikeOpP = symbolP "~~*"++notLikeOpP :: Parser Range+notLikeOpP = symbolP "!~~"++notILikeOpP :: Parser Range+notILikeOpP = symbolP "!~~*"++regexMatchesP :: Parser Range+regexMatchesP = symbolP "~"++notRegexMatchesP :: Parser Range+notRegexMatchesP = symbolP "!~"++regexIgnoreCaseMatchesP :: Parser Range+regexIgnoreCaseMatchesP = symbolP "~*"++notRegexIgnoreCaseMatchesP :: Parser Range+notRegexIgnoreCaseMatchesP = symbolP "!~*"++inequalityOpP :: Parser (Text, Range)+inequalityOpP = P.token showTok posFromTok testTok+ where+ -- <=> is actually an equality, but it seems to parse here+ testTok (TokSymbol op, s, e)+ | op `elem` ["<", ">", "<>", "<=>", "!="] = Just (op, Range s e)++ testTok _ = Nothing++equalityOpP :: Parser (Text, Range)+equalityOpP = P.token showTok posFromTok testTok+ where+ testTok (TokSymbol op, s, e)+ | op `elem` ["<=", ">=", "="] = Just (op, Range s e)++ testTok _ = Nothing
+ src/Database/Sql/Vertica/Scanner.hs view
@@ -0,0 +1,273 @@+-- 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.Vertica.Scanner where++import Prelude hiding ((&&), (||), not)++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.Lazy as BL+import qualified Data.ByteString.Builder as BB++import Data.List (sortBy)+import Data.Foldable (asum)+import Data.Char (isAlphaNum, isAlpha, isSpace, isDigit)++import Database.Sql.Position+import Database.Sql.Vertica.Token++import Data.Predicate.Class++import Numeric (readHex, readOct)+++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` ['e', 'E'] && TL.length t > 2 && TL.index t 1 == '\'' ->+ case tokExtString p t of+ Left (err, p') -> [(err, p, p')]+ Right (string, rest, p') -> (TokString string, p, p') : go p' rest++ c | isAlpha c || 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++ -- comments+ '-' | "--" `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)++ (digits, rest) ->+ let p' = advanceHorizontal (1 + TL.length digits) p+ in (TokNumber $ TL.cons '.' digits, p, p') : go p' rest++ c | isDigit c -> let (num, rest) = TL.span (isDigit || (=='.')) t+ p' = advanceHorizontal (TL.length num) p+ in (TokNumber num, 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 returns Text, not ByteString, because there is no way to put arbitrary byte sequences in this kind of Vertica string (... for now?)+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+ in if len `mod` 2 == 0+ then go (advanceHorizontal len p)+ (TL.take (len `div` 2) quotes :ts)+ rest++ else co (advanceHorizontal len p)+ (TL.take (len `div` 2) quotes :ts)+ rest++ _ -> let (t, rest) = TL.span (/= d) input+ in go (advance t p) (t:ts) rest++ co p ts input =+ case TL.span isSpace input of+ (space, rest)+ | TL.any (== '\n') space && TL.take 1 rest == TL.singleton d -> go (advanceHorizontal 1 $ advance space p) ts (TL.drop 1 rest)+ | otherwise -> Right (TL.concat $ reverse ts, input, p)+++tokExtString :: Position -> Text -> Either (Token, Position) (ByteString, Text, Position)+tokExtString pos = go (advanceHorizontal 2 pos) [] . TL.drop 2+ where+ boring = not . (`elem` ['\'', '\\'])+ halve bs = BL.take (BL.length bs `div` 2) bs+ go p bss input = case TL.span boring input of+ (cs, "") -> Left (TokError "end of input inside string", advance cs p)+ ("", rest) -> handleSlashesOrQuote p bss rest+ (cs, rest) ->+ let bs = TL.encodeUtf8 cs+ in handleSlashesOrQuote (advance cs p) (bs:bss) rest++ handleSlashesOrQuote p bss input = case TL.span (== '\\') input of+ (cs, "") -> Left (TokError "end of input inside string", advance cs p) -- `input` matches `^(\\)+$`+ ("", _) -> handleQuote p bss input -- `input` matches `^'`+ (slashes, rest) -> -- `input` matches `^(\\)+.+`+ let slashes' = TL.encodeUtf8 slashes+ len = BL.length slashes'+ in if len `mod` 2 == 0+ then go (advanceHorizontal len p) (halve slashes':bss) rest+ else case TL.splitAt 1 rest of+ (c, rest')+ | c == "b" -> go (advanceHorizontal (len + 1) p) ("\BS":halve slashes':bss) rest'+ | c == "f" -> go (advanceHorizontal (len + 1) p) ("\FF":halve slashes':bss) rest'+ | c == "n" -> go (advanceHorizontal (len + 1) p) ("\n":halve slashes':bss) rest'+ | c == "r" -> go (advanceHorizontal (len + 1) p) ("\r":halve slashes':bss) rest'+ | c == "t" -> go (advanceHorizontal (len + 1) p) ("\t":halve slashes':bss) rest'+ | c == "'" -> go (advanceHorizontal (len + 1) p) ("'":halve slashes':bss) rest'+ | c == "x" -> consumeHex rest' len p slashes' bss -- consume one or two hex+ -- digits, translating into the corresponding utf8 value. If no hex digits+ -- follow the x, it's a literal x as if there were no backslash.+ | hasOctalPrefix rest -> consumeOctal rest len p slashes' bss -- consume one or two+ -- or three octal digits, translating into the corresponding utf8 value. If+ -- it's > o277, take the 8 LSB.+ | otherwise -> go (advanceHorizontal (len + 1) p) (TL.encodeUtf8 c:halve slashes':bss) rest'+ -- the backslash has no effect, ie it's the same as if there were no backslash.++ handleQuote p bss input = case TL.splitAt 1 input of+ ("'", rest) -> Right ( BL.concat $ reverse bss+ , rest+ , advanceHorizontal 1 p+ )+ _ -> error "this shouldn't happen"++ consumeHex rest' len p slashes' bss =+ let charLimit = 2+ isHex = flip elem (['0'..'9'] ++ ['a'..'f'] ++ ['A'..'F'])+ (hex, _) = TL.span isHex (TL.take charLimit rest')++ toByteString :: TL.Text -> BL.ByteString+ toByteString "" = "x"+ toByteString t =+ let [(num, _)] = (readHex $ TL.unpack t) :: [(Int, String)]+ in BB.toLazyByteString $ BB.word8 $ fromIntegral num++ rest'' = TL.drop (fromIntegral $ TL.length hex) rest'+ in go (advanceHorizontal (len + 1 + TL.length hex) p) (toByteString hex:halve slashes':bss) rest''++ isOctal = flip elem ['0'..'7']++ hasOctalPrefix text = isOctal $ TL.head text++ consumeOctal rest len p slashes' bss =+ let charLimit = 3+ (octal, _) = TL.span isOctal (TL.take charLimit rest)++ toByteString :: TL.Text -> BL.ByteString+ toByteString "" = error "this shouldn't happen"+ toByteString t =+ let [(num, _)] = (readOct $ TL.unpack t) :: [(Int, String)]+ in BB.toLazyByteString $ BB.word8 $ fromIntegral num++ rest' = TL.drop (fromIntegral $ TL.length octal) rest+ in go (advanceHorizontal (len + TL.length octal) p) (toByteString octal:halve slashes':bss) rest'+++tokName :: Position -> Text -> Either (Token, Position, Position) (Text, Bool, Text, Position)+tokName pos = go pos [] False+ where+ go :: Position -> [Text] -> Bool -> Text -> Either (Token, Position, Position) (Text, Bool, Text, Position)+ go p [] _ "" = error $ "parse error at " ++ show p+ go p ts seen_quotes "" = Right (TL.concat $ reverse ts, seen_quotes, "", p)+ go p ts seen_quotes input = case TL.head input of+-- Case where outside double quote+ c | isWordBody c ->+ let (word, rest) = TL.span isWordBody input+ p' = advanceHorizontal (TL.length word) p+ in go p' (TL.toLower word:ts) seen_quotes rest++ c | c == '"' ->+ case tokString p '"' input of+ Left p' -> Left (TokError "end of input inside string", p, p')+ Right (quoted, rest, p') -> go p' (quoted:ts) True rest++ _ -> case ts of+ [] -> error "empty token"+ _ -> Right (TL.concat $ reverse ts, seen_quotes, input, p)+
+ src/Database/Sql/Vertica/Token.hs view
@@ -0,0 +1,113 @@+-- 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.Vertica.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+ | 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 True)+ , ("and", WordInfo False False True False)+ , ("asc", WordInfo False False False False)+ , ("as", WordInfo False False False False)+ , ("at", WordInfo False True True False)+ , ("between", WordInfo False False False False)+ , ("by", WordInfo False False False False)+ , ("case", WordInfo False False False False)+ , ("comma", WordInfo False False False False)+ , ("cross", WordInfo False False False False)+ , ("current_database", WordInfo False False False True)+ , ("current_date", WordInfo False False False True)+ , ("current_schema", WordInfo False False False True)+ , ("current_timestamp", WordInfo False False False False)+ , ("current_time", WordInfo False False False False)+ , ("current_user", WordInfo False False False True)+ , ("desc", WordInfo False False False False)+ , ("distinct", WordInfo False False False False)+ , ("else", WordInfo False False False False)+ , ("end", WordInfo False False False False)+ , ("except", WordInfo False False False False)+ , ("false", WordInfo False False False False)+ , ("from", WordInfo False False False False)+ , ("full", WordInfo False False False False)+ , ("group", WordInfo False False True False)+ , ("having", WordInfo False False False False)+ , ("ilike", WordInfo False False False False)+ , ("ilikeb", WordInfo False False False False)+ , ("inner", WordInfo False False False False)+ , ("intersect", WordInfo False False False False)+ , ("interval", WordInfo False False True False)+ , ("in", WordInfo False False False False)+ , ("is", WordInfo False False False False)+ , ("isnull", WordInfo False False False True)+ , ("join", WordInfo False False False False)+ , ("left", WordInfo False False False True)+ , ("likeb", WordInfo False False False False)+ , ("limit", WordInfo False False False False)+ , ("localtimestamp", WordInfo False False False False)+ , ("localtime", WordInfo False False True False)+ , ("natural", WordInfo False False False False)+ , ("not", WordInfo False False False False)+ , ("notnull", WordInfo False False False True)+ , ("null", WordInfo False False False False)+ , ("on", WordInfo False False False False)+ , ("order", WordInfo False False True False)+ , ("or", WordInfo False False True False)+ , ("outer", WordInfo False False False False)+ , ("overlaps", WordInfo False False False False)+ , ("right", WordInfo False False False True)+ , ("segmented", WordInfo False False False False)+ , ("select", WordInfo False False False False)+ , ("semi", WordInfo False False False False)+ , ("session_user", WordInfo False False False True)+ , ("sysdate", WordInfo False False False True)+ , ("then", WordInfo False False False False)+ , ("time", WordInfo False False True False)+ , ("timezone", WordInfo False False True False)+ , ("true", WordInfo False False False False)+ , ("union", WordInfo False False False False)+ , ("unknown", WordInfo False False False False)+ , ("user", WordInfo False False True True)+ , ("using", WordInfo False False False False)+ , ("when", WordInfo False False False False)+ , ("where", WordInfo False False False False)+ , ("window", WordInfo False False False False)+ , ("with", WordInfo False False False False)+ , ("zone", WordInfo False False True False)+ ]
+ src/Database/Sql/Vertica/Type.hs view
@@ -0,0 +1,859 @@+-- 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 DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}++module Database.Sql.Vertica.Type where++import Database.Sql.Type+import Database.Sql.Position+import Database.Sql.Info+import Database.Sql.Util.Columns+import Database.Sql.Util.Joins+import Database.Sql.Util.Lineage.Table+import Database.Sql.Util.Lineage.ColumnPlus as ColumnPlus+import Database.Sql.Util.Scope+import Database.Sql.Util.Tables+import Database.Sql.Util.Schema as Schema++import Control.Arrow+import Control.Monad.Reader (asks, local)+import Control.Monad.Writer (listen)+import Control.Monad.Identity++import Data.Either (partitionEithers)+import Data.List (foldl')+import Data.List.NonEmpty (NonEmpty((:|)), toList, fromList)+import Data.Maybe (catMaybes)+import Data.Semigroup+import Data.Text.Lazy (Text)++import Data.Aeson (ToJSON (..), (.=))+import qualified Data.Aeson as JSON++import qualified Data.Foldable as F+import Data.Proxy (Proxy (..))++import Data.Set (Set)+import qualified Data.Set as S+import Data.Map (Map)+import qualified Data.Map as M++import Data.Data (Data)+import GHC.Generics (Generic)+++data Vertica++deriving instance Data Vertica++dialectProxy :: Proxy Vertica+dialectProxy = Proxy++instance Dialect Vertica where+ type DialectCreateTableExtra Vertica r = TableInfo r++ shouldCTEsShadowTables _ = True++ resolveCreateTableExtra _ = resolveTableInfo++ getSelectScope _ fromColumns selectionAliases = SelectScope+ { bindForWhere = bindFromColumns fromColumns+ , bindForGroup = bindBothColumns fromColumns selectionAliases+ , bindForHaving = bindFromColumns fromColumns+ , bindForOrder = bindBothColumns fromColumns selectionAliases+ , bindForNamedWindow = bindFromColumns fromColumns+ }++ areLcolumnsVisibleInLateralViews _ = False+++data TableInfo r a = TableInfo+ { tableInfoInfo :: a+ , tableInfoOrdering :: Maybe [Order r a]+ , tableInfoEncoding :: Maybe (TableEncoding r a)+ , tableInfoSegmentation :: Maybe (Segmentation r a)+ , tableInfoKSafety :: Maybe (KSafety a)+ , tableInfoPartitioning :: Maybe (Partitioning r a)+ }++deriving instance (ConstrainSNames Data r a, Data r) => Data (TableInfo r a)+deriving instance Generic (TableInfo r a)+deriving instance ConstrainSNames Eq r a => Eq (TableInfo r a)+deriving instance ConstrainSNames Show r a => Show (TableInfo r a)+deriving instance ConstrainSASNames Functor r => Functor (TableInfo r)+deriving instance ConstrainSASNames Foldable r => Foldable (TableInfo r)+deriving instance ConstrainSASNames Traversable r => Traversable (TableInfo r)++overJust :: Applicative f => (t -> f a) -> Maybe t -> f (Maybe a)+overJust _ Nothing = pure Nothing+overJust f (Just x) = Just <$> f x++resolveTableInfo :: TableInfo RawNames a -> Resolver (TableInfo ResolvedNames) a+resolveTableInfo TableInfo{..} = do+ tableInfoOrdering' <- overJust (mapM $ resolveOrder []) tableInfoOrdering+ tableInfoEncoding' <- overJust resolveTableEncoding tableInfoEncoding+ tableInfoSegmentation' <- overJust resolveSegmentation tableInfoSegmentation+ tableInfoPartitioning' <- overJust resolvePartitioning tableInfoPartitioning+ pure TableInfo+ { tableInfoOrdering = tableInfoOrdering'+ , tableInfoEncoding = tableInfoEncoding'+ , tableInfoSegmentation = tableInfoSegmentation'+ , tableInfoPartitioning = tableInfoPartitioning'+ , ..+ }+++data VerticaStatement r a = VerticaStandardSqlStatement (Statement Vertica r a)+ | VerticaCreateProjectionStatement (CreateProjection r a)+ | VerticaMultipleRenameStatement (MultipleRename r a)+ | VerticaSetSchemaStatement (SetSchema r a)+ | VerticaMergeStatement (Merge r a)+ | VerticaUnhandledStatement a++deriving instance (ConstrainSNames Data r a, Data r) => Data (VerticaStatement r a)+deriving instance Generic (VerticaStatement r a)+deriving instance ConstrainSNames Eq r a => Eq (VerticaStatement r a)+deriving instance ConstrainSNames Show r a => Show (VerticaStatement r a)+deriving instance ConstrainSASNames Functor r => Functor (VerticaStatement r)+deriving instance ConstrainSASNames Foldable r => Foldable (VerticaStatement r)+deriving instance ConstrainSASNames Traversable r => Traversable (VerticaStatement r)+++data TableEncoding r a = TableEncoding a [(ColumnRef r a, Encoding a)]++deriving instance (ConstrainSNames Data r a, Data r) => Data (TableEncoding r a)+deriving instance Generic (TableEncoding r a)+deriving instance ConstrainSNames Eq r a => Eq (TableEncoding r a)+deriving instance ConstrainSNames Show r a => Show (TableEncoding r a)+deriving instance ConstrainSASNames Functor r => Functor (TableEncoding r)+deriving instance ConstrainSASNames Foldable r => Foldable (TableEncoding r)+deriving instance ConstrainSASNames Traversable r => Traversable (TableEncoding r)++resolveTableEncoding :: TableEncoding RawNames a -> Resolver (TableEncoding ResolvedNames) a+resolveTableEncoding (TableEncoding info encodings) = do+ encodings' <- forM encodings $ \ (column, encoding) -> do+ column' <- resolveColumnName column+ pure (column', encoding)+ pure $ TableEncoding info encodings'+++data Segmentation r a = UnsegmentedAllNodes a+ | UnsegmentedOneNode a (Node a)+ | SegmentedBy a (Expr r a) (NodeList a)++deriving instance (ConstrainSNames Data r a, Data r) => Data (Segmentation r a)+deriving instance Generic (Segmentation r a)+deriving instance ConstrainSNames Eq r a => Eq (Segmentation r a)+deriving instance ConstrainSNames Show r a => Show (Segmentation r a)+deriving instance ConstrainSASNames Functor r => Functor (Segmentation r)+deriving instance ConstrainSASNames Foldable r => Foldable (Segmentation r)+deriving instance ConstrainSASNames Traversable r => Traversable (Segmentation r)++resolveSegmentation :: Segmentation RawNames a -> Resolver (Segmentation ResolvedNames) a+resolveSegmentation (UnsegmentedAllNodes info) = pure $ UnsegmentedAllNodes info+resolveSegmentation (UnsegmentedOneNode info node) = pure $ UnsegmentedOneNode info node+resolveSegmentation (SegmentedBy info expr nodelist) = do+ expr' <- resolveExpr expr+ pure $ SegmentedBy info expr' nodelist+++data Node a = Node a Text+ deriving (Generic, Data, Eq, Show, Functor, Foldable, Traversable)++data NodeListOffset a = NodeListOffset a Int+ deriving (Generic, Data, Eq, Show, Functor, Foldable, Traversable)++data NodeList a = AllNodes a (Maybe (NodeListOffset a))+ | Nodes a (NonEmpty (Node a))+ deriving (Generic, Data, Eq, Show, Functor, Foldable, Traversable)++data KSafety a = KSafety a (Maybe Int)+ deriving (Generic, Data, Eq, Show, Functor, Foldable, Traversable)++data Partitioning r a = Partitioning a (Expr r a)++deriving instance (ConstrainSNames Data r a, Data r) => Data (Partitioning r a)+deriving instance Generic (Partitioning r a)+deriving instance ConstrainSNames Eq r a => Eq (Partitioning r a)+deriving instance ConstrainSNames Show r a => Show (Partitioning r a)+deriving instance ConstrainSASNames Functor r => Functor (Partitioning r)+deriving instance ConstrainSASNames Foldable r => Foldable (Partitioning r)+deriving instance ConstrainSASNames Traversable r => Traversable (Partitioning r)++resolvePartitioning :: Partitioning RawNames a -> Resolver (Partitioning ResolvedNames) a+resolvePartitioning (Partitioning info expr) = Partitioning info <$> resolveExpr expr+++data Encoding a = EncodingAuto a+ | EncodingBlockDict a+ | EncodingBlockDictComp a+ | EncodingBZipComp a+ | EncodingCommonDeltaComp a+ | EncodingDeltaRangeComp a+ | EncodingDeltaVal a+ | EncodingGCDDelta a+ | EncodingGZipComp a+ | EncodingRLE a+ | EncodingNone a+ deriving (Generic, Data, Eq, Show, Functor, Foldable, Traversable)+++data CreateProjection r a = CreateProjection+ { createProjectionInfo :: a+ , createProjectionIfNotExists :: Maybe a+ , createProjectionName :: ProjectionName a+ , createProjectionColumns :: Maybe (NonEmpty (ProjectionColumn a))+ , createProjectionQuery :: Query r a+ , createProjectionSegmentation :: Maybe (Segmentation r a)+ , createProjectionKSafety :: Maybe (KSafety a)+ }++deriving instance (ConstrainSNames Data r a, Data r) => Data (CreateProjection r a)+deriving instance Generic (CreateProjection r a)+deriving instance ConstrainSNames Eq r a => Eq (CreateProjection r a)+deriving instance ConstrainSNames Show r a => Show (CreateProjection r a)+deriving instance ConstrainSASNames Functor r => Functor (CreateProjection r)+deriving instance ConstrainSASNames Foldable r => Foldable (CreateProjection r)+deriving instance ConstrainSASNames Traversable r => Traversable (CreateProjection r)+++data ProjectionName a = ProjectionName a (Maybe (QSchemaName Maybe a)) Text+ deriving (Generic, Data, Eq, Show, Functor, Foldable, Traversable)+++data ProjectionColumn a = ProjectionColumn+ { projectionColumnInfo :: a+ , projectionColumnName :: Text+ , projectionColumnAccessRank :: Maybe (AccessRank a)+ , projectionColumnEncoding :: Maybe (Encoding a)+ } deriving (Generic, Data, Eq, Show, Functor, Foldable, Traversable)++data AccessRank a = AccessRank a Int+ deriving (Generic, Data, Read, Show, Eq, Ord, Functor, Foldable, Traversable)++data MultipleRename r a = MultipleRename a [AlterTable r a]++deriving instance (ConstrainSNames Data r a, Data r) => Data (MultipleRename r a)+deriving instance Generic (MultipleRename r a)+deriving instance ConstrainSNames Eq r a => Eq (MultipleRename r a)+deriving instance ConstrainSNames Show r a => Show (MultipleRename r a)+deriving instance ConstrainSASNames Functor r => Functor (MultipleRename r)+deriving instance ConstrainSASNames Foldable r => Foldable (MultipleRename r)+deriving instance ConstrainSASNames Traversable r => Traversable (MultipleRename r)++data SetSchema r a = SetSchema+ { setSchemaInfo :: a+ , setSchemaTable :: TableName r a+ , setSchemaName :: SchemaName r a+ }++deriving instance (ConstrainSNames Data r a, Data r) => Data (SetSchema r a)+deriving instance Generic (SetSchema r a)+deriving instance ConstrainSNames Eq r a => Eq (SetSchema r a)+deriving instance ConstrainSNames Show r a => Show (SetSchema r a)+deriving instance ConstrainSASNames Functor r => Functor (SetSchema r)+deriving instance ConstrainSASNames Foldable r => Foldable (SetSchema r)+deriving instance ConstrainSASNames Traversable r => Traversable (SetSchema r)++data Merge r a = Merge+ { mergeInfo :: a+ , mergeTargetTable :: TableName r a+ , mergeTargetAlias :: Maybe (TableAlias a)+ , mergeSourceTable :: TableName r a+ , mergeSourceAlias :: Maybe (TableAlias a)+ , mergeCondition :: Expr r a+ , mergeUpdateDirective :: Maybe (NonEmpty (ColumnRef r a, DefaultExpr r a))+ , mergeInsertDirectiveColumns :: Maybe (NonEmpty (ColumnRef r a))+ , mergeInsertDirectiveValues :: Maybe (NonEmpty (DefaultExpr r a))+ }++deriving instance (ConstrainSNames Data r a, Data r) => Data (Merge r a)+deriving instance Generic (Merge r a)+deriving instance ConstrainSNames Eq r a => Eq (Merge r a)+deriving instance ConstrainSNames Show r a => Show (Merge r a)+deriving instance ConstrainSASNames Functor r => Functor (Merge r)+deriving instance ConstrainSASNames Foldable r => Foldable (Merge r)+deriving instance ConstrainSASNames Traversable r => Traversable (Merge r)+++decomposeMerge :: forall d a . Merge ResolvedNames a -> NonEmpty (Statement d ResolvedNames a)+decomposeMerge Merge{..} = fromList $ catMaybes [ fmap mkInsert mergeInsertDirectiveValues+ , fmap mkUpdate mergeUpdateDirective+ ]+ where+ r :: a+ r = mergeInfo++ toAliases :: Maybe (TableAlias a) -> TablishAliases a+ toAliases mAlias = case mAlias of+ Just alias -> TablishAliasesT alias+ Nothing -> TablishAliasesNone++ makeExprAlias :: Expr ResolvedNames a -> [ColumnAlias a]+ makeExprAlias = const []++ lhs :: Tablish ResolvedNames a+ lhs = let RTableName lhsFqtn lhsSchemaMember = mergeTargetTable+ in TablishTable r (toAliases mergeTargetAlias) (RTableRef lhsFqtn lhsSchemaMember)++ rhs :: Tablish ResolvedNames a+ rhs = let RTableName rhsFqtn rhsSchemaMember = mergeSourceTable+ in TablishTable r (toAliases mergeSourceAlias) (RTableRef rhsFqtn rhsSchemaMember)++ mkInsert :: NonEmpty (DefaultExpr ResolvedNames a) -> Statement d ResolvedNames a+ mkInsert insertVals =+ let selectInfo = r++ toSelectExpr (DefaultValue _) = error "don't know how to make SelectExpr from DefaultValue"+ toSelectExpr (ExprValue expr) = SelectExpr r (makeExprAlias expr) expr++ selectCols = SelectColumns r $ map toSelectExpr $ toList insertVals+ selectFrom =+ let join' = TablishJoin r (JoinInner r) (JoinOn $ UnOpExpr r "NOT" mergeCondition) lhs rhs+ in Just $ SelectFrom r [join']+ selectWhere = Nothing+ selectTimeseries = Nothing+ selectGroup = Nothing+ selectHaving = Nothing+ selectNamedWindow = Nothing+ selectDistinct = Distinct False++ insertInfo = r+ insertBehavior = InsertAppend r+ insertTable = mergeTargetTable+ insertColumns = mergeInsertDirectiveColumns+ insertValues = InsertSelectValues $ QuerySelect r Select{..}+ in InsertStmt Insert{..}++ mkUpdate :: NonEmpty (RColumnRef a, DefaultExpr ResolvedNames a) -> Statement d ResolvedNames a+ mkUpdate setExprs =+ let updateInfo = r+ updateTable = mergeTargetTable+ updateAlias = mergeTargetAlias+ updateSetExprs = setExprs+ updateFrom = Just $ TablishJoin r (JoinInner r) (JoinOn mergeCondition) lhs rhs+ updateWhere = Nothing+ in UpdateStmt Update{..}+++instance HasJoins (VerticaStatement ResolvedNames a) where+ getJoins (VerticaStandardSqlStatement stmt) = getJoins stmt+ getJoins (VerticaCreateProjectionStatement CreateProjection{..}) = getJoins (QueryStmt createProjectionQuery)+ getJoins (VerticaMultipleRenameStatement _) = S.empty+ getJoins (VerticaSetSchemaStatement _) = S.empty+ getJoins (VerticaMergeStatement merge) = foldMap getJoins $ toList $ decomposeMerge merge+ getJoins (VerticaUnhandledStatement _) = S.empty+++instance HasTableLineage (VerticaStatement ResolvedNames a) where+ getTableLineage (VerticaStandardSqlStatement stmt) = tableLineage stmt++ -- CREATE PROJECTION does not create a **table** so it has no table lineage.+ getTableLineage (VerticaCreateProjectionStatement _) = M.empty++ getTableLineage (VerticaMultipleRenameStatement (MultipleRename _ renames)) =+ foldl' (\ ls -> squashTableLineage ls . tableLineage . AlterTableStmt) M.empty renames++ getTableLineage (VerticaSetSchemaStatement (SetSchema _ (RTableName fqtn _) (QSchemaName _ (Identity (DatabaseName _ db)) schema schemaType))) = case schemaType of+ NormalSchema ->+ let from@(FullyQualifiedTableName _ _ table) = mkFQTN fqtn+ to = FullyQualifiedTableName db schema table+ in M.fromList [(to, S.singleton from), (from, S.empty)]+ SessionSchema -> error $ "can't set a table's schema to SessionSchema"++ getTableLineage (VerticaMergeStatement merge) = M.unionsWith S.union $ map tableLineage $ toList $ decomposeMerge merge++ getTableLineage (VerticaUnhandledStatement _) = M.empty+++instance HasColumnLineage (VerticaStatement ResolvedNames Range) where+ getColumnLineage (VerticaStandardSqlStatement stmt) = columnLineage stmt++ -- CREATE PROJECTION does not create a **table** so it has no column lineage.+ getColumnLineage (VerticaCreateProjectionStatement _) = returnNothing M.empty++ getColumnLineage (VerticaMultipleRenameStatement (MultipleRename _ renames)) =+ returnNothing $ foldl' (\ ls -> squashColumns ls . snd . columnLineage . AlterTableStmt) M.empty renames+ where+ squashColumns :: ColumnLineagePlus -> ColumnLineagePlus -> ColumnLineagePlus+ squashColumns old new =+ -- This gets to be simpler because we know we're dealing with single columns all the way through.+ -- This means we can safely discard the FieldChains and look at the keys as sets.+ let new' = M.map (toColumnPlusSet . M.foldMapWithKey go . fromColumnPlusSet) new+ fromColumnPlusSet :: ColumnPlusSet -> Map (Either FQTN FQCN) (Set Range)+ fromColumnPlusSet ColumnPlusSet{..} =+ M.fromList $ map (Right *** (S.unions . M.elems)) (M.toList columnPlusColumns)+ ++ map (first Left) (M.toList columnPlusTables)++ retuple :: (Either a b, c) -> Either (a, c) (b, c)+ retuple (Left x, z) = Left (x, z)+ retuple (Right y, z) = Right (y, z)++ toColumnPlusSet :: Map (Either FQTN FQCN) (Set Range) -> ColumnPlusSet+ toColumnPlusSet ds =+ let (ts, cs) = partitionEithers $ map retuple $ M.toList ds+ in ColumnPlusSet (M.singleton (FieldChain M.empty) <$> M.fromList cs) (M.fromList ts)++ go k v = maybe (M.singleton k v) fromColumnPlusSet $ M.lookup k old+ in M.union new' old++ getColumnLineage (VerticaSetSchemaStatement (SetSchema _ (RTableName fqtn SchemaMember{..}) schemaName)) =+ let from = map (qualifyColumnName fqtn) columnsList+ to = map (qualifyColumnName fqtn{tableNameSchema = pure schemaName}) columnsList+ in returnNothing+ $ M.insert (Left $ fqtnToFQTN fqtn) emptyColumnPlusSet+ $ M.insert (Left $ fqtnToFQTN fqtn{tableNameSchema = pure schemaName}) (singleTableSet (getInfo fqtn) $ fqtnToFQTN fqtn)+ $ M.union (ColumnPlus.emptyLineage from) $ M.fromList $ zip (map (Right . fqcnToFQCN) to) $ map (singleColumnSet (getInfo fqtn) . fqcnToFQCN) from++ getColumnLineage (VerticaMergeStatement merge) = returnNothing $+ let x:xs = map (snd . columnLineage) (toList $ decomposeMerge merge)+ in foldr (<>) x xs++ getColumnLineage (VerticaUnhandledStatement _) = returnNothing M.empty++++resolveVerticaStatement :: VerticaStatement RawNames a -> Resolver (VerticaStatement ResolvedNames) a+resolveVerticaStatement (VerticaStandardSqlStatement stmt) = VerticaStandardSqlStatement <$> resolveStatement stmt+resolveVerticaStatement (VerticaCreateProjectionStatement CreateProjection{..}) = do+ WithColumns createProjectionQuery' columns <- resolveQueryWithColumns createProjectionQuery+ bindColumns columns $ do+ createProjectionSegmentation' <- overJust resolveSegmentation createProjectionSegmentation+ pure $ VerticaCreateProjectionStatement CreateProjection+ { createProjectionQuery = createProjectionQuery'+ , createProjectionSegmentation = createProjectionSegmentation'+ , ..+ }++resolveVerticaStatement (VerticaMultipleRenameStatement stmt) = VerticaMultipleRenameStatement <$> resolveMultipleRename stmt+resolveVerticaStatement (VerticaSetSchemaStatement stmt) = VerticaSetSchemaStatement <$> resolveSetSchema stmt++resolveVerticaStatement (VerticaMergeStatement Merge{..}) = do+ mergeTargetTable'@(RTableName tFqtn tSchemaMember) <- resolveTableName mergeTargetTable+ mergeSourceTable'@(RTableName sFqtn sSchemaMember) <- resolveTableName mergeSourceTable++ let mkColRefs :: [UQColumnName ()] -> FQTableName a -> [RColumnRef a]+ mkColRefs uqcns fqtn = map (\uqcn -> RColumnRef $ uqcn { columnNameInfo = tableNameInfo fqtn+ , columnNameTable = Identity fqtn+ }) uqcns+ tgtColRefs = mkColRefs (columnsList tSchemaMember) tFqtn+ tgtColSet = case mergeTargetAlias of+ Just alias -> (Just $ RTableAlias alias, tgtColRefs)+ Nothing -> (Just $ RTableRef tFqtn tSchemaMember, tgtColRefs)+ srcColRefs = mkColRefs (columnsList sSchemaMember) sFqtn+ srcColSet = case mergeSourceAlias of+ Just alias -> (Just $ RTableAlias alias, srcColRefs)+ Nothing -> (Just $ RTableRef sFqtn sSchemaMember, srcColRefs)++ mergeCondition' <- bindColumns [srcColSet, tgtColSet] $ resolveExpr mergeCondition++ let resolveColRef oqcn = RColumnRef $ oqcn { columnNameTable = Identity tFqtn }+ resolveSetExpr (oqcn, expr) = do+ expr' <- resolveDefaultExpr expr+ return (resolveColRef oqcn, expr')+ mergeUpdateDirective' <- bindColumns [srcColSet] $ mapM (mapM resolveSetExpr) mergeUpdateDirective++ let mergeInsertDirectiveColumns' = fmap (fmap resolveColRef) mergeInsertDirectiveColumns+ mergeInsertDirectiveValues' <- bindColumns [srcColSet] $ mapM (mapM resolveDefaultExpr) mergeInsertDirectiveValues++ pure $ VerticaMergeStatement Merge+ { mergeTargetTable = mergeTargetTable'+ , mergeSourceTable = mergeSourceTable'+ , mergeCondition = mergeCondition'+ , mergeUpdateDirective = mergeUpdateDirective'+ , mergeInsertDirectiveColumns = mergeInsertDirectiveColumns'+ , mergeInsertDirectiveValues = mergeInsertDirectiveValues'+ , ..+ }++resolveVerticaStatement (VerticaUnhandledStatement info) = pure $ VerticaUnhandledStatement info++resolveMultipleRename :: MultipleRename RawNames a -> Resolver (MultipleRename ResolvedNames) a+resolveMultipleRename (MultipleRename info []) = pure $ MultipleRename info []+resolveMultipleRename (MultipleRename info (a:as)) = do+ -- TODO (part of T416947): apply derived updates based on warnings+ (a', _) <- listen $ resolveAlterTable a+ catalog <- asks catalog+++ -- here we're discarding SchemaChangeErrors - I'm not sure what's right+ let merge cat ch = fst $ applySchemaChange ch cat+ catalog' = foldl' merge catalog $ getSchemaChange a'++ MultipleRename info' as' <- local (\ ri -> ri { catalog = catalog' }) $ resolveMultipleRename $ MultipleRename info as++ pure $ MultipleRename info' (a':as')++resolveSetSchema :: SetSchema RawNames a -> Resolver (SetSchema ResolvedNames) a+resolveSetSchema SetSchema{..} = do+ setSchemaTable' <- resolveTableName setSchemaTable+ setSchemaName' <- resolveSchemaName setSchemaName+ pure SetSchema+ { setSchemaTable = setSchemaTable'+ , setSchemaName = setSchemaName'+ , ..+ }+++instance HasSchemaChange (VerticaStatement ResolvedNames a) where+ getSchemaChange (VerticaStandardSqlStatement stmt) = getSchemaChange stmt+ getSchemaChange (VerticaCreateProjectionStatement _) = []+ getSchemaChange (VerticaMultipleRenameStatement stmt) = getSchemaChange stmt+ getSchemaChange (VerticaSetSchemaStatement stmt) = getSchemaChange stmt+ getSchemaChange (VerticaMergeStatement _) = []+ getSchemaChange (VerticaUnhandledStatement _) = []++instance HasSchemaChange (MultipleRename ResolvedNames a) where+ getSchemaChange (MultipleRename _ renames) = renames >>= getSchemaChange++instance HasSchemaChange (SetSchema ResolvedNames a) where+ getSchemaChange (SetSchema _ (RTableName fqtn table) schemaName) =+ [ Schema.DropTable $ void fqtn+ , Schema.CreateTable (void fqtn { tableNameSchema = pure schemaName }) table+ ]+++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (VerticaStatement r a) where+ toJSON (VerticaStandardSqlStatement stmt) = toJSON stmt+ toJSON (VerticaCreateProjectionStatement stmt) = toJSON stmt+ toJSON (VerticaMultipleRenameStatement stmt) = toJSON stmt+ toJSON (VerticaSetSchemaStatement stmt) = toJSON stmt+ toJSON (VerticaMergeStatement stmt) = toJSON stmt++ toJSON (VerticaUnhandledStatement info) = JSON.object+ [ "tag" .= JSON.String "VerticaUnhandledStatement"+ , "info" .= info+ ]++typeExample :: ()+typeExample = const () $ toJSON (undefined :: VerticaStatement ResolvedNames Range)++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (CreateProjection r a) where+ toJSON CreateProjection{..} = JSON.object+ [ "tag" .= JSON.String "CreateProjection"+ , "info" .= createProjectionInfo+ , "ifnotexists" .= createProjectionIfNotExists+ , "name" .= createProjectionName+ , "columns" .= fmap F.toList createProjectionColumns+ , "query" .= createProjectionQuery+ , "segmentation" .= createProjectionSegmentation+ , "ksafety" .= createProjectionKSafety+ ]++instance ToJSON a => ToJSON (ProjectionColumn a) where+ toJSON ProjectionColumn{..} = JSON.object+ [ "tag" .= JSON.String "ProjectionColumn"+ , "info" .= projectionColumnInfo+ , "name" .= projectionColumnName+ , "accessrank" .= projectionColumnAccessRank+ , "encoding" .= projectionColumnEncoding+ ]++instance ToJSON a => ToJSON (ProjectionName a) where+ toJSON (ProjectionName info schema projection) = JSON.object+ [ "tag" .= JSON.String "ProjectionName"+ , "info" .= info+ , "schema" .= schema+ , "projection" .= projection+ ]++instance ToJSON a => ToJSON (AccessRank a) where+ toJSON (AccessRank info rank) = JSON.object+ [ "tag" .= JSON.String "AccessRank"+ , "info" .= info+ , "rank" .= rank+ ]++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (TableInfo r a) where+ toJSON TableInfo{..} = JSON.object+ [ "tag" .= JSON.String "TableInfo"+ , "dialect" .= JSON.String "Vertica"+ , "ordering" .= tableInfoOrdering+ , "encoding" .= tableInfoEncoding+ , "segmentation" .= tableInfoSegmentation+ , "ksafety" .= tableInfoKSafety+ , "partitioning" .= tableInfoPartitioning+ ]++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (TableEncoding r a) where+ toJSON (TableEncoding info encodings) = JSON.object+ [ "tag" .= JSON.String "TableEncoding"+ , "info" .= info+ , "encodings" .= encodings+ ]++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (Segmentation r a) where+ toJSON (UnsegmentedAllNodes info) = JSON.object+ [ "tag" .= JSON.String "UnsegmentedAllNodes"+ , "info" .= info+ ]++ toJSON (UnsegmentedOneNode info node) = JSON.object+ [ "tag" .= JSON.String "UnsegmentedAllNodes"+ , "info" .= info+ , "node" .= node+ ]++ toJSON (SegmentedBy info expr nodes) = JSON.object+ [ "tag" .= JSON.String "UnsegmentedAllNodes"+ , "info" .= info+ , "expr" .= expr+ , "nodes" .= nodes+ ]++instance ToJSON a => ToJSON (KSafety a) where+ toJSON (KSafety info factor) = JSON.object+ [ "tag" .= JSON.String "KSafety"+ , "info" .= info+ , "factor" .= factor+ ]++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (Partitioning r a) where+ toJSON (Partitioning info expr) = JSON.object+ [ "tag" .= JSON.String "Partitioning"+ , "info" .= info+ , "expr" .= expr+ ]+++instance ToJSON a => ToJSON (Encoding a) where+ toJSON (EncodingAuto info) = JSON.object+ [ "tag" .= JSON.String "EncodingAuto"+ , "info" .= info+ ]++ toJSON (EncodingBlockDict info) = JSON.object+ [ "tag" .= JSON.String "EncodingBlockDict"+ , "info" .= info+ ]++ toJSON (EncodingBlockDictComp info) = JSON.object+ [ "tag" .= JSON.String "EncodingBlockDictComp"+ , "info" .= info+ ]++ toJSON (EncodingBZipComp info) = JSON.object+ [ "tag" .= JSON.String "EncodingBZipComp"+ , "info" .= info+ ]++ toJSON (EncodingCommonDeltaComp info) = JSON.object+ [ "tag" .= JSON.String "EncodingCommonDeltaComp"+ , "info" .= info+ ]++ toJSON (EncodingDeltaRangeComp info) = JSON.object+ [ "tag" .= JSON.String "EncodingDeltaRangeComp"+ , "info" .= info+ ]++ toJSON (EncodingDeltaVal info) = JSON.object+ [ "tag" .= JSON.String "EncodingDeltaVal"+ , "info" .= info+ ]++ toJSON (EncodingGCDDelta info) = JSON.object+ [ "tag" .= JSON.String "EncodingGCDDelta"+ , "info" .= info+ ]++ toJSON (EncodingGZipComp info) = JSON.object+ [ "tag" .= JSON.String "EncodingGZipComp"+ , "info" .= info+ ]++ toJSON (EncodingRLE info) = JSON.object+ [ "tag" .= JSON.String "EncodingRLE"+ , "info" .= info+ ]++ toJSON (EncodingNone info) = JSON.object+ [ "tag" .= JSON.String "EncodingNone"+ , "info" .= info+ ]++instance ToJSON a => ToJSON (Node a) where+ toJSON (Node info name) = JSON.object+ [ "tag" .= JSON.String "Node"+ , "info" .= info+ , "name" .= name+ ]++instance ToJSON a => ToJSON (NodeList a) where+ toJSON (AllNodes info offset) = JSON.object+ [ "tag" .= JSON.String "AllNodes"+ , "info" .= info+ , "offset" .= offset+ ]++ toJSON (Nodes info (n:|ns)) = JSON.object+ [ "tag" .= JSON.String "Nodes"+ , "info" .= info+ , "nodes" .= (n:ns)+ ]++instance ToJSON a => ToJSON (NodeListOffset a) where+ toJSON (NodeListOffset info offset) = JSON.object+ [ "tag" .= JSON.String "NodeListOffset"+ , "info" .= info+ , "offset" .= offset+ ]++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (MultipleRename r a) where+ toJSON (MultipleRename info renames) = JSON.object+ [ "tag" .= JSON.String "MultipleRename"+ , "info" .= info+ , "renames" .= renames+ ]++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (SetSchema r a) where+ toJSON (SetSchema info table schema) = JSON.object+ [ "tag" .= JSON.String "SetSchema"+ , "info" .= info+ , "table" .= table+ , "schema" .= schema+ ]++instance (ConstrainSNames ToJSON r a, ToJSON a) => ToJSON (Merge r a) where+ toJSON Merge{..} = JSON.object+ [ "tag" .= JSON.String "Merge"+ , "info" .= mergeInfo+ , "mergeTargetTable" .= mergeTargetTable+ , "mergeTargetAlias" .= mergeTargetAlias+ , "mergeSourceTable" .= mergeSourceTable+ , "mergeSourceAlias" .= mergeSourceAlias+ , "mergeCondition" .= mergeCondition+ , "mergeUpdateDirective" .= fmap toList mergeUpdateDirective+ , "mergeInsertDirectiveColumns" .= fmap toList mergeInsertDirectiveColumns+ , "mergeInsertDirectiveValues" .= fmap toList mergeInsertDirectiveValues+ ]++instance HasInfo (TableInfo r a) where+ type Info (TableInfo r a) = a+ getInfo TableInfo{..} = tableInfoInfo++instance HasInfo (TableEncoding r a) where+ type Info (TableEncoding r a) = a+ getInfo (TableEncoding info _) = info++instance HasInfo (Segmentation r a) where+ type Info (Segmentation r a) = a+ getInfo (UnsegmentedAllNodes info) = info+ getInfo (UnsegmentedOneNode info _) = info+ getInfo (SegmentedBy info _ _) = info++instance HasInfo (Partitioning r a) where+ type Info (Partitioning r a) = a+ getInfo (Partitioning info _) = info++instance HasInfo (KSafety a) where+ type Info (KSafety a) = a+ getInfo (KSafety info _) = info++instance HasInfo (NodeList a) where+ type Info (NodeList a) = a+ getInfo (AllNodes info _) = info+ getInfo (Nodes info _) = info++instance HasInfo (NodeListOffset a) where+ type Info (NodeListOffset a) = a+ getInfo (NodeListOffset info _) = info++instance HasInfo (Node a) where+ type Info (Node a) = a+ getInfo (Node info _) = info++instance HasInfo (AccessRank a) where+ type Info (AccessRank a) = a+ getInfo (AccessRank info _) = info++instance HasInfo (Encoding a) where+ type Info (Encoding a) = a+ getInfo (EncodingAuto info) = info+ getInfo (EncodingBlockDict info) = info+ getInfo (EncodingBlockDictComp info) = info+ getInfo (EncodingBZipComp info) = info+ getInfo (EncodingCommonDeltaComp info) = info+ getInfo (EncodingDeltaRangeComp info) = info+ getInfo (EncodingDeltaVal info) = info+ getInfo (EncodingGCDDelta info) = info+ getInfo (EncodingGZipComp info) = info+ getInfo (EncodingRLE info) = info+ getInfo (EncodingNone info) = info++instance HasInfo (ProjectionName a) where+ type Info (ProjectionName a) = a+ getInfo (ProjectionName info _ _) = info++instance HasInfo (MultipleRename r a) where+ type Info (MultipleRename r a) = a+ getInfo (MultipleRename info _) = info++instance HasInfo (SetSchema r a) where+ type Info (SetSchema r a) = a+ getInfo (SetSchema info _ _) = info++instance HasInfo (Merge r a) where+ type Info (Merge r a) = a+ getInfo Merge{..} = mergeInfo++instance HasTables (VerticaStatement ResolvedNames a) where+ goTables (VerticaStandardSqlStatement s) = goTables s+ goTables (VerticaCreateProjectionStatement _) = return ()+ goTables (VerticaMultipleRenameStatement mr) = goTables mr+ goTables (VerticaSetSchemaStatement _) = return ()+ goTables (VerticaMergeStatement merge) = goTables merge+ goTables (VerticaUnhandledStatement _) = return ()++instance HasTables (MultipleRename ResolvedNames a) where+ goTables (MultipleRename _ alters) = mapM_ goTables alters++instance HasTables (Merge ResolvedNames a) where+ goTables merge = mapM_ goTables $ toList $ decomposeMerge merge++instance HasColumns (VerticaStatement ResolvedNames a) where+ goColumns (VerticaStandardSqlStatement s) = goColumns s+ goColumns (VerticaCreateProjectionStatement s) = goColumns s+ goColumns (VerticaMultipleRenameStatement _) = return ()+ goColumns (VerticaSetSchemaStatement _) = return ()+ goColumns (VerticaMergeStatement m) = goColumns m+ goColumns (VerticaUnhandledStatement _) = return ()++instance HasColumns (CreateProjection ResolvedNames a) where+ goColumns CreateProjection{..} = bindClause "CREATE" $ do+ goColumns createProjectionQuery+ goColumns createProjectionSegmentation++instance HasColumns (Segmentation ResolvedNames a) where+ goColumns (UnsegmentedAllNodes _) = return ()+ goColumns (UnsegmentedOneNode _ _) = return ()+ goColumns (SegmentedBy _ expr _) = goColumns expr++instance HasColumns (Merge ResolvedNames a) where+ goColumns merge = bindClause "MERGE" $ mapM_ goColumns $ toList $ decomposeMerge merge