--convert SQL into relational or database context expressions
{-# LANGUAGE TypeFamilies, FlexibleInstances, ScopedTypeVariables, GeneralizedNewtypeDeriving #-}
module ProjectM36.SQL.Convert where
import ProjectM36.Base as B
import ProjectM36.Error
import ProjectM36.DataTypes.SQL.Null
import ProjectM36.SQL.Select
import ProjectM36.DatabaseContext (someDatabaseContextExprs)
import ProjectM36.SQL.Insert as Insert
import ProjectM36.Key (databaseContextExprForUniqueKey, inclusionDependencyForKey)
import ProjectM36.SQL.DBUpdate
import ProjectM36.SQL.Update as Update
import ProjectM36.SQL.Delete as Delete
import ProjectM36.SQL.CreateTable as CreateTable
import ProjectM36.SQL.DropTable as DropTable
import ProjectM36.RelationalExpression
import ProjectM36.DataFrame (DataFrameExpr(..), AttributeOrderExpr(..), Order(..), usesDataFrameFeatures)
import ProjectM36.AttributeNames as A
import ProjectM36.Relation (attributes, atomTypeForName)
import qualified ProjectM36.Attribute as A
import qualified Data.Text as T
import qualified ProjectM36.WithNameExpr as With
import Control.Monad (foldM, when)
import qualified Data.Set as S
import qualified Data.Map as M
import Data.List (intercalate, find)
import qualified Data.Functor.Foldable as Fold
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
--import Control.Monad (void)
import Control.Monad.Trans.State (StateT, get, put, runStateT, evalStateT)
import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)
import Control.Monad.Identity (Identity, runIdentity)
import Control.Monad.Trans.Class (lift)
#if MIN_VERSION_base(4,20,0)
#else
import Data.Foldable (foldl')
#endif
import Data.Bifunctor (bimap)
--import qualified Data.HashSet as HS

--import Debug.Trace

{-
TODO
* enable duplicate rows by adding uuid column
-}

--over the course of conversion of a table expression, we collect all the table aliases we encounter, including non-aliased table references, including the type of the table, projections have their own name resolution system
newtype TableContext = TableContext (M.Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper))
  deriving (NonEmpty TableContext -> TableContext
TableContext -> TableContext -> TableContext
forall b. Integral b => b -> TableContext -> TableContext
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> TableContext -> TableContext
$cstimes :: forall b. Integral b => b -> TableContext -> TableContext
sconcat :: NonEmpty TableContext -> TableContext
$csconcat :: NonEmpty TableContext -> TableContext
<> :: TableContext -> TableContext -> TableContext
$c<> :: TableContext -> TableContext -> TableContext
Semigroup, Semigroup TableContext
TableContext
[TableContext] -> TableContext
TableContext -> TableContext -> TableContext
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [TableContext] -> TableContext
$cmconcat :: [TableContext] -> TableContext
mappend :: TableContext -> TableContext -> TableContext
$cmappend :: TableContext -> TableContext -> TableContext
mempty :: TableContext
$cmempty :: TableContext
Monoid, Int -> TableContext -> ShowS
[TableContext] -> ShowS
TableContext -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TableContext] -> ShowS
$cshowList :: [TableContext] -> ShowS
show :: TableContext -> [Char]
$cshow :: TableContext -> [Char]
showsPrec :: Int -> TableContext -> ShowS
$cshowsPrec :: Int -> TableContext -> ShowS
Show, TableContext -> TableContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableContext -> TableContext -> Bool
$c/= :: TableContext -> TableContext -> Bool
== :: TableContext -> TableContext -> Bool
$c== :: TableContext -> TableContext -> Bool
Eq)

type TypeForRelExprF = RelationalExpr -> Either RelationalError Relation

type ConvertM = StateT TableContext (ExceptT SQLError Identity)

runConvertM :: TableContext -> ConvertM a -> Either SQLError (a, TableContext)
runConvertM :: forall a.
TableContext -> ConvertM a -> Either SQLError (a, TableContext)
runConvertM TableContext
tcontext ConvertM a
m = forall a. Identity a -> a
runIdentity (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ConvertM a
m TableContext
tcontext))

runLocalConvertM :: ConvertM a -> ConvertM a
runLocalConvertM :: forall a. ConvertM a -> ConvertM a
runLocalConvertM ConvertM a
m = do
  TableContext
saveState <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  a
ret <- ConvertM a
m
  forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put TableContext
saveState
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
ret

evalConvertM :: TableContext -> ConvertM a -> Either SQLError a
evalConvertM :: forall a. TableContext -> ConvertM a -> Either SQLError a
evalConvertM TableContext
tcontext ConvertM a
m = forall a. Identity a -> a
runIdentity (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ConvertM a
m TableContext
tcontext))

data SelectItemsConvertTask = SelectItemsConvertTask { SelectItemsConvertTask -> Set ColumnProjectionName
taskProjections :: S.Set ColumnProjectionName,
                                                       SelectItemsConvertTask -> [(ColumnProjectionName, ColumnAlias)]
taskRenames :: [(ColumnProjectionName, ColumnAlias)],
                                                       SelectItemsConvertTask -> [ExtendTupleExpr]
taskExtenders :: [ExtendTupleExpr],
                                                       SelectItemsConvertTask -> [Set ColumnProjectionName]
taskGroups :: [S.Set ColumnProjectionName]
                                                     } deriving (Int -> SelectItemsConvertTask -> ShowS
[SelectItemsConvertTask] -> ShowS
SelectItemsConvertTask -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SelectItemsConvertTask] -> ShowS
$cshowList :: [SelectItemsConvertTask] -> ShowS
show :: SelectItemsConvertTask -> [Char]
$cshow :: SelectItemsConvertTask -> [Char]
showsPrec :: Int -> SelectItemsConvertTask -> ShowS
$cshowsPrec :: Int -> SelectItemsConvertTask -> ShowS
Show, SelectItemsConvertTask -> SelectItemsConvertTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectItemsConvertTask -> SelectItemsConvertTask -> Bool
$c/= :: SelectItemsConvertTask -> SelectItemsConvertTask -> Bool
== :: SelectItemsConvertTask -> SelectItemsConvertTask -> Bool
$c== :: SelectItemsConvertTask -> SelectItemsConvertTask -> Bool
Eq)

emptyTask :: SelectItemsConvertTask
emptyTask :: SelectItemsConvertTask
emptyTask = SelectItemsConvertTask { taskProjections :: Set ColumnProjectionName
taskProjections = forall a. Set a
S.empty,
                                     taskRenames :: [(ColumnProjectionName, ColumnAlias)]
taskRenames = forall a. Monoid a => a
mempty,
                                     taskGroups :: [Set ColumnProjectionName]
taskGroups = forall a. Monoid a => a
mempty,
                                     taskExtenders :: [ExtendTupleExpr]
taskExtenders = forall a. Monoid a => a
mempty }

                                          
-- (real attribute name in table- immutable, (renamed "preferred" attribute name needed to disambiguate names on conflict, set of names which are used to reference the "preferred" name)
type AttributeAlias = AttributeName
-- the AttributeAlias is necessary when then is otherwise a naming conflict such as with join conditions which would otherwise cause duplicate column names which SQL supports but the relational algebra does not
type ColumnAliasRemapper = M.Map AttributeName (AttributeAlias, S.Set ColumnName)

insertIntoColumnAliasRemap' :: AttributeName -> AttributeAlias -> ColumnName -> ColumnAliasRemapper -> Either SQLError ColumnAliasRemapper
insertIntoColumnAliasRemap' :: Text
-> Text
-> ColumnName
-> ColumnAliasRemapper
-> Either SQLError ColumnAliasRemapper
insertIntoColumnAliasRemap' Text
attrName Text
attrAlias ColumnName
colName ColumnAliasRemapper
remap =
  case Text
attrName forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` ColumnAliasRemapper
remap of
    Maybe (Text, Set ColumnName)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
attrName (Text
attrAlias, forall a. a -> Set a
S.singleton ColumnName
colName) ColumnAliasRemapper
remap
    Just (Text
attrAlias', Set ColumnName
colNames) | Text
attrAlias' forall a. Eq a => a -> a -> Bool
== Text
attrAlias ->
                                  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
attrName (Text
attrAlias, forall a. Ord a => a -> Set a -> Set a
S.insert ColumnName
colName Set ColumnName
colNames) ColumnAliasRemapper
remap
                                  | Bool
otherwise ->
                                    forall a b. a -> Either a b
Left (ColumnAlias -> SQLError
ColumnAliasResolutionError (Text -> ColumnAlias
ColumnAlias Text
attrName))

-- | Used to note if columns are remapped to different attributes in order to mitigate attribute naming conflicts.
insertColumnAlias ::
  TableAlias -> -- table reference
  AttributeName -> -- real attribute name
  ColumnAlias -> -- column alias
  ColumnName -> -- original reference name
  ConvertM ()
insertColumnAlias :: TableAlias -> Text -> ColumnAlias -> ColumnName -> ConvertM ()
insertColumnAlias TableAlias
tAlias Text
attrName (ColumnAlias Text
colAlias) ColumnName
colName = do
  TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tmap <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  case TableAlias
tAlias forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tmap of
    Maybe (RelationalExpr, Attributes, ColumnAliasRemapper)
Nothing -> forall a. SQLError -> ConvertM a
throwSQLE (TableAlias -> SQLError
MissingTableReferenceError TableAlias
tAlias)
    Just (RelationalExpr
rve,Attributes
attrs,ColumnAliasRemapper
remap) -> do
      case Text
-> Text
-> ColumnName
-> ColumnAliasRemapper
-> Either SQLError ColumnAliasRemapper
insertIntoColumnAliasRemap' Text
attrName Text
colAlias ColumnName
colName ColumnAliasRemapper
remap of
        Left SQLError
err -> forall a. SQLError -> ConvertM a
throwSQLE SQLError
err
        Right ColumnAliasRemapper
remap' -> do
          let tmap' :: Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tmap' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert TableAlias
tAlias (RelationalExpr
rve, Attributes
attrs, ColumnAliasRemapper
remap') Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tmap
          forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
-> TableContext
TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tmap')

-- debugging utility function
prettyTableContext :: TableContext -> String
prettyTableContext :: TableContext -> [Char]
prettyTableContext (TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tMap) = [Char]
"TableContext {\n" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {b}. (TableAlias, (a, b, ColumnAliasRemapper)) -> [Char]
prettyKV (forall k a. Map k a -> [(k, a)]
M.toList Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tMap) forall a. Semigroup a => a -> a -> a
<> [Char]
"}"
  where
    prettyKV :: (TableAlias, (a, b, ColumnAliasRemapper)) -> [Char]
prettyKV (TableAlias Text
k, (a
_rvexpr, b
_attrs, ColumnAliasRemapper
aliasMap)) =
      [Char]
" " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
k forall a. Semigroup a => a -> a -> a
<> [Char]
"::  " forall a. Semigroup a => a -> a -> a
<> 
      ColumnAliasRemapper -> [Char]
prettyColumnAliasRemapper ColumnAliasRemapper
aliasMap forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"

prettyColumnAliasRemapper :: ColumnAliasRemapper -> String
prettyColumnAliasRemapper :: ColumnAliasRemapper -> [Char]
prettyColumnAliasRemapper ColumnAliasRemapper
cAMap = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Text
realAttr, (Text
attrAlias, Set ColumnName
colNameSet)) -> [Char]
"real->" forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
realAttr forall a. Semigroup a => a -> a -> a
<> [Char]
":alias->" forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
attrAlias forall a. Semigroup a => a -> a -> a
<> [Char]
":alts->{" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Set ColumnName
colNameSet forall a. Semigroup a => a -> a -> a
<> [Char]
"}") (forall k a. Map k a -> [(k, a)]
M.toList ColumnAliasRemapper
cAMap)


{-  
traceStateM :: ConvertM ()
traceStateM = do
  s <- get
  traceM (prettyTableContext s)
-}

-- key: alias value: real column attribute name
type ColumnAliasMap = M.Map ColumnAlias AttributeName

tableAliasesAsWithNameAssocs :: ConvertM WithNamesAssocs
tableAliasesAsWithNameAssocs :: ConvertM WithNamesAssocs
tableAliasesAsWithNameAssocs = do
  (TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tmap) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  forall a. (a -> Bool) -> [a] -> [a]
filter (WithNameExprBase (), RelationalExpr) -> Bool
notSelfRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {f :: * -> *} {b} {b} {c}.
Applicative f =>
(TableAlias, (b, b, c)) -> f (WithNameExprBase (), b)
mapper (forall k a. Map k a -> [(k, a)]
M.toList Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tmap)
  where
    notSelfRef :: (WithNameExprBase (), RelationalExpr) -> Bool
notSelfRef (WithNameExpr Text
nam (), RelationVariable Text
nam' ()) | Text
nam forall a. Eq a => a -> a -> Bool
== Text
nam' = Bool
False
                                                            | Bool
otherwise = Bool
True
    notSelfRef (WithNameExprBase (), RelationalExpr)
_ = Bool
True
--    mapper :: (TableAlias, (RelationalExpr, Attributes)) -> ConvertM (WithNameExpr, RelationalExpr)
    mapper :: (TableAlias, (b, b, c)) -> f (WithNameExprBase (), b)
mapper (TableAlias Text
nam, (b
rvExpr, b
_, c
_)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Text -> a -> WithNameExprBase a
WithNameExpr Text
nam (), b
rvExpr)

throwSQLE :: SQLError -> ConvertM a
throwSQLE :: forall a. SQLError -> ConvertM a
throwSQLE = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE

type ColumnAliasRenameMap = M.Map (TableAlias, AttributeName) ColumnAlias

-- | Pass state down to subselect, but discard any state changes from the subselect processing.
withSubSelect :: ConvertM a -> ConvertM (a, ColumnAliasRenameMap)
withSubSelect :: forall a. ConvertM a -> ConvertM (a, ColumnAliasRenameMap)
withSubSelect ConvertM a
m = do
  state :: TableContext
state@(TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
orig) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  a
ret <- ConvertM a
m
  (TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
postSub) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put TableContext
state
  -- diff the state to get just the items that were added
  let tableDiffFolder :: ColumnAliasRenameMap
-> (TableAlias, (RelationalExpr, Attributes, ColumnAliasRemapper))
-> StateT
     TableContext (ExceptT SQLError Identity) ColumnAliasRenameMap
tableDiffFolder ColumnAliasRenameMap
acc (TableAlias
tAlias, (RelationVariable Text
_rv (), Attributes
_ , ColumnAliasRemapper
colAliasRemapper)) = do
        let convertColAliases :: ColumnAliasRemapper -> (AttributeName, (AttributeName, S.Set ColumnName)) -> ColumnAliasRenameMap -> ColumnAliasRenameMap
            convertColAliases :: ColumnAliasRemapper
-> (Text, (Text, Set ColumnName))
-> ColumnAliasRenameMap
-> ColumnAliasRenameMap
convertColAliases ColumnAliasRemapper
origColAlRemapper (Text
attrName, (Text
attrAlias,Set ColumnName
_)) ColumnAliasRenameMap
acc' =
              if forall k a. Ord k => k -> Map k a -> Bool
M.member Text
attrName ColumnAliasRemapper
origColAlRemapper then
                ColumnAliasRenameMap
acc'
                else
                forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (TableAlias
tAlias, Text
attrName) (Text -> ColumnAlias
ColumnAlias Text
attrAlias) ColumnAliasRenameMap
acc'
        case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TableAlias
tAlias Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
orig of
          -- new table has been added to column alias map, add all columns aliased
          Maybe (RelationalExpr, Attributes, ColumnAliasRemapper)
Nothing -> do
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColumnAliasRenameMap
acc forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ColumnAliasRemapper
-> (Text, (Text, Set ColumnName))
-> ColumnAliasRenameMap
-> ColumnAliasRenameMap
convertColAliases forall a. Monoid a => a
mempty) forall a. Monoid a => a
mempty (forall k a. Map k a -> [(k, a)]
M.toList ColumnAliasRemapper
colAliasRemapper))
          -- we are aware of the table, but there may have been some new columns added
          Just (RelationalExpr
_,Attributes
_,ColumnAliasRemapper
colAliasRemapper') ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColumnAliasRenameMap
acc forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ColumnAliasRemapper
-> (Text, (Text, Set ColumnName))
-> ColumnAliasRenameMap
-> ColumnAliasRenameMap
convertColAliases ColumnAliasRemapper
colAliasRemapper') forall a. Monoid a => a
mempty (forall k a. Map k a -> [(k, a)]
M.toList ColumnAliasRemapper
colAliasRemapper'))
      tableDiffFolder ColumnAliasRenameMap
_ (TableAlias
_, (RelationalExpr
rvexpr, Attributes
_, ColumnAliasRemapper
_)) = forall a. SQLError -> ConvertM a
throwSQLE (RelationalExpr -> SQLError
UnexpectedRelationalExprError RelationalExpr
rvexpr)
            
  ColumnAliasRenameMap
diff <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ColumnAliasRenameMap
-> (TableAlias, (RelationalExpr, Attributes, ColumnAliasRemapper))
-> StateT
     TableContext (ExceptT SQLError Identity) ColumnAliasRenameMap
tableDiffFolder forall a. Monoid a => a
mempty (forall k a. Map k a -> [(k, a)]
M.toList Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
postSub)

  forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
ret, ColumnAliasRenameMap
diff)

-- if we find a column naming conflict, generate a non-conflicting name for insertion into the column alias map
generateColumnAlias :: TableAlias -> AttributeName -> ConvertM ColumnAlias
generateColumnAlias :: TableAlias -> Text -> ConvertM ColumnAlias
generateColumnAlias (TableAlias Text
tAlias) Text
attrName = do
  TableContext
tctx <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  let potentialNames :: [ColumnName]
potentialNames = forall a b. (a -> b) -> [a] -> [b]
map [Text] -> ColumnName
ColumnName ([[Text
attrName],
                                        [Text
tAlias forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
attrName]] forall a. Semigroup a => a -> a -> a
<>
                                        forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> [Text
tAlias forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
attrName forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
x)]) [Int
1::Int ..])
      nameIsAvailable :: ColumnName -> Bool
nameIsAvailable ColumnName
nam = 
        case ColumnName -> TableContext -> Either SQLError TableAlias
findOneColumn' ColumnName
nam TableContext
tctx of
          Left ColumnResolutionError{} -> --no match, so we can use this name
            Bool
True
          Either SQLError TableAlias
_ -> Bool
False --some conflict, so loop
      firstAvailableName :: Maybe ColumnName
firstAvailableName = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ColumnName -> Bool
nameIsAvailable [ColumnName]
potentialNames
--  traceShowM ("generateColumnAlias scan"::String, tAlias, attrName, firstAvailableName)     
  case Maybe ColumnName
firstAvailableName of
    Just (ColumnName [Text
nam]) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ColumnAlias
ColumnAlias Text
nam)
    Maybe ColumnName
_ -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ ColumnName -> SQLError
ColumnResolutionError ([Text] -> ColumnName
ColumnName [Text
attrName])

-- | Insert another table into the TableContext. Returns an alias map of any columns which could conflict with column names already present in the TableContext so that they can be optionally renamed.
insertTable :: TableAlias -> RelationalExpr -> Attributes -> ConvertM ColumnAliasMap
insertTable :: TableAlias
-> RelationalExpr -> Attributes -> ConvertM ColumnAliasMap
insertTable TableAlias
tAlias RelationalExpr
expr Attributes
rtype = do
  (TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
map') <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TableAlias
tAlias Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
map' of
    Maybe (RelationalExpr, Attributes, ColumnAliasRemapper)
Nothing -> do
      forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall a b. (a -> b) -> a -> b
$ Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
-> TableContext
TableContext forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert TableAlias
tAlias (RelationalExpr
expr, Attributes
rtype, forall a. Monoid a => a
mempty) Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
map'
--      traceShowM ("insertTable"::String, tAlias)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    Just (RelationalExpr, Attributes, ColumnAliasRemapper)
_ -> forall a. SQLError -> ConvertM a
throwSQLE (TableAlias -> SQLError
DuplicateTableReferenceError TableAlias
tAlias)

-- | When a column is mentioned, it may need to be aliased. The table name must already be in the table context so that we can identify that the attribute exists. Without a table name, we must look for a uniquely named column amongst all tables. Thus, we pre-emptively eliminate duplicate column names.
noteColumnMention :: Maybe TableAlias -> ColumnName -> Maybe ColumnAlias -> ConvertM ColumnAlias
noteColumnMention :: Maybe TableAlias
-> ColumnName -> Maybe ColumnAlias -> ConvertM ColumnAlias
noteColumnMention Maybe TableAlias
mTblAlias ColumnName
colName Maybe ColumnAlias
mColAlias = do
  -- find the relevant table for the key to the right table
  tc :: TableContext
tc@(TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tcontext) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  -- check if we already have a mention mapping
  let lookupWithTableAlias :: TableAlias -> Text -> ConvertM ColumnAlias
lookupWithTableAlias (TableAlias Text
tAlias) Text
colAttr = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe TableAlias
mTblAlias Bool -> Bool -> Bool
&& forall a. a -> Maybe a
Just (Text -> TableAlias
TableAlias Text
tAlias) forall a. Eq a => a -> a -> Bool
/= Maybe TableAlias
mTblAlias) (forall a. SQLError -> ConvertM a
throwSQLE (TableAlias -> SQLError
TableAliasMismatchError (Text -> TableAlias
TableAlias Text
tAlias)))
      -- we have a specific table alias, so ensure it's valid
        let tPrefixColAttr :: Text
tPrefixColAttr = Text
tAlias forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
colAttr
            insertColAlias :: Text -> ConvertM ColumnAlias
insertColAlias Text
newAlias = do
              TableAlias -> Text -> ColumnAlias -> ColumnName -> ConvertM ()
insertColumnAlias (Text -> TableAlias
TableAlias Text
tAlias) Text
colAttr (Text -> ColumnAlias
ColumnAlias Text
newAlias) ColumnName
colName
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ColumnAlias
ColumnAlias Text
newAlias)
        case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> TableAlias
TableAlias Text
tAlias) Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tcontext of
          Maybe (RelationalExpr, Attributes, ColumnAliasRemapper)
Nothing -> do -- add a new colaliasremapper
            Text -> ConvertM ColumnAlias
insertColAlias (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
tPrefixColAttr ColumnAlias -> Text
unColumnAlias Maybe ColumnAlias
mColAlias)
          Just (RelationalExpr
_, Attributes
_, ColumnAliasRemapper
colAlRemapper) -> do
            -- table alias already known, check for column alias
            case Text -> ColumnAliasRemapper -> Either SQLError Text
attributeNameForAttributeAlias Text
colAttr ColumnAliasRemapper
colAlRemapper of
              Left SQLError
_ -> do
                -- col alias missing, so add it- figure out if it needs a table prefix
                let sqlColAlias :: Text
sqlColAlias = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
colAttr ColumnAlias -> Text
unColumnAlias Maybe ColumnAlias
mColAlias
                case ColumnName -> TableContext -> Either SQLError [(TableAlias, Text)]
findNotedColumn' ([Text] -> ColumnName
ColumnName [Text
colAttr]) TableContext
tc of
                               Left SQLError
_ -> -- no match, so table prefix not required
                                 Text -> ConvertM ColumnAlias
insertColAlias Text
sqlColAlias
                               Right [] -> -- no match, so table prefix not required
                                 Text -> ConvertM ColumnAlias
insertColAlias Text
sqlColAlias
                               Right [(TableAlias, Text)
_] -> -- we have a match, so we need the table prefix
                                 Text -> ConvertM ColumnAlias
insertColAlias (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
tPrefixColAttr ColumnAlias -> Text
unColumnAlias Maybe ColumnAlias
mColAlias)
                               Right ((TableAlias, Text)
_:[(TableAlias, Text)]
_) -> forall a. SQLError -> ConvertM a
throwSQLE (ColumnName -> SQLError
AmbiguousColumnResolutionError ColumnName
colName)
              Right Text
attrName ->
                -- we know the alias already, so return it
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ColumnAlias
ColumnAlias Text
attrName)

  case ColumnName
colName of
    ColumnName [Text
tAlias,Text
colAlias] -> TableAlias -> Text -> ConvertM ColumnAlias
lookupWithTableAlias (Text -> TableAlias
TableAlias Text
tAlias) Text
colAlias
    ColumnName [Text
colAlias] ->
      case Maybe TableAlias
mTblAlias of
        Just TableAlias
tAlias -> TableAlias -> Text -> ConvertM ColumnAlias
lookupWithTableAlias TableAlias
tAlias Text
colAlias
        Maybe TableAlias
Nothing -> do
          -- lookup without table alias
          -- unqualified column alias- search for unambiguous table reference
          let folder :: (TableAlias, (RelationalExpr, Attributes, ColumnAliasRemapper))
-> [(TableAlias, Text)] -> [(TableAlias, Text)]
folder (TableAlias
ta, (RelationalExpr
_, Attributes
_, ColumnAliasRemapper
colAliasRemapper)) [(TableAlias, Text)]
acc =
                case Text -> ColumnAliasRemapper -> Either SQLError Text
attributeNameForAttributeAlias Text
colAlias ColumnAliasRemapper
colAliasRemapper of
                  Left SQLError
_ -> [(TableAlias, Text)]
acc
                  Right Text
attrName -> (TableAlias
ta,Text
attrName) forall a. a -> [a] -> [a]
: [(TableAlias, Text)]
acc
              sqlColAlias :: Text
sqlColAlias = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
colAlias ColumnAlias -> Text
unColumnAlias Maybe ColumnAlias
mColAlias
      
          case forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TableAlias, (RelationalExpr, Attributes, ColumnAliasRemapper))
-> [(TableAlias, Text)] -> [(TableAlias, Text)]
folder forall a. Monoid a => a
mempty (forall k a. Map k a -> [(k, a)]
M.toList Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tcontext) of
            [] -> do -- no matches, search raw attributes
              case ColumnName -> TableContext -> [TableAlias]
findColumn' ColumnName
colName TableContext
tc of
                [] -> -- no match in attributes, either, error
                  forall a. SQLError -> ConvertM a
throwSQLE (ColumnName -> SQLError
UnexpectedColumnNameError ColumnName
colName)
                [TableAlias
tAlias] -> do -- one match, insert it
                  TableAlias -> Text -> ColumnAlias -> ColumnName -> ConvertM ()
insertColumnAlias TableAlias
tAlias Text
sqlColAlias (Text -> ColumnAlias
ColumnAlias Text
colAlias) ColumnName
colName
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ColumnAlias
ColumnAlias Text
colAlias)
                (TableAlias
_:[TableAlias]
_) -> -- too many matches, error
                  forall a. SQLError -> ConvertM a
throwSQLE (ColumnName -> SQLError
AmbiguousColumnResolutionError ColumnName
colName)
            [(TableAlias
tAlias, Text
attrName)] -> do -- valid attribute match, so add colaliasremapper
              TableAlias -> Text -> ColumnAlias -> ColumnName -> ConvertM ()
insertColumnAlias TableAlias
tAlias Text
attrName (Text -> ColumnAlias
ColumnAlias Text
colAlias) ColumnName
colName
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ColumnAlias
ColumnAlias Text
colAlias)
            ((TableAlias, Text)
_:[(TableAlias, Text)]
_) -> -- two many matches, error
              forall a. SQLError -> ConvertM a
throwSQLE (ColumnName -> SQLError
AmbiguousColumnResolutionError ColumnName
colName)
    other :: ColumnName
other@ColumnName{} -> forall a. SQLError -> ConvertM a
throwSQLE (ColumnName -> SQLError
UnexpectedColumnNameError ColumnName
other)   

lookupTable :: TableAlias -> ConvertM (RelationalExpr, Attributes, ColumnAliasRemapper)
lookupTable :: TableAlias
-> ConvertM (RelationalExpr, Attributes, ColumnAliasRemapper)
lookupTable TableAlias
ta = do
  (TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
map') <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TableAlias
ta Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
map' of
    Maybe (RelationalExpr, Attributes, ColumnAliasRemapper)
Nothing -> forall a. SQLError -> ConvertM a
throwSQLE (TableAlias -> SQLError
MissingTableReferenceError TableAlias
ta)
    Just (RelationalExpr, Attributes, ColumnAliasRemapper)
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr, Attributes, ColumnAliasRemapper)
res

-- | Find a column name or column alias in the underlying table context. Returns key into table context.
findColumn :: ColumnName -> ConvertM [TableAlias]
findColumn :: ColumnName -> ConvertM [TableAlias]
findColumn ColumnName
targetCol = 
  ColumnName -> TableContext -> [TableAlias]
findColumn' ColumnName
targetCol forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. Monad m => StateT s m s
get
  
-- | non ConvertM version of findColumn
findColumn' :: ColumnName -> TableContext -> [TableAlias]
findColumn' :: ColumnName -> TableContext -> [TableAlias]
findColumn' ColumnName
targetCol (TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tMap) = do
  forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey TableAlias
-> (RelationalExpr, Attributes, ColumnAliasRemapper)
-> [TableAlias]
-> [TableAlias]
folder [] Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tMap
   where
    folder :: TableAlias
-> (RelationalExpr, Attributes, ColumnAliasRemapper)
-> [TableAlias]
-> [TableAlias]
folder tAlias :: TableAlias
tAlias@(TableAlias Text
tat) (RelationalExpr
_rvExpr, Attributes
rtype, ColumnAliasRemapper
_) [TableAlias]
acc =
      case ColumnName
targetCol of
        ColumnName [Text
colName'] ->
          if forall a. Ord a => a -> Set a -> Bool
S.member Text
colName' (Attributes -> Set Text
A.attributeNameSet Attributes
rtype) then
            TableAlias
tAlias forall a. a -> [a] -> [a]
: [TableAlias]
acc
            else
            [TableAlias]
acc
        ColumnName [Text
tPrefix, Text
colName'] ->
          if Text
tat forall a. Eq a => a -> a -> Bool
== Text
tPrefix Bool -> Bool -> Bool
&& forall a. Ord a => a -> Set a -> Bool
S.member Text
colName' (Attributes -> Set Text
A.attributeNameSet Attributes
rtype) then
            TableAlias
tAlias forall a. a -> [a] -> [a]
: [TableAlias]
acc
            else
            [TableAlias]
acc
        ColumnName
_ -> [TableAlias]
acc

-- search ColumnAliasRemapper for columns which have already been noted- can be used for probing for new aliases
findNotedColumn' :: ColumnName -> TableContext -> Either SQLError [(TableAlias, AttributeName)]
findNotedColumn' :: ColumnName -> TableContext -> Either SQLError [(TableAlias, Text)]
findNotedColumn' (ColumnName [Text
attr]) (TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tcontext) =
  -- search all column alias remappers for attribute- if there is a conflict because the alias is ambiguous, error out
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TableAlias, (RelationalExpr, Attributes, ColumnAliasRemapper))
-> [(TableAlias, Text)] -> [(TableAlias, Text)]
folder forall a. Monoid a => a
mempty (forall k a. Map k a -> [(k, a)]
M.toList Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tcontext)
  where
    folder :: (TableAlias, (RelationalExpr, Attributes, ColumnAliasRemapper))
-> [(TableAlias, Text)] -> [(TableAlias, Text)]
folder (TableAlias
ta, (RelationalExpr
_, Attributes
_, ColumnAliasRemapper
colAliasRemapper)) [(TableAlias, Text)]
acc =
      case Text -> ColumnAliasRemapper -> Either SQLError Text
attributeNameForAttributeAlias Text
attr ColumnAliasRemapper
colAliasRemapper of
        Left SQLError
_ -> [(TableAlias, Text)]
acc
        Right Text
attrName -> (TableAlias
ta,Text
attrName) forall a. a -> [a] -> [a]
: [(TableAlias, Text)]
acc

findNotedColumn' (ColumnName [Text
tPrefix, Text
attr]) (TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tcontext) =
  --find referenced table alias
  --search for noted column in column alias remapper
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> TableAlias
TableAlias Text
tPrefix) Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tcontext of
    Maybe (RelationalExpr, Attributes, ColumnAliasRemapper)
Nothing -> forall a b. a -> Either a b
Left (TableAlias -> SQLError
MissingTableReferenceError (Text -> TableAlias
TableAlias Text
tPrefix))
    Just (RelationalExpr
_, Attributes
_, ColumnAliasRemapper
colAlRemapper) -> do
      Text
attrName <- Text -> ColumnAliasRemapper -> Either SQLError Text
attributeNameForAttributeAlias Text
attr ColumnAliasRemapper
colAlRemapper
      forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text -> TableAlias
TableAlias Text
tPrefix, Text
attrName)]
findNotedColumn' ColumnName
colName TableContext
_ = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ColumnName -> SQLError
UnexpectedColumnNameError ColumnName
colName      


attributeNameForAttributeAlias :: AttributeAlias -> ColumnAliasRemapper -> Either SQLError AttributeName
attributeNameForAttributeAlias :: Text -> ColumnAliasRemapper -> Either SQLError Text
attributeNameForAttributeAlias Text
al ColumnAliasRemapper
remapper = do
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, (Text, Set ColumnName))
-> Either SQLError Text -> Either SQLError Text
folder (forall a b. a -> Either a b
Left (ColumnAlias -> SQLError
ColumnAliasResolutionError (Text -> ColumnAlias
ColumnAlias Text
al))) (forall k a. Map k a -> [(k, a)]
M.toList ColumnAliasRemapper
remapper)
  where
    folder :: (Text, (Text, Set ColumnName))
-> Either SQLError Text -> Either SQLError Text
folder (Text
_attrName, (Text
attrAlias, Set ColumnName
_)) Either SQLError Text
acc =
               if Text
attrAlias forall a. Eq a => a -> a -> Bool
== Text
al then
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
attrAlias
               else
                 Either SQLError Text
acc
  

findOneColumn :: ColumnName -> ConvertM TableAlias
findOneColumn :: ColumnName -> ConvertM TableAlias
findOneColumn ColumnName
targetCol = do
  TableContext
tcontext <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  case ColumnName -> TableContext -> Either SQLError TableAlias
findOneColumn' ColumnName
targetCol TableContext
tcontext of
    Left SQLError
err -> forall a. SQLError -> ConvertM a
throwSQLE SQLError
err
    Right TableAlias
match -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TableAlias
match

findOneColumn' :: ColumnName -> TableContext -> Either SQLError TableAlias
findOneColumn' :: ColumnName -> TableContext -> Either SQLError TableAlias
findOneColumn' ColumnName
targetCol TableContext
tcontext = do
  case ColumnName -> TableContext -> [TableAlias]
findColumn' ColumnName
targetCol TableContext
tcontext of
    [] -> do
      forall a b. a -> Either a b
Left (ColumnName -> SQLError
ColumnResolutionError ColumnName
targetCol)
    [TableAlias
match] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TableAlias
match
    [TableAlias]
_matches -> forall a b. a -> Either a b
Left (ColumnName -> SQLError
AmbiguousColumnResolutionError ColumnName
targetCol)

-- | Search the TableContext for a column alias remapping for the given column name. This function can change the state context if column names conflict.
attributeNameForColumnName :: ColumnName -> ConvertM AttributeName
attributeNameForColumnName :: ColumnName -> ConvertM Text
attributeNameForColumnName ColumnName
colName = do
  tKey :: TableAlias
tKey@(TableAlias Text
tAlias) <- ColumnName -> ConvertM TableAlias
findOneColumn ColumnName
colName
  tcontext :: TableContext
tcontext@(TableContext Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tmap) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  let (RelationalExpr
_, Attributes
rvattrs, ColumnAliasRemapper
colAliases) = Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
tmap forall k a. Ord k => Map k a -> k -> a
M.! TableAlias
tKey
  --strip table prefix, if necessary
  (ColumnAlias Text
colAttr) <- case ColumnName
colName of
                ColumnName [Text
attr] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ColumnAlias
ColumnAlias Text
attr
                ColumnName [Text
_tname,Text
attr] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ColumnAlias
ColumnAlias Text
attr
                ColumnName{} -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ ColumnName -> SQLError
ColumnResolutionError ColumnName
colName
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
colAttr ColumnAliasRemapper
colAliases of
    Just (Text
alias,Set ColumnName
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
alias -- we found it, so it's valid
    Maybe (Text, Set ColumnName)
Nothing ->
      -- look in rvattrs, so we don't need the table alias prefix. The lack of an entry in the column alias map indicates that the column was not renamed in the join condition.
      if Text
colAttr Text -> Attributes -> Bool
`A.isAttributeNameContained` Attributes
rvattrs then
        -- we have a matching attribute, but it could conflict with another attribute, so check for that
        case ColumnName -> TableContext -> Either SQLError TableAlias
findOneColumn' ([Text] -> ColumnName
ColumnName [Text
colAttr]) TableContext
tcontext of
          Right TableAlias
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
colAttr
          Left (AmbiguousColumnResolutionError{}) -> do
            --we have a conflict, so insert a new column alias and return it
            (ColumnAlias Text
al) <- Maybe TableAlias
-> ColumnName -> Maybe ColumnAlias -> ConvertM ColumnAlias
noteColumnMention (forall a. a -> Maybe a
Just TableAlias
tKey) ([Text] -> ColumnName
ColumnName [Text
tAlias,Text
colAttr]) forall a. Maybe a
Nothing
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
al
          Left SQLError
err -> forall a. SQLError -> ConvertM a
throwSQLE SQLError
err
      else
        case ColumnName
colName of
          ColumnName [Text
_, Text
col] | Text
col Text -> Attributes -> Bool
`A.isAttributeNameContained` Attributes
rvattrs ->
                                -- the column has not been aliased, so we presume it can be use the column name directly
                                forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
col
          ColumnName
_ -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ ColumnName -> SQLError
ColumnResolutionError ColumnName
colName

wrapTypeF :: TypeForRelExprF -> RelationalExpr -> ConvertM Relation
wrapTypeF :: TypeForRelExprF -> RelationalExpr -> ConvertM Relation
wrapTypeF TypeForRelExprF
typeF RelationalExpr
relExpr =
  case TypeForRelExprF
typeF RelationalExpr
relExpr of
    Left RelationalError
relError -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
relError)
    Right Relation
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
v    

baseDFExpr :: DataFrameExpr
baseDFExpr :: DataFrameExpr
baseDFExpr = DataFrameExpr { convertExpr :: RelationalExpr
convertExpr = forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs (forall a. a -> Maybe a
Just []) (forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs () [forall a. Map Text (AtomExprBase a) -> TupleExprBase a
TupleExpr forall a. Monoid a => a
mempty]), --relationTrue if the table expression is empty "SELECT 1"
                             orderExprs :: [AttributeOrderExpr]
orderExprs = [],
                             offset :: Maybe Integer
offset = forall a. Maybe a
Nothing,
                             limit :: Maybe Integer
limit = forall a. Maybe a
Nothing }

falseDFExpr :: DataFrameExpr
falseDFExpr :: DataFrameExpr
falseDFExpr = DataFrameExpr { convertExpr :: RelationalExpr
convertExpr = forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs (forall a. a -> Maybe a
Just []) (forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs () []), --relationFalse 
                             orderExprs :: [AttributeOrderExpr]
orderExprs = [],
                             offset :: Maybe Integer
offset = forall a. Maybe a
Nothing,
                             limit :: Maybe Integer
limit = forall a. Maybe a
Nothing }


convertQuery :: TypeForRelExprF -> Query -> ConvertM DataFrameExpr
convertQuery :: TypeForRelExprF -> Query -> ConvertM DataFrameExpr
convertQuery TypeForRelExprF
typeF (QuerySelect Select
sel) = TypeForRelExprF -> Select -> ConvertM DataFrameExpr
convertSelect TypeForRelExprF
typeF Select
sel
convertQuery TypeForRelExprF
typeF (QueryValues [[ScalarExpr]]
vals) = do
  let convertTupleExprs :: [ScalarExpr]
-> StateT
     TableContext (ExceptT SQLError Identity) (TupleExprBase ())
convertTupleExprs [ScalarExpr]
tupVals = do
        forall a. Map Text (AtomExprBase a) -> TupleExprBase a
TupleExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Int
c, ScalarExpr
sexpr) -> do
                                            AtomExprBase ()
atomExpr <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
sexpr
                                            forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"attr_" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
c), AtomExprBase ()
atomExpr)
                                        ) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1::Int ..] [ScalarExpr]
tupVals)
  [TupleExprBase ()]
tupleExprs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [ScalarExpr]
-> StateT
     TableContext (ExceptT SQLError Identity) (TupleExprBase ())
convertTupleExprs [[ScalarExpr]]
vals
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataFrameExpr
baseDFExpr { convertExpr :: RelationalExpr
convertExpr = forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs forall a. Maybe a
Nothing (forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs () [TupleExprBase ()]
tupleExprs) })
convertQuery TypeForRelExprF
_typeF (QueryTable TableName
tname) = do
  Text
rvName <- TableName -> ConvertM Text
convertTableName TableName
tname
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DataFrameExpr
baseDFExpr { convertExpr :: RelationalExpr
convertExpr = forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
rvName () }
convertQuery TypeForRelExprF
typeF (QueryOp QueryOperator
op Query
q1 Query
q2) = do
  let dfErr :: SQLError
dfErr = Text -> SQLError
NotSupportedError (Text
"ORDER BY/LIMIT/OFFSET in " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show QueryOperator
op))
  DataFrameExpr
dfExpr1 <- forall a. ConvertM a -> ConvertM a
runLocalConvertM (TypeForRelExprF -> Query -> ConvertM DataFrameExpr
convertQuery TypeForRelExprF
typeF Query
q1)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DataFrameExpr -> Bool
usesDataFrameFeatures DataFrameExpr
dfExpr1) forall a b. (a -> b) -> a -> b
$ forall a. SQLError -> ConvertM a
throwSQLE SQLError
dfErr  
  Relation
dfType1 <- case TypeForRelExprF
typeF (DataFrameExpr -> RelationalExpr
convertExpr DataFrameExpr
dfExpr1) of
              Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
              Right Relation
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
t

  DataFrameExpr
dfExpr2 <- forall a. ConvertM a -> ConvertM a
runLocalConvertM (TypeForRelExprF -> Query -> ConvertM DataFrameExpr
convertQuery TypeForRelExprF
typeF Query
q2)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DataFrameExpr -> Bool
usesDataFrameFeatures DataFrameExpr
dfExpr2) forall a b. (a -> b) -> a -> b
$ forall a. SQLError -> ConvertM a
throwSQLE SQLError
dfErr   
  Relation
dfType2 <- case TypeForRelExprF
typeF (DataFrameExpr -> RelationalExpr
convertExpr DataFrameExpr
dfExpr2) of
               Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
               Right Relation
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
t

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Relation
dfType1 forall a. Eq a => a -> a -> Bool
/= Relation
dfType2) forall a b. (a -> b) -> a -> b
$ forall a. SQLError -> ConvertM a
throwSQLE (QueryOperator -> Attributes -> Attributes -> SQLError
QueryOperatorTypeMismatchError QueryOperator
op (Relation -> Attributes
attributes Relation
dfType1) (Relation -> Attributes
attributes Relation
dfType2))

  let relOp :: RelationalExpr -> RelationalExpr -> RelationalExpr
relOp = case QueryOperator
op of
        QueryOperator
UnionQueryOperator -> forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union
        QueryOperator
ExceptQueryOperator -> forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Difference
        QueryOperator
IntersectQueryOperator -> forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DataFrameExpr
baseDFExpr { convertExpr :: RelationalExpr
convertExpr = RelationalExpr -> RelationalExpr -> RelationalExpr
relOp (DataFrameExpr -> RelationalExpr
convertExpr DataFrameExpr
dfExpr1) (DataFrameExpr -> RelationalExpr
convertExpr DataFrameExpr
dfExpr2) }
             
convertSelect :: TypeForRelExprF -> Select -> ConvertM DataFrameExpr
convertSelect :: TypeForRelExprF -> Select -> ConvertM DataFrameExpr
convertSelect TypeForRelExprF
typeF Select
sel = do
  WithNamesAssocs
wExprs <- case Select -> Maybe WithClause
withClause Select
sel of
              Maybe WithClause
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
              Just WithClause
wClause -> do
                TypeForRelExprF -> WithClause -> ConvertM WithNamesAssocs
convertWithClause TypeForRelExprF
typeF WithClause
wClause
  -- extract all mentioned tables into the table alias map for
  let typeF' :: TypeForRelExprF
typeF' = TypeForRelExprF -> WithNamesAssocs -> TypeForRelExprF
appendWithsToTypeF TypeForRelExprF
typeF WithNamesAssocs
wExprs
  (DataFrameExpr
dfExpr, ColumnAliasMap
_colRemap) <- case Select -> Maybe TableExpr
tableExpr Select
sel of
              Maybe TableExpr
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataFrameExpr
baseDFExpr, forall a. Monoid a => a
mempty)
              Just TableExpr
tExpr -> TypeForRelExprF
-> TableExpr
-> StateT
     TableContext
     (ExceptT SQLError Identity)
     (DataFrameExpr, ColumnAliasMap)
convertTableExpr TypeForRelExprF
typeF' TableExpr
tExpr
  let explicitWithF :: RelationalExpr -> RelationalExpr
explicitWithF = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null WithNamesAssocs
wExprs then forall a. a -> a
id else forall a.
WithNamesAssocsBase a
-> RelationalExprBase a -> RelationalExprBase a
With WithNamesAssocs
wExprs
      ([GroupByExpr]
groupByExprs, Maybe HavingExpr
havingExpr) = case Select -> Maybe TableExpr
tableExpr Select
sel of
                                     Maybe TableExpr
Nothing -> ([],forall a. Maybe a
Nothing)
                                     Just TableExpr
texpr -> (TableExpr -> [GroupByExpr]
groupByClause TableExpr
texpr, TableExpr -> Maybe HavingExpr
havingClause TableExpr
texpr)
  -- convert projection using table alias map to resolve column names
  RelationalExpr -> RelationalExpr
projF <- TypeForRelExprF
-> [SelectItem]
-> [GroupByExpr]
-> Maybe HavingExpr
-> ConvertM (RelationalExpr -> RelationalExpr)
convertProjection TypeForRelExprF
typeF' (Select -> [SelectItem]
projectionClause Select
sel) [GroupByExpr]
groupByExprs Maybe HavingExpr
havingExpr
  -- add with clauses
  WithNamesAssocs
withAssocs <- ConvertM WithNamesAssocs
tableAliasesAsWithNameAssocs
  let withF :: RelationalExpr -> RelationalExpr
withF = case WithNamesAssocs
withAssocs of
                [] -> forall a. a -> a
id
                WithNamesAssocs
_ -> forall a.
WithNamesAssocsBase a
-> RelationalExprBase a -> RelationalExprBase a
With WithNamesAssocs
withAssocs
      finalRelExpr :: RelationalExpr
finalRelExpr = RelationalExpr -> RelationalExpr
explicitWithF (RelationalExpr -> RelationalExpr
withF (RelationalExpr -> RelationalExpr
projF (DataFrameExpr -> RelationalExpr
convertExpr DataFrameExpr
dfExpr)))
  -- if we have only one table alias or the columns are all unambiguous, remove table aliasing of attributes
  -- apply rename reduction- this could be applied by the static query optimizer, but we do it here to simplify the tests so that they aren't polluted with redundant renames
--  traceShowM ("finalExpr"::String, finalRelExpr)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataFrameExpr
dfExpr { convertExpr :: RelationalExpr
convertExpr = RelationalExpr
finalRelExpr })


-- returns a new typeF function which adds type checking for "with" clause expressions
appendWithsToTypeF :: TypeForRelExprF -> WithNamesAssocs -> TypeForRelExprF
appendWithsToTypeF :: TypeForRelExprF -> WithNamesAssocs -> TypeForRelExprF
appendWithsToTypeF TypeForRelExprF
typeF WithNamesAssocs
withAssocs RelationalExpr
relExpr =
  case RelationalExpr
relExpr of
    expr :: RelationalExpr
expr@(RelationVariable Text
x ()) -> case forall a.
Text -> WithNamesAssocsBase a -> Maybe (RelationalExprBase a)
With.lookup Text
x WithNamesAssocs
withAssocs of
                               Maybe RelationalExpr
Nothing -> TypeForRelExprF
typeF RelationalExpr
expr
                               Just RelationalExpr
matchExpr -> TypeForRelExprF
typeF RelationalExpr
matchExpr
    RelationalExpr
other -> TypeForRelExprF
typeF RelationalExpr
other
      

-- | Slightly different processing for subselects.
convertSubSelect :: TypeForRelExprF -> Select -> ConvertM RelationalExpr
convertSubSelect :: TypeForRelExprF -> Select -> ConvertM RelationalExpr
convertSubSelect TypeForRelExprF
typeF Select
sel = do
  ((RelationalExpr -> RelationalExpr
applyF, RelationalExpr
tExpr), ColumnAliasRenameMap
colRenames) <- forall a. ConvertM a -> ConvertM (a, ColumnAliasRenameMap)
withSubSelect forall a b. (a -> b) -> a -> b
$ do
    WithNamesAssocs
wExprs <- case Select -> Maybe WithClause
withClause Select
sel of
                Maybe WithClause
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
                Just WithClause
wClause -> do
                  TypeForRelExprF -> WithClause -> ConvertM WithNamesAssocs
convertWithClause TypeForRelExprF
typeF WithClause
wClause
    let typeF' :: TypeForRelExprF
typeF' = TypeForRelExprF -> WithNamesAssocs -> TypeForRelExprF
appendWithsToTypeF TypeForRelExprF
typeF WithNamesAssocs
wExprs    
    (DataFrameExpr
dfExpr, ColumnAliasMap
_colMap) <- case Select -> Maybe TableExpr
tableExpr Select
sel of
                            Maybe TableExpr
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataFrameExpr
baseDFExpr, forall a. Monoid a => a
mempty)
                            Just TableExpr
tExpr -> TypeForRelExprF
-> TableExpr
-> StateT
     TableContext
     (ExceptT SQLError Identity)
     (DataFrameExpr, ColumnAliasMap)
convertTableExpr TypeForRelExprF
typeF' TableExpr
tExpr  
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DataFrameExpr -> Bool
usesDataFrameFeatures DataFrameExpr
dfExpr) forall a b. (a -> b) -> a -> b
$ forall a. SQLError -> ConvertM a
throwSQLE (Text -> SQLError
NotSupportedError Text
"ORDER BY/LIMIT/OFFSET in subquery")
    let explicitWithF :: RelationalExpr -> RelationalExpr
explicitWithF = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null WithNamesAssocs
wExprs then forall a. a -> a
id else forall a.
WithNamesAssocsBase a
-> RelationalExprBase a -> RelationalExprBase a
With WithNamesAssocs
wExprs    
    -- convert projection using table alias map to resolve column names
    RelationalExpr -> RelationalExpr
projF <- TypeForRelExprF
-> [SelectItem]
-> [GroupByExpr]
-> Maybe HavingExpr
-> ConvertM (RelationalExpr -> RelationalExpr)
convertProjection TypeForRelExprF
typeF' (Select -> [SelectItem]
projectionClause Select
sel) [] forall a. Maybe a
Nothing -- the projection can only project on attributes from the subselect table expression
    -- add with clauses
    WithNamesAssocs
withAssocs <- ConvertM WithNamesAssocs
tableAliasesAsWithNameAssocs
    let withF :: RelationalExpr -> RelationalExpr
withF = case WithNamesAssocs
withAssocs of
                  [] -> forall a. a -> a
id
                  WithNamesAssocs
_ -> forall a.
WithNamesAssocsBase a
-> RelationalExprBase a -> RelationalExprBase a
With WithNamesAssocs
withAssocs
    -- add disambiguation renaming
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr -> RelationalExpr
explicitWithF forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalExpr -> RelationalExpr
withF forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalExpr -> RelationalExpr
projF, DataFrameExpr -> RelationalExpr
convertExpr DataFrameExpr
dfExpr)
    
  let renamedExpr :: RelationalExpr
renamedExpr = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((TableAlias, Text), ColumnAlias)
-> RelationalExpr -> RelationalExpr
renamerFolder RelationalExpr
tExpr (forall k a. Map k a -> [(k, a)]
M.toList ColumnAliasRenameMap
colRenames)
      renamerFolder :: ((TableAlias, Text), ColumnAlias)
-> RelationalExpr -> RelationalExpr
renamerFolder ((TableAlias Text
tAlias, Text
oldAttrName), ColumnAlias Text
newAttrName)=
        Set (Text, Text)
-> RelationalExpr -> RelationalExpr -> RelationalExpr
pushDownAttributeRename (forall a. a -> Set a
S.singleton (Text
oldAttrName, Text
newAttrName)) (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
tAlias ())
        
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr -> RelationalExpr
applyF RelationalExpr
renamedExpr)

convertSelectItem :: TypeForRelExprF -> SelectItemsConvertTask -> (Int, SelectItem) -> ConvertM SelectItemsConvertTask
convertSelectItem :: TypeForRelExprF
-> SelectItemsConvertTask
-> (Int, SelectItem)
-> ConvertM SelectItemsConvertTask
convertSelectItem TypeForRelExprF
typeF SelectItemsConvertTask
acc (Int
c,SelectItem
selItem) = 
  case SelectItem
selItem of
    -- select * from x
    (Identifier (ColumnProjectionName [ProjectionName
Asterisk]), Maybe ColumnAlias
Nothing) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectItemsConvertTask
acc
    -- select sup.* from s as sup
    (Identifier qpn :: ColumnProjectionName
qpn@(ColumnProjectionName [ProjectionName Text
_, ProjectionName
Asterisk]), Maybe ColumnAlias
Nothing) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SelectItemsConvertTask
acc { taskProjections :: Set ColumnProjectionName
taskProjections = forall a. Ord a => a -> Set a -> Set a
S.insert ColumnProjectionName
qpn (SelectItemsConvertTask -> Set ColumnProjectionName
taskProjections SelectItemsConvertTask
acc) }
    -- select a from x
    (Identifier qpn :: ColumnProjectionName
qpn@(ColumnProjectionName [ProjectionName Text
_col]), Maybe ColumnAlias
Nothing) -> do
      --look up unaliased column name
      TableAlias
_ <- ColumnProjectionName -> ConvertM TableAlias
colinfo ColumnProjectionName
qpn
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SelectItemsConvertTask
acc { taskProjections :: Set ColumnProjectionName
taskProjections = forall a. Ord a => a -> Set a -> Set a
S.insert ColumnProjectionName
qpn (SelectItemsConvertTask -> Set ColumnProjectionName
taskProjections SelectItemsConvertTask
acc)
                 }
    -- select city as x from s        
    (Identifier qpn :: ColumnProjectionName
qpn@(ColumnProjectionName [ProjectionName Text
_]), Just newName :: ColumnAlias
newName@(ColumnAlias Text
newNameTxt)) -> do
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SelectItemsConvertTask
acc { taskProjections :: Set ColumnProjectionName
taskProjections = forall a. Ord a => a -> Set a -> Set a
S.insert ([ProjectionName] -> ColumnProjectionName
ColumnProjectionName [Text -> ProjectionName
ProjectionName Text
newNameTxt]) (SelectItemsConvertTask -> Set ColumnProjectionName
taskProjections SelectItemsConvertTask
acc),
                       taskRenames :: [(ColumnProjectionName, ColumnAlias)]
taskRenames = SelectItemsConvertTask -> [(ColumnProjectionName, ColumnAlias)]
taskRenames SelectItemsConvertTask
acc forall a. Semigroup a => a -> a -> a
<> [(ColumnProjectionName
qpn, ColumnAlias
newName)] }
    -- select s.city from s
    (Identifier qpn :: ColumnProjectionName
qpn@(ColumnProjectionName [ProjectionName Text
tname, ProjectionName Text
colname]), Maybe ColumnAlias
Nothing) -> do
      --lookup column renaming, if applicable
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SelectItemsConvertTask
acc { taskProjections :: Set ColumnProjectionName
taskProjections = forall a. Ord a => a -> Set a -> Set a
S.insert ColumnProjectionName
qpn (SelectItemsConvertTask -> Set ColumnProjectionName
taskProjections SelectItemsConvertTask
acc),
                       taskRenames :: [(ColumnProjectionName, ColumnAlias)]
taskRenames = SelectItemsConvertTask -> [(ColumnProjectionName, ColumnAlias)]
taskRenames SelectItemsConvertTask
acc forall a. Semigroup a => a -> a -> a
<> [([ProjectionName] -> ColumnProjectionName
ColumnProjectionName [Text -> ProjectionName
ProjectionName Text
colname], Text -> ColumnAlias
ColumnAlias (Text -> [Text] -> Text
T.intercalate Text
"." [Text
tname,Text
colname]))] }
    -- other exprs
    (ProjectionScalarExpr
scalarExpr, Maybe ColumnAlias
mAlias) -> do
      let attrName' :: Maybe ColumnAlias -> a -> Text
attrName' (Just (ColumnAlias Text
nam)) a
_ = Text
nam
          attrName' Maybe ColumnAlias
Nothing a
c' = Text
"attr_" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show a
c')
          newAttrName :: Text
newAttrName = forall {a}. Show a => Maybe ColumnAlias -> a -> Text
attrName' Maybe ColumnAlias
mAlias Int
c
      AtomExprBase ()
atomExpr <- AtomExprBase () -> AtomExprBase ()
processSQLAggregateFunctions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF ProjectionScalarExpr
scalarExpr
      -- we need to apply the projections after the extension!
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SelectItemsConvertTask
acc { taskExtenders :: [ExtendTupleExpr]
taskExtenders = forall a. Text -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr Text
newAttrName AtomExprBase ()
atomExpr forall a. a -> [a] -> [a]
: SelectItemsConvertTask -> [ExtendTupleExpr]
taskExtenders SelectItemsConvertTask
acc,
                   taskProjections :: Set ColumnProjectionName
taskProjections = forall a. Ord a => a -> Set a -> Set a
S.insert ([ProjectionName] -> ColumnProjectionName
ColumnProjectionName [Text -> ProjectionName
ProjectionName Text
newAttrName]) (SelectItemsConvertTask -> Set ColumnProjectionName
taskProjections SelectItemsConvertTask
acc)
                     }
  where
   colinfo :: ColumnProjectionName -> ConvertM TableAlias
colinfo (ColumnProjectionName [ProjectionName Text
name]) = do
     ColumnName -> ConvertM TableAlias
findOneColumn ([Text] -> ColumnName
ColumnName [Text
name])
   colinfo ColumnProjectionName
colProjName = forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ ColumnProjectionName -> SQLError
UnexpectedColumnProjectionName ColumnProjectionName
colProjName

convertProjection :: TypeForRelExprF -> [SelectItem] -> [GroupByExpr] -> Maybe HavingExpr -> ConvertM (RelationalExpr -> RelationalExpr)
convertProjection :: TypeForRelExprF
-> [SelectItem]
-> [GroupByExpr]
-> Maybe HavingExpr
-> ConvertM (RelationalExpr -> RelationalExpr)
convertProjection TypeForRelExprF
typeF [SelectItem]
selItems [GroupByExpr]
groupBys Maybe HavingExpr
havingExpr = do
    GroupByInfo
groupInfo <- TypeForRelExprF
-> [GroupByExpr]
-> Maybe HavingExpr
-> [SelectItem]
-> ConvertM GroupByInfo
convertGroupBy TypeForRelExprF
typeF [GroupByExpr]
groupBys Maybe HavingExpr
havingExpr [SelectItem]
selItems
    SelectItemsConvertTask
task <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (TypeForRelExprF
-> SelectItemsConvertTask
-> (Int, SelectItem)
-> ConvertM SelectItemsConvertTask
convertSelectItem TypeForRelExprF
typeF) SelectItemsConvertTask
emptyTask (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1::Int ..] [SelectItem]
selItems)
    -- SQL supports only one grouping at a time, but multiple aggregations, so we create the group as attribute "_sql_aggregate" and the aggregations as fold projections on it
    RelationalExpr -> RelationalExpr
fGroup <- if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GroupByInfo -> [(Text, GroupByExpr)]
nonAggregates GroupByInfo
groupInfo)) Bool -> Bool -> Bool
||
                 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GroupByInfo -> [(Text, GroupByExpr)]
nonAggregates GroupByInfo
groupInfo) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GroupByInfo -> [ProjectionScalarExpr]
aggregates GroupByInfo
groupInfo)))
                 -- special case: SELECT max(status) FROM city- handle aggregations without GROUP BY                 
              then
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
AttributeNamesBase a
-> Text -> RelationalExprBase a -> RelationalExprBase a
Group (forall a. Set Text -> AttributeNamesBase a
InvertedAttributeNames
                              (forall a. Ord a => [a] -> Set a
S.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (GroupByInfo -> [(Text, GroupByExpr)]
nonAggregates GroupByInfo
groupInfo)))) Text
"_sql_aggregate"
              else
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id
    let coalesceBoolF :: AtomExprBase () -> AtomExprBase ()
coalesceBoolF AtomExprBase ()
expr = Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_coalesce_bool" [AtomExprBase ()
expr]
    RelationalExpr -> RelationalExpr
fGroupHavingExtend <- 
      case GroupByInfo -> Maybe ProjectionScalarExpr
havingRestriction GroupByInfo
groupInfo of
        Maybe ProjectionScalarExpr
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id
        Just ProjectionScalarExpr
sexpr -> do
          AtomExprBase ()
convertedAtomExpr <- TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF ProjectionScalarExpr
sexpr
          let atomExpr :: AtomExprBase ()
atomExpr = AtomExprBase () -> AtomExprBase ()
processSQLAggregateFunctions AtomExprBase ()
convertedAtomExpr
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (forall a. Text -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr Text
"_sql_having" (AtomExprBase () -> AtomExprBase ()
coalesceBoolF AtomExprBase ()
atomExpr))
    let fGroupRestriction :: RelationalExpr -> RelationalExpr
fGroupRestriction = case GroupByInfo -> Maybe ProjectionScalarExpr
havingRestriction GroupByInfo
groupInfo of
                              Maybe ProjectionScalarExpr
Nothing -> forall a. a -> a
id
                              Just ProjectionScalarExpr
_ ->
                                  forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (forall a. Text -> AtomExprBase a -> RestrictionPredicateExprBase a
AttributeEqualityPredicate Text
"_sql_having" (forall a. Atom -> AtomExprBase a
NakedAtomExpr (Bool -> Atom
BoolAtom Bool
True)))
    --apply projections
    RelationalExpr -> RelationalExpr
fProjection <- if forall a. Set a -> Bool
S.null (SelectItemsConvertTask -> Set ColumnProjectionName
taskProjections SelectItemsConvertTask
task) then
                     forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id
                   else do
                     let projFolder :: (Set Text, [Text])
-> ColumnProjectionName
-> StateT
     TableContext (ExceptT SQLError Identity) (Set Text, [Text])
projFolder (Set Text
attrNames, [Text]
b) (ColumnProjectionName [ProjectionName Text
nam]) =
                           forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => a -> Set a -> Set a
S.insert Text
nam Set Text
attrNames, [Text]
b)
                         projFolder (Set Text
attrNames, [Text]
b) (ColumnProjectionName [ProjectionName Text
nameA, ProjectionName Text
nameB]) =
                           forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => a -> Set a -> Set a
S.insert ([Text] -> Text
T.concat [Text
nameA, Text
".", Text
nameB]) Set Text
attrNames, [Text]
b)
                         projFolder (Set Text
attrNames, [Text]
relExprAttributes) (ColumnProjectionName [ProjectionName Text
tname, ProjectionName
Asterisk]) =
                           forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Text
attrNames, [Text]
relExprAttributes forall a. Semigroup a => a -> a -> a
<> [Text
tname])
                         projFolder (Set Text, [Text])
_ ColumnProjectionName
colProjName = forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ ColumnProjectionName -> SQLError
UnexpectedColumnProjectionName ColumnProjectionName
colProjName
                     (Set Text
attrNames, [Text]
relExprRvs) <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Set Text, [Text])
-> ColumnProjectionName
-> StateT
     TableContext (ExceptT SQLError Identity) (Set Text, [Text])
projFolder forall a. Monoid a => a
mempty (forall a. Set a -> [a]
S.toList (SelectItemsConvertTask -> Set ColumnProjectionName
taskProjections SelectItemsConvertTask
task))
                     let attrsProj :: AttributeNamesBase ()
attrsProj = forall a. Eq a => [AttributeNamesBase a] -> AttributeNamesBase a
A.some (forall a b. (a -> b) -> [a] -> [b]
map (\Text
rv -> forall a. RelationalExprBase a -> AttributeNamesBase a
RelationalExprAttributeNames (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
rv ())) [Text]
relExprRvs forall a. Semigroup a => a -> a -> a
<> [forall a. Set Text -> AttributeNamesBase a
AttributeNames Set Text
attrNames])
                     forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNamesBase ()
attrsProj
    -- apply extensions
    let fExtended :: RelationalExpr -> RelationalExpr
fExtended = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ExtendTupleExpr
ext RelationalExpr -> RelationalExpr
acc -> forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend ExtendTupleExpr
ext forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalExpr -> RelationalExpr
acc) forall a. a -> a
id (SelectItemsConvertTask -> [ExtendTupleExpr]
taskExtenders SelectItemsConvertTask
task)
    -- process SQL aggregates by replacing projections
    -- apply rename
    Set (Text, Text)
renamesSet <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Set (Text, Text)
acc (ColumnProjectionName
qProjName, ColumnAlias Text
newName) -> do
                          Text
oldName <- ColumnProjectionName -> ConvertM Text
convertColumnProjectionName ColumnProjectionName
qProjName
                          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
S.insert (Text
oldName, Text
newName) Set (Text, Text)
acc) forall a. Set a
S.empty (SelectItemsConvertTask -> [(ColumnProjectionName, ColumnAlias)]
taskRenames SelectItemsConvertTask
task)
    let fRenames :: RelationalExpr -> RelationalExpr
fRenames = if forall a. Set a -> Bool
S.null Set (Text, Text)
renamesSet then forall a. a -> a
id else forall a.
Set (Text, Text) -> RelationalExprBase a -> RelationalExprBase a
Rename Set (Text, Text)
renamesSet
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr -> RelationalExpr
fGroupRestriction forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalExpr -> RelationalExpr
fProjection forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalExpr -> RelationalExpr
fGroupHavingExtend forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalExpr -> RelationalExpr
fExtended forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalExpr -> RelationalExpr
fRenames forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalExpr -> RelationalExpr
fGroup)

convertUnqualifiedColumnName :: UnqualifiedColumnName -> AttributeName
convertUnqualifiedColumnName :: UnqualifiedColumnName -> Text
convertUnqualifiedColumnName (UnqualifiedColumnName Text
nam) = Text
nam

convertColumnName :: ColumnName -> ConvertM AttributeName
convertColumnName :: ColumnName -> ConvertM Text
convertColumnName ColumnName
colName = do
  ColumnName -> ConvertM Text
attributeNameForColumnName ColumnName
colName

convertColumnProjectionName :: ColumnProjectionName -> ConvertM AttributeName
convertColumnProjectionName :: ColumnProjectionName -> ConvertM Text
convertColumnProjectionName qpn :: ColumnProjectionName
qpn@(ColumnProjectionName [ProjectionName]
names) = do
  let namer :: ProjectionName -> ConvertM Text
namer (ProjectionName Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
      namer ProjectionName
Asterisk = forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ ColumnProjectionName -> SQLError
UnexpectedAsteriskError ColumnProjectionName
qpn
  [Text]
names' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ProjectionName -> ConvertM Text
namer [ProjectionName]
names
  ColumnName -> ConvertM Text
convertColumnName ([Text] -> ColumnName
ColumnName [Text]
names')
                      
        
convertTableExpr :: TypeForRelExprF -> TableExpr -> ConvertM (DataFrameExpr, ColumnAliasMap)
convertTableExpr :: TypeForRelExprF
-> TableExpr
-> StateT
     TableContext
     (ExceptT SQLError Identity)
     (DataFrameExpr, ColumnAliasMap)
convertTableExpr TypeForRelExprF
typeF TableExpr
tExpr = do
    (RelationalExpr
fromExpr, ColumnAliasMap
columnMap) <- TypeForRelExprF
-> [TableRef] -> ConvertM (RelationalExpr, ColumnAliasMap)
convertFromClause TypeForRelExprF
typeF (TableExpr -> [TableRef]
fromClause TableExpr
tExpr)
    RelationalExpr -> RelationalExpr
whereF <- case TableExpr -> Maybe RestrictionExpr
whereClause TableExpr
tExpr of
      Just RestrictionExpr
whereExpr -> do
        RestrictionPredicateExpr
restrictPredExpr <- TypeForRelExprF
-> RestrictionExpr -> ConvertM RestrictionPredicateExpr
convertWhereClause TypeForRelExprF
typeF RestrictionExpr
whereExpr
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExpr
restrictPredExpr
      Maybe RestrictionExpr
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id
    [AttributeOrderExpr]
orderExprs' <- TypeForRelExprF -> [SortExpr] -> ConvertM [AttributeOrderExpr]
convertOrderByClause TypeForRelExprF
typeF (TableExpr -> [SortExpr]
orderByClause TableExpr
tExpr)
    -- add disambiguation renaming
    let disambiguationRenamerF :: RelationalExpr -> RelationalExpr
disambiguationRenamerF = if forall a. Set a -> Bool
S.null Set (Text, Text)
renames then forall a. a -> a
id else forall a.
Set (Text, Text) -> RelationalExprBase a -> RelationalExprBase a
Rename Set (Text, Text)
renames
        renames :: Set (Text, Text)
renames = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ColumnAlias, Text) -> [(Text, Text)] -> [(Text, Text)]
folder forall a. Monoid a => a
mempty (forall k a. Map k a -> [(k, a)]
M.toList ColumnAliasMap
columnMap)
        whereAttrNames :: Set Text
whereAttrNames = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\(ColumnName [Text]
cs) -> Text -> [Text] -> Text
T.intercalate Text
"." [Text]
cs) Set ColumnName
whereColNames
        whereColNames :: Set ColumnName
whereColNames = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty RestrictionExpr -> Set ColumnName
columnNamesInRestrictionExpr (TableExpr -> Maybe RestrictionExpr
whereClause TableExpr
tExpr)
        folder :: (ColumnAlias, Text) -> [(Text, Text)] -> [(Text, Text)]
folder (ColumnAlias Text
alias, Text
attrName) [(Text, Text)]
acc = -- include renamer only if the column is referenced and the renaming is not redundant
          if Text
alias forall a. Eq a => a -> a -> Bool
/= Text
attrName Bool -> Bool -> Bool
&& forall a. Ord a => a -> Set a -> Bool
S.member Text
alias Set Text
whereAttrNames then
             (Text
attrName, Text
alias)forall a. a -> [a] -> [a]
:[(Text, Text)]
acc
             else
            [(Text, Text)]
acc
    
    let dfExpr :: DataFrameExpr
dfExpr = DataFrameExpr { convertExpr :: RelationalExpr
convertExpr = RelationalExpr -> RelationalExpr
whereF (RelationalExpr -> RelationalExpr
disambiguationRenamerF RelationalExpr
fromExpr),
                                 orderExprs :: [AttributeOrderExpr]
orderExprs = [AttributeOrderExpr]
orderExprs',
                                 offset :: Maybe Integer
offset = TableExpr -> Maybe Integer
offsetClause TableExpr
tExpr,
                                 limit :: Maybe Integer
limit = TableExpr -> Maybe Integer
limitClause TableExpr
tExpr }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataFrameExpr
dfExpr, ColumnAliasMap
columnMap)

func :: FunctionName -> [AtomExpr] -> AtomExpr
func :: Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
fname [AtomExprBase ()]
args = forall a. Text -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr Text
fname [AtomExprBase ()]
args ()

convertWhereClause :: TypeForRelExprF -> RestrictionExpr -> ConvertM RestrictionPredicateExpr
convertWhereClause :: TypeForRelExprF
-> RestrictionExpr -> ConvertM RestrictionPredicateExpr
convertWhereClause TypeForRelExprF
typeF (RestrictionExpr ScalarExpr
rexpr) = do
    let wrongType :: AtomType -> ConvertM a
wrongType AtomType
t = forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ AtomType -> AtomType -> SQLError
TypeMismatchError AtomType
t AtomType
BoolAtomType --must be boolean expression
        coalesceBoolF :: AtomExprBase () -> AtomExprBase ()
coalesceBoolF AtomExprBase ()
expr = Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_coalesce_bool" [AtomExprBase ()
expr]
        sqlEq :: [AtomExprBase ()] -> AtomExprBase ()
sqlEq = Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_equals"
    case ScalarExpr
rexpr of
      IntegerLiteral{} -> forall {a}. AtomType -> ConvertM a
wrongType AtomType
IntegerAtomType
      DoubleLiteral{} -> forall {a}. AtomType -> ConvertM a
wrongType AtomType
DoubleAtomType
      NullLiteral{} -> forall {a}. AtomType -> ConvertM a
wrongType AtomType
IntegerAtomType
      StringLiteral{} -> forall {a}. AtomType -> ConvertM a
wrongType AtomType
TextAtomType
      Identifier ColumnName
_i -> forall {a}. AtomType -> ConvertM a
wrongType AtomType
TextAtomType -- could be a better error here
      BooleanLiteral Bool
True -> 
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. RestrictionPredicateExprBase a
TruePredicate
      BooleanLiteral Bool
False ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate forall a. RestrictionPredicateExprBase a
TruePredicate)
      BinaryOperator (Identifier ColumnName
colName) (OperatorName [Text
"="]) ScalarExpr
exprMatch -> do --we don't know here if this results in a boolean expression, so we pass it down
        Text
attrName <- ColumnName -> ConvertM Text
attributeNameForColumnName ColumnName
colName
        AtomExprBase ()
expr' <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
exprMatch
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate (AtomExprBase () -> AtomExprBase ()
coalesceBoolF (Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_equals" [forall a. Text -> AtomExprBase a
AttributeAtomExpr Text
attrName, AtomExprBase ()
expr'])))
      BinaryOperator ScalarExpr
exprA OperatorName
op ScalarExpr
exprB -> do
        AtomExprBase ()
a <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
exprA
        AtomExprBase ()
b <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
exprB
        [AtomExprBase ()] -> AtomExprBase ()
f <- Bool
-> OperatorName -> ConvertM ([AtomExprBase ()] -> AtomExprBase ())
lookupOperator Bool
False OperatorName
op
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate (AtomExprBase () -> AtomExprBase ()
coalesceBoolF ([AtomExprBase ()] -> AtomExprBase ()
f [AtomExprBase ()
a,AtomExprBase ()
b])))
      PostfixOperator ScalarExpr
expr (OperatorName [Text]
ops) -> do
        AtomExprBase ()
expr' <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
expr
        let isnull :: RestrictionPredicateExpr
isnull = forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate (AtomExprBase () -> AtomExprBase ()
coalesceBoolF (Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_isnull" [AtomExprBase ()
expr']))
        case [Text]
ops of
          [Text
"is", Text
"null"] -> 
            forall (f :: * -> *) a. Applicative f => a -> f a
pure RestrictionPredicateExpr
isnull
          [Text
"is", Text
"not", Text
"null"] -> 
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
isnull)
          [Text]
other -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError (Text
"postfix operator: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show [Text]
other))
      InExpr InFlag
inOrNotIn ScalarExpr
sexpr (InList [ScalarExpr]
matches') -> do
        AtomExprBase ()
eqExpr <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
sexpr
        case forall a. [a] -> [a]
reverse [ScalarExpr]
matches' of
         (ScalarExpr
match:[ScalarExpr]
matches) -> do
           AtomExprBase ()
firstItem <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
match
           let predExpr' :: AtomExprBase ()
predExpr' = [AtomExprBase ()] -> AtomExprBase ()
sqlEq [AtomExprBase ()
eqExpr, AtomExprBase ()
firstItem]
               folder :: AtomExprBase () -> ScalarExpr -> ConvertM (AtomExprBase ())
folder AtomExprBase ()
predExpr'' ScalarExpr
sexprItem = do
                 AtomExprBase ()
item <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
sexprItem
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_or" [[AtomExprBase ()] -> AtomExprBase ()
sqlEq [AtomExprBase ()
eqExpr,AtomExprBase ()
item], AtomExprBase ()
predExpr'']
           RestrictionPredicateExpr
res <- forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtomExprBase () -> AtomExprBase ()
coalesceBoolF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM AtomExprBase () -> ScalarExpr -> ConvertM (AtomExprBase ())
folder AtomExprBase ()
predExpr' [ScalarExpr]
matches 
           case InFlag
inOrNotIn of
             InFlag
In -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RestrictionPredicateExpr
res
             InFlag
NotIn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExpr
res)
         [] -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError Text
"empty IN() clause"
      ExistsExpr Select
subQ -> do
        RelationalExpr
relExpr  <- TypeForRelExprF -> Select -> ConvertM RelationalExpr
convertSubSelect TypeForRelExprF
typeF Select
subQ
        --pretty sure I have to rename attributes in both the top-level query and in this one to prevent attribute conflicts- we can't rename all the attributes in the subquery, because the renamer won't know which attributes actually refer to the top-level attributes- should we just prefix all attributes unconditionally or send a signal upstream to rename attributes? FIXME
        let rexpr' :: RelationalExpr
rexpr' = forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project forall a. AttributeNamesBase a
A.empty RelationalExpr
relExpr
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. RelationalExprBase a -> RestrictionPredicateExprBase a
RelationalExprPredicate RelationalExpr
rexpr')
      ScalarExpr
other -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError (Text
"where clause: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ScalarExpr
other))


convertScalarExpr :: TypeForRelExprF -> ScalarExpr -> ConvertM AtomExpr
convertScalarExpr :: TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
expr = do
    let naked :: Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Atom -> AtomExprBase a
NakedAtomExpr
    case ScalarExpr
expr of
      IntegerLiteral Integer
i -> forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Integer -> Atom
IntegerAtom Integer
i)
      DoubleLiteral Double
d -> forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Double -> Atom
DoubleAtom Double
d)
      StringLiteral Text
s -> forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Text -> Atom
TextAtom Text
s)
      BooleanLiteral Bool
True -> forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Bool -> Atom
BoolAtom Bool
True)
      -- pure $ ConstructedAtomExpr "True" [] ()
      BooleanLiteral Bool
False -> forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Bool -> Atom
BoolAtom Bool
False)
      --pure $ ConstructedAtomExpr "False" [] ()
      -- we don't have enough type context with a cast, so we default to text
      ScalarExpr
NullLiteral -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr Text
"SQLNullOfUnknownType" [] ()
      Identifier ColumnName
i -> do
        forall a. Text -> AtomExprBase a
AttributeAtomExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnName -> ConvertM Text
convertColumnName ColumnName
i
      BinaryOperator ScalarExpr
exprA OperatorName
op ScalarExpr
exprB -> do
        AtomExprBase ()
a <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
exprA
        AtomExprBase ()
b <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
exprB
        [AtomExprBase ()] -> AtomExprBase ()
f <- Bool
-> OperatorName -> ConvertM ([AtomExprBase ()] -> AtomExprBase ())
lookupOperator Bool
False OperatorName
op
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [AtomExprBase ()] -> AtomExprBase ()
f [AtomExprBase ()
a,AtomExprBase ()
b]
      FunctionApplication FuncName
funcName' [ScalarExpr]
fargs -> do
        [AtomExprBase ()] -> AtomExprBase ()
func' <- FuncName -> ConvertM ([AtomExprBase ()] -> AtomExprBase ())
lookupFunc FuncName
funcName'
        [AtomExprBase ()]
fargs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF) [ScalarExpr]
fargs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AtomExprBase ()] -> AtomExprBase ()
func' [AtomExprBase ()]
fargs')
      ScalarExpr
other -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError (Text
"scalar expr: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ScalarExpr
other))

-- SQL conflates projection and extension so we use the SQL context name here
convertProjectionScalarExpr :: TypeForRelExprF -> ProjectionScalarExpr -> ConvertM AtomExpr
convertProjectionScalarExpr :: TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF ProjectionScalarExpr
expr = do
    let naked :: Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Atom -> AtomExprBase a
NakedAtomExpr
    case ProjectionScalarExpr
expr of
      IntegerLiteral Integer
i -> forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Integer -> Atom
IntegerAtom Integer
i)
      DoubleLiteral Double
d -> forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Double -> Atom
DoubleAtom Double
d)
      StringLiteral Text
s -> forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Text -> Atom
TextAtom Text
s)
      BooleanLiteral Bool
True ->
        forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Bool -> Atom
BoolAtom Bool
True)
        --pure $ ConstructedAtomExpr "True" [] ()
      BooleanLiteral Bool
False ->
        forall {a}.
Atom
-> StateT TableContext (ExceptT SQLError Identity) (AtomExprBase a)
naked (Bool -> Atom
BoolAtom Bool
False)
        --pure $ ConstructedAtomExpr "False" [] ()
      ProjectionScalarExpr
NullLiteral -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr Text
"SQLNullOfUnknownType" [] ()
      Identifier ColumnProjectionName
i -> do
        forall a. Text -> AtomExprBase a
AttributeAtomExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnProjectionName -> ConvertM Text
convertColumnProjectionName ColumnProjectionName
i
      BinaryOperator ProjectionScalarExpr
exprA OperatorName
op ProjectionScalarExpr
exprB -> do
        AtomExprBase ()
a <- TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF ProjectionScalarExpr
exprA
        AtomExprBase ()
b <- TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF ProjectionScalarExpr
exprB
        [AtomExprBase ()] -> AtomExprBase ()
f <- Bool
-> OperatorName -> ConvertM ([AtomExprBase ()] -> AtomExprBase ())
lookupOperator Bool
False OperatorName
op
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [AtomExprBase ()] -> AtomExprBase ()
f [AtomExprBase ()
a,AtomExprBase ()
b]
      FunctionApplication FuncName
fname [ProjectionScalarExpr]
fargs -> do
        [AtomExprBase ()] -> AtomExprBase ()
func' <- FuncName -> ConvertM ([AtomExprBase ()] -> AtomExprBase ())
lookupFunc FuncName
fname
        -- as a special case, count(*) is valid, if non-sensical SQL, so handle it here
        [AtomExprBase ()]
fargs' <- if FuncName
fname forall a. Eq a => a -> a -> Bool
== [Text] -> FuncName
FuncName [Text
"count"] Bool -> Bool -> Bool
&& [ProjectionScalarExpr]
fargs forall a. Eq a => a -> a -> Bool
== [forall n. n -> ScalarExprBase n
Identifier ([ProjectionName] -> ColumnProjectionName
ColumnProjectionName [ProjectionName
Asterisk])] then
                   forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall a. Text -> AtomExprBase a
AttributeAtomExpr Text
"_sql_aggregate"]
                 else 
                   forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF) [ProjectionScalarExpr]
fargs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AtomExprBase ()] -> AtomExprBase ()
func' [AtomExprBase ()]
fargs')
      PrefixOperator OperatorName
op ProjectionScalarExpr
sexpr -> do
        [AtomExprBase ()] -> AtomExprBase ()
func' <- Bool
-> OperatorName -> ConvertM ([AtomExprBase ()] -> AtomExprBase ())
lookupOperator Bool
True OperatorName
op
        AtomExprBase ()
arg <- TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF ProjectionScalarExpr
sexpr
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AtomExprBase ()] -> AtomExprBase ()
func' [AtomExprBase ()
arg])
      CaseExpr [(ProjectionScalarExpr, ProjectionScalarExpr)]
conditionals Maybe ProjectionScalarExpr
mElse -> do
        let coalesceBoolF :: AtomExprBase () -> AtomExprBase ()
coalesceBoolF AtomExprBase ()
expr' = Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_coalesce_bool" [AtomExprBase ()
expr']
        [(AtomExprBase (), AtomExprBase ())]
conditionals' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(ProjectionScalarExpr
ifExpr, ProjectionScalarExpr
thenExpr) -> do
                                  AtomExprBase ()
ifE <- AtomExprBase () -> AtomExprBase ()
coalesceBoolF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF ProjectionScalarExpr
ifExpr
                                  AtomExprBase ()
thenE <- TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF ProjectionScalarExpr
thenExpr
                                  
                                  forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtomExprBase ()
ifE, AtomExprBase ()
thenE)
                              ) [(ProjectionScalarExpr, ProjectionScalarExpr)]
conditionals

        AtomExprBase ()
elseExpr <- case Maybe ProjectionScalarExpr
mElse of
                      Maybe ProjectionScalarExpr
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Atom -> AtomExprBase a
NakedAtomExpr forall a b. (a -> b) -> a -> b
$ AtomType -> Maybe Atom -> Atom
nullAtom (Text -> AtomType
TypeVariableType Text
"a") forall a. Maybe a
Nothing --will the engine resolve this type variable?
                      Just ProjectionScalarExpr
expr' -> TypeForRelExprF
-> ProjectionScalarExpr -> ConvertM (AtomExprBase ())
convertProjectionScalarExpr TypeForRelExprF
typeF ProjectionScalarExpr
expr'
        let ifThenFolder :: AtomExprBase a
-> (AtomExprBase a, AtomExprBase a) -> AtomExprBase a
ifThenFolder AtomExprBase a
acc (AtomExprBase a
ifE, AtomExprBase a
thenE) = forall a.
AtomExprBase a
-> AtomExprBase a -> AtomExprBase a -> AtomExprBase a
IfThenAtomExpr AtomExprBase a
ifE AtomExprBase a
thenE AtomExprBase a
acc
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}.
AtomExprBase a
-> (AtomExprBase a, AtomExprBase a) -> AtomExprBase a
ifThenFolder AtomExprBase ()
elseExpr [(AtomExprBase (), AtomExprBase ())]
conditionals'
      ProjectionScalarExpr
other -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError (Text
"projection scalar expr: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectionScalarExpr
other))

convertOrderByClause :: TypeForRelExprF -> [SortExpr] -> ConvertM [AttributeOrderExpr]
convertOrderByClause :: TypeForRelExprF -> [SortExpr] -> ConvertM [AttributeOrderExpr]
convertOrderByClause TypeForRelExprF
typeF =
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SortExpr
-> StateT
     TableContext (ExceptT SQLError Identity) AttributeOrderExpr
converter
    where
      converter :: SortExpr
-> StateT
     TableContext (ExceptT SQLError Identity) AttributeOrderExpr
converter (SortExpr ScalarExpr
sexpr Maybe Direction
mDirection Maybe NullsOrder
mNullsOrder) = do
        AtomExprBase ()
atomExpr <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
sexpr
        Text
attrn <- case AtomExprBase ()
atomExpr of
                   AttributeAtomExpr Text
aname -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
aname
                   AtomExprBase ()
x -> forall a. SQLError -> ConvertM a
throwSQLE (Text -> SQLError
NotSupportedError ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show AtomExprBase ()
x)))
        let ordering :: Order
ordering = case Maybe Direction
mDirection of
                         Maybe Direction
Nothing -> Order
AscendingOrder
                         Just Direction
Ascending -> Order
AscendingOrder
                         Just Direction
Descending -> Order
DescendingOrder
        case Maybe NullsOrder
mNullsOrder of
          Maybe NullsOrder
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just NullsOrder
x -> forall a. SQLError -> ConvertM a
throwSQLE (Text -> SQLError
NotSupportedError ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show NullsOrder
x)))
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Order -> AttributeOrderExpr
AttributeOrderExpr Text
attrn Order
ordering)
  

convertWithClause :: TypeForRelExprF -> WithClause -> ConvertM WithNamesAssocs
convertWithClause :: TypeForRelExprF -> WithClause -> ConvertM WithNamesAssocs
convertWithClause TypeForRelExprF
typeF WithClause
wClause =
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM WithExpr
-> StateT
     TableContext
     (ExceptT SQLError Identity)
     (WithNameExprBase (), RelationalExpr)
convertOneWith (forall a. NonEmpty a -> [a]
NE.toList (WithClause -> NonEmpty WithExpr
withExprs WithClause
wClause))
  where
    convertOneWith :: WithExpr
-> StateT
     TableContext
     (ExceptT SQLError Identity)
     (WithNameExprBase (), RelationalExpr)
convertOneWith (WithExpr (WithExprAlias Text
alias) Select
sel) = do
      RelationalExpr
relExpr <- TypeForRelExprF -> Select -> ConvertM RelationalExpr
convertSubSelect TypeForRelExprF
typeF Select
sel
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Text -> a -> WithNameExprBase a
WithNameExpr Text
alias (), RelationalExpr
relExpr)

type ColumnRemap = M.Map ColumnName ColumnName

convertFromClause :: TypeForRelExprF -> [TableRef] -> ConvertM (RelationalExpr, ColumnAliasMap)
convertFromClause :: TypeForRelExprF
-> [TableRef] -> ConvertM (RelationalExpr, ColumnAliasMap)
convertFromClause TypeForRelExprF
typeF (TableRef
firstRef:[TableRef]
trefs) = do
    --the first table ref must be a straight RelationVariable
  let convertFirstTableRef :: TableRef -> ConvertM (RelationalExpr, ColumnAliasMap)
convertFirstTableRef (SimpleTableRef (TableName [Text
nam])) = do
        let rv :: RelationalExpr
rv = forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
nam ()
        Relation
typeR <- TypeForRelExprF -> RelationalExpr -> ConvertM Relation
wrapTypeF TypeForRelExprF
typeF RelationalExpr
rv
        ColumnAliasMap
colMap <- TableAlias
-> RelationalExpr -> Attributes -> ConvertM ColumnAliasMap
insertTable (Text -> TableAlias
TableAlias Text
nam) RelationalExpr
rv (Relation -> Attributes
attributes Relation
typeR)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr
rv, ColumnAliasMap
colMap)
      convertFirstTableRef (AliasedTableRef (SimpleTableRef (TableName [Text
nam])) al :: TableAlias
al@(TableAlias Text
alias)) = do
        let rv :: RelationalExpr
rv = forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
nam ()
        Relation
typeR <- TypeForRelExprF -> RelationalExpr -> ConvertM Relation
wrapTypeF TypeForRelExprF
typeF RelationalExpr
rv
        ColumnAliasMap
colMap <- TableAlias
-> RelationalExpr -> Attributes -> ConvertM ColumnAliasMap
insertTable TableAlias
al RelationalExpr
rv (Relation -> Attributes
attributes Relation
typeR)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
alias (), ColumnAliasMap
colMap)
      convertFirstTableRef TableRef
tref =
        forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError (Text
"first table ref: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show TableRef
tref))
  (RelationalExpr
firstRel, ColumnAliasMap
colMap) <- TableRef -> ConvertM (RelationalExpr, ColumnAliasMap)
convertFirstTableRef TableRef
firstRef
  RelationalExpr
expr' <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (TypeForRelExprF
-> RelationalExpr -> (Int, TableRef) -> ConvertM RelationalExpr
joinTableRef TypeForRelExprF
typeF) RelationalExpr
firstRel (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [TableRef]
trefs)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr
expr', ColumnAliasMap
colMap)
convertFromClause TypeForRelExprF
_ [] = forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError Text
"empty table refs"  

-- | Convert TableRefs after the first one (assumes all additional TableRefs are for joins). Returns the qualified name key that was added to the map, the underlying relexpr (not aliased so that it can used for extracting type information), and the new table context map
convertTableRef :: TypeForRelExprF -> TableRef -> ConvertM (TableAlias, RelationalExpr)
convertTableRef :: TypeForRelExprF
-> TableRef -> ConvertM (TableAlias, RelationalExpr)
convertTableRef TypeForRelExprF
typeF TableRef
tref =
  case TableRef
tref of
    SimpleTableRef (TableName [Text
nam]) -> do
      let rv :: RelationalExpr
rv = forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
nam ()
          ta :: TableAlias
ta = Text -> TableAlias
TableAlias Text
nam
      Relation
typeRel <- TypeForRelExprF -> RelationalExpr -> ConvertM Relation
wrapTypeF TypeForRelExprF
typeF RelationalExpr
rv 
      ColumnAliasMap
_ <- TableAlias
-> RelationalExpr -> Attributes -> ConvertM ColumnAliasMap
insertTable TableAlias
ta RelationalExpr
rv (Relation -> Attributes
attributes Relation
typeRel)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableAlias
ta, RelationalExpr
rv) -- include with clause even for simple cases because we use this mapping to 
    AliasedTableRef (SimpleTableRef (TableName [Text
nam])) TableAlias
tAlias -> do
      Relation
typeRel <- TypeForRelExprF -> RelationalExpr -> ConvertM Relation
wrapTypeF TypeForRelExprF
typeF (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
nam ())
      let rv :: RelationalExpr
rv = forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
nam ()
      ColumnAliasMap
_ <- TableAlias
-> RelationalExpr -> Attributes -> ConvertM ColumnAliasMap
insertTable TableAlias
tAlias RelationalExpr
rv (Relation -> Attributes
attributes Relation
typeRel)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableAlias
tAlias, forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
nam ())
    TableRef
x -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError (Text
"table ref: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show TableRef
x))

  
joinTableRef :: TypeForRelExprF -> RelationalExpr -> (Int, TableRef) -> ConvertM RelationalExpr
joinTableRef :: TypeForRelExprF
-> RelationalExpr -> (Int, TableRef) -> ConvertM RelationalExpr
joinTableRef TypeForRelExprF
typeF RelationalExpr
rvA (Int
_c,TableRef
tref) = do
      -- optionally prefix attributes unelss the expr is a RelationVariable
  let attrRenamer :: Text -> RelationalExpr -> [Text] -> ConvertM RelationalExpr
attrRenamer Text
x RelationalExpr
expr [Text]
attrs = do
        [(Text, Text)]
renamed <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text
-> RelationalExpr
-> Text
-> StateT TableContext (ExceptT SQLError Identity) (Text, Text)
renameOneAttr Text
x RelationalExpr
expr) [Text]
attrs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
Set (Text, Text) -> RelationalExprBase a -> RelationalExprBase a
Rename (forall a. Ord a => [a] -> Set a
S.fromList [(Text, Text)]
renamed) RelationalExpr
expr)
      -- prefix all attributes
      prefixRenamer :: TableAlias
-> RelationalExprBase a
-> [Text]
-> StateT
     TableContext (ExceptT SQLError Identity) (RelationalExprBase a)
prefixRenamer TableAlias
tAlias RelationalExprBase a
expr [Text]
attrs = do
        [(Text, Text)]
renamed <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TableAlias
-> Text
-> StateT TableContext (ExceptT SQLError Identity) (Text, Text)
prefixOneAttr TableAlias
tAlias) [Text]
attrs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
Set (Text, Text) -> RelationalExprBase a -> RelationalExprBase a
Rename (forall a. Ord a => [a] -> Set a
S.fromList [(Text, Text)]
renamed) RelationalExprBase a
expr)
      prefixOneAttr :: TableAlias
-> Text
-> StateT TableContext (ExceptT SQLError Identity) (Text, Text)
prefixOneAttr tAlias :: TableAlias
tAlias@(TableAlias Text
tPrefix) Text
old_name = do
        -- insert into columnAliasMap
        let new_name :: Text
new_name = [Text] -> Text
T.concat [Text
tPrefix, Text
".", Text
old_name]
--        traceShowM ("prefixOneAttr", tAlias, old_name, new_name)
        (ColumnAlias Text
alias) <- Maybe TableAlias
-> ColumnName -> Maybe ColumnAlias -> ConvertM ColumnAlias
noteColumnMention (forall a. a -> Maybe a
Just TableAlias
tAlias) ([Text] -> ColumnName
ColumnName [Text
old_name]) (forall a. a -> Maybe a
Just (Text -> ColumnAlias
ColumnAlias Text
new_name))
--        traceShowM ("joinTableRef prefixOneAttr", alias)
--        traceStateM
--        insertColumnAlias tAlias old_name (ColumnAlias new_name) (ColumnName [new_name])
--        addColumnAlias tAlias (ColumnAlias new_name) old_name
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
old_name, Text
alias)
      renameOneAttr :: Text
-> RelationalExpr
-> Text
-> StateT TableContext (ExceptT SQLError Identity) (Text, Text)
renameOneAttr Text
x RelationalExpr
expr Text
old_name = do
--        traceShowM ("renameOneAttr", old_name, new_name)
        TableAlias -> Text -> ColumnAlias -> ColumnName -> ConvertM ()
insertColumnAlias (Text -> TableAlias
TableAlias Text
prefix) Text
old_name (Text -> ColumnAlias
ColumnAlias Text
new_name) ([Text] -> ColumnName
ColumnName [Text
new_name])
--        addColumnAlias (TableAlias prefix) (ColumnAlias new_name) old_name
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
old_name, Text
new_name)
        where
          new_name :: Text
new_name = [Text] -> Text
T.concat [Text
prefix, Text
".", Text
old_name]
          prefix :: Text
prefix = case RelationalExpr
expr of
            RelationVariable Text
rvName () -> Text
rvName
            RelationalExpr
_ -> Text
x -- probably need to return errors for some expressions
      crossJoin :: TableRef -> ConvertM RelationalExpr
crossJoin TableRef
jtref = do
            --rename all columns to prefix them with a generated alias to prevent any natural join occurring, then perform normal join
            -- we need the type to get all the attribute names for both relexprs
            (TableAlias
_tKey, RelationalExpr
rvB) <- TypeForRelExprF
-> TableRef -> ConvertM (TableAlias, RelationalExpr)
convertTableRef TypeForRelExprF
typeF TableRef
jtref
            case TypeForRelExprF
typeF RelationalExpr
rvA of
              Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
              Right Relation
typeA ->
                case TypeForRelExprF
typeF RelationalExpr
rvB of
                  Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
                  Right Relation
typeB -> do
                    let attrsA :: Set Text
attrsA = Attributes -> Set Text
A.attributeNameSet (Relation -> Attributes
attributes Relation
typeA)
                        attrsB :: Set Text
attrsB = Attributes -> Set Text
A.attributeNameSet (Relation -> Attributes
attributes Relation
typeB)
                        attrsIntersection :: Set Text
attrsIntersection = forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set Text
attrsA Set Text
attrsB
                        --find intersection of attributes and rename all of them with prefix 'expr'+c+'.'
                    RelationalExpr
exprA <- Text -> RelationalExpr -> [Text] -> ConvertM RelationalExpr
attrRenamer Text
"a" RelationalExpr
rvA (forall a. Set a -> [a]
S.toList Set Text
attrsIntersection)
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join RelationalExpr
exprA RelationalExpr
rvB)
  case TableRef
tref of
          SimpleTableRef TableName
tname -> -- a simple table ref in this position implies a cross join (no join condition unless it appears in the where clause)
            TableRef -> ConvertM RelationalExpr
crossJoin (TableName -> TableRef
SimpleTableRef TableName
tname)
          NaturalJoinTableRef TableRef
jtref -> do
            -- then natural join is the only type of join which the relational algebra supports natively
            (TableAlias
_, RelationalExpr
rvB) <- TypeForRelExprF
-> TableRef -> ConvertM (TableAlias, RelationalExpr)
convertTableRef TypeForRelExprF
typeF TableRef
jtref
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join RelationalExpr
rvA RelationalExpr
rvB
          CrossJoinTableRef TableRef
jtref -> TableRef -> ConvertM RelationalExpr
crossJoin TableRef
jtref
          InnerJoinTableRef TableRef
jtref (JoinUsing [UnqualifiedColumnName]
qnames) -> do
            (TableAlias
tKey, RelationalExpr
rvB) <- TypeForRelExprF
-> TableRef -> ConvertM (TableAlias, RelationalExpr)
convertTableRef TypeForRelExprF
typeF TableRef
jtref
            let jCondAttrs :: Set Text
jCondAttrs = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map UnqualifiedColumnName -> Text
convertUnqualifiedColumnName [UnqualifiedColumnName]
qnames
            (Set Text
attrsIntersection, Set Text
_attrsA, Set Text
_attrsB) <- TypeForRelExprF
-> RelationalExpr
-> RelationalExpr
-> ConvertM (Set Text, Set Text, Set Text)
commonAttributeNames TypeForRelExprF
typeF RelationalExpr
rvA RelationalExpr
rvB
            --rename attributes used in the join condition
            let attrsToRename :: Set Text
attrsToRename = forall a. Ord a => Set a -> Set a -> Set a
S.difference Set Text
attrsIntersection Set Text
jCondAttrs
--            traceShowM ("inner", attrsToRename, attrsIntersection, jCondAttrs)
                rvNameB :: Text
rvNameB = case TableAlias
tKey of
                            TableAlias Text
ta -> Text
ta
            RelationalExpr
exprA <- Text -> RelationalExpr -> [Text] -> ConvertM RelationalExpr
attrRenamer Text
"a" RelationalExpr
rvA (forall a. Set a -> [a]
S.toList Set Text
attrsToRename)
            RelationalExpr
exprB <- forall {a}.
TableAlias
-> RelationalExprBase a
-> [Text]
-> StateT
     TableContext (ExceptT SQLError Identity) (RelationalExprBase a)
prefixRenamer TableAlias
tKey (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
rvNameB ()) (forall a. Set a -> [a]
S.toList Set Text
attrsToRename)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join RelationalExpr
exprA RelationalExpr
exprB)
            
          InnerJoinTableRef TableRef
jtref (JoinOn (JoinOnCondition ScalarExpr
joinExpr)) -> do
            --create a cross join but extend with the boolean sexpr
            --extend the table with the join conditions, then join on those
            --exception: for simple attribute equality, use regular join renames using JoinOn logic
            
            (TableAlias
tKey, RelationalExpr
rvB) <- TypeForRelExprF
-> TableRef -> ConvertM (TableAlias, RelationalExpr)
convertTableRef TypeForRelExprF
typeF TableRef
jtref
            --rvA and rvB now reference potentially aliased relation variables (needs with clause to execute), but this is useful for making attributes rv-prefixed
            --extract all table aliases to create a remapping for SQL names discovered in the sexpr
            
            RelationalExpr -> RelationalExpr
withExpr <- forall a.
WithNamesAssocsBase a
-> RelationalExprBase a -> RelationalExprBase a
With forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConvertM WithNamesAssocs
tableAliasesAsWithNameAssocs
            (Set Text
_commonAttrs, Set Text
attrsA, Set Text
attrsB) <- TypeForRelExprF
-> RelationalExpr
-> RelationalExpr
-> ConvertM (Set Text, Set Text, Set Text)
commonAttributeNames TypeForRelExprF
typeF (RelationalExpr -> RelationalExpr
withExpr RelationalExpr
rvA) (RelationalExpr -> RelationalExpr
withExpr RelationalExpr
rvB)
            -- first, execute the rename, renaming all attributes according to their table aliases
            let rvPrefix :: RelationalExpr -> ConvertM Text
rvPrefix RelationalExpr
rvExpr =
                  case RelationalExpr
rvExpr of
                    RelationVariable Text
nam () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
nam
                    RelationalExpr
x -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError (Text
"cannot derived name for relational expression " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show RelationalExpr
x))
                   
                rvNameB :: Text
rvNameB = case TableAlias
tKey of
                             TableAlias Text
ta -> Text
ta
            Text
rvNameA <- RelationalExpr -> ConvertM Text
rvPrefix RelationalExpr
rvA
--            rvPrefixB <- rvPrefix rvB
            RelationalExpr
exprA <- forall {a}.
TableAlias
-> RelationalExprBase a
-> [Text]
-> StateT
     TableContext (ExceptT SQLError Identity) (RelationalExprBase a)
prefixRenamer (Text -> TableAlias
TableAlias Text
rvNameA) RelationalExpr
rvA (forall a. Set a -> [a]
S.toList Set Text
attrsA)
            RelationalExpr
exprB <- forall {a}.
TableAlias
-> RelationalExprBase a
-> [Text]
-> StateT
     TableContext (ExceptT SQLError Identity) (RelationalExprBase a)
prefixRenamer TableAlias
tKey (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
rvNameB ()) (forall a. Set a -> [a]
S.toList Set Text
attrsB)
            -- for the join condition, we can potentially extend to include all the join criteria columns, then project them away after constructing the join condition
            AtomExprBase ()
joinRe <- TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
joinExpr --' why are we renaming here- can't we call attributenameforcolumnname in the scalarexpr conversion???
            --let joinCommonAttrRenamer (RelationVariable rvName ()) old_name =
            --rename all common attrs and use the new names in the join condition
            let allAttrs :: Set Text
allAttrs = forall a. Ord a => Set a -> Set a -> Set a
S.union Set Text
attrsA Set Text
attrsB
                firstAvailableName :: t -> Set Text -> Text
firstAvailableName t
c Set Text
allAttrs' =
                  let new_name :: Text
new_name = [Char] -> Text
T.pack ([Char]
"join_" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show t
c) in
                  if forall a. Ord a => a -> Set a -> Bool
S.member Text
new_name Set Text
allAttrs' then
                    t -> Set Text -> Text
firstAvailableName (t
c forall a. Num a => a -> a -> a
+ t
1) Set Text
allAttrs'
                    else
                    Text
new_name
                joinName :: Text
joinName = forall {t}. (Show t, Num t) => t -> Set Text -> Text
firstAvailableName (Int
1::Int) Set Text
allAttrs
                extender :: ExtendTupleExpr
extender = forall a. Text -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr Text
joinName (Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_coalesce_bool" [AtomExprBase ()
joinRe])
                --joinMatchRestriction = Restrict (AttributeEqualityPredicate joinName (ConstructedAtomExpr "True" [] ()))
                joinMatchRestriction :: RelationalExpr -> RelationalExpr
joinMatchRestriction = forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (forall a. Text -> AtomExprBase a -> RestrictionPredicateExprBase a
AttributeEqualityPredicate Text
joinName (forall a. Atom -> AtomExprBase a
NakedAtomExpr (Bool -> Atom
BoolAtom Bool
True)))
                projectAwayJoinMatch :: RelationalExpr -> RelationalExpr
projectAwayJoinMatch = forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (forall a. Set Text -> AttributeNamesBase a
InvertedAttributeNames (forall a. Ord a => [a] -> Set a
S.fromList [Text
joinName]))
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalExpr -> RelationalExpr
projectAwayJoinMatch (RelationalExpr -> RelationalExpr
joinMatchRestriction (forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend ExtendTupleExpr
extender (forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join RelationalExpr
exprB RelationalExpr
exprA))))
          TableRef
other -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError (Text
"join: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show TableRef
other))

lookupOperator :: Bool -> OperatorName -> ConvertM ([AtomExpr] -> AtomExpr)
lookupOperator :: Bool
-> OperatorName -> ConvertM ([AtomExprBase ()] -> AtomExprBase ())
lookupOperator Bool
isPrefix op :: OperatorName
op@(OperatorName [Text]
nam)
  | Bool
isPrefix = do
      let f :: Text -> [AtomExprBase ()] -> AtomExprBase ()
f = Text -> [AtomExprBase ()] -> AtomExprBase ()
func
      case [Text]
nam of
        [Text
"-"] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_negate"
        [Text]
_ -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ OperatorName -> SQLError
NoSuchSQLOperatorError OperatorName
op
  | Bool
otherwise =
      FuncName -> ConvertM ([AtomExprBase ()] -> AtomExprBase ())
lookupFunc ([Text] -> FuncName
FuncName [Text]
nam)


-- this could be amended to support more complex expressions such as coalesce by returning an [AtomExpr] -> AtomExpr function
lookupFunc :: FuncName -> ConvertM ([AtomExpr] -> AtomExpr)
lookupFunc :: FuncName -> ConvertM ([AtomExprBase ()] -> AtomExprBase ())
lookupFunc FuncName
qname =
  case FuncName
qname of
    FuncName [Text
nam] ->
      case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
nam [(Text, [AtomExprBase ()] -> AtomExprBase ())]
sqlFuncs of
        Maybe ([AtomExprBase ()] -> AtomExprBase ())
Nothing -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ FuncName -> SQLError
NoSuchSQLFunctionError FuncName
qname
        Just [AtomExprBase ()] -> AtomExprBase ()
match -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [AtomExprBase ()] -> AtomExprBase ()
match
    FuncName
other -> forall a. SQLError -> ConvertM a
throwSQLE forall a b. (a -> b) -> a -> b
$ Text -> SQLError
NotSupportedError (Text
"function name: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show FuncName
other))
  where
    f :: Text -> [AtomExprBase ()] -> AtomExprBase ()
f = Text -> [AtomExprBase ()] -> AtomExprBase ()
func
    aggMapper :: (FuncName, Text) -> (Text, [AtomExprBase ()] -> AtomExprBase ())
aggMapper (FuncName [Text
nam], Text
nam') = (Text
nam, Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
nam')
    aggMapper (FuncName [Text]
other,Text
_) = forall a. HasCallStack => [Char] -> a
error ([Char]
"unexpected multi-component SQL aggregate function: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Text]
other)
    sqlFuncs :: [(Text, [AtomExprBase ()] -> AtomExprBase ())]
sqlFuncs = [(Text
">",Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_gt"),
                 (Text
"<",Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_lt"),
                 (Text
">=",Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_gte"),
                 (Text
"<=",Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_lte"),
                 (Text
"=",Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_equals"),
                 (Text
"!=",Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_not_equals"), -- function missing
                 (Text
"<>",Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_not_equals"), -- function missing
                 (Text
"+", Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_add"),
                 (Text
"and", Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_and"),
                 (Text
"or", Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_or"),
                 (Text
"abs", Text -> [AtomExprBase ()] -> AtomExprBase ()
f Text
"sql_abs")
               ] forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (FuncName, Text) -> (Text, [AtomExprBase ()] -> AtomExprBase ())
aggMapper [(FuncName, Text)]
aggregateFunctionsMap


-- | Used in join condition detection necessary for renames to enable natural joins.
commonAttributeNames :: TypeForRelExprF -> RelationalExpr -> RelationalExpr -> ConvertM (S.Set AttributeName, S.Set AttributeName, S.Set AttributeName)
commonAttributeNames :: TypeForRelExprF
-> RelationalExpr
-> RelationalExpr
-> ConvertM (Set Text, Set Text, Set Text)
commonAttributeNames TypeForRelExprF
typeF RelationalExpr
rvA RelationalExpr
rvB =
  case TypeForRelExprF
typeF RelationalExpr
rvA of
    Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
    Right Relation
typeA ->
      case TypeForRelExprF
typeF RelationalExpr
rvB of
        Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
        Right Relation
typeB -> do
          let attrsA :: Set Text
attrsA = Attributes -> Set Text
A.attributeNameSet (Relation -> Attributes
attributes Relation
typeA)
              attrsB :: Set Text
attrsB = Attributes -> Set Text
A.attributeNameSet (Relation -> Attributes
attributes Relation
typeB)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set Text
attrsA Set Text
attrsB, Set Text
attrsA, Set Text
attrsB)

-- | Used to remap SQL qualified names to new names to prevent conflicts in join conditions.
renameIdentifier :: (ColumnName -> ColumnName) -> ScalarExpr -> ScalarExpr
renameIdentifier :: (ColumnName -> ColumnName) -> ScalarExpr -> ScalarExpr
renameIdentifier ColumnName -> ColumnName
renamer = forall t a. Recursive t => (Base t a -> a) -> t -> a
Fold.cata ScalarExprBaseF ColumnName ScalarExpr -> ScalarExpr
renamer'
  where
    renamer' :: ScalarExprBaseF ColumnName ScalarExpr -> ScalarExpr
    renamer' :: ScalarExprBaseF ColumnName ScalarExpr -> ScalarExpr
renamer' (IdentifierF ColumnName
n) = forall n. n -> ScalarExprBase n
Identifier (ColumnName -> ColumnName
renamer ColumnName
n)
    renamer' ScalarExprBaseF ColumnName ScalarExpr
x = forall t. Corecursive t => Base t t -> t
Fold.embed ScalarExprBaseF ColumnName ScalarExpr
x

-- find all column aliases in a scalar expression- useful for determining if a renamer needs to be applied
columnNamesInScalarExpr :: ScalarExpr -> S.Set ColumnName
columnNamesInScalarExpr :: ScalarExpr -> Set ColumnName
columnNamesInScalarExpr = forall t a. Recursive t => (Base t a -> a) -> t -> a
Fold.cata ScalarExprBaseF ColumnName (Set ColumnName) -> Set ColumnName
finder
  where
    finder :: ScalarExprBaseF ColumnName (S.Set ColumnName) -> S.Set ColumnName
    finder :: ScalarExprBaseF ColumnName (Set ColumnName) -> Set ColumnName
finder (IdentifierF ColumnName
n) = forall a. a -> Set a
S.singleton ColumnName
n
    finder ScalarExprBaseF ColumnName (Set ColumnName)
sexpr = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => Set a -> Set a -> Set a
S.union forall a. Monoid a => a
mempty ScalarExprBaseF ColumnName (Set ColumnName)
sexpr

columnNamesInRestrictionExpr :: RestrictionExpr -> S.Set ColumnName
columnNamesInRestrictionExpr :: RestrictionExpr -> Set ColumnName
columnNamesInRestrictionExpr (RestrictionExpr ScalarExpr
sexpr) = ScalarExpr -> Set ColumnName
columnNamesInScalarExpr ScalarExpr
sexpr

-- | If the restriction includes a EXISTS expression, we must rename all attributes at the top-level to prevent conflicts.
needsToRenameAllAttributes :: RestrictionExpr -> Bool
needsToRenameAllAttributes :: RestrictionExpr -> Bool
needsToRenameAllAttributes (RestrictionExpr ScalarExpr
sexpr) =
  forall {n}. ScalarExprBase n -> Bool
rec' ScalarExpr
sexpr
  where
  rec' :: ScalarExprBase n -> Bool
rec' ScalarExprBase n
sexpr' =
    case ScalarExprBase n
sexpr' of
      DoubleLiteral{} -> Bool
False
      StringLiteral{} -> Bool
False
      IntegerLiteral{} -> Bool
False
      NullLiteral{} -> Bool
False
      BooleanLiteral{} -> Bool
False
      Identifier{} -> Bool
False
      BinaryOperator ScalarExprBase n
e1 OperatorName
_ ScalarExprBase n
e2 -> ScalarExprBase n -> Bool
rec' ScalarExprBase n
e1 Bool -> Bool -> Bool
|| ScalarExprBase n -> Bool
rec' ScalarExprBase n
e2
      PrefixOperator OperatorName
_ ScalarExprBase n
e1 -> ScalarExprBase n -> Bool
rec' ScalarExprBase n
e1
      PostfixOperator ScalarExprBase n
e1 OperatorName
_ -> ScalarExprBase n -> Bool
rec' ScalarExprBase n
e1
      BetweenOperator ScalarExprBase n
e1 ScalarExprBase n
_ ScalarExprBase n
e2 -> ScalarExprBase n -> Bool
rec' ScalarExprBase n
e1 Bool -> Bool -> Bool
|| ScalarExprBase n -> Bool
rec' ScalarExprBase n
e2
      FunctionApplication FuncName
_ [ScalarExprBase n]
e1 -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ScalarExprBase n -> Bool
rec' [ScalarExprBase n]
e1
      CaseExpr [(ScalarExprBase n, ScalarExprBase n)]
cases Maybe (ScalarExprBase n)
else' -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ScalarExprBase n
when', ScalarExprBase n
then') ->
                                          ScalarExprBase n -> Bool
rec' ScalarExprBase n
when' Bool -> Bool -> Bool
|| ScalarExprBase n -> Bool
rec' ScalarExprBase n
then' Bool -> Bool -> Bool
|| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ScalarExprBase n -> Bool
rec' Maybe (ScalarExprBase n)
else') [(ScalarExprBase n, ScalarExprBase n)]
cases
      QuantifiedComparison{} -> Bool
True
      InExpr InFlag
_ ScalarExprBase n
sexpr'' InPredicateValue
_ -> ScalarExprBase n -> Bool
rec' ScalarExprBase n
sexpr''
      BooleanOperatorExpr ScalarExprBase n
e1 BoolOp
_ ScalarExprBase n
e2 -> ScalarExprBase n -> Bool
rec' ScalarExprBase n
e1 Bool -> Bool -> Bool
|| ScalarExprBase n -> Bool
rec' ScalarExprBase n
e2
      ExistsExpr{} -> Bool
True

{-
":showexpr relation{tuple{val 4, children relation{tuple{val 6,children relation{tuple{}}}}},
                   tuple{val 10, children relation{tuple{val 1, children relation{tuple{}}},
                                                   tuple{val 2, children relation{tuple{}}}}}}
-}

-- rename an attribute within a relational expression
-- this really should be generalized to a standard fold or via recursion schemes
pushDownAttributeRename :: S.Set (AttributeName, AttributeName) -> RelationalExpr -> RelationalExpr -> RelationalExpr
pushDownAttributeRename :: Set (Text, Text)
-> RelationalExpr -> RelationalExpr -> RelationalExpr
pushDownAttributeRename Set (Text, Text)
renameSet RelationalExpr
matchExpr RelationalExpr
targetExpr =
  case RelationalExpr
targetExpr of
    RelationalExpr
_ | RelationalExpr
targetExpr forall a. Eq a => a -> a -> Bool
== RelationalExpr
matchExpr ->
        forall a.
Set (Text, Text) -> RelationalExprBase a -> RelationalExprBase a
Rename Set (Text, Text)
renameSet RelationalExpr
targetExpr
    x :: RelationalExpr
x@MakeRelationFromExprs{} -> RelationalExpr
x
    x :: RelationalExpr
x@MakeStaticRelation{} -> RelationalExpr
x
    x :: RelationalExpr
x@ExistingRelation{} -> RelationalExpr
x
    x :: RelationalExpr
x@RelationValuedAttribute{} -> RelationalExpr
x
    x :: RelationalExpr
x@RelationVariable{} -> RelationalExpr
x
    Project AttributeNamesBase ()
attrs RelationalExpr
expr -> forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNamesBase ()
attrs (RelationalExpr -> RelationalExpr
push RelationalExpr
expr)
    Union RelationalExpr
exprA RelationalExpr
exprB -> forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union (RelationalExpr -> RelationalExpr
push RelationalExpr
exprA) (RelationalExpr -> RelationalExpr
push RelationalExpr
exprB)
    Join RelationalExpr
exprA RelationalExpr
exprB -> forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join (RelationalExpr -> RelationalExpr
push RelationalExpr
exprA) (RelationalExpr -> RelationalExpr
push RelationalExpr
exprB)
    Rename Set (Text, Text)
rset RelationalExpr
expr -> forall a.
Set (Text, Text) -> RelationalExprBase a -> RelationalExprBase a
Rename (forall a. Ord a => Set a -> Set a -> Set a
S.union Set (Text, Text)
rset Set (Text, Text)
renameSet) (RelationalExpr -> RelationalExpr
push RelationalExpr
expr)
    Difference RelationalExpr
exprA RelationalExpr
exprB -> forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Difference (RelationalExpr -> RelationalExpr
push RelationalExpr
exprA) (RelationalExpr -> RelationalExpr
push RelationalExpr
exprB)
    B.Group AttributeNamesBase ()
gAttrs Text
newAttr RelationalExpr
expr -> forall a.
AttributeNamesBase a
-> Text -> RelationalExprBase a -> RelationalExprBase a
B.Group AttributeNamesBase ()
gAttrs Text
newAttr (RelationalExpr -> RelationalExpr
push RelationalExpr
expr)
    Ungroup Text
attrName RelationalExpr
expr -> forall a. Text -> RelationalExprBase a -> RelationalExprBase a
Ungroup Text
attrName (RelationalExpr -> RelationalExpr
push RelationalExpr
expr)
    Restrict RestrictionPredicateExpr
rExpr RelationalExpr
expr -> forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExpr -> RestrictionPredicateExpr
pushRestrict RestrictionPredicateExpr
rExpr) (RelationalExpr -> RelationalExpr
push RelationalExpr
expr)
    Equals RelationalExpr
exprA RelationalExpr
exprB -> forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Equals (RelationalExpr -> RelationalExpr
push RelationalExpr
exprA) (RelationalExpr -> RelationalExpr
push RelationalExpr
exprB)
    NotEquals RelationalExpr
exprA RelationalExpr
exprB -> forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
NotEquals (RelationalExpr -> RelationalExpr
push RelationalExpr
exprA) (RelationalExpr -> RelationalExpr
push RelationalExpr
exprB)
    Extend ExtendTupleExpr
eExpr RelationalExpr
expr -> forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (ExtendTupleExpr -> ExtendTupleExpr
pushExtend ExtendTupleExpr
eExpr) (RelationalExpr -> RelationalExpr
push RelationalExpr
expr)
    With WithNamesAssocs
wAssocs RelationalExpr
expr -> forall a.
WithNamesAssocsBase a
-> RelationalExprBase a -> RelationalExprBase a
With WithNamesAssocs
wAssocs (RelationalExpr -> RelationalExpr
push RelationalExpr
expr)
  where
    push :: RelationalExpr -> RelationalExpr
push = Set (Text, Text)
-> RelationalExpr -> RelationalExpr -> RelationalExpr
pushDownAttributeRename Set (Text, Text)
renameSet RelationalExpr
matchExpr
    pushRestrict :: RestrictionPredicateExpr -> RestrictionPredicateExpr
pushRestrict RestrictionPredicateExpr
expr =
      case RestrictionPredicateExpr
expr of
        x :: RestrictionPredicateExpr
x@RestrictionPredicateExpr
TruePredicate -> RestrictionPredicateExpr
x
        AndPredicate RestrictionPredicateExpr
eA RestrictionPredicateExpr
eB -> forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate (RestrictionPredicateExpr -> RestrictionPredicateExpr
pushRestrict RestrictionPredicateExpr
eA) (RestrictionPredicateExpr -> RestrictionPredicateExpr
pushRestrict RestrictionPredicateExpr
eB)
        OrPredicate RestrictionPredicateExpr
eA RestrictionPredicateExpr
eB -> forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
OrPredicate (RestrictionPredicateExpr -> RestrictionPredicateExpr
pushRestrict RestrictionPredicateExpr
eA) (RestrictionPredicateExpr -> RestrictionPredicateExpr
pushRestrict RestrictionPredicateExpr
eB)
        NotPredicate RestrictionPredicateExpr
e -> forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate (RestrictionPredicateExpr -> RestrictionPredicateExpr
pushRestrict RestrictionPredicateExpr
e)
        RelationalExprPredicate RelationalExpr
rexpr -> forall a. RelationalExprBase a -> RestrictionPredicateExprBase a
RelationalExprPredicate (RelationalExpr -> RelationalExpr
push RelationalExpr
rexpr)
        AtomExprPredicate AtomExprBase ()
aexpr -> forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate (AtomExprBase () -> AtomExprBase ()
pushAtom AtomExprBase ()
aexpr)
        AttributeEqualityPredicate Text
attr AtomExprBase ()
aexpr -> forall a. Text -> AtomExprBase a -> RestrictionPredicateExprBase a
AttributeEqualityPredicate Text
attr (AtomExprBase () -> AtomExprBase ()
pushAtom AtomExprBase ()
aexpr)
    pushExtend :: ExtendTupleExpr -> ExtendTupleExpr
pushExtend (AttributeExtendTupleExpr Text
attrName AtomExprBase ()
aexpr) =
      --should this rename the attrName, too?
      forall a. Text -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr Text
attrName (AtomExprBase () -> AtomExprBase ()
pushAtom AtomExprBase ()
aexpr)
    pushAtom :: AtomExprBase () -> AtomExprBase ()
pushAtom AtomExprBase ()
expr =
      case AtomExprBase ()
expr of
        x :: AtomExprBase ()
x@AttributeAtomExpr{} -> AtomExprBase ()
x --potential rename
        x :: AtomExprBase ()
x@NakedAtomExpr{} -> AtomExprBase ()
x
        x :: AtomExprBase ()
x@SubrelationAttributeAtomExpr{} -> AtomExprBase ()
x 
        FunctionAtomExpr Text
fname [AtomExprBase ()]
args () -> forall a. Text -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr Text
fname (AtomExprBase () -> AtomExprBase ()
pushAtom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AtomExprBase ()]
args) ()
        RelationAtomExpr RelationalExpr
e -> forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr (RelationalExpr -> RelationalExpr
push RelationalExpr
e)
        IfThenAtomExpr AtomExprBase ()
ifE AtomExprBase ()
thenE AtomExprBase ()
elseE -> forall a.
AtomExprBase a
-> AtomExprBase a -> AtomExprBase a -> AtomExprBase a
IfThenAtomExpr (AtomExprBase () -> AtomExprBase ()
pushAtom AtomExprBase ()
ifE) (AtomExprBase () -> AtomExprBase ()
pushAtom AtomExprBase ()
thenE) (AtomExprBase () -> AtomExprBase ()
pushAtom AtomExprBase ()
elseE)
        ConstructedAtomExpr Text
dConsName [AtomExprBase ()]
args () -> forall a. Text -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr Text
dConsName (AtomExprBase () -> AtomExprBase ()
pushAtom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AtomExprBase ()]
args) ()
        
mkTableContextFromDatabaseContext :: DatabaseContext -> TransactionGraph -> Either RelationalError TableContext
mkTableContextFromDatabaseContext :: DatabaseContext
-> TransactionGraph -> Either RelationalError TableContext
mkTableContextFromDatabaseContext DatabaseContext
dbc TransactionGraph
tgraph = do
  Map TableAlias (RelationalExpr, Attributes, ColumnAliasRemapper)
-> TableContext
TableContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, GraphRefRelationalExpr)
-> Either
     RelationalError
     (TableAlias, (RelationalExpr, Attributes, ColumnAliasRemapper))
rvMapper (forall k a. Map k a -> [(k, a)]
M.toList (DatabaseContext -> RelationVariables
relationVariables DatabaseContext
dbc))
  where
    rvMapper :: (Text, GraphRefRelationalExpr)
-> Either
     RelationalError
     (TableAlias, (RelationalExpr, Attributes, ColumnAliasRemapper))
rvMapper (Text
nam, GraphRefRelationalExpr
rvexpr) = do
      let gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (forall a. a -> Maybe a
Just DatabaseContext
dbc) TransactionGraph
tgraph
      Relation
typeRel <- forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
rvexpr)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> TableAlias
TableAlias Text
nam,
            (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
nam (), Relation -> Attributes
attributes Relation
typeRel, forall a. Monoid a => a
mempty))

convertUpdate :: TypeForRelExprF -> Update -> ConvertM DatabaseContextExpr
convertUpdate :: TypeForRelExprF -> Update -> ConvertM DatabaseContextExpr
convertUpdate TypeForRelExprF
typeF Update
up = do
  let convertSetColumns :: (UnqualifiedColumnName, ScalarExpr)
-> StateT
     TableContext (ExceptT SQLError Identity) (Text, AtomExprBase ())
convertSetColumns (UnqualifiedColumnName Text
colName, ScalarExpr
sexpr) = do
        (,) Text
colName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeForRelExprF -> ScalarExpr -> ConvertM (AtomExprBase ())
convertScalarExpr TypeForRelExprF
typeF ScalarExpr
sexpr
  Map Text (AtomExprBase ())
atomMap <- forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (UnqualifiedColumnName, ScalarExpr)
-> StateT
     TableContext (ExceptT SQLError Identity) (Text, AtomExprBase ())
convertSetColumns (Update -> [(UnqualifiedColumnName, ScalarExpr)]
setColumns Update
up)
  Text
rvname <- TableName -> ConvertM Text
convertTableName (Update -> TableName
Update.target Update
up)
  let rv :: RelationalExpr
rv = forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
rvname ()  
  case TypeForRelExprF
typeF RelationalExpr
rv of
    Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
    Right Relation
typeRel -> do
      ColumnAliasMap
_ <- TableAlias
-> RelationalExpr -> Attributes -> ConvertM ColumnAliasMap
insertTable (Text -> TableAlias
TableAlias Text
rvname) RelationalExpr
rv (Relation -> Attributes
attributes Relation
typeRel)
      RestrictionPredicateExpr
restrictionExpr <- case Update -> Maybe RestrictionExpr
mRestriction Update
up of
                           Maybe RestrictionExpr
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. RestrictionPredicateExprBase a
TruePredicate
                           Just RestrictionExpr
restriction' -> TypeForRelExprF
-> RestrictionExpr -> ConvertM RestrictionPredicateExpr
convertWhereClause TypeForRelExprF
typeF RestrictionExpr
restriction'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
Text
-> Map Text (AtomExprBase ())
-> RestrictionPredicateExprBase a
-> DatabaseContextExprBase a
B.Update Text
rvname Map Text (AtomExprBase ())
atomMap RestrictionPredicateExpr
restrictionExpr)

convertTableName :: TableName -> ConvertM RelVarName
convertTableName :: TableName -> ConvertM Text
convertTableName (TableName [Text
tname]) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
tname
convertTableName t :: TableName
t@TableName{} = forall a. SQLError -> ConvertM a
throwSQLE (TableName -> SQLError
UnexpectedTableNameError TableName
t)

convertDBUpdates :: TypeForRelExprF -> [DBUpdate] -> ConvertM DatabaseContextExpr
convertDBUpdates :: TypeForRelExprF -> [DBUpdate] -> ConvertM DatabaseContextExpr
convertDBUpdates TypeForRelExprF
typeF [DBUpdate]
dbUpdates = forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TypeForRelExprF -> DBUpdate -> ConvertM DatabaseContextExpr
convertDBUpdate TypeForRelExprF
typeF) [DBUpdate]
dbUpdates

convertDBUpdate :: TypeForRelExprF -> DBUpdate -> ConvertM DatabaseContextExpr
convertDBUpdate :: TypeForRelExprF -> DBUpdate -> ConvertM DatabaseContextExpr
convertDBUpdate TypeForRelExprF
typeF (UpdateUpdate Update
up) = TypeForRelExprF -> Update -> ConvertM DatabaseContextExpr
convertUpdate TypeForRelExprF
typeF Update
up
convertDBUpdate TypeForRelExprF
typeF (UpdateInsert Insert
ins) = TypeForRelExprF -> Insert -> ConvertM DatabaseContextExpr
convertInsert TypeForRelExprF
typeF Insert
ins
convertDBUpdate TypeForRelExprF
typeF (UpdateDelete Delete
del) = TypeForRelExprF -> Delete -> ConvertM DatabaseContextExpr
convertDelete TypeForRelExprF
typeF Delete
del
convertDBUpdate TypeForRelExprF
typeF (UpdateCreateTable CreateTable
ct) = TypeForRelExprF -> CreateTable -> ConvertM DatabaseContextExpr
convertCreateTable TypeForRelExprF
typeF CreateTable
ct
convertDBUpdate TypeForRelExprF
typeF (UpdateDropTable DropTable
dt) = TypeForRelExprF -> DropTable -> ConvertM DatabaseContextExpr
convertDropTable TypeForRelExprF
typeF DropTable
dt

convertInsert :: TypeForRelExprF -> Insert -> ConvertM DatabaseContextExpr
convertInsert :: TypeForRelExprF -> Insert -> ConvertM DatabaseContextExpr
convertInsert TypeForRelExprF
typeF Insert
ins = do
  -- check that all columns are mentioned because Project:M36 does not support default columns
  Text
rvTarget <- TableName -> ConvertM Text
convertTableName (Insert -> TableName
Insert.target Insert
ins)
  let eRvTargetType :: Either RelationalError Relation
eRvTargetType = TypeForRelExprF
typeF (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
rvTarget ())
  case Either RelationalError Relation
eRvTargetType of
    Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
    Right Relation
rvTargetType -> do
      -- if types do not align due to nullability, then add SQLJust
      DataFrameExpr
dfExpr <- TypeForRelExprF -> Query -> ConvertM DataFrameExpr
convertQuery TypeForRelExprF
typeF (Insert -> Query
source Insert
ins)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DataFrameExpr -> Bool
usesDataFrameFeatures DataFrameExpr
dfExpr) forall a b. (a -> b) -> a -> b
$ forall a. SQLError -> ConvertM a
throwSQLE (Text -> SQLError
NotSupportedError Text
"ORDER BY/LIMIT/OFFSET in subquery")
      case TypeForRelExprF
typeF (DataFrameExpr -> RelationalExpr
convertExpr DataFrameExpr
dfExpr) of
        Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
        Right Relation
rvExprType -> do
          let rvExprAttrNames :: [Text]
rvExprAttrNames = Attributes -> [Text]
A.attributeNamesList (Relation -> Attributes
attributes Relation
rvExprType)
              insAttrNames :: [Text]
insAttrNames = forall a b. (a -> b) -> [a] -> [b]
map UnqualifiedColumnName -> Text
convertUnqualifiedColumnName (Insert -> [UnqualifiedColumnName]
Insert.targetColumns Insert
ins)
              rvExprColNameSet :: Set UnqualifiedColumnName
rvExprColNameSet = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Text -> UnqualifiedColumnName
UnqualifiedColumnName (forall a. Ord a => [a] -> Set a
S.fromList [Text]
rvExprAttrNames)
              insAttrColSet :: Set UnqualifiedColumnName
insAttrColSet = forall a. Ord a => [a] -> Set a
S.fromList (Insert -> [UnqualifiedColumnName]
Insert.targetColumns Insert
ins)
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
rvExprAttrNames forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
insAttrNames) forall a b. (a -> b) -> a -> b
$ forall a. SQLError -> ConvertM a
throwSQLE (Set UnqualifiedColumnName -> Set UnqualifiedColumnName -> SQLError
ColumnNamesMismatch Set UnqualifiedColumnName
rvExprColNameSet Set UnqualifiedColumnName
insAttrColSet)
    

          -- insert into s(s#,sname,city,status) select * from s; -- we need to reorder attributes to align?
          -- rename attributes rexpr via query/values to map to targetCol attrs
          let atomTypeForName' :: Text -> Relation -> ConvertM AtomType
atomTypeForName' Text
attrName Relation
type' =
                case Text -> Relation -> Either RelationalError AtomType
atomTypeForName Text
attrName Relation
type' of
                  Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
                  Right AtomType
targetType -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomType
targetType
              ren :: Text -> Text -> RelationalExprBase a -> RelationalExprBase a
ren Text
a Text
b (Rename Set (Text, Text)
names RelationalExprBase a
expr) = forall a.
Set (Text, Text) -> RelationalExprBase a -> RelationalExprBase a
Rename (forall a. Ord a => a -> Set a -> Set a
S.insert (Text
a,Text
b) Set (Text, Text)
names) RelationalExprBase a
expr
              ren Text
a Text
b RelationalExprBase a
e = forall a.
Set (Text, Text) -> RelationalExprBase a -> RelationalExprBase a
Rename (forall a. a -> Set a
S.singleton (Text
a, Text
b)) RelationalExprBase a
e
              sqlPrefix :: a -> a
sqlPrefix a
s = a
"_sql_" forall a. Semigroup a => a -> a -> a
<> a
s
              projHide :: Text -> RelationalExprBase a -> RelationalExprBase a
projHide Text
n = forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (forall a. Set Text -> AttributeNamesBase a
InvertedAttributeNames (forall a. a -> Set a
S.singleton Text
n))
              -- if one of the types is a nullable version of the other
--              isSQLNullableCombo t1 t2 = isSQLNullableSpecificType t1 t2 || isSQLNullableSpecificType t2 t1
              sqlNullMorpher :: Text
-> Text -> AtomType -> AtomType -> RelationalExpr -> RelationalExpr
sqlNullMorpher Text
interName Text
targetName AtomType
targetType AtomType
t2 RelationalExpr
expr
                | AtomType -> AtomType -> Bool
isSQLNullableSpecificType AtomType
targetType AtomType
t2 = -- targetType is nullable version of t2
                  forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (forall a. Text -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr Text
targetName (forall a. Text -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr Text
"SQLJust" [forall a. Text -> AtomExprBase a
AttributeAtomExpr Text
interName] ())) RelationalExpr
expr
                | Bool
otherwise = RelationalExpr
expr
               
          let typeMatchRenamer :: RelationalExpr -> (Text, Text) -> ConvertM RelationalExpr
typeMatchRenamer RelationalExpr
acc (Text
targetAttrName, Text
sourceAttrName) = do
                AtomType
targetType <- Text -> Relation -> ConvertM AtomType
atomTypeForName' Text
targetAttrName Relation
rvTargetType
                AtomType
insType <- Text -> Relation -> ConvertM AtomType
atomTypeForName' Text
sourceAttrName Relation
rvExprType
                if AtomType
targetType forall a. Eq a => a -> a -> Bool
== AtomType
insType Bool -> Bool -> Bool
&& Text
targetAttrName forall a. Eq a => a -> a -> Bool
== Text
sourceAttrName then --nothing to do
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
acc
                  else if Text
targetAttrName forall a. Eq a => a -> a -> Bool
/= Text
sourceAttrName Bool -> Bool -> Bool
&&
                          AtomType
targetType forall a. Eq a => a -> a -> Bool
== AtomType
insType then do
                          --simple rename
                         forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a}.
Text -> Text -> RelationalExprBase a -> RelationalExprBase a
ren Text
sourceAttrName Text
targetAttrName RelationalExpr
acc
                  else if Text
targetAttrName forall a. Eq a => a -> a -> Bool
== Text
sourceAttrName Bool -> Bool -> Bool
&&
                          AtomType
targetType forall a. Eq a => a -> a -> Bool
/= AtomType
insType Bool -> Bool -> Bool
&&
                          AtomType -> AtomType -> Bool
isSQLNullableSpecificType AtomType
targetType AtomType
insType
                  then do -- we need to extend the expr, but we want to use the targetName, so we have to rename it twice
                         let intermediateName :: Text
intermediateName = forall {a}. (Semigroup a, IsString a) => a -> a
sqlPrefix Text
targetAttrName
                         forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a}.
Text -> Text -> RelationalExprBase a -> RelationalExprBase a
ren Text
intermediateName Text
targetAttrName (Text
-> Text -> AtomType -> AtomType -> RelationalExpr -> RelationalExpr
sqlNullMorpher Text
intermediateName Text
targetAttrName AtomType
targetType AtomType
insType (forall {a}.
Text -> Text -> RelationalExprBase a -> RelationalExprBase a
ren Text
sourceAttrName Text
intermediateName RelationalExpr
acc))
                  else if Text
targetAttrName forall a. Eq a => a -> a -> Bool
/= Text
sourceAttrName Bool -> Bool -> Bool
&&
                          AtomType
targetType forall a. Eq a => a -> a -> Bool
/= AtomType
insType Bool -> Bool -> Bool
&&
                          AtomType -> AtomType -> Bool
isSQLNullableSpecificType AtomType
targetType AtomType
insType then do
                         -- we extend the expr, but don't need an intermediate rename
                         forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> RelationalExprBase a -> RelationalExprBase a
projHide Text
sourceAttrName (forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (forall a. Text -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr Text
targetAttrName (forall a. Text -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr Text
"SQLJust" [forall a. Text -> AtomExprBase a
AttributeAtomExpr Text
sourceAttrName] ())) RelationalExpr
acc)
                  else if Text
targetAttrName forall a. Eq a => a -> a -> Bool
== Text
sourceAttrName Bool -> Bool -> Bool
&&
                          AtomType -> Bool
isSQLNullUnknownType AtomType
insType Bool -> Bool -> Bool
&&
                          AtomType -> Bool
isNullAtomType AtomType
targetType then do
                         case AtomType -> Maybe AtomType
atomTypeFromSQLNull AtomType
targetType of
                           Maybe AtomType
Nothing -> do
                             forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
acc
                           -- replace null of unknown type with typed null
                           Just AtomType
atype -> do
                               forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (forall a. Text -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr Text
targetAttrName (forall a. Atom -> AtomExprBase a
NakedAtomExpr (AtomType -> Maybe Atom -> Atom
nullAtom AtomType
atype forall a. Maybe a
Nothing))) (forall a. Text -> RelationalExprBase a -> RelationalExprBase a
projHide Text
sourceAttrName RelationalExpr
acc)
                  else if Text
targetAttrName forall a. Eq a => a -> a -> Bool
/= Text
sourceAttrName Bool -> Bool -> Bool
&&
                          AtomType -> Bool
isSQLNullUnknownType AtomType
insType Bool -> Bool -> Bool
&&
                          AtomType -> Bool
isNullAtomType AtomType
targetType then do
                         case AtomType -> Maybe AtomType
atomTypeFromSQLNull AtomType
targetType of
                           Maybe AtomType
Nothing -> do
                             forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
acc
                           -- replace null of unknown type with typed null
                           Just AtomType
_atype -> do
                               forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> RelationalExprBase a -> RelationalExprBase a
projHide Text
sourceAttrName forall a b. (a -> b) -> a -> b
$ forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (forall a. Text -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr Text
targetAttrName (forall a. Text -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr Text
"SQLNull" [] ())) RelationalExpr
acc
                  else
                         forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationalExpr
acc
                         
          RelationalExpr
insExpr <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM RelationalExpr -> (Text, Text) -> ConvertM RelationalExpr
typeMatchRenamer (DataFrameExpr -> RelationalExpr
convertExpr DataFrameExpr
dfExpr) (forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
insAttrNames [Text]
rvExprAttrNames)
{-          let insExpr = if rvExprColNameSet == insAttrColSet then -- if the attributes already align, don't perform any renaming
                          convertExpr dfExpr
                        else
                          Rename (S.fromList (filter rendundantRename (zip rvExprAttrNames insAttrNames))) (convertExpr dfExpr)
              rendundantRename (a,b) = a /= b-}
{-          traceShowM ("source ins"::String, source ins)
          traceShowM ("source ins converted"::String, convertExpr dfExpr)
          traceShowM ("ins converted"::String, insExpr)
          traceShowM ("rvTargetType"::String, rvTargetType)-}

          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> RelationalExprBase a -> DatabaseContextExprBase a
B.Insert Text
rvTarget RelationalExpr
insExpr

convertDelete :: TypeForRelExprF -> Delete.Delete -> ConvertM DatabaseContextExpr
convertDelete :: TypeForRelExprF -> Delete -> ConvertM DatabaseContextExpr
convertDelete TypeForRelExprF
typeF Delete
del = do
  Text
rvname <- TableName -> ConvertM Text
convertTableName (Delete -> TableName
Delete.target Delete
del)
  let rv :: RelationalExpr
rv = forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
rvname ()
  case TypeForRelExprF
typeF RelationalExpr
rv of
    Left RelationalError
err -> forall a. SQLError -> ConvertM a
throwSQLE (RelationalError -> SQLError
SQLRelationalError RelationalError
err)
    Right Relation
typeRel -> do
      ColumnAliasMap
_ <- TableAlias
-> RelationalExpr -> Attributes -> ConvertM ColumnAliasMap
insertTable (Text -> TableAlias
TableAlias Text
rvname) RelationalExpr
rv (Relation -> Attributes
attributes Relation
typeRel)
      RestrictionPredicateExpr
res <- TypeForRelExprF
-> RestrictionExpr -> ConvertM RestrictionPredicateExpr
convertWhereClause TypeForRelExprF
typeF (Delete -> RestrictionExpr
restriction Delete
del)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
Text -> RestrictionPredicateExprBase a -> DatabaseContextExprBase a
B.Delete Text
rvname RestrictionPredicateExpr
res)

convertCreateTable :: TypeForRelExprF -> CreateTable -> ConvertM DatabaseContextExpr
convertCreateTable :: TypeForRelExprF -> CreateTable -> ConvertM DatabaseContextExpr
convertCreateTable TypeForRelExprF
_typeF CreateTable
ct = do
  Text
rvTarget <- TableName -> ConvertM Text
convertTableName (CreateTable -> TableName
CreateTable.target CreateTable
ct)
  ([AttributeExprBase ()]
attrs, [DatabaseContextExpr]
constraintExprs) <- Text
-> [(UnqualifiedColumnName, ColumnType, PerColumnConstraints)]
-> ConvertM ([AttributeExprBase ()], [DatabaseContextExpr])
convertColumnNamesAndTypes Text
rvTarget (CreateTable
-> [(UnqualifiedColumnName, ColumnType, PerColumnConstraints)]
CreateTable.targetColumns CreateTable
ct)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DatabaseContextExpr] -> DatabaseContextExpr
someDatabaseContextExprs (forall a.
Text -> [AttributeExprBase a] -> DatabaseContextExprBase a
Define Text
rvTarget [AttributeExprBase ()]
attrs forall a. a -> [a] -> [a]
: [DatabaseContextExpr]
constraintExprs))

convertDropTable :: TypeForRelExprF -> DropTable -> ConvertM DatabaseContextExpr
convertDropTable :: TypeForRelExprF -> DropTable -> ConvertM DatabaseContextExpr
convertDropTable TypeForRelExprF
_typeF DropTable
dt = do
  Text
rvTarget <- TableName -> ConvertM Text
convertTableName (DropTable -> TableName
DropTable.target DropTable
dt)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Text -> DatabaseContextExprBase a
Undefine Text
rvTarget)

convertColumnNamesAndTypes :: RelVarName -> [(UnqualifiedColumnName, ColumnType, PerColumnConstraints)] -> ConvertM ([AttributeExpr], [DatabaseContextExpr])
convertColumnNamesAndTypes :: Text
-> [(UnqualifiedColumnName, ColumnType, PerColumnConstraints)]
-> ConvertM ([AttributeExprBase ()], [DatabaseContextExpr])
convertColumnNamesAndTypes Text
rvName =
  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([AttributeExprBase ()], [DatabaseContextExpr])
-> (UnqualifiedColumnName, ColumnType, PerColumnConstraints)
-> ConvertM ([AttributeExprBase ()], [DatabaseContextExpr])
processColumn forall a. Monoid a => a
mempty
  where
    processColumn :: ([AttributeExprBase ()], [DatabaseContextExpr])
-> (UnqualifiedColumnName, ColumnType, PerColumnConstraints)
-> ConvertM ([AttributeExprBase ()], [DatabaseContextExpr])
processColumn ([AttributeExprBase ()], [DatabaseContextExpr])
acc (ucn :: UnqualifiedColumnName
ucn@(UnqualifiedColumnName Text
colName), ColumnType
colType, PerColumnConstraints
constraints) = do
      TypeConstructor
aTypeCons <- ColumnType -> PerColumnConstraints -> ConvertM TypeConstructor
convertColumnType ColumnType
colType PerColumnConstraints
constraints
      [DatabaseContextExpr]
constraintExprs <- Text
-> UnqualifiedColumnName
-> PerColumnConstraints
-> ConvertM [DatabaseContextExpr]
convertPerColumnConstraints Text
rvName UnqualifiedColumnName
ucn PerColumnConstraints
constraints
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ( forall a b. (a, b) -> a
fst ([AttributeExprBase ()], [DatabaseContextExpr])
acc forall a. Semigroup a => a -> a -> a
<> [forall a. Text -> TypeConstructor -> a -> AttributeExprBase a
AttributeAndTypeNameExpr Text
colName TypeConstructor
aTypeCons ()],
             [DatabaseContextExpr]
constraintExprs forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd ([AttributeExprBase ()], [DatabaseContextExpr])
acc)

convertColumnType :: ColumnType -> PerColumnConstraints -> ConvertM TypeConstructor
convertColumnType :: ColumnType -> PerColumnConstraints -> ConvertM TypeConstructor
convertColumnType ColumnType
colType PerColumnConstraints
constraints = do
  let mkTypeCons :: AtomType -> TypeConstructor
mkTypeCons AtomType
aType =
        let typeName :: Text
typeName = Int -> Text -> Text
T.dropEnd (forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char]
"AtomType"::String)) ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show AtomType
aType))
            tCons :: TypeConstructor
tCons = forall a. Text -> [TypeConstructor] -> TypeConstructorBase a
ADTypeConstructor Text
typeName []
        in
          if PerColumnConstraints -> Bool
notNullConstraint PerColumnConstraints
constraints then
            TypeConstructor
tCons
          else
            forall a. Text -> [TypeConstructor] -> TypeConstructorBase a
ADTypeConstructor Text
"SQLNullable" [TypeConstructor
tCons]
      colTCons :: TypeConstructor
colTCons = AtomType -> TypeConstructor
mkTypeCons forall a b. (a -> b) -> a -> b
$
             case ColumnType
colType of
               ColumnType
IntegerColumnType -> AtomType
IntegerAtomType
               ColumnType
TextColumnType -> AtomType
TextAtomType
               ColumnType
BoolColumnType -> AtomType
BoolAtomType
               ColumnType
DoubleColumnType -> AtomType
DoubleAtomType
               ColumnType
DateTimeColumnType -> AtomType
DateTimeAtomType
               ColumnType
DateColumnType -> AtomType
DayAtomType
               ColumnType
ByteaColumnType -> AtomType
ByteStringAtomType
  forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeConstructor
colTCons

convertPerColumnConstraints :: RelVarName -> UnqualifiedColumnName -> PerColumnConstraints -> ConvertM [DatabaseContextExpr]
convertPerColumnConstraints :: Text
-> UnqualifiedColumnName
-> PerColumnConstraints
-> ConvertM [DatabaseContextExpr]
convertPerColumnConstraints Text
rvname (UnqualifiedColumnName Text
colName) PerColumnConstraints
constraints = do
  -- NOT NULL constraints are already enforced by the column type
  [DatabaseContextExpr]
fkExprs <- case PerColumnConstraints -> Maybe (TableName, UnqualifiedColumnName)
references PerColumnConstraints
constraints of
               Maybe (TableName, UnqualifiedColumnName)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []        
               Just (TableName [Text
fkTableName], UnqualifiedColumnName Text
fkColName) -> do
                 let fkIncDepName :: Text
fkIncDepName = Text
rvname forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> Text
colName forall a. Semigroup a => a -> a -> a
<> Text
"__" forall a. Semigroup a => a -> a -> a
<> Text
fkTableName forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> Text
fkColName forall a. Semigroup a => a -> a -> a
<> Text
"_fk"
                     mkFK :: InclusionDependency
mkFK = RelationalExpr -> RelationalExpr -> InclusionDependency
InclusionDependency (forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (forall a. Set Text -> AttributeNamesBase a
AttributeNames (forall a. a -> Set a
S.singleton Text
colName)) (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
rvname ())) (forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (forall a. Set Text -> AttributeNamesBase a
AttributeNames (forall a. a -> Set a
S.singleton Text
fkColName)) (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
fkTableName ()))

                 forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall a. Text -> InclusionDependency -> DatabaseContextExprBase a
AddInclusionDependency Text
fkIncDepName InclusionDependency
mkFK]
               Just (TableName [Text]
fkTableNames, UnqualifiedColumnName Text
fkColName) ->
                 forall a. SQLError -> ConvertM a
throwSQLE (Text -> SQLError
NotSupportedError (Text
"schema-qualified table name in fk constraint: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show [Text]
fkTableNames) forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
fkColName))
  -- the uniqueness constraint in SQL does not consider NULLs to be equal by default
  let uniqueExprs :: [DatabaseContextExpr]
uniqueExprs = if PerColumnConstraints -> Bool
uniquenessConstraint PerColumnConstraints
constraints then
                      if PerColumnConstraints -> Bool
notNullConstraint PerColumnConstraints
constraints then
                        [Text -> [Text] -> DatabaseContextExpr
databaseContextExprForUniqueKey Text
rvname [Text
colName]]
                      else
                        [Text -> Text -> DatabaseContextExpr
databaseContextExprForUniqueKeyWithNull Text
rvname Text
colName]
                    else
                      []
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [DatabaseContextExpr]
uniqueExprs forall a. Semigroup a => a -> a -> a
<> [DatabaseContextExpr]
fkExprs

databaseContextExprForUniqueKeyWithNull :: RelVarName -> AttributeName -> DatabaseContextExpr
databaseContextExprForUniqueKeyWithNull :: Text -> Text -> DatabaseContextExpr
databaseContextExprForUniqueKeyWithNull Text
rvname Text
attrName =
  forall a. Text -> InclusionDependency -> DatabaseContextExprBase a
AddInclusionDependency Text
incDepName InclusionDependency
incDep
  where
    incDep :: InclusionDependency
incDep = AttributeNamesBase () -> RelationalExpr -> InclusionDependency
inclusionDependencyForKey (forall a. Set Text -> AttributeNamesBase a
AttributeNames (forall a. a -> Set a
S.singleton Text
attrName)) (forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExpr
notNull (forall a. Text -> a -> RelationalExprBase a
RelationVariable Text
rvname ()))
    incDepName :: Text
incDepName = Text
rvname forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> Text
attrName forall a. Semigroup a => a -> a -> a
<> Text
"_unique"
    notNull :: RestrictionPredicateExpr
notNull = forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate (forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate (Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_isnull" [forall a. Text -> AtomExprBase a
AttributeAtomExpr Text
attrName] ))
                                  

{-
select city,max(status) from s group by city;
(((s{city,status}) group ({status} as sub)) : {status2:=max(@sub)}){city,status2} rename {status2 as status}

before: Project (AttributeNames (fromList ["attr_2","city"])) (Extend (AttributeExtendTupleExpr "attr_2" (FunctionAtomExpr "sql_max" [AttributeAtomExpr "status"] ())) (RelationVariable "s" ()))

after: Rename (fromList [("status2","status")]) (Project (AttributeNames (fromList ["city","status2"])) (Extend (AttributeExtendTupleExpr "status2" (FunctionAtomExpr "max" [AttributeAtomExpr "sub"] ())) (Group (AttributeNames (fromList ["status"])) "sub" (Project (AttributeNames (fromList ["city","status"])) (RelationVariable "s" ())))))
-}

-- (s group ({all but city} as sub): {maxstatus:=max(@sub{status})}){city,maxstatus}
-- select city,max(status) from s group by city;

convertGroupBy :: TypeForRelExprF -> [GroupByExpr] -> Maybe HavingExpr -> [SelectItem] -> ConvertM GroupByInfo
convertGroupBy :: TypeForRelExprF
-> [GroupByExpr]
-> Maybe HavingExpr
-> [SelectItem]
-> ConvertM GroupByInfo
convertGroupBy TypeForRelExprF
_typeF [GroupByExpr]
groupBys Maybe HavingExpr
mHavingExpr [SelectItem]
sqlProjection = do
  --first, check that projection includes an aggregate, otherwise, there's no point
  --find aggregate functions at the top-level (including within other functions such as 1+max(x)), and refocus them on the group attribute projected on the aggregate target
  -- do we need an operator to apply a relexpr to a subrelation? For example, it would be useful to apply a projection across all the subrelations, and types are maintained
--  foldM convertGroupByExpr emptyGroupByInfo sqlProjection
  -- each scalar expr must appear at the top-level SelectItem list
--    convertGroupByExpr acc
  -- search group by exprs to find the matching sexpr- if more than one matches, error
  --todo: handle asterisk
  let findMatchingProjection :: GroupByExpr -> ConvertM GroupByItem
findMatchingProjection expr :: GroupByExpr
expr@(GroupByExpr ProjectionScalarExpr
gbexpr) =
        let exprMatcher :: SelectItem -> [ProjectionScalarExpr] -> [ProjectionScalarExpr]
exprMatcher (ProjectionScalarExpr
projExpr, Maybe ColumnAlias
_alias) [ProjectionScalarExpr]
acc =
              if ProjectionScalarExpr -> ProjectionScalarExpr -> Bool
containsProjScalarExpr ProjectionScalarExpr
gbexpr ProjectionScalarExpr
projExpr then
                ProjectionScalarExpr
projExpr forall a. a -> [a] -> [a]
: [ProjectionScalarExpr]
acc
              else
                [ProjectionScalarExpr]
acc
        in
          case forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SelectItem -> [ProjectionScalarExpr] -> [ProjectionScalarExpr]
exprMatcher forall a. Monoid a => a
mempty [SelectItem]
sqlProjection of
            [] -> forall a. SQLError -> ConvertM a
throwSQLE (ProjectionScalarExpr -> SQLError
AggregateGroupByMismatchError ProjectionScalarExpr
gbexpr)
            [ProjectionScalarExpr
match] -> if ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
match then
                         forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectionScalarExpr -> GroupByExpr -> GroupByItem
AggGroupByItem ProjectionScalarExpr
match GroupByExpr
expr)
                       else
                         forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectionScalarExpr -> GroupByExpr -> GroupByItem
NonAggGroupByItem ProjectionScalarExpr
match GroupByExpr
expr)
            [ProjectionScalarExpr]
_matches -> forall a. SQLError -> ConvertM a
throwSQLE (ProjectionScalarExpr -> SQLError
AggregateGroupByMismatchError ProjectionScalarExpr
gbexpr)
      collectGroupByInfo :: GroupByInfo -> GroupByExpr -> ConvertM GroupByInfo
collectGroupByInfo GroupByInfo
info GroupByExpr
gbsexpr = do
        -- validate that there is a corresponding group by
        GroupByItem
matchExpr <- GroupByExpr -> ConvertM GroupByItem
findMatchingProjection GroupByExpr
gbsexpr
        case GroupByItem
matchExpr of
          AggGroupByItem ProjectionScalarExpr
pe GroupByExpr
_gb -> 
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ GroupByInfo
info { aggregates :: [ProjectionScalarExpr]
aggregates = ProjectionScalarExpr
pe forall a. a -> [a] -> [a]
: GroupByInfo -> [ProjectionScalarExpr]
aggregates GroupByInfo
info }
          NonAggGroupByItem (Identifier ColumnProjectionName
colName) GroupByExpr
gb -> do
            Text
aname <- ColumnProjectionName -> ConvertM Text
convertColumnProjectionName ColumnProjectionName
colName
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ GroupByInfo
info { nonAggregates :: [(Text, GroupByExpr)]
nonAggregates = (Text
aname, GroupByExpr
gb) forall a. a -> [a] -> [a]
: GroupByInfo -> [(Text, GroupByExpr)]
nonAggregates GroupByInfo
info }
          NonAggGroupByItem ProjectionScalarExpr
pe GroupByExpr
_ -> do
            forall a. SQLError -> ConvertM a
throwSQLE (ProjectionScalarExpr -> SQLError
UnsupportedGroupByProjectionError ProjectionScalarExpr
pe)
      -- find select items which are not mentioned in the group by expression and make sure that are in the aggregates info
--      collectNonGroupByInfo :: [ProjectionScalarExpr] -> GroupByInfo -> SelectItem ->  ConvertM GroupByInfo
      collectNonGroupByInfo :: GroupByInfo -> (ProjectionScalarExpr, b) -> f GroupByInfo
collectNonGroupByInfo GroupByInfo
info (ProjectionScalarExpr
projExpr, b
_alias) = 
       if ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
projExpr then
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupByInfo
info { aggregates :: [ProjectionScalarExpr]
aggregates = ProjectionScalarExpr
projExpr forall a. a -> [a] -> [a]
: GroupByInfo -> [ProjectionScalarExpr]
aggregates GroupByInfo
info })
       else
         forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupByInfo
info
         
  GroupByInfo
groups1 <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM GroupByInfo -> GroupByExpr -> ConvertM GroupByInfo
collectGroupByInfo GroupByInfo
emptyGroupByInfo [GroupByExpr]
groupBys
  GroupByInfo
groups2 <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {f :: * -> *} {b}.
Applicative f =>
GroupByInfo -> (ProjectionScalarExpr, b) -> f GroupByInfo
collectNonGroupByInfo GroupByInfo
groups1 [SelectItem]
sqlProjection
  let groups3 :: GroupByInfo
groups3 = case Maybe HavingExpr
mHavingExpr of
                  Just (HavingExpr ProjectionScalarExpr
sexpr) -> GroupByInfo
groups2 { havingRestriction :: Maybe ProjectionScalarExpr
havingRestriction = forall a. a -> Maybe a
Just ProjectionScalarExpr
sexpr }
                  Maybe HavingExpr
Nothing -> GroupByInfo
groups2
  -- perform some validation
{-  let sqlProj = HS.fromList (map fst sqlProjection)
      groupByProj = HS.fromList (aggregates groups2 <> map fst (nonAggregates groups2))
      diff = HS.difference sqlProj groupByProj
  if HS.null diff then-}
  forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupByInfo
groups3
{-    else
    throwSQLE (GroupByColumnNotReferencedInGroupByError (HS.toList diff))-}
    


data GroupByItem = AggGroupByItem ProjectionScalarExpr GroupByExpr |
                   NonAggGroupByItem ProjectionScalarExpr GroupByExpr
 deriving (Int -> GroupByItem -> ShowS
[GroupByItem] -> ShowS
GroupByItem -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GroupByItem] -> ShowS
$cshowList :: [GroupByItem] -> ShowS
show :: GroupByItem -> [Char]
$cshow :: GroupByItem -> [Char]
showsPrec :: Int -> GroupByItem -> ShowS
$cshowsPrec :: Int -> GroupByItem -> ShowS
Show, GroupByItem -> GroupByItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupByItem -> GroupByItem -> Bool
$c/= :: GroupByItem -> GroupByItem -> Bool
== :: GroupByItem -> GroupByItem -> Bool
$c== :: GroupByItem -> GroupByItem -> Bool
Eq)

-- | Validated "group by" and "having" data
data GroupByInfo =
  GroupByInfo { GroupByInfo -> [ProjectionScalarExpr]
aggregates :: [ProjectionScalarExpr], -- ^ mentioned in group by clause and uses aggregation
                GroupByInfo -> [(Text, GroupByExpr)]
nonAggregates :: [(AttributeName, GroupByExpr)], -- ^ mentioned in group by clause by not aggregations
                GroupByInfo -> Maybe ProjectionScalarExpr
havingRestriction :: Maybe ProjectionScalarExpr                
              }
  deriving (Int -> GroupByInfo -> ShowS
[GroupByInfo] -> ShowS
GroupByInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GroupByInfo] -> ShowS
$cshowList :: [GroupByInfo] -> ShowS
show :: GroupByInfo -> [Char]
$cshow :: GroupByInfo -> [Char]
showsPrec :: Int -> GroupByInfo -> ShowS
$cshowsPrec :: Int -> GroupByInfo -> ShowS
Show, GroupByInfo -> GroupByInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupByInfo -> GroupByInfo -> Bool
$c/= :: GroupByInfo -> GroupByInfo -> Bool
== :: GroupByInfo -> GroupByInfo -> Bool
$c== :: GroupByInfo -> GroupByInfo -> Bool
Eq)

emptyGroupByInfo :: GroupByInfo
emptyGroupByInfo :: GroupByInfo
emptyGroupByInfo = GroupByInfo { aggregates :: [ProjectionScalarExpr]
aggregates = [], nonAggregates :: [(Text, GroupByExpr)]
nonAggregates = [], havingRestriction :: Maybe ProjectionScalarExpr
havingRestriction = forall a. Maybe a
Nothing }

aggregateFunctionsMap :: [(FuncName, FunctionName)]
aggregateFunctionsMap :: [(FuncName, Text)]
aggregateFunctionsMap = [([Text] -> FuncName
FuncName [Text
"max"], Text
"sql_max"),
                       ([Text] -> FuncName
FuncName [Text
"min"], Text
"sql_min"),
                       ([Text] -> FuncName
FuncName [Text
"sum"], Text
"sql_sum"),
                       ([Text] -> FuncName
FuncName [Text
"count"], Text
"sql_count")]

isAggregateFunction :: FuncName -> Bool
isAggregateFunction :: FuncName -> Bool
isAggregateFunction FuncName
fname = FuncName
fname forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(FuncName, Text)]
aggregateFunctionsMap

containsAggregate :: ProjectionScalarExpr -> Bool
containsAggregate :: ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
expr =
  case ProjectionScalarExpr
expr of
    IntegerLiteral{} -> Bool
False
    DoubleLiteral{} -> Bool
False
    StringLiteral{} -> Bool
False
    BooleanLiteral{} -> Bool
False
    ProjectionScalarExpr
NullLiteral -> Bool
False
    Identifier{} -> Bool
False
    BinaryOperator ProjectionScalarExpr
e1 OperatorName
op ProjectionScalarExpr
e2 -> ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e1 Bool -> Bool -> Bool
|| ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e2 Bool -> Bool -> Bool
|| forall {p}. p -> Bool
opAgg OperatorName
op
    PrefixOperator OperatorName
op ProjectionScalarExpr
e1 -> ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e1 Bool -> Bool -> Bool
|| forall {p}. p -> Bool
opAgg OperatorName
op
    PostfixOperator ProjectionScalarExpr
e1 OperatorName
op -> ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e1 Bool -> Bool -> Bool
|| forall {p}. p -> Bool
opAgg OperatorName
op
    BetweenOperator ProjectionScalarExpr
e1 ProjectionScalarExpr
e2 ProjectionScalarExpr
e3 -> ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e1 Bool -> Bool -> Bool
|| ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e2 Bool -> Bool -> Bool
|| ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e3
    FunctionApplication FuncName
fname [ProjectionScalarExpr]
args -> FuncName -> Bool
isAggregateFunction FuncName
fname Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ProjectionScalarExpr -> Bool
containsAggregate [ProjectionScalarExpr]
args
    c :: ProjectionScalarExpr
c@CaseExpr{} -> forall (t :: * -> *). Foldable t => t Bool -> Bool
or (Bool
cElse forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(ProjectionScalarExpr
when', ProjectionScalarExpr
res) -> [ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
res, ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
when']) (forall n.
ScalarExprBase n -> [(ScalarExprBase n, ScalarExprBase n)]
caseWhens ProjectionScalarExpr
c))
      where
        cElse :: Bool
cElse = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ProjectionScalarExpr -> Bool
containsAggregate (forall n. ScalarExprBase n -> Maybe (ScalarExprBase n)
caseElse ProjectionScalarExpr
c)
    q :: ProjectionScalarExpr
q@QuantifiedComparison{} -> ProjectionScalarExpr -> Bool
containsAggregate (forall n. ScalarExprBase n -> ScalarExprBase n
qcExpr ProjectionScalarExpr
q)
    InExpr InFlag
_ ProjectionScalarExpr
e1 InPredicateValue
_ -> ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e1
    BooleanOperatorExpr ProjectionScalarExpr
e1 BoolOp
opName ProjectionScalarExpr
e2 -> forall {p}. p -> Bool
opAgg BoolOp
opName Bool -> Bool -> Bool
|| ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e1 Bool -> Bool -> Bool
|| ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e2
    ExistsExpr{} -> Bool
False
  where
    opAgg :: p -> Bool
opAgg p
_opName = Bool
False

-- | Returns True iff a projection scalar expr within a larger expression. Used for group by aggregation validation.
containsProjScalarExpr :: ProjectionScalarExpr -> ProjectionScalarExpr -> Bool
containsProjScalarExpr :: ProjectionScalarExpr -> ProjectionScalarExpr -> Bool
containsProjScalarExpr ProjectionScalarExpr
needle ProjectionScalarExpr
haystack =
  (ProjectionScalarExpr
needle forall a. Eq a => a -> a -> Bool
== ProjectionScalarExpr
haystack) Bool -> Bool -> Bool
||
    case ProjectionScalarExpr
haystack of
      IntegerLiteral{} -> Bool
False
      DoubleLiteral{} -> Bool
False
      StringLiteral{} -> Bool
False
      BooleanLiteral{} -> Bool
False
      ProjectionScalarExpr
NullLiteral -> Bool
False
      Identifier{} -> Bool
False
      BinaryOperator ProjectionScalarExpr
e1 OperatorName
_op ProjectionScalarExpr
e2 -> ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
e1 Bool -> Bool -> Bool
|| ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
e2
      PrefixOperator OperatorName
_op ProjectionScalarExpr
e1 -> ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
e1
      PostfixOperator ProjectionScalarExpr
e1 OperatorName
_op -> ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
e1
      BetweenOperator ProjectionScalarExpr
e1 ProjectionScalarExpr
e2 ProjectionScalarExpr
e3 -> ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
e1 Bool -> Bool -> Bool
|| ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
e2 Bool -> Bool -> Bool
|| ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
e3
      FunctionApplication FuncName
_fname [ProjectionScalarExpr]
args -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ProjectionScalarExpr -> Bool
con [ProjectionScalarExpr]
args
      c :: ProjectionScalarExpr
c@CaseExpr{} -> forall (t :: * -> *). Foldable t => t Bool -> Bool
or (Bool
cElse forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(ProjectionScalarExpr
when', ProjectionScalarExpr
res) -> [ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
res, ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
when']) (forall n.
ScalarExprBase n -> [(ScalarExprBase n, ScalarExprBase n)]
caseWhens ProjectionScalarExpr
c))
        where
          cElse :: Bool
cElse = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ProjectionScalarExpr -> Bool
con (forall n. ScalarExprBase n -> Maybe (ScalarExprBase n)
caseElse ProjectionScalarExpr
c)
      q :: ProjectionScalarExpr
q@QuantifiedComparison{} -> ProjectionScalarExpr -> Bool
con (forall n. ScalarExprBase n -> ScalarExprBase n
qcExpr ProjectionScalarExpr
q)
      InExpr InFlag
_ ProjectionScalarExpr
e1 InPredicateValue
_ -> ProjectionScalarExpr -> Bool
containsAggregate ProjectionScalarExpr
e1
      BooleanOperatorExpr ProjectionScalarExpr
e1 BoolOp
_opName ProjectionScalarExpr
e2 -> ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
e1 Bool -> Bool -> Bool
|| ProjectionScalarExpr -> Bool
con ProjectionScalarExpr
e2
      ExistsExpr{} -> Bool
False
   where
     con :: ProjectionScalarExpr -> Bool
con = ProjectionScalarExpr -> ProjectionScalarExpr -> Bool
containsProjScalarExpr ProjectionScalarExpr
needle

-- depth first replacement for scalar expr modification
replaceProjScalarExpr :: (ProjectionScalarExpr -> ProjectionScalarExpr) -> ProjectionScalarExpr -> ProjectionScalarExpr
replaceProjScalarExpr :: (ProjectionScalarExpr -> ProjectionScalarExpr)
-> ProjectionScalarExpr -> ProjectionScalarExpr
replaceProjScalarExpr ProjectionScalarExpr -> ProjectionScalarExpr
r ProjectionScalarExpr
orig =
  case ProjectionScalarExpr
orig of
    IntegerLiteral{} -> ProjectionScalarExpr -> ProjectionScalarExpr
r ProjectionScalarExpr
orig
    DoubleLiteral{} -> ProjectionScalarExpr -> ProjectionScalarExpr
r ProjectionScalarExpr
orig
    StringLiteral{} -> ProjectionScalarExpr -> ProjectionScalarExpr
r ProjectionScalarExpr
orig
    BooleanLiteral{} -> ProjectionScalarExpr -> ProjectionScalarExpr
r ProjectionScalarExpr
orig
    NullLiteral{} -> ProjectionScalarExpr -> ProjectionScalarExpr
r ProjectionScalarExpr
orig
    Identifier{} -> ProjectionScalarExpr -> ProjectionScalarExpr
r ProjectionScalarExpr
orig
    BinaryOperator ProjectionScalarExpr
e1 OperatorName
op ProjectionScalarExpr
e2 -> ProjectionScalarExpr -> ProjectionScalarExpr
r (forall n.
ScalarExprBase n
-> OperatorName -> ScalarExprBase n -> ScalarExprBase n
BinaryOperator (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e1) OperatorName
op (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e2))
    PrefixOperator OperatorName
op ProjectionScalarExpr
e1 -> ProjectionScalarExpr -> ProjectionScalarExpr
r (forall n. OperatorName -> ScalarExprBase n -> ScalarExprBase n
PrefixOperator OperatorName
op (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e1))
    PostfixOperator ProjectionScalarExpr
e1 OperatorName
op -> ProjectionScalarExpr -> ProjectionScalarExpr
r (forall n. ScalarExprBase n -> OperatorName -> ScalarExprBase n
PostfixOperator (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e1) OperatorName
op)
    BetweenOperator ProjectionScalarExpr
e1 ProjectionScalarExpr
e2 ProjectionScalarExpr
e3 -> ProjectionScalarExpr -> ProjectionScalarExpr
r (forall n.
ScalarExprBase n
-> ScalarExprBase n -> ScalarExprBase n -> ScalarExprBase n
BetweenOperator (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e1) (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e2) (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e3))
    FunctionApplication FuncName
fname [ProjectionScalarExpr]
args -> ProjectionScalarExpr -> ProjectionScalarExpr
r (forall n. FuncName -> [ScalarExprBase n] -> ScalarExprBase n
FunctionApplication FuncName
fname (forall a b. (a -> b) -> [a] -> [b]
map ProjectionScalarExpr -> ProjectionScalarExpr
recr [ProjectionScalarExpr]
args))
    c :: ProjectionScalarExpr
c@CaseExpr{} -> ProjectionScalarExpr -> ProjectionScalarExpr
r (CaseExpr { caseWhens :: [(ProjectionScalarExpr, ProjectionScalarExpr)]
caseWhens = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr -> ProjectionScalarExpr
recr) (forall n.
ScalarExprBase n -> [(ScalarExprBase n, ScalarExprBase n)]
caseWhens ProjectionScalarExpr
c),
                                  caseElse :: Maybe ProjectionScalarExpr
caseElse = ProjectionScalarExpr -> ProjectionScalarExpr
recr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. ScalarExprBase n -> Maybe (ScalarExprBase n)
caseElse ProjectionScalarExpr
c
                                })
    c :: ProjectionScalarExpr
c@QuantifiedComparison{} -> ProjectionScalarExpr -> ProjectionScalarExpr
r (ProjectionScalarExpr
c{ qcExpr :: ProjectionScalarExpr
qcExpr = ProjectionScalarExpr -> ProjectionScalarExpr
recr (forall n. ScalarExprBase n -> ScalarExprBase n
qcExpr ProjectionScalarExpr
c) })
    InExpr InFlag
flag ProjectionScalarExpr
e1 InPredicateValue
predval -> ProjectionScalarExpr -> ProjectionScalarExpr
r (forall n.
InFlag -> ScalarExprBase n -> InPredicateValue -> ScalarExprBase n
InExpr InFlag
flag (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e1) InPredicateValue
predval)
    BooleanOperatorExpr ProjectionScalarExpr
e1 BoolOp
op ProjectionScalarExpr
e2 -> ProjectionScalarExpr -> ProjectionScalarExpr
r (forall n.
ScalarExprBase n -> BoolOp -> ScalarExprBase n -> ScalarExprBase n
BooleanOperatorExpr (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e1) BoolOp
op (ProjectionScalarExpr -> ProjectionScalarExpr
recr ProjectionScalarExpr
e2))
    e :: ProjectionScalarExpr
e@ExistsExpr{} -> ProjectionScalarExpr
e
  where
    recr :: ProjectionScalarExpr -> ProjectionScalarExpr
recr = (ProjectionScalarExpr -> ProjectionScalarExpr)
-> ProjectionScalarExpr -> ProjectionScalarExpr
replaceProjScalarExpr ProjectionScalarExpr -> ProjectionScalarExpr
r

-- find SQL aggregate functions and replace then with folds on attribute "_sql_aggregate"
processSQLAggregateFunctions :: AtomExpr -> AtomExpr
processSQLAggregateFunctions :: AtomExprBase () -> AtomExprBase ()
processSQLAggregateFunctions AtomExprBase ()
expr = 
  case AtomExprBase ()
expr of
    AttributeAtomExpr{} -> AtomExprBase ()
expr
    NakedAtomExpr{} -> AtomExprBase ()
expr
    SubrelationAttributeAtomExpr{} -> AtomExprBase ()
expr
    FunctionAtomExpr Text
fname [AttributeAtomExpr Text
attrName] ()
      | Text
fname forall a. Eq a => a -> a -> Bool
== Text
"sql_count" Bool -> Bool -> Bool
&& -- count(*) counts the number of rows
        Text
attrName forall a. Eq a => a -> a -> Bool
== Text
"_sql_aggregate" -> AtomExprBase ()
expr
      | Text
fname forall a. Eq a => a -> a -> Bool
== Text
"sql_count" -> -- count(city) counts the number city elements that are not null
        Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
fname [forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr
                     (forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict
                       (forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate
                        (forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate
                         (Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
"sql_isnull" [forall a. Text -> AtomExprBase a
AttributeAtomExpr Text
attrName]))) (forall a. Text -> RelationalExprBase a
RelationValuedAttribute Text
"_sql_aggregate"))]
      | Text
fname forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(FuncName, Text)]
aggregateFunctionsMap ->
          Text -> [AtomExprBase ()] -> AtomExprBase ()
func Text
fname
            [forall a. Text -> Text -> AtomExprBase a
SubrelationAttributeAtomExpr Text
"_sql_aggregate" Text
attrName]
    FunctionAtomExpr Text
fname [AtomExprBase ()]
args () -> forall a. Text -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr Text
fname (forall a b. (a -> b) -> [a] -> [b]
map AtomExprBase () -> AtomExprBase ()
processSQLAggregateFunctions [AtomExprBase ()]
args) ()
    RelationAtomExpr{} -> AtomExprBase ()
expr --not supported in SQL
    IfThenAtomExpr AtomExprBase ()
ifE AtomExprBase ()
thenE AtomExprBase ()
elseE -> forall a.
AtomExprBase a
-> AtomExprBase a -> AtomExprBase a -> AtomExprBase a
IfThenAtomExpr (AtomExprBase () -> AtomExprBase ()
processSQLAggregateFunctions AtomExprBase ()
ifE) (AtomExprBase () -> AtomExprBase ()
processSQLAggregateFunctions AtomExprBase ()
thenE) (AtomExprBase () -> AtomExprBase ()
processSQLAggregateFunctions AtomExprBase ()
elseE)
    ConstructedAtomExpr{} -> AtomExprBase ()
expr --not supported in SQL