module Database.Sql.Util.Scope
( runResolverWarn, runResolverWError, runResolverNoWarn
, WithColumns (..)
, queryColumnNames
, resolveStatement, resolveQuery, resolveQueryWithColumns, resolveSelectAndOrders, resolveCTE, resolveInsert
, resolveInsertValues, resolveDefaultExpr, resolveDelete, resolveTruncate
, resolveCreateTable, resolveTableDefinition, resolveColumnOrConstraint
, resolveColumnDefinition, resolveAlterTable, resolveDropTable
, resolveSelectColumns, resolvedTableHasName, resolvedTableHasSchema
, resolveSelection, resolveExpr, resolveTableName, resolveDropTableName
, resolveCreateSchemaName, resolveSchemaName
, resolveTableRef, resolveColumnName, resolvePartition, resolveSelectFrom
, resolveTablish, resolveJoinCondition, resolveSelectWhere, resolveSelectTimeseries
, resolveSelectGroup, resolveSelectHaving, resolveOrder
, selectionNames, mkTableSchemaMember
) where
import Prelude hiding ((&&), (||), not)
import Data.Predicate.Class
import Data.Maybe (mapMaybe)
import Data.Either (lefts, rights)
import Data.Traversable (traverse)
import Database.Sql.Type
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy (Text)
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Except
import Control.Monad.Identity
import Control.Arrow (first, (&&&))
import Data.Proxy (Proxy (..))
makeResolverInfo :: Dialect d => Proxy d -> Catalog -> ResolverInfo a
makeResolverInfo dialect catalog = ResolverInfo
{ bindings = emptyBindings
, onCTECollision =
if shouldCTEsShadowTables dialect
then \ f x -> f x
else \ _ x -> x
, selectScope = getSelectScope dialect
, lcolumnsAreVisibleInLateralViews = areLcolumnsVisibleInLateralViews dialect
, ..
}
makeColumnAlias :: a -> Text -> Resolver ColumnAlias a
makeColumnAlias r alias = ColumnAlias r alias . ColumnAliasId <$> getNextCounter
where
getNextCounter = modify (subtract 1) >> get
runResolverWarn :: Dialect d => Resolver r a -> Proxy d -> Catalog -> (Either (ResolutionError a) (r a), [Either (ResolutionError a) (ResolutionSuccess a)])
runResolverWarn resolver dialect catalog = runWriter $ runExceptT $ runReaderT (evalStateT resolver 0) $ makeResolverInfo dialect catalog
runResolverWError :: Dialect d => Resolver r a -> Proxy d -> Catalog -> Either [ResolutionError a] ((r a), [ResolutionSuccess a])
runResolverWError resolver dialect catalog =
let (result, warningsSuccesses) = runResolverWarn resolver dialect catalog
warnings = lefts warningsSuccesses
successes = rights warningsSuccesses
in case (result, warnings) of
(Right x, []) -> Right (x, successes)
(Right _, ws) -> Left ws
(Left e, ws) -> Left (e:ws)
runResolverNoWarn :: Dialect d => Resolver r a -> Proxy d -> Catalog -> Either (ResolutionError a) (r a)
runResolverNoWarn resolver dialect catalog = fst $ runResolverWarn resolver dialect catalog
resolveStatement :: Dialect d => Statement d RawNames a -> Resolver (Statement d ResolvedNames) a
resolveStatement (QueryStmt stmt) = QueryStmt <$> resolveQuery stmt
resolveStatement (InsertStmt stmt) = InsertStmt <$> resolveInsert stmt
resolveStatement (UpdateStmt stmt) = UpdateStmt <$> resolveUpdate stmt
resolveStatement (DeleteStmt stmt) = DeleteStmt <$> resolveDelete stmt
resolveStatement (TruncateStmt stmt) = TruncateStmt <$> resolveTruncate stmt
resolveStatement (CreateTableStmt stmt) = CreateTableStmt <$> resolveCreateTable stmt
resolveStatement (AlterTableStmt stmt) = AlterTableStmt <$> resolveAlterTable stmt
resolveStatement (DropTableStmt stmt) = DropTableStmt <$> resolveDropTable stmt
resolveStatement (CreateViewStmt stmt) = CreateViewStmt <$> resolveCreateView stmt
resolveStatement (DropViewStmt stmt) = DropViewStmt <$> resolveDropView stmt
resolveStatement (CreateSchemaStmt stmt) = CreateSchemaStmt <$> resolveCreateSchema stmt
resolveStatement (GrantStmt stmt) = pure $ GrantStmt stmt
resolveStatement (RevokeStmt stmt) = pure $ RevokeStmt stmt
resolveStatement (BeginStmt info) = pure $ BeginStmt info
resolveStatement (CommitStmt info) = pure $ CommitStmt info
resolveStatement (RollbackStmt info) = pure $ RollbackStmt info
resolveStatement (ExplainStmt info stmt) = ExplainStmt info <$> resolveStatement stmt
resolveStatement (EmptyStmt info) = pure $ EmptyStmt info
resolveQuery :: Query RawNames a -> Resolver (Query ResolvedNames) a
resolveQuery = (withColumnsValue <$>) . resolveQueryWithColumns
resolveQueryWithColumns :: Query RawNames a -> Resolver (WithColumns (Query ResolvedNames)) a
resolveQueryWithColumns (QuerySelect info select) = do
WithColumnsAndOrders select' columns _ <- resolveSelectAndOrders select []
pure $ WithColumns (QuerySelect info select') columns
resolveQueryWithColumns (QueryExcept info Unused lhs rhs) = do
WithColumns lhs' columns <- resolveQueryWithColumns lhs
rhs' <- resolveQuery rhs
cs <- forM (queryColumnNames lhs') $ \case
RColumnRef QColumnName{..} -> makeColumnAlias columnNameInfo columnNameName
RColumnAlias (ColumnAlias aliasInfo name _) -> makeColumnAlias aliasInfo name
pure $ WithColumns (QueryExcept info (ColumnAliasList cs) lhs' rhs') columns
resolveQueryWithColumns (QueryUnion info distinct Unused lhs rhs) = do
WithColumns lhs' columns <- resolveQueryWithColumns lhs
rhs' <- resolveQuery rhs
cs <- forM (queryColumnNames lhs') $ \case
RColumnRef QColumnName{..} -> makeColumnAlias columnNameInfo columnNameName
RColumnAlias (ColumnAlias aliasInfo name _) -> makeColumnAlias aliasInfo name
pure $ WithColumns (QueryUnion info distinct (ColumnAliasList cs) lhs' rhs') columns
resolveQueryWithColumns (QueryIntersect info Unused lhs rhs) = do
WithColumns lhs' columns <- resolveQueryWithColumns lhs
rhs' <- resolveQuery rhs
cs <- forM (queryColumnNames lhs') $ \case
RColumnRef QColumnName{..} -> makeColumnAlias columnNameInfo columnNameName
RColumnAlias (ColumnAlias aliasInfo name _) -> makeColumnAlias aliasInfo name
pure $ WithColumns (QueryIntersect info (ColumnAliasList cs) lhs' rhs') columns
resolveQueryWithColumns (QueryWith info [] query) = overWithColumns (QueryWith info []) <$> resolveQueryWithColumns query
resolveQueryWithColumns (QueryWith info (cte:ctes) query) = do
cte' <- resolveCTE cte
Catalog{..} <- asks catalog
let TableAlias _ alias _ = cteAlias cte'
updateBindings <- fmap ($ local (mapBindings $ bindCTE cte')) $
case catalogHasTable $ QTableName () None alias of
Exists -> asks onCTECollision
DoesNotExist -> pure id
WithColumns (QueryWith _ ctes' query') columns <- updateBindings $ resolveQueryWithColumns $ QueryWith info ctes query
pure $ WithColumns (QueryWith info (cte':ctes') query') columns
resolveQueryWithColumns (QueryOrder info orders query) = do
WithColumns query' columns <- resolveQueryWithColumns query
ResolvedOrders orders' <- resolveOrders query orders
pure $ WithColumns (QueryOrder info orders' query') columns
resolveQueryWithColumns (QueryLimit info limit query) = overWithColumns (QueryLimit info limit) <$> resolveQueryWithColumns query
resolveQueryWithColumns (QueryOffset info offset query) = overWithColumns (QueryOffset info offset) <$> resolveQueryWithColumns query
newtype ResolvedOrders a = ResolvedOrders [Order ResolvedNames a]
resolveOrders :: Query RawNames a -> [Order RawNames a] -> Resolver ResolvedOrders a
resolveOrders query orders = case query of
QuerySelect _ s -> do
WithColumnsAndOrders _ _ os <- resolveSelectAndOrders s orders
pure $ ResolvedOrders os
q@(QueryExcept _ _ _ _) -> do
q'@(QueryExcept _ (ColumnAliasList cs) _ _) <- resolveQuery q
let exprs = map (\ c@(ColumnAlias info _ _) -> ColumnExpr info $ RColumnAlias c) cs
bindAliasedColumns (queryColumnNames q') $ ResolvedOrders <$> mapM (resolveOrder exprs) orders
q@(QueryUnion _ _ _ _ _) -> do
q'@(QueryUnion _ _ (ColumnAliasList cs) _ _) <- resolveQuery q
let exprs = map (\ c@(ColumnAlias info _ _) -> ColumnExpr info $ RColumnAlias c) cs
bindAliasedColumns (queryColumnNames q') $ ResolvedOrders <$> mapM (resolveOrder exprs) orders
q@(QueryIntersect _ _ _ _) -> do
q'@(QueryIntersect _ (ColumnAliasList cs) _ _) <- resolveQuery q
let exprs = map (\ c@(ColumnAlias info _ _) -> ColumnExpr info $ RColumnAlias c) cs
bindAliasedColumns (queryColumnNames q') $ ResolvedOrders <$> mapM (resolveOrder exprs) orders
QueryWith _ _ _ -> error "unexpected AST: QueryOrder enclosing QueryWith"
QueryOrder _ _ q -> do
resolveOrders q orders
QueryLimit _ _ q -> resolveOrders q orders
QueryOffset _ _ q -> resolveOrders q orders
bindCTE :: CTE ResolvedNames a -> Bindings a -> Bindings a
bindCTE CTE{..} =
let columns =
case cteColumns of
[] -> queryColumnNames cteQuery
cs -> map RColumnAlias cs
cte = (cteAlias, columns)
in \ Bindings{..} -> Bindings{boundCTEs = cte:boundCTEs, ..}
selectionNames :: Selection ResolvedNames a -> [RColumnRef a]
selectionNames (SelectExpr _ [alias] (ColumnExpr _ ref)) =
let refName = case ref of
RColumnRef (QColumnName _ _ name) -> name
RColumnAlias (ColumnAlias _ name _) -> name
ColumnAlias _ aliasName _ = alias
in if (refName == aliasName) then [ref] else [RColumnAlias alias]
selectionNames (SelectExpr _ aliases _) = map RColumnAlias aliases
selectionNames (SelectStar _ _ (StarColumnNames referents)) = referents
selectionExprs :: Selection ResolvedNames a -> [Expr ResolvedNames a]
selectionExprs (SelectExpr info aliases _) = map (ColumnExpr info . RColumnAlias) aliases
selectionExprs (SelectStar info _ (StarColumnNames referents)) = map (ColumnExpr info) referents
queryColumnNames :: Query ResolvedNames a -> [RColumnRef a]
queryColumnNames (QuerySelect _ Select{selectCols = SelectColumns _ cols}) = cols >>= selectionNames
queryColumnNames (QueryExcept _ (ColumnAliasList cs) _ _) = map RColumnAlias cs
queryColumnNames (QueryUnion _ _ (ColumnAliasList cs) _ _) = map RColumnAlias cs
queryColumnNames (QueryIntersect _ (ColumnAliasList cs) _ _) = map RColumnAlias cs
queryColumnNames (QueryWith _ _ query) = queryColumnNames query
queryColumnNames (QueryOrder _ _ query) = queryColumnNames query
queryColumnNames (QueryLimit _ _ query) = queryColumnNames query
queryColumnNames (QueryOffset _ _ query) = queryColumnNames query
resolveSelectAndOrders :: Select RawNames a -> [Order RawNames a] -> Resolver (WithColumnsAndOrders (Select ResolvedNames)) a
resolveSelectAndOrders Select{..} orders = do
(selectFrom', columns) <- traverse resolveSelectFrom selectFrom >>= \case
Nothing -> pure (Nothing, [])
Just (WithColumns selectFrom' columns) -> pure (Just selectFrom', columns)
selectTimeseries' <- traverse (bindColumns columns . resolveSelectTimeseries) selectTimeseries
maybeBindTimeSlice selectTimeseries' $ do
selectCols' <- bindColumns columns $ resolveSelectColumns columns selectCols
let selectedAliases = selectionNames =<< selectColumnsList selectCols'
selectedExprs = selectionExprs =<< selectColumnsList selectCols'
SelectScope{..} <- (\ f -> f columns selectedAliases) <$> asks selectScope
selectHaving' <- bindForHaving $ traverse resolveSelectHaving selectHaving
selectWhere' <- bindForWhere $ traverse resolveSelectWhere selectWhere
selectGroup' <- bindForGroup $ traverse (resolveSelectGroup selectedExprs) selectGroup
selectNamedWindow' <- bindForNamedWindow $ traverse resolveSelectNamedWindow selectNamedWindow
orders' <- bindForOrder $ mapM (resolveOrder selectedExprs) orders
let select = Select { selectCols = selectCols'
, selectFrom = selectFrom'
, selectWhere = selectWhere'
, selectTimeseries = selectTimeseries'
, selectGroup = selectGroup'
, selectHaving = selectHaving'
, selectNamedWindow = selectNamedWindow'
, ..
}
pure $ WithColumnsAndOrders select columns orders'
where
maybeBindTimeSlice Nothing = id
maybeBindTimeSlice (Just timeseries) = bindColumns [(Nothing, [RColumnAlias $ selectTimeseriesSliceName timeseries])]
resolveCTE :: CTE RawNames a -> Resolver (CTE ResolvedNames) a
resolveCTE CTE{..} = do
cteQuery' <- resolveQuery cteQuery
pure $ CTE
{ cteQuery = cteQuery'
, ..
}
resolveInsert :: Insert RawNames a -> Resolver (Insert ResolvedNames) a
resolveInsert Insert{..} = do
insertTable'@(RTableName fqtn _) <- resolveTableName insertTable
let insertColumns' = fmap (fmap (\uqcn -> RColumnRef $ uqcn { columnNameTable = Identity fqtn })) insertColumns
insertValues' <- resolveInsertValues insertValues
pure $ Insert
{ insertTable = insertTable'
, insertColumns = insertColumns'
, insertValues = insertValues'
, ..
}
resolveInsertValues :: InsertValues RawNames a -> Resolver (InsertValues ResolvedNames) a
resolveInsertValues (InsertExprValues info exprs) = InsertExprValues info <$> mapM (mapM resolveDefaultExpr) exprs
resolveInsertValues (InsertSelectValues query) = InsertSelectValues <$> resolveQuery query
resolveInsertValues (InsertDefaultValues info) = pure $ InsertDefaultValues info
resolveInsertValues (InsertDataFromFile info path) = pure $ InsertDataFromFile info path
resolveDefaultExpr :: DefaultExpr RawNames a -> Resolver (DefaultExpr ResolvedNames) a
resolveDefaultExpr (DefaultValue info) = pure $ DefaultValue info
resolveDefaultExpr (ExprValue expr) = ExprValue <$> resolveExpr expr
resolveUpdate :: Update RawNames a -> Resolver (Update ResolvedNames) a
resolveUpdate Update{..} = do
updateTable'@(RTableName fqtn schemaMember) <- resolveTableName updateTable
let uqcns = columnsList schemaMember
tgtColRefs = map (\uqcn -> RColumnRef $ uqcn { columnNameInfo = tableNameInfo fqtn
, columnNameTable = Identity fqtn
}) uqcns
tgtColSet = case updateAlias of
Just alias -> (Just $ RTableAlias alias, tgtColRefs)
Nothing -> (Just $ RTableRef fqtn schemaMember, tgtColRefs)
(updateFrom', srcColSet) <- case updateFrom of
Just tablish -> resolveTablish tablish >>= (\ (WithColumns t cs) -> return (Just t, cs))
Nothing -> return (Nothing, [])
updateSetExprs' <- bindColumns srcColSet $
mapM (\(uqcn, expr) -> (RColumnRef uqcn { columnNameTable = Identity fqtn},) <$> resolveDefaultExpr expr) updateSetExprs
updateWhere' <- bindColumns (tgtColSet:srcColSet) $ mapM resolveExpr updateWhere
pure $ Update
{ updateTable = updateTable'
, updateSetExprs = updateSetExprs'
, updateFrom = updateFrom'
, updateWhere = updateWhere'
, ..
}
resolveDelete :: forall a . Delete RawNames a -> Resolver (Delete ResolvedNames) a
resolveDelete (Delete info tableName expr) = do
tableName'@(RTableName fqtn table@SchemaMember{..}) <- resolveTableName tableName
when (tableType /= Table) $ fail $ "delete only works on tables; can't delete on a " ++ show tableType
let QTableName tableInfo _ _ = tableName
bindColumns [(Just $ RTableRef fqtn table, map (\ (QColumnName () None column) -> RColumnRef $ QColumnName tableInfo (pure fqtn) column) columnsList)] $ do
expr' <- traverse resolveExpr expr
pure $ Delete info tableName' expr'
resolveTruncate :: Truncate RawNames a -> Resolver (Truncate ResolvedNames) a
resolveTruncate (Truncate info name) = do
name' <- resolveTableName name
pure $ Truncate info name'
resolveCreateTable :: forall d a . (Dialect d) => CreateTable d RawNames a -> Resolver (CreateTable d ResolvedNames) a
resolveCreateTable CreateTable{..} = do
createTableName'@(RCreateTableName fqtn _) <- resolveCreateTableName createTableName createTableIfNotExists
WithColumns createTableDefinition' columns <- resolveTableDefinition fqtn createTableDefinition
bindColumns columns $ do
createTableExtra' <- traverse (resolveCreateTableExtra (Proxy :: Proxy d)) createTableExtra
pure $ CreateTable
{ createTableName = createTableName'
, createTableDefinition = createTableDefinition'
, createTableExtra = createTableExtra'
, ..
}
mkTableSchemaMember :: [UQColumnName ()] -> SchemaMember
mkTableSchemaMember columnsList = SchemaMember{..}
where
tableType = Table
persistence = Persistent
viewQuery = Nothing
resolveTableDefinition :: FQTableName a -> TableDefinition d RawNames a -> Resolver (WithColumns (TableDefinition d ResolvedNames)) a
resolveTableDefinition fqtn (TableColumns info cs) = do
cs' <- mapM resolveColumnOrConstraint cs
let columns = mapMaybe columnOrConstraintToColumn $ NonEmpty.toList cs'
table = mkTableSchemaMember $ map (\ c -> c{columnNameInfo = (), columnNameTable = None}) columns
pure $ WithColumns (TableColumns info cs') [(Just $ RTableRef fqtn table, map RColumnRef columns)]
where
columnOrConstraintToColumn (ColumnOrConstraintConstraint _) = Nothing
columnOrConstraintToColumn (ColumnOrConstraintColumn ColumnDefinition{columnDefinitionName = QColumnName columnInfo None name}) =
Just $ QColumnName columnInfo (pure fqtn) name
resolveTableDefinition _ (TableLike info name) = do
name' <- resolveTableName name
pure $ WithColumns (TableLike info name') []
resolveTableDefinition fqtn (TableAs info cols query) = do
query' <- resolveQuery query
let columns = queryColumnNames query'
table = mkTableSchemaMember $ map toUQCN columns
toUQCN (RColumnRef fqcn) = fqcn{columnNameInfo = (), columnNameTable = None}
toUQCN (RColumnAlias (ColumnAlias _ cn _)) = QColumnName{..}
where
columnNameInfo = ()
columnNameName = cn
columnNameTable = None
pure $ WithColumns (TableAs info cols query') [(Just $ RTableRef fqtn table, columns)]
resolveTableDefinition _ (TableNoColumnInfo info) = do
pure $ WithColumns (TableNoColumnInfo info) []
resolveColumnOrConstraint :: ColumnOrConstraint d RawNames a -> Resolver (ColumnOrConstraint d ResolvedNames) a
resolveColumnOrConstraint (ColumnOrConstraintColumn column) = ColumnOrConstraintColumn <$> resolveColumnDefinition column
resolveColumnOrConstraint (ColumnOrConstraintConstraint constraint) = pure $ ColumnOrConstraintConstraint constraint
resolveColumnDefinition :: ColumnDefinition d RawNames a -> Resolver (ColumnDefinition d ResolvedNames) a
resolveColumnDefinition ColumnDefinition{..} = do
columnDefinitionDefault' <- traverse resolveExpr columnDefinitionDefault
pure $ ColumnDefinition
{ columnDefinitionDefault = columnDefinitionDefault'
, ..
}
resolveAlterTable :: AlterTable RawNames a -> Resolver (AlterTable ResolvedNames) a
resolveAlterTable (AlterTableRenameTable info old new) = do
old'@(RTableName (QTableName _ (Identity oldSchema@(QSchemaName _ (Identity oldDb@(DatabaseName _ _)) _ oldSchemaType)) _) table) <- resolveTableName old
let new'@(RTableName (QTableName _ (Identity (QSchemaName _ _ _ newSchemaType)) _) _) = case new of
QTableName tInfo (Just (QSchemaName sInfo (Just db) s sType)) t ->
RTableName (QTableName tInfo (pure (QSchemaName sInfo (pure db) s sType)) t) table
QTableName tInfo (Just (QSchemaName sInfo Nothing s sType)) t ->
RTableName (QTableName tInfo (pure (QSchemaName sInfo (pure oldDb) s sType)) t) table
QTableName tInfo Nothing t ->
RTableName (QTableName tInfo (pure oldSchema) t) table
case (oldSchemaType, newSchemaType) of
(NormalSchema, NormalSchema) -> pure ()
(SessionSchema, SessionSchema) -> pure ()
(NormalSchema, SessionSchema) -> error "can't rename a table into the session schema"
(SessionSchema, NormalSchema) -> error "can't rename a table out of the session schema"
pure $ AlterTableRenameTable info old' new'
resolveAlterTable (AlterTableRenameColumn info table old new) = do
table' <- resolveTableName table
pure $ AlterTableRenameColumn info table' old new
resolveAlterTable (AlterTableAddColumns info table columns) = do
table' <- resolveTableName table
pure $ AlterTableAddColumns info table' columns
resolveDropTable :: DropTable RawNames a -> Resolver (DropTable ResolvedNames) a
resolveDropTable DropTable{..} = do
dropTableNames' <- mapM resolveDropTableName dropTableNames
pure $ DropTable
{ dropTableNames = dropTableNames'
, ..
}
resolveCreateView :: CreateView RawNames a -> Resolver (CreateView ResolvedNames) a
resolveCreateView CreateView{..} = do
createViewName' <- resolveCreateTableName createViewName createViewIfNotExists
createViewQuery' <- resolveQuery createViewQuery
pure $ CreateView
{ createViewName = createViewName'
, createViewQuery = createViewQuery'
, ..
}
resolveDropView :: DropView RawNames a -> Resolver (DropView ResolvedNames) a
resolveDropView DropView{..} = do
dropViewName' <- resolveDropTableName dropViewName
pure $ DropView
{ dropViewName = dropViewName'
, ..
}
resolveCreateSchema :: CreateSchema RawNames a -> Resolver (CreateSchema ResolvedNames) a
resolveCreateSchema CreateSchema{..} = do
createSchemaName' <- resolveCreateSchemaName createSchemaName createSchemaIfNotExists
pure $ CreateSchema
{ createSchemaName = createSchemaName'
, ..
}
resolveSelectColumns :: ColumnSet a -> SelectColumns RawNames a -> Resolver (SelectColumns ResolvedNames) a
resolveSelectColumns columns (SelectColumns info selections) = SelectColumns info <$> mapM (resolveSelection columns) selections
qualifiedOnly :: [(Maybe a, b)] -> [(a, b)]
qualifiedOnly = mapMaybe (\(mTable, cs) -> case mTable of
(Just t) -> Just (t, cs)
Nothing -> Nothing)
resolveSelection :: ColumnSet a -> Selection RawNames a -> Resolver (Selection ResolvedNames) a
resolveSelection columns (SelectStar info Nothing Unused) = do
pure $ SelectStar info Nothing $ StarColumnNames $ map (const info <$>) $ snd =<< columns
resolveSelection columns (SelectStar info (Just oqtn@(QTableName _ (Just schema) _)) Unused) = do
let qualifiedColumns = qualifiedOnly columns
case filter ((resolvedTableHasSchema schema && resolvedTableHasName oqtn) . fst) qualifiedColumns of
[] -> throwError $ UnintroducedTable oqtn
[(t, cs)] -> pure $ SelectStar info (Just t) $ StarColumnNames $ map (const info <$>) cs
_ -> throwError $ AmbiguousTable oqtn
resolveSelection columns (SelectStar info (Just oqtn@(QTableName tableInfo Nothing table)) Unused) = do
let qualifiedColumns = qualifiedOnly columns
case filter (resolvedTableHasName oqtn . fst) qualifiedColumns of
[] -> throwError $ UnintroducedTable $ QTableName tableInfo Nothing table
[(t, cs)] -> pure $ SelectStar info (Just t) $ StarColumnNames $ map (const info <$>) cs
_ -> throwError $ AmbiguousTable $ QTableName tableInfo Nothing table
resolveSelection _ (SelectExpr info alias expr) = SelectExpr info alias <$> resolveExpr expr
resolveExpr :: Expr RawNames a -> Resolver (Expr ResolvedNames) a
resolveExpr (BinOpExpr info op lhs rhs) = BinOpExpr info op <$> resolveExpr lhs <*> resolveExpr rhs
resolveExpr (CaseExpr info whens else_) = CaseExpr info <$> mapM resolveWhen whens <*> traverse resolveExpr else_
where
resolveWhen (when_, then_) = (,) <$> resolveExpr when_ <*> resolveExpr then_
resolveExpr (UnOpExpr info op expr) = UnOpExpr info op <$> resolveExpr expr
resolveExpr (LikeExpr info op escape pattern expr) = do
escape' <- traverse (fmap Escape . resolveExpr . escapeExpr) escape
pattern' <- Pattern <$> resolveExpr (patternExpr pattern)
expr' <- resolveExpr expr
pure $ LikeExpr info op escape' pattern' expr'
resolveExpr (ConstantExpr info constant) = pure $ ConstantExpr info constant
resolveExpr (ColumnExpr info column) = ColumnExpr info <$> resolveColumnName column
resolveExpr (InListExpr info list expr) = InListExpr info <$> mapM resolveExpr list <*> resolveExpr expr
resolveExpr (InSubqueryExpr info query expr) = do
query' <- resolveQuery query
expr' <- resolveExpr expr
pure $ InSubqueryExpr info query' expr'
resolveExpr (BetweenExpr info expr start end) =
BetweenExpr info <$> resolveExpr expr <*> resolveExpr start <*> resolveExpr end
resolveExpr (OverlapsExpr info range1 range2) = OverlapsExpr info <$> resolveRange range1 <*> resolveRange range2
where
resolveRange (from, to) = (,) <$> resolveExpr from <*> resolveExpr to
resolveExpr (FunctionExpr info name distinct args params filter' over) =
FunctionExpr info name distinct <$> mapM resolveExpr args <*> mapM resolveParam params <*> traverse resolveFilter filter' <*> traverse resolveOverSubExpr over
where
resolveParam (param, expr) = (param,) <$> resolveExpr expr
resolveOverSubExpr (OverWindowExpr i window) =
OverWindowExpr i <$> resolveWindowExpr window
resolveOverSubExpr (OverWindowName i windowName) =
pure $ OverWindowName i windowName
resolveOverSubExpr (OverPartialWindowExpr i partWindow) =
OverPartialWindowExpr i <$> resolvePartialWindowExpr partWindow
resolveFilter (Filter i expr) =
Filter i <$> resolveExpr expr
resolveExpr (AtTimeZoneExpr info expr tz) = AtTimeZoneExpr info <$> resolveExpr expr <*> resolveExpr tz
resolveExpr (SubqueryExpr info query) = SubqueryExpr info <$> resolveQuery query
resolveExpr (ArrayExpr info array) = ArrayExpr info <$> mapM resolveExpr array
resolveExpr (ExistsExpr info query) = ExistsExpr info <$> resolveQuery query
resolveExpr (FieldAccessExpr info expr field) = FieldAccessExpr info <$> resolveExpr expr <*> pure field
resolveExpr (ArrayAccessExpr info expr idx) = ArrayAccessExpr info <$> resolveExpr expr <*> resolveExpr idx
resolveExpr (TypeCastExpr info onFail expr type_) = TypeCastExpr info onFail <$> resolveExpr expr <*> pure type_
resolveExpr (VariableSubstitutionExpr info) = pure $ VariableSubstitutionExpr info
resolveOrder :: [Expr ResolvedNames a]
-> Order RawNames a
-> Resolver (Order ResolvedNames) a
resolveOrder exprs (Order i posOrExpr direction nullPos) =
Order i <$> resolvePositionOrExpr exprs posOrExpr <*> pure direction <*> pure nullPos
resolveWindowExpr :: WindowExpr RawNames a
-> Resolver (WindowExpr ResolvedNames) a
resolveWindowExpr WindowExpr{..} =
do
windowExprPartition' <- traverse resolvePartition windowExprPartition
windowExprOrder' <- mapM (resolveOrder []) windowExprOrder
pure $ WindowExpr
{ windowExprPartition = windowExprPartition'
, windowExprOrder = windowExprOrder'
, ..
}
resolvePartialWindowExpr :: PartialWindowExpr RawNames a
-> Resolver (PartialWindowExpr ResolvedNames) a
resolvePartialWindowExpr PartialWindowExpr{..} =
do
partWindowExprOrder' <- mapM (resolveOrder []) partWindowExprOrder
partWindowExprPartition' <- mapM resolvePartition partWindowExprPartition
pure $ PartialWindowExpr
{ partWindowExprOrder = partWindowExprOrder'
, partWindowExprPartition = partWindowExprPartition'
, ..
}
resolveNamedWindowExpr :: NamedWindowExpr RawNames a
-> Resolver (NamedWindowExpr ResolvedNames) a
resolveNamedWindowExpr (NamedWindowExpr info name window) =
NamedWindowExpr info name <$> resolveWindowExpr window
resolveNamedWindowExpr (NamedPartialWindowExpr info name partWindow) =
NamedPartialWindowExpr info name <$> resolvePartialWindowExpr partWindow
resolveTableName :: OQTableName a -> Resolver RTableName a
resolveTableName table = do
Catalog{..} <- asks catalog
lift $ lift $ catalogResolveTableName table
resolveCreateTableName :: CreateTableName RawNames a -> Maybe a -> Resolver (CreateTableName ResolvedNames) a
resolveCreateTableName tableName ifNotExists = do
Catalog{..} <- asks catalog
tableName'@(RCreateTableName fqtn existence) <- lift $ lift $ catalogResolveCreateTableName tableName
when ((existence, void ifNotExists) == (Exists, Nothing)) $ tell [ Left $ UnexpectedTable fqtn ]
pure $ tableName'
resolveDropTableName :: DropTableName RawNames a -> Resolver (DropTableName ResolvedNames) a
resolveDropTableName tableName = do
(getName <$> resolveTableName tableName)
`catchError` handleMissing
where
getName (RTableName name table) = RDropExistingTableName name table
handleMissing (MissingTable name) = pure $ RDropMissingTableName name
handleMissing e = throwError e
resolveCreateSchemaName :: CreateSchemaName RawNames a -> Maybe a -> Resolver (CreateSchemaName ResolvedNames) a
resolveCreateSchemaName schemaName ifNotExists = do
Catalog{..} <- asks catalog
schemaName'@(RCreateSchemaName fqsn existence) <- lift $ lift $ catalogResolveCreateSchemaName schemaName
when ((existence, void ifNotExists) == (Exists, Nothing)) $ tell [ Left $ UnexpectedSchema fqsn ]
pure schemaName'
resolveSchemaName :: SchemaName RawNames a -> Resolver (SchemaName ResolvedNames) a
resolveSchemaName schemaName = do
Catalog{..} <- asks catalog
lift $ lift $ catalogResolveSchemaName schemaName
resolveTableRef :: OQTableName a -> Resolver (WithColumns RTableRef) a
resolveTableRef tableName = do
ResolverInfo{catalog = Catalog{..}, bindings = Bindings{..}, ..} <- ask
lift $ lift $ catalogResolveTableRef boundCTEs tableName
resolveColumnName :: forall a . OQColumnName a -> Resolver (RColumnRef) a
resolveColumnName columnName = do
(Catalog{..}, Bindings{..}) <- asks (catalog &&& bindings)
lift $ lift $ catalogResolveColumnName boundColumns columnName
resolvePartition :: Partition RawNames a -> Resolver (Partition ResolvedNames) a
resolvePartition (PartitionBy info exprs) = PartitionBy info <$> mapM resolveExpr exprs
resolvePartition (PartitionBest info) = pure $ PartitionBest info
resolvePartition (PartitionNodes info) = pure $ PartitionNodes info
resolveSelectFrom :: SelectFrom RawNames a -> Resolver (WithColumns (SelectFrom ResolvedNames)) a
resolveSelectFrom (SelectFrom info tablishes) = do
tablishesWithColumns <- mapM resolveTablish tablishes
let (tablishes', css) = unzip $ map (\ (WithColumns t cs) -> (t, cs)) tablishesWithColumns
pure $ WithColumns (SelectFrom info tablishes') $ concat css
resolveTablish :: forall a . Tablish RawNames a -> Resolver (WithColumns (Tablish ResolvedNames)) a
resolveTablish (TablishTable info aliases name) = do
WithColumns name' columns <- resolveTableRef name
let columns' = case aliases of
TablishAliasesNone -> columns
TablishAliasesT t -> map (first $ const $ Just $ RTableAlias t) columns
TablishAliasesTC t cs -> [(Just $ RTableAlias t, map RColumnAlias cs)]
pure $ WithColumns (TablishTable info aliases name') columns'
resolveTablish (TablishSubQuery info aliases query) = do
query' <- resolveQuery query
let columns = queryColumnNames query'
(tAlias, cAliases) = case aliases of
TablishAliasesNone -> (Nothing, columns)
TablishAliasesT t -> (Just $ RTableAlias t, columns)
TablishAliasesTC t cs -> (Just $ RTableAlias t, map RColumnAlias cs)
pure $ WithColumns (TablishSubQuery info aliases query') [(tAlias, cAliases)]
resolveTablish (TablishJoin info joinType cond lhs rhs) = do
WithColumns lhs' lcolumns <- resolveTablish lhs
lcolumnsAreVisible <- asks lcolumnsAreVisibleInLateralViews
let bindForRhs = case (lcolumnsAreVisible, rhs) of
(True, TablishLateralView _ _ _) -> bindColumns lcolumns
_ -> id
WithColumns rhs' rcolumns <- bindForRhs $ resolveTablish rhs
let colsForRestOfQuery = case joinType of
JoinSemi _ -> lcolumns
_ -> lcolumns ++ rcolumns
bindColumns (lcolumns ++ rcolumns) $ do
cond' <- resolveJoinCondition cond lcolumns rcolumns
pure $ WithColumns (TablishJoin info joinType cond' lhs' rhs') $ colsForRestOfQuery
resolveTablish (TablishLateralView info LateralView{..} lhs) = do
(lhs', lcolumns) <- case lhs of
Nothing -> return (Nothing, [])
Just tablish -> do
WithColumns lhs' lcolumns <- resolveTablish tablish
return (Just lhs', lcolumns)
bindColumns lcolumns $ do
lateralViewExprs' <- mapM resolveExpr lateralViewExprs
let view = LateralView
{ lateralViewExprs = lateralViewExprs'
, ..
}
defaultCols <- map RColumnAlias . concat <$> mapM defaultAliases lateralViewExprs'
let rcolumns = case lateralViewAliases of
TablishAliasesNone -> [(Nothing, defaultCols)]
TablishAliasesT t -> [(Just $ RTableAlias t, defaultCols)]
TablishAliasesTC t cs -> [(Just $ RTableAlias t, map RColumnAlias cs)]
pure $ WithColumns (TablishLateralView info view lhs') $ lcolumns ++ rcolumns
where
defaultAliases (FunctionExpr r (QFunctionName _ _ rawName) _ args _ _ _) = do
let argsLessOne = (length args) 1
alias = makeColumnAlias r
prependAlias :: Text -> Int -> Resolver ColumnAlias a
prependAlias prefix int = alias $ prefix `TL.append` (TL.pack $ show int)
name = TL.toLower rawName
functionSpecificLookups
| name == "explode" = map alias [ "col", "key", "val" ]
| name == "inline" = map alias [ "col1", "col2" ]
| name == "json_tuple" = map (prependAlias "c") $ take argsLessOne [0..]
| name == "parse_url_tuple" = map (prependAlias "c") $ take argsLessOne [0..]
| name == "posexplode" = map alias [ "pos", "val" ]
| name == "stack" =
let n = case head args of
(ConstantExpr _ (NumericConstant _ nText)) -> read $ TL.unpack nText
_ -> argsLessOne
k = argsLessOne
len = (k `div` n) + (if k `mod` n == 0 then 0 else 1)
in map (prependAlias "col") $ take len [0..]
| otherwise = []
sequence functionSpecificLookups
defaultAliases _ = fail "lateral view must have a FunctionExpr"
resolveJoinCondition :: JoinCondition RawNames a -> ColumnSet a -> ColumnSet a -> Resolver (JoinCondition ResolvedNames) a
resolveJoinCondition (JoinNatural info _) lhs rhs = do
let name (RColumnRef (QColumnName _ _ column)) = column
name (RColumnAlias (ColumnAlias _ alias _)) = alias
columns = RNaturalColumns $ do
l <- snd =<< lhs
r <- snd =<< rhs
if name l == name r
then [RUsingColumn l r]
else []
pure $ JoinNatural info columns
resolveJoinCondition (JoinOn expr) _ _ = JoinOn <$> resolveExpr expr
resolveJoinCondition (JoinUsing info cols) lhs rhs = JoinUsing info <$> mapM resolveColumn cols
where
resolveColumn (QColumnName columnInfo _ column) = do
let resolveIn columns =
case filter hasName $ snd =<< columns of
[] -> throwError $ MissingColumn $ QColumnName columnInfo Nothing column
[c] -> pure c
_ -> throwError $ AmbiguousColumn $ QColumnName columnInfo Nothing column
hasName (RColumnRef (QColumnName _ _ column')) = column' == column
hasName (RColumnAlias (ColumnAlias _ column' _)) = column' == column
l <- resolveIn lhs
r <- resolveIn rhs
pure $ RUsingColumn l r
resolveSelectWhere :: SelectWhere RawNames a -> Resolver (SelectWhere ResolvedNames) a
resolveSelectWhere (SelectWhere info expr) = SelectWhere info <$> resolveExpr expr
resolveSelectTimeseries :: SelectTimeseries RawNames a -> Resolver (SelectTimeseries ResolvedNames) a
resolveSelectTimeseries SelectTimeseries{..} = do
selectTimeseriesPartition' <- traverse resolvePartition selectTimeseriesPartition
selectTimeseriesOrder' <- resolveExpr selectTimeseriesOrder
pure $ SelectTimeseries
{ selectTimeseriesPartition = selectTimeseriesPartition'
, selectTimeseriesOrder = selectTimeseriesOrder'
, ..
}
resolvePositionOrExpr :: [Expr ResolvedNames a] -> PositionOrExpr RawNames a -> Resolver (PositionOrExpr ResolvedNames) a
resolvePositionOrExpr _ (PositionOrExprExpr expr) = PositionOrExprExpr <$> resolveExpr expr
resolvePositionOrExpr exprs (PositionOrExprPosition info pos Unused)
| pos < 1 = throwError $ BadPositionalReference info pos
| otherwise =
case drop (pos 1) exprs of
expr:_ -> pure $ PositionOrExprPosition info pos expr
[] -> throwError $ BadPositionalReference info pos
resolveGroupingElement :: [Expr ResolvedNames a] -> GroupingElement RawNames a -> Resolver (GroupingElement ResolvedNames) a
resolveGroupingElement exprs (GroupingElementExpr info posOrExpr) =
GroupingElementExpr info <$> resolvePositionOrExpr exprs posOrExpr
resolveGroupingElement _ (GroupingElementSet info exprs) =
GroupingElementSet info <$> mapM resolveExpr exprs
resolveSelectGroup :: [Expr ResolvedNames a] -> SelectGroup RawNames a -> Resolver (SelectGroup ResolvedNames) a
resolveSelectGroup exprs SelectGroup{..} = do
selectGroupGroupingElements' <- mapM (resolveGroupingElement exprs) selectGroupGroupingElements
pure $ SelectGroup
{ selectGroupGroupingElements = selectGroupGroupingElements'
, ..
}
resolveSelectHaving :: SelectHaving RawNames a -> Resolver (SelectHaving ResolvedNames) a
resolveSelectHaving (SelectHaving info exprs) = SelectHaving info <$> mapM resolveExpr exprs
resolveSelectNamedWindow :: SelectNamedWindow RawNames a
-> Resolver (SelectNamedWindow ResolvedNames) a
resolveSelectNamedWindow (SelectNamedWindow info windows) =
SelectNamedWindow info <$> mapM resolveNamedWindowExpr windows