khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-11-29 14:45:51 +03:00
Code Issues Projects Releases Wiki Activity

Update along with renamed SQL operators.

Browse Source
This commit is contained in:
Kei Hibino 2013-04-27 01:05:57 +09:00
parent 60701b5b32
commit ea250cdd4c
2 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
schema-th/src/Database/HDBC/Schema/PostgreSQL.hs
View File

@ -35,7 +35,7 @@ import qualified Database.HDBC.Schema.PgCatalog.PgAttribute as Attr
import Database.HDBC.Schema.PgCatalog.PgType (PgType(..), tableOfPgType, fieldsOfPgType)
import qualified Database.HDBC.Schema.PgCatalog.PgType as Type
import Language.SQL.Keyword (Keyword(..), (<.>), (<=>))
import Language.SQL.Keyword (Keyword(..), (<.>), (.=.))
import qualified Language.SQL.Keyword as SQL
import Database.HDBC.Schema.Driver
@ -103,9 +103,9 @@ relOidQuerySQL =
pgCatalog <.> "pg_namespace", AS, "nsp", ",",
pgCatalog <.> "pg_class", AS, "rel",
WHERE,
"rel" <.> "relnamespace" <=> "nsp" <.> "oid", AND,
"rel" <.> "relnamespace" .=. "nsp" <.> "oid", AND,
"nspname" <=> "?", AND, "relname" <=> "?"
"nspname" .=. "?", AND, "relname" .=. "?"
]
attributeQuerySQL :: Query (Singleton String, Singleton String) PgAttribute
@ -118,7 +118,7 @@ attributeQuerySQL =
"(", SQL.word $ untypeQuery relOidQuerySQL, ")", AS, "rel", ",",
SQL.word tableOfPgAttribute, AS, "att",
WHERE,
"attrelid" <=> "rel_object_id", AND,
"attrelid" .=. "rel_object_id", AND,
"attnum", ">", "0" -- attnum of normal attributes begins from 1
]
@ -134,8 +134,8 @@ columnQuerySQL =
"(", SQL.word $ untypeQuery attributeQuerySQL, ")", AS, "att", ",",
SQL.word tableOfPgType, AS, "typ",
WHERE,
"atttypid" <=> "typ" <.> "oid", AND,
"typ" <.> "typtype" <=> "'b'", AND,
"atttypid" .=. "typ" <.> "oid", AND,
"typ" <.> "typtype" .=. "'b'", AND,
"(",
"typcategory = 'B'", OR,
"typcategory = 'D'", OR,
@ -152,12 +152,12 @@ primaryKeyQuerySQL =
"(", SQL.word $ untypeQuery attributeQuerySQL, ")", AS, "att", ",",
pgCatalog <.> "pg_constraint", AS, "con",
WHERE,
"conrelid" <=> "attrelid", AND,
"conkey[1]" <=> "attnum", AND,
"conrelid" .=. "attrelid", AND,
"conkey[1]" .=. "attnum", AND,
"attnotnull" <=> "TRUE", AND,
"contype" <=> "'p'", AND,
"array_length (conkey, 1)" <=> "1"]
"attnotnull" .=. "TRUE", AND,
"contype" .=. "'p'", AND,
"array_length (conkey, 1)" .=. "1"]
logPrefix :: String -> String
logPrefix = ("PostgreSQL: " ++)

6
schema-th/src/Database/HDBC/TH.hs
View File

@ -78,7 +78,7 @@ import Database.Record.FromSql (FromSql(recordFromSql), recordFromSql')
import Database.Record.ToSql (ToSql(recordToSql), recordToSql')
import Database.HDBC.Record.Persistable ()
import Database.HDBC.Record.Query (Query, typedQuery)
import Language.SQL.Keyword (Keyword(..), (<=>))
import Language.SQL.Keyword (Keyword(..), (.=.))
import qualified Language.SQL.Keyword as SQL
import Database.HDBC.Schema.Driver (Driver, getFields, getPrimaryKey)
@ -336,7 +336,7 @@ defineSqlPrimarySelect name' (table, recordType) fields pkey =
defineConstantSqlQuery pkeyType recordType name'
. SQL.unwordsSQL
$ [SELECT, fields' `SQL.sepBy` ", ",
FROM, SQL.word table, WHERE, SQL.word pkey <=> "?"]
FROM, SQL.word table, WHERE, SQL.word pkey .=. "?"]
where fields' = map (SQL.word . fst) fields
pkeyType = fromJust $ lookup pkey fields
@ -346,7 +346,7 @@ defineSqlPrimaryUpdate name' table fields pkey =
. SQL.unwordsSQL
$ [UPDATE, SQL.word table, SET, assignments `SQL.sepBy` ", ",
WHERE, SQL.word pkey, "= ?"]
where assignments = map (\f -> SQL.word f <=> "?") . filter (/= pkey) $ fields
where assignments = map (\f -> SQL.word f .=. "?") . filter (/= pkey) $ fields
defineSqlInsert :: VarName -> String -> [String] -> Q [Dec]
defineSqlInsert name' table fields = do