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 )
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'
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
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
_ -> []
]
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]
]
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
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
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