module Database.Selda.Compile where
import Database.Selda.Column
import Database.Selda.Query.Type
import Database.Selda.SQL
import Database.Selda.SQL.Print
import Database.Selda.SqlType
import Database.Selda.Table
import Database.Selda.Table.Compile
import Database.Selda.Transform
import Database.Selda.Types
import Data.Proxy
import Data.Text (Text, empty)
import Data.Typeable
compile :: Result a => Query s a -> (Text, [Param])
compile = snd . compileWithTables
compileWithTables :: Result a => Query s a -> ([TableName], (Text, [Param]))
compileWithTables = compSql . snd . compQuery
compileInsert :: Insert a => Text -> Table a -> [a] -> (Text, [Param])
compileInsert _ _ [] = (empty, [])
compileInsert defkw tbl rows = compInsert defkw tbl (map params rows)
compileUpdate :: forall s a. (Columns (Cols s a), Result (Cols s a))
=> Table a
-> (Cols s a -> Cols s a)
-> (Cols s a -> Col s Bool)
-> (Text, [Param])
compileUpdate tbl upd check =
compUpdate (tableName tbl) predicate updated
where
names = map colName (tableCols tbl)
cs = toTup names
updated = zip names (finalCols (upd cs))
C predicate = check cs
compileDelete :: Columns (Cols s a)
=> Table a -> (Cols s a -> Col s Bool) -> (Text, [Param])
compileDelete tbl check = compDelete (tableName tbl) predicate
where C predicate = check $ toTup $ map colName $ tableCols tbl
compQuery :: Result a => Query s a -> (Int, SQL)
compQuery q =
(nameSupply st, SQL final (Product [srcs]) [] [] [] Nothing)
where
(cs, st) = runQueryM q
final = finalCols cs
sql = state2sql st
live = colNames final ++ allNonOutputColNames sql
srcs = removeDeadCols live sql
class Typeable (Res r) => Result r where
type Res r
toRes :: Proxy r -> [SqlValue] -> Res r
finalCols :: r -> [SomeCol]
instance (Typeable a, SqlType a, Result b) => Result (Col s a :*: b) where
type Res (Col s a :*: b) = a :*: Res b
toRes _ (x:xs) = fromSql x :*: toRes (Proxy :: Proxy b) xs
toRes _ _ = error "backend bug: too few result columns to toRes"
finalCols (a :*: b) = finalCols a ++ finalCols b
instance (Typeable a, SqlType a) => Result (Col s a) where
type Res (Col s a) = a
toRes _ [x] = fromSql x
toRes _ [] = error "backend bug: too few result columns to toRes"
toRes _ _ = error "backend bug: too many result columns to toRes"
finalCols (C c) = [Some c]