khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-12-03 15:47:08 +03:00
Code Issues Projects Releases Wiki Activity

Move system catalog schemas into relational-join package which doesn't depend on HDBC.

Browse Source 
--HG--
rename : schema-th/src/Database/HDBC/Schema/PgCatalog/PgAttribute.hs => relational-join/src/Database/Relational/Schema/PgCatalog/PgAttribute.hs
rename : schema-th/src/Database/HDBC/Schema/PgCatalog/PgType.hs => relational-join/src/Database/Relational/Schema/PgCatalog/PgType.hs
This commit is contained in:
Kei Hibino 2013-05-15 01:10:06 +09:00
parent 4c449348df
commit e731a0ea16
9 changed files with 149 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
relational-join/relational-join.cabal
View File

@ -32,6 +32,11 @@ library
Database.Relational.Query.Type
Database.Relational.Query.Derives
Database.Relational.Query.TH
Database.Relational.Schema.DB2Syscat.Columns
Database.Relational.Schema.PgCatalog.PgAttribute
Database.Relational.Schema.PgCatalog.PgType
-- other-modules:
build-depends: base <5
, array

9
relational-join/src/Database/Relational/Query/Table.hs
View File

@ -1,15 +1,15 @@
module Database.Relational.Query.Table (
Untyped, name', width', columns', (!),
Table, unType, name, width, columns, index, table, outer,
Table, unType, name, shortName, width, columns, index, table, outer,
) where
import Data.Array (Array, listArray, elems)
import qualified Data.Array as Array
data Untyped = Untyped
{ name' :: String
, width' :: Int
{ name' :: String
, width' :: Int
, columnArray :: Array Int String
}
@ -25,6 +25,9 @@ newtype Table r = Table { unType :: Untyped }
name :: Table r -> String
name = name' . unType
shortName :: Table r -> String
shortName = tail . dropWhile (/= '.') . name
width :: Table r -> Int
width = width' . unType

97
relational-join/src/Database/Relational/Schema/DB2Syscat/Columns.hs Normal file
View File

@ -0,0 +1,97 @@
{-# LANGUAGE TemplateHaskell #-}
-- |
-- Module : Database.Relational.Schema.DB2Syscat.Columns
-- Copyright : 2013 Kei Hibino
-- License : BSD3
--
-- Maintainer : ex8k.hibino@gmail.com
-- Stability : experimental
-- Portability : unknown
module Database.Relational.Schema.DB2Syscat.Columns where
import Data.Int (Int16, Int32, Int64)
import Database.Record.TH (derivingShow)
import Database.Relational.Query.TH (defineTableTypesAndRecordDefault)
$(defineTableTypesAndRecordDefault
"SYSCAT" "columns"
[
-- column schema type length NULL
-- ------------------------------ --------- ------------------ -------- ----- ------
-- TABSCHEMA SYSIBM VARCHAR 128 0 No
("tabschema", [t|String|]),
-- TABNAME SYSIBM VARCHAR 128 0 No
("tabname", [t|String|]),
-- COLNAME SYSIBM VARCHAR 128 0 No
("colname", [t|String|]),
-- COLNO SYSIBM SMALLINT 2 0 No
("colno", [t|Int16|]),
-- TYPESCHEMA SYSIBM VARCHAR 128 0 No
("typeschema", [t|String|]),
-- TYPENAME SYSIBM VARCHAR 18 0 No
("typename", [t|String|]),
-- LENGTH SYSIBM INTEGER 4 0 No
("length", [t|Int32|]),
-- SCALE SYSIBM SMALLINT 2 0 No
("scale", [t|Int16|]),
-- DEFAULT SYSIBM VARCHAR 254 0 Yes
("default", [t|Maybe String|]),
-- NULLS SYSIBM CHARACTER 1 0 No
("nulls", [t|String|]),
-- CODEPAGE SYSIBM SMALLINT 2 0 No
("codepage", [t|Int16|]),
-- LOGGED SYSIBM CHARACTER 1 0 No
("logged", [t|String|]),
-- COMPACT SYSIBM CHARACTER 1 0 No
("compact", [t|String|]),
-- COLCARD SYSIBM BIGINT 8 0 No
("colcard", [t|Int64|]),
-- HIGH2KEY SYSIBM VARCHAR 254 0 Yes
("high2key", [t|Maybe String|]),
-- LOW2KEY SYSIBM VARCHAR 254 0 Yes
("low2key", [t|Maybe String|]),
-- AVGCOLLEN SYSIBM INTEGER 4 0 No
("avgcollen", [t|Int32|]),
-- KEYSEQ SYSIBM SMALLINT 2 0 Yes
("keyseq", [t|Maybe Int16|]),
-- PARTKEYSEQ SYSIBM SMALLINT 2 0 Yes
("partkeyseq", [t|Maybe Int16|]),
-- NQUANTILES SYSIBM SMALLINT 2 0 No
("nquantiles", [t|Int16|]),
-- NMOSTFREQ SYSIBM SMALLINT 2 0 No
("nmostfreq", [t|Int16|]),
-- NUMNULLS SYSIBM BIGINT 8 0 No
("numnulls", [t|Int64|]),
-- TARGET_TYPESCHEMA SYSIBM VARCHAR 128 0 Yes
("target_typeschema", [t|Maybe String|]),
-- TARGET_TYPENAME SYSIBM VARCHAR 18 0 Yes
("target_typename", [t|Maybe String|]),
-- SCOPE_TABSCHEMA SYSIBM VARCHAR 128 0 Yes
("scope_tabschema", [t|Maybe String|]),
-- SCOPE_TABNAME SYSIBM VARCHAR 128 0 Yes
("scope_tabname", [t|Maybe String|]),
-- SOURCE_TABSCHEMA SYSIBM VARCHAR 128 0 Yes
("source_tabschema", [t|Maybe String|]),
-- SOURCE_TABNAME SYSIBM VARCHAR 128 0 Yes
("source_tabname", [t|Maybe String|]),
-- DL_FEATURES SYSIBM CHARACTER 10 0 Yes
("dl_features", [t|Maybe String|]),
-- SPECIAL_PROPS SYSIBM CHARACTER 8 0 Yes
("special_props", [t|Maybe String|]),
-- HIDDEN SYSIBM CHARACTER 1 0 No
("hidden", [t|String|]),
-- INLINE_LENGTH SYSIBM INTEGER 4 0 No
("inline_length", [t|Int32|]),
-- IDENTITY SYSIBM CHARACTER 1 0 No
("identity", [t|String|]),
-- GENERATED SYSIBM CHARACTER 1 0 No
("generated", [t|String|]),
-- TEXT SYSIBM CLOB 65538 0 Yes
("text", [t|Maybe String|]),
-- REMARKS SYSIBM VARCHAR 254 0 Yes
("remarks", [t|Maybe String|])
]
[derivingShow])

9
schema-th/src/Database/HDBC/Schema/PgCatalog/PgAttribute.hs → relational-join/src/Database/Relational/Schema/PgCatalog/PgAttribute.hs
View File

@ -1,5 +1,4 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- |
-- Module : Database.HDBC.Schema.PgCatalog.PgAttribute
@ -9,20 +8,14 @@
-- Maintainer : ex8k.hibino@gmail.com
-- Stability : experimental
-- Portability : unknown
module Database.HDBC.Schema.PgCatalog.PgAttribute where
module Database.Relational.Schema.PgCatalog.PgAttribute where
import Data.Int (Int16, Int32)
import Database.HDBC (SqlValue)
import Database.HDBC.Record.Persistable ()
import Database.Record.TH (derivingShow)
import Database.Relational.Query.TH (defineTableTypesAndRecordDefault)
$(defineTableTypesAndRecordDefault
[t| SqlValue |]
"PG_CATALOG" "pg_attribute"
[

11
schema-th/src/Database/HDBC/Schema/PgCatalog/PgType.hs → relational-join/src/Database/Relational/Schema/PgCatalog/PgType.hs
View File

@ -1,28 +1,21 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- |
-- Module : Database.HDBC.Schema.PgCatalog.PgType
-- Module : Database.Relational.Schema.PgCatalog.PgType
-- Copyright : 2013 Kei Hibino
-- License : BSD3
--
-- Maintainer : ex8k.hibino@gmail.com
-- Stability : experimental
-- Portability : unknown
module Database.HDBC.Schema.PgCatalog.PgType where
module Database.Relational.Schema.PgCatalog.PgType where
import Data.Int (Int16, Int32)
import Database.HDBC (SqlValue)
import Database.HDBC.Record.Persistable ()
import Database.Record.TH (derivingShow)
import Database.Relational.Query.TH (defineTableTypesAndRecordDefault)
$(defineTableTypesAndRecordDefault
[t| SqlValue |]
"PG_CATALOG" "pg_type"
[

4
schema-th/HDBC-schema-th.cabal
View File

@ -27,8 +27,8 @@ library
Database.HDBC.SqlValueExtra
Database.HDBC.Schema.Driver
Database.HDBC.Schema.IBMDB2
Database.HDBC.Schema.PgCatalog.PgAttribute
Database.HDBC.Schema.PgCatalog.PgType
-- Database.HDBC.Schema.PgCatalog.PgAttribute
-- Database.HDBC.Schema.PgCatalog.PgType
Database.HDBC.Schema.PostgreSQL
build-depends: base <5

92
schema-th/src/Database/HDBC/Schema/IBMDB2.hs
View File

@ -23,6 +23,7 @@ import Data.Map (Map, fromList)
import qualified Data.Map as Map
import Data.Time (LocalTime, Day)
import Language.Haskell.TH (TypeQ)
import qualified Language.Haskell.TH.Name.CamelCase as TH
import qualified Language.Haskell.TH.Name.Extra as TH
import Database.HDBC (IConnection, SqlValue)
@ -31,6 +32,7 @@ import Database.HDBC.Record.Query (runQuery', listToUnique)
import Database.HDBC.Record.Persistable ()
import Database.Record.TH (derivingShow)
import Database.Record.TH (defineRecordWithSqlTypeDefaultFromDefined)
import qualified Database.Relational.Query.Table as Table
import Database.Relational.Query.Type (unsafeTypedQuery, fromRelation)
@ -44,90 +46,8 @@ import qualified Language.SQL.Keyword as SQL
import Database.HDBC.Schema.Driver
(TypeMap, Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
$(defineTableTypesAndRecordDefault
[t| SqlValue |]
"SYSCAT" "columns"
[
-- column schema type length NULL
-- ------------------------------ --------- ------------------ -------- ----- ------
-- TABSCHEMA SYSIBM VARCHAR 128 0 No
("tabschema", [t|String|]),
-- TABNAME SYSIBM VARCHAR 128 0 No
("tabname", [t|String|]),
-- COLNAME SYSIBM VARCHAR 128 0 No
("colname", [t|String|]),
-- COLNO SYSIBM SMALLINT 2 0 No
("colno", [t|Int16|]),
-- TYPESCHEMA SYSIBM VARCHAR 128 0 No
("typeschema", [t|String|]),
-- TYPENAME SYSIBM VARCHAR 18 0 No
("typename", [t|String|]),
-- LENGTH SYSIBM INTEGER 4 0 No
("length", [t|Int32|]),
-- SCALE SYSIBM SMALLINT 2 0 No
("scale", [t|Int16|]),
-- DEFAULT SYSIBM VARCHAR 254 0 Yes
("default", [t|Maybe String|]),
-- NULLS SYSIBM CHARACTER 1 0 No
("nulls", [t|String|]),
-- CODEPAGE SYSIBM SMALLINT 2 0 No
("codepage", [t|Int16|]),
-- LOGGED SYSIBM CHARACTER 1 0 No
("logged", [t|String|]),
-- COMPACT SYSIBM CHARACTER 1 0 No
("compact", [t|String|]),
-- COLCARD SYSIBM BIGINT 8 0 No
("colcard", [t|Int64|]),
-- HIGH2KEY SYSIBM VARCHAR 254 0 Yes
("high2key", [t|Maybe String|]),
-- LOW2KEY SYSIBM VARCHAR 254 0 Yes
("low2key", [t|Maybe String|]),
-- AVGCOLLEN SYSIBM INTEGER 4 0 No
("avgcollen", [t|Int32|]),
-- KEYSEQ SYSIBM SMALLINT 2 0 Yes
("keyseq", [t|Maybe Int16|]),
-- PARTKEYSEQ SYSIBM SMALLINT 2 0 Yes
("partkeyseq", [t|Maybe Int16|]),
-- NQUANTILES SYSIBM SMALLINT 2 0 No
("nquantiles", [t|Int16|]),
-- NMOSTFREQ SYSIBM SMALLINT 2 0 No
("nmostfreq", [t|Int16|]),
-- NUMNULLS SYSIBM BIGINT 8 0 No
("numnulls", [t|Int64|]),
-- TARGET_TYPESCHEMA SYSIBM VARCHAR 128 0 Yes
("target_typeschema", [t|Maybe String|]),
-- TARGET_TYPENAME SYSIBM VARCHAR 18 0 Yes
("target_typename", [t|Maybe String|]),
-- SCOPE_TABSCHEMA SYSIBM VARCHAR 128 0 Yes
("scope_tabschema", [t|Maybe String|]),
-- SCOPE_TABNAME SYSIBM VARCHAR 128 0 Yes
("scope_tabname", [t|Maybe String|]),
-- SOURCE_TABSCHEMA SYSIBM VARCHAR 128 0 Yes
("source_tabschema", [t|Maybe String|]),
-- SOURCE_TABNAME SYSIBM VARCHAR 128 0 Yes
("source_tabname", [t|Maybe String|]),
-- DL_FEATURES SYSIBM CHARACTER 10 0 Yes
("dl_features", [t|Maybe String|]),
-- SPECIAL_PROPS SYSIBM CHARACTER 8 0 Yes
("special_props", [t|Maybe String|]),
-- HIDDEN SYSIBM CHARACTER 1 0 No
("hidden", [t|String|]),
-- INLINE_LENGTH SYSIBM INTEGER 4 0 No
("inline_length", [t|Int32|]),
-- IDENTITY SYSIBM CHARACTER 1 0 No
("identity", [t|String|]),
-- GENERATED SYSIBM CHARACTER 1 0 No
("generated", [t|String|]),
-- TEXT SYSIBM CLOB 65538 0 Yes
("text", [t|Maybe String|]),
-- REMARKS SYSIBM VARCHAR 254 0 Yes
("remarks", [t|Maybe String|])
]
[derivingShow])
import Database.Relational.Schema.DB2Syscat.Columns
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault =
@ -188,6 +108,10 @@ primaryKeyQuerySQL =
"const.tabschema = ?", AND, "const.tabname = ?"]
$(defineRecordWithSqlTypeDefaultFromDefined
[t| SqlValue |] (Table.shortName tableOfColumns))
logPrefix :: String -> String
logPrefix = ("IBMDB2: " ++)

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

@ -1,5 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- |
-- Module : Database.HDBC.Schema.PostgreSQL
@ -14,6 +15,7 @@ module Database.HDBC.Schema.PostgreSQL (
) where
import Language.Haskell.TH (TypeQ)
import qualified Language.Haskell.TH.Name.CamelCase as TH
import qualified Language.Haskell.TH.Name.Extra as TH
import Data.Int (Int16, Int32, Int64)
@ -24,24 +26,27 @@ import Data.Time
(DiffTime, NominalDiffTime,
LocalTime, ZonedTime, Day, TimeOfDay)
import Database.HDBC (IConnection)
import Database.HDBC (IConnection, SqlValue)
import Database.Record.TH (defineRecordWithSqlTypeDefaultFromDefined)
import qualified Database.Relational.Query.Table as Table
import Database.Relational.Query.Type (unsafeTypedQuery)
import Database.Relational.Query (Query(untypeQuery))
import Database.HDBC.Record.Query (runQuery', listToUnique)
import Database.HDBC.Schema.PgCatalog.PgAttribute (PgAttribute, tableOfPgAttribute)
import qualified Database.HDBC.Schema.PgCatalog.PgAttribute as Attr
import Database.HDBC.Schema.PgCatalog.PgType (PgType(..), tableOfPgType)
import qualified Database.HDBC.Schema.PgCatalog.PgType as Type
import Database.Relational.Schema.PgCatalog.PgAttribute (PgAttribute(PgAttribute), tableOfPgAttribute)
import qualified Database.Relational.Schema.PgCatalog.PgAttribute as Attr
import Database.Relational.Schema.PgCatalog.PgType (PgType(..), tableOfPgType)
import qualified Database.Relational.Schema.PgCatalog.PgType as Type
import Language.SQL.Keyword (Keyword(..), (<.>), (.=.))
import qualified Language.SQL.Keyword as SQL
import Database.HDBC.Record.Persistable ()
import Database.HDBC.Schema.Driver
(TypeMap, Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault =
fromList [("bool", [t| Bool |]),
@ -160,6 +165,13 @@ primaryKeyQuerySQL =
"contype" .=. "'p'", AND,
"array_length (conkey, 1)" .=. "1"]
$(defineRecordWithSqlTypeDefaultFromDefined
[t| SqlValue |] (Table.shortName tableOfPgAttribute))
$(defineRecordWithSqlTypeDefaultFromDefined
[t| SqlValue |] (Table.shortName tableOfPgType))
logPrefix :: String -> String
logPrefix = ("PostgreSQL: " ++)

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

@ -29,18 +29,26 @@ import Database.HDBC (IConnection, SqlValue)
import Language.Haskell.TH.Name.CamelCase (ConName)
import Language.Haskell.TH (Q, runIO, TypeQ, Dec)
import Database.HDBC.Session (withConnectionIO)
import Database.Record.TH (defineRecordWithSqlTypeDefault)
import qualified Database.Relational.Query.TH as Relational
import Database.HDBC.Session (withConnectionIO)
import Database.HDBC.Record.Persistable ()
import Database.HDBC.Schema.Driver (Driver, getFields, getPrimaryKey)
defineTableDefault' :: String -> String -> [(String, TypeQ)] -> [ConName] -> Q [Dec]
defineTableDefault' = Relational.defineTableDefault' [t| SqlValue |]
defineTableDefault' schema table columns derives = do
modelD <- Relational.defineTableDefault' schema table columns derives
sqlvD <- defineRecordWithSqlTypeDefault [t| SqlValue |] table columns
return $ modelD ++ sqlvD
defineTableDefault :: String -> String -> [(String, TypeQ)] -> [ConName] -> Maybe Int -> Maybe Int -> Q [Dec]
defineTableDefault = Relational.defineTableDefault [t| SqlValue |]
defineTableDefault schema table columns derives primary notNull = do
modelD <- Relational.defineTableDefault schema table columns derives primary notNull
sqlvD <- defineRecordWithSqlTypeDefault [t| SqlValue |] table columns
return $ modelD ++ sqlvD
putLog :: String -> IO ()
putLog = putStrLn