{-# LANGUAGE OverloadedStrings #-}
module Database.Relational.SimpleSql (
QuerySuffix, showsQuerySuffix,
updatePrefixSQL,
updateOtherThanKeySQL,
insertPrefixSQL,
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.ToSql (untypedUpdateValuesIndex)
import Database.Relational.Internal.String
(StringSQL, stringSQL, showStringSQL, rowConsStringSQL, )
import Database.Relational.Pi (Pi, expandIndexes')
import Database.Relational.Table (Table, name, columns, recordWidth)
import qualified Database.Relational.Record as Record
type QuerySuffix = [Keyword]
showsQuerySuffix :: QuerySuffix -> StringSQL
showsQuerySuffix :: QuerySuffix -> StringSQL
showsQuerySuffix = forall a. Monoid a => [a] -> a
mconcat
updatePrefixSQL :: Table r -> StringSQL
updatePrefixSQL :: forall r. Table r -> StringSQL
updatePrefixSQL Table r
table = StringSQL
UPDATE forall a. Semigroup a => a -> a -> a
<> String -> StringSQL
stringSQL (forall r. Table r -> String
name Table r
table)
updateSQL' :: String
-> [StringSQL]
-> [StringSQL]
-> String
updateSQL' :: String -> QuerySuffix -> QuerySuffix -> String
updateSQL' String
table QuerySuffix
cols QuerySuffix
key =
StringSQL -> String
showStringSQL forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[StringSQL
UPDATE, String -> StringSQL
stringSQL String
table, StringSQL
SET, (StringSQL -> StringSQL -> StringSQL) -> QuerySuffix -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
(|*|) QuerySuffix
updAssigns,
StringSQL
WHERE, (StringSQL -> StringSQL -> StringSQL) -> QuerySuffix -> StringSQL
SQL.fold StringSQL -> StringSQL -> StringSQL
SQL.and QuerySuffix
keyAssigns]
where
assigns :: QuerySuffix -> QuerySuffix
assigns QuerySuffix
cs = [ StringSQL
c StringSQL -> StringSQL -> StringSQL
.=. StringSQL
"?" | StringSQL
c <- QuerySuffix
cs ]
updAssigns :: QuerySuffix
updAssigns = QuerySuffix -> QuerySuffix
assigns QuerySuffix
cols
keyAssigns :: QuerySuffix
keyAssigns = QuerySuffix -> QuerySuffix
assigns QuerySuffix
key
updateOtherThanKeySQL' :: String
-> [StringSQL]
-> [Int]
-> String
updateOtherThanKeySQL' :: String -> QuerySuffix -> [Int] -> String
updateOtherThanKeySQL' String
table QuerySuffix
cols [Int]
ixs =
String -> QuerySuffix -> QuerySuffix -> String
updateSQL' String
table QuerySuffix
updColumns QuerySuffix
keyColumns
where
width' :: Int
width' = forall (t :: * -> *) a. Foldable t => t a -> Int
length QuerySuffix
cols
cols' :: Array Int StringSQL
cols' = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
width' forall a. Num a => a -> a -> a
-Int
1) QuerySuffix
cols
otherThanKey :: [Int]
otherThanKey = [Int] -> Int -> [Int]
untypedUpdateValuesIndex [Int]
ixs Int
width'
columns' :: [Int] -> QuerySuffix
columns' [Int]
is = [ Array Int StringSQL
cols' forall i e. Ix i => Array i e -> i -> e
! Int
i | Int
i <- [Int]
is ]
updColumns :: QuerySuffix
updColumns = [Int] -> QuerySuffix
columns' [Int]
otherThanKey
keyColumns :: QuerySuffix
keyColumns = [Int] -> QuerySuffix
columns' [Int]
ixs
updateOtherThanKeySQL :: Table r
-> Pi r p
-> String
updateOtherThanKeySQL :: forall r p. Table r -> Pi r p -> String
updateOtherThanKeySQL Table r
tbl Pi r p
key =
String -> QuerySuffix -> [Int] -> String
updateOtherThanKeySQL' (forall r. Table r -> String
name Table r
tbl) (forall r. Table r -> QuerySuffix
columns Table r
tbl) (forall a b. PersistableRecordWidth a -> Pi a b -> [Int]
expandIndexes' (forall r. Table r -> PersistableRecordWidth r
recordWidth Table r
tbl) Pi r p
key)
insertPrefixSQL :: Pi r r' -> Table r -> StringSQL
insertPrefixSQL :: forall r r'. Pi r r' -> Table r -> StringSQL
insertPrefixSQL Pi r r'
pi' Table r
table =
StringSQL
INSERT forall a. Semigroup a => a -> a -> a
<> StringSQL
INTO forall a. Semigroup a => a -> a -> a
<> String -> StringSQL
stringSQL (forall r. Table r -> String
name Table r
table) forall a. Semigroup a => a -> a -> a
<> QuerySuffix -> StringSQL
rowConsStringSQL QuerySuffix
cols where
cols :: QuerySuffix
cols = forall c r. Record c r -> QuerySuffix
Record.columns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b.
PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
Record.wpi (forall r. Table r -> PersistableRecordWidth r
recordWidth Table r
table) (forall r c. Table r -> Record c r
Record.unsafeFromTable Table r
table) forall a b. (a -> b) -> a -> b
$ Pi r r'
pi'
deletePrefixSQL' :: String -> StringSQL
deletePrefixSQL' :: String -> StringSQL
deletePrefixSQL' String
table = StringSQL
DELETE forall a. Semigroup a => a -> a -> a
<> StringSQL
FROM forall a. Semigroup a => a -> a -> a
<> String -> StringSQL
stringSQL String
table
deletePrefixSQL :: Table r
-> StringSQL
deletePrefixSQL :: forall r. Table r -> StringSQL
deletePrefixSQL = String -> StringSQL
deletePrefixSQL' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Table r -> String
name