-- | Analysis and transformation of SQL queries.
module Database.Selda.Transform where
import Database.Selda.Exp
    ( allNamesIn, Exp(Col, AggrEx), SomeCol(..) )
import Database.Selda.SQL
    ( SQL(SQL, groups, ordering, liveExtras, source, restricts, cols),
      SqlSource(Product, EmptyTable, TableName, Values, RawSql, Union,
                Join) )
import Database.Selda.Query.Type ( GenState(GenState) )
import Database.Selda.Types ( ColName )

-- | Remove all dead columns recursively, assuming that the given list of
--   column names contains all names present in the final result.
removeDeadCols :: [ColName] -> SQL -> SQL
removeDeadCols :: [ColName] -> SQL -> SQL
removeDeadCols [ColName]
live SQL
sql =
    case SQL -> SqlSource
source SQL
sql' of
      SqlSource
EmptyTable          -> SQL
sql'
      TableName TableName
_         -> SQL
sql'
      Values  [SomeCol SQL]
_ [[Param]]
_         -> SQL
sql'
      RawSql QueryFragment
_            -> SQL
sql'
      Product [SQL]
qs          -> SQL
sql' {source :: SqlSource
source = [SQL] -> SqlSource
Product forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map SQL -> SQL
noDead [SQL]
qs}
      Join JoinType
jt Exp SQL Bool
on SQL
l SQL
r      -> SQL
sql' {source :: SqlSource
source = JoinType -> Exp SQL Bool -> SQL -> SQL -> SqlSource
Join JoinType
jt Exp SQL Bool
on (SQL -> SQL
noDead SQL
l) (SQL -> SQL
noDead SQL
r)}
      Union Bool
union_all SQL
l SQL
r -> SQL
sql' {source :: SqlSource
source = Bool -> SQL -> SQL -> SqlSource
Union Bool
union_all (SQL -> SQL
noDead SQL
l) (SQL -> SQL
noDead SQL
r)}
  where
    noDead :: SQL -> SQL
noDead = [ColName] -> SQL -> SQL
removeDeadCols [ColName]
live'
    sql' :: SQL
sql' = [ColName] -> SQL -> SQL
keepCols (SQL -> [ColName]
implicitlyLiveCols SQL
sql forall a. [a] -> [a] -> [a]
++ [ColName]
live) SQL
sql
    live' :: [ColName]
live' = SQL -> [ColName]
allColNames SQL
sql'

-- | Return the names of all columns in the given top-level query.
--   Subqueries are not traversed.
allColNames :: SQL -> [ColName]
allColNames :: SQL -> [ColName]
allColNames SQL
sql = [SomeCol SQL] -> [ColName]
colNames (SQL -> [SomeCol SQL]
cols SQL
sql) forall a. [a] -> [a] -> [a]
++ SQL -> [ColName]
implicitlyLiveCols SQL
sql

-- | Return the names of all non-output (i.e. 'cols') columns in the given
--   top-level query. Subqueries are not traversed.
implicitlyLiveCols :: SQL -> [ColName]
implicitlyLiveCols :: SQL -> [ColName]
implicitlyLiveCols SQL
sql = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Names a => a -> [ColName]
allNamesIn (SQL -> [Exp SQL Bool]
restricts SQL
sql)
  , [SomeCol SQL] -> [ColName]
colNames (SQL -> [SomeCol SQL]
groups SQL
sql)
  , [SomeCol SQL] -> [ColName]
colNames (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ SQL -> [(Order, SomeCol SQL)]
ordering SQL
sql)
  , [SomeCol SQL] -> [ColName]
colNames (SQL -> [SomeCol SQL]
liveExtras SQL
sql)
  , case SQL -> SqlSource
source SQL
sql of
      Join JoinType
_ Exp SQL Bool
on SQL
_ SQL
_ -> forall a. Names a => a -> [ColName]
allNamesIn Exp SQL Bool
on
      SqlSource
_             -> []
  ]

-- | Get all column names appearing in the given list of (possibly complex)
--   columns.
colNames :: [SomeCol SQL] -> [ColName]
colNames :: [SomeCol SQL] -> [ColName]
colNames [SomeCol SQL]
cs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ColName
n | Some Exp SQL a
c <- [SomeCol SQL]
cs, ColName
n <- forall a. Names a => a -> [ColName]
allNamesIn Exp SQL a
c]
  , [ColName
n | Named ColName
_ Exp SQL a
c <- [SomeCol SQL]
cs, ColName
n <- forall a. Names a => a -> [ColName]
allNamesIn Exp SQL a
c]
  , [ColName
n | Named ColName
n Exp SQL a
_ <- [SomeCol SQL]
cs]
  ]

-- | Remove all columns but the given, named ones and aggregates, from a query's
--   list of outputs.
--   If we want to refer to a column in an outer query, it must have a name.
--   If it doesn't, then it's either not referred to by an outer query, or
--   the outer query duplicates the expression, thereby referring directly
--   to the names of its components.
keepCols :: [ColName] -> SQL -> SQL
keepCols :: [ColName] -> SQL -> SQL
keepCols [ColName]
live SQL
sql = SQL
sql {cols :: [SomeCol SQL]
cols = [SomeCol SQL]
filtered}
  where
    filtered :: [SomeCol SQL]
filtered = forall a. (a -> Bool) -> [a] -> [a]
filter (forall {t :: * -> *} {sql}.
Foldable t =>
SomeCol sql -> t ColName -> Bool
`oneOf` [ColName]
live) (SQL -> [SomeCol SQL]
cols SQL
sql)
    oneOf :: SomeCol sql -> t ColName -> Bool
oneOf (Some (AggrEx Text
_ Exp sql a
_)) t ColName
_    = Bool
True
    oneOf (Named ColName
_ (AggrEx Text
_ Exp sql a
_)) t ColName
_ = Bool
True
    oneOf (Some (Col ColName
n)) t ColName
ns        = ColName
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t ColName
ns
    oneOf (Named ColName
n Exp sql a
_) t ColName
ns           = ColName
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t ColName
ns
    oneOf SomeCol sql
_ t ColName
_                      = Bool
False

-- | Build the outermost query from the SQL generation state.
--   Groups are ignored, as they are only used by 'aggregate'.
state2sql :: GenState -> SQL
state2sql :: GenState -> SQL
state2sql (GenState [SQL
sql] [Exp SQL Bool]
srs [SomeCol SQL]
_ Int
_ Int
_) =
  SQL
sql {restricts :: [Exp SQL Bool]
restricts = SQL -> [Exp SQL Bool]
restricts SQL
sql forall a. [a] -> [a] -> [a]
++ [Exp SQL Bool]
srs}
state2sql (GenState [SQL]
ss [Exp SQL Bool]
srs [SomeCol SQL]
_ Int
_ Int
_) =
  [SomeCol SQL]
-> SqlSource
-> [Exp SQL Bool]
-> [SomeCol SQL]
-> [(Order, SomeCol SQL)]
-> Maybe (Int, Int)
-> [SomeCol SQL]
-> Bool
-> SQL
SQL ([SQL] -> [SomeCol SQL]
allCols [SQL]
ss) ([SQL] -> SqlSource
Product [SQL]
ss) [Exp SQL Bool]
srs [] [] forall a. Maybe a
Nothing [] Bool
False

-- | Get all output columns from a list of SQL ASTs.
allCols :: [SQL] -> [SomeCol SQL]
allCols :: [SQL] -> [SomeCol SQL]
allCols [SQL]
sqls = [forall {sql}. SomeCol sql -> SomeCol sql
outCol SomeCol SQL
col | SQL
sql <- [SQL]
sqls, SomeCol SQL
col <- SQL -> [SomeCol SQL]
cols SQL
sql]
  where
    outCol :: SomeCol sql -> SomeCol sql
outCol (Named ColName
n Exp sql a
_) = forall sql a. Exp sql a -> SomeCol sql
Some (forall sql a. ColName -> Exp sql a
Col ColName
n)
    outCol SomeCol sql
c           = SomeCol sql
c