module Database.Relational.Query.SQL (
QuerySuffix, showsQuerySuffix,
updatePrefixSQL,
updateSQL',
updateOtherThanKeySQL', updateOtherThanKeySQL,
insertPrefixSQL, insertSQL,
deletePrefixSQL', deletePrefixSQL
) where
import Data.Array (listArray, (!))
import Data.Monoid (mconcat, (<>))
import Language.SQL.Keyword (Keyword(..), (.=.), (|*|))
import qualified Language.SQL.Keyword as SQL
import Database.Record (PersistableWidth)
import Database.Record.ToSql (untypedUpdateValuesIndex)
import Database.Relational.Query.Internal.SQL
(StringSQL, stringSQL, showStringSQL, rowConsStringSQL, )
import Database.Relational.Query.Pi (Pi)
import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi
import Database.Relational.Query.Table (Table, name, columns, recordWidth)
import qualified Database.Relational.Query.Projection as Projection
type QuerySuffix = [Keyword]
showsQuerySuffix :: QuerySuffix -> StringSQL
showsQuerySuffix = mconcat
updatePrefixSQL :: Table r -> StringSQL
updatePrefixSQL table = UPDATE <> stringSQL (name table)
updateSQL' :: String
-> [StringSQL]
-> [StringSQL]
-> String
updateSQL' table cols key =
showStringSQL $ mconcat
[UPDATE, stringSQL table, SET, SQL.fold (|*|) updAssigns,
WHERE, SQL.fold SQL.and keyAssigns]
where
assigns cs = [ c .=. "?" | c <- cs ]
updAssigns = assigns cols
keyAssigns = assigns key
updateOtherThanKeySQL' :: String
-> [StringSQL]
-> [Int]
-> String
updateOtherThanKeySQL' table cols ixs =
updateSQL' table updColumns keyColumns
where
width' = length cols
cols' = listArray (0, width' 1) cols
otherThanKey = untypedUpdateValuesIndex ixs width'
columns' is = [ cols' ! i | i <- is ]
updColumns = columns' otherThanKey
keyColumns = columns' ixs
updateOtherThanKeySQL :: Table r
-> Pi r p
-> String
updateOtherThanKeySQL tbl key =
updateOtherThanKeySQL' (name tbl) (columns tbl) (UnsafePi.unsafeExpandIndexes' (recordWidth tbl) key)
insertPrefixSQL :: Pi r r' -> Table r -> StringSQL
insertPrefixSQL pi' table =
INSERT <> INTO <> stringSQL (name table) <> rowConsStringSQL cols where
cols = Projection.columns . Projection.wpi (recordWidth table) (Projection.unsafeFromTable table) $ pi'
insertSQL :: PersistableWidth r
=> Pi r r'
-> Table r
-> String
insertSQL pi' tbl = showStringSQL $ insertPrefixSQL pi' tbl <> VALUES <> vs where
w = UnsafePi.width pi'
vs = rowConsStringSQL (replicate w "?")
deletePrefixSQL' :: String -> StringSQL
deletePrefixSQL' table = DELETE <> FROM <> stringSQL table
deletePrefixSQL :: Table r
-> StringSQL
deletePrefixSQL = deletePrefixSQL' . name