relational-postgresql8 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+57/−63 lines, 7 filesdep +transformersdep ~relational-querydep ~relational-query-HDBCPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependency ranges changed: relational-query, relational-query-HDBC

API changes (from Hackage documentation)

Files

• relational-postgresql8.cabal +5/−4
• src/Database/HDBC/Schema/PostgreSQL8.hs +37/−32
• src/Database/Relational/Schema/PgCatalog8/PgAttribute.hs +3/−6
• src/Database/Relational/Schema/PgCatalog8/PgClass.hs +3/−5
• src/Database/Relational/Schema/PgCatalog8/PgConstraint.hs +3/−5
• src/Database/Relational/Schema/PgCatalog8/PgNamespace.hs +3/−5
• src/Database/Relational/Schema/PgCatalog8/PgType.hs +3/−6

@@ -1,5 +1,5 @@ name:                relational-postgresql8-version:             0.1.0.0+version:             0.2.0.0 synopsis:            PostgreSQL v8.x driver for haskell-relational-record description:         This package contains a driver of old PostgreSQL for haskell-relational-record. homepage:            https://github.com/yuga/haskell-relational-record-driver-postgresql8@@ -30,13 +30,14 @@   build-depends:       base <5                      , containers                      , time+                     , transformers                      , persistable-record                      , HDBC >=2                      , names-th-                     , relational-query-                     , relational-query-HDBC+                     , relational-query >=0.8.0.0+                     , relational-query-HDBC >=0.2.0.0                      , template-haskell    hs-source-dirs:      src-  +   ghc-options:         -Wall

@@ -18,8 +18,11 @@   ) where  import Language.Haskell.TH (TypeQ)-import qualified Language.Haskell.TH.Lib.Extra as TH +import Control.Applicative ((<|>))+import Control.Monad (guard)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Maybe (MaybeT) import Data.Char (toLower) import Data.Map (fromList) @@ -38,7 +41,8 @@ import qualified Database.Relational.Schema.PgCatalog8.PgType as Type  import Database.HDBC.Schema.Driver-  (TypeMap, Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)+  (TypeMap, LogChan, putVerbose, maybeIO, failWith,+   Driver, hoistMaybe, getFieldsWithMap, getPrimaryKey, emptyDriver)   $(makeRecordPersistableWithSqlTypeDefaultFromDefined@@ -50,57 +54,58 @@ logPrefix :: String -> String logPrefix =  ("PostgreSQL: " ++) -putLog :: String -> IO ()-putLog =  TH.reportMessage . logPrefix+putLog :: LogChan -> String -> IO ()+putLog lchan = putVerbose lchan . logPrefix -compileErrorIO :: String -> IO a-compileErrorIO =  fail . logPrefix+compileError :: LogChan -> String -> MaybeT IO a+compileError lchan = failWith lchan . logPrefix  getPrimaryKey' :: IConnection conn-              => conn-              -> String-              -> String-              -> IO [String]-getPrimaryKey' conn scm' tbl' = do+               => conn+               -> LogChan+               -> String+               -> String+               -> IO [String]+getPrimaryKey' conn lchan scm' tbl' = do   let scm = map toLower scm'       tbl = map toLower tbl'   mayKeyLen <- runQuery' conn primaryKeyLengthQuerySQL (scm, tbl)   case mayKeyLen of     []        -> do-      putLog   "getPrimaryKey: Primary key not found."+      putLog lchan   "getPrimaryKey: Primary key not found."       return []     [keyLen]  -> do       primCols <- runQuery' conn (primaryKeyQuerySQL keyLen) (scm, tbl)       let primaryKeyCols = normalizeColumn `fmap` primCols-      putLog $ "getPrimaryKey: primary key = " ++ show primaryKeyCols+      putLog lchan $ "getPrimaryKey: primary key = " ++ show primaryKeyCols       return primaryKeyCols     _:_:_     -> do-      putLog   "getPrimaryKey: Fail to detect primary key. Something wrong."+      putLog lchan   "getPrimaryKey: Fail to detect primary key. Something wrong."       return [] -getFields' :: IConnection conn-          => TypeMap-          -> conn-          -> String-          -> String-          -> IO ([(String, TypeQ)], [Int])-getFields' tmap conn scm' tbl' = do+getColumns' :: IConnection conn+            => TypeMap+            -> conn+            -> LogChan+            -> String+            -> String+            -> IO ([(String, TypeQ)], [Int])+getColumns' tmap conn lchan scm' tbl' = maybeIO ([], []) id $ do   let scm = map toLower scm'       tbl = map toLower tbl'-  cols <- runQuery' conn columnQuerySQL (scm, tbl)-  case cols of-    [] ->  compileErrorIO-           $ "getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl-    _  ->  return ()+  cols <- lift $ runQuery' conn columnQuerySQL (scm, tbl)+  guard (not $ null cols) <|>+    compileError lchan+    ("getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl)    let notNullIdxs = map fst . filter (notNull . snd) . zip [0..] $ cols-  putLog+  lift . putLog lchan     $  "getFields: num of columns = " ++ show (length cols)     ++ ", not null columns = " ++ show notNullIdxs-  let getType' col = case getType (fromList tmap) col of-        Nothing -> compileErrorIO-                   $ "Type mapping is not defined against PostgreSQL type: " ++ Type.typname (snd col)-        Just p  -> return p+  let getType' col =+        hoistMaybe (getType (fromList tmap) col) <|>+        compileError lchan+        ("Type mapping is not defined against PostgreSQL type: " ++ Type.typname (snd col))    types <- mapM getType' cols   return (types, notNullIdxs)@@ -108,5 +113,5 @@ -- | Driver implementation driverPostgreSQL :: IConnection conn => Driver conn driverPostgreSQL =-  emptyDriver { getFieldsWithMap = getFields' }+  emptyDriver { getFieldsWithMap = getColumns' }               { getPrimaryKey    = getPrimaryKey' }

@@ -13,14 +13,11 @@  import Data.Int (Int16, Int32) -import Database.Record.TH (derivingShow)-import Database.Relational.Query.TH (defineTableTypesAndRecordDefault)-+import Database.Relational.Query.TH (defineTableTypesAndRecord) import Database.Relational.Schema.PgCatalog8.Config (config) -$(defineTableTypesAndRecordDefault config+$(defineTableTypesAndRecord config   "PG_CATALOG" "pg_attribute"-   [ -- Table "pg_catalog.pg_attribute" --     Column     |   Type    | Modifiers@@ -68,4 +65,4 @@ --  attfdwoptions | text[]    |           <- since 9.2     -- ("attfdwoptions", [t|String|])   ]-  [derivingShow])+  [''Show])

@@ -13,12 +13,10 @@  import Data.Int (Int32) -import Database.Record.TH (derivingShow)-import Database.Relational.Query.TH (defineTableTypesAndRecordDefault)-+import Database.Relational.Query.TH (defineTableTypesAndRecord) import Database.Relational.Schema.PgCatalog8.Config (config) -$(defineTableTypesAndRecordDefault config+$(defineTableTypesAndRecord config   "PG_CATALOG" "pg_class"   [("oid"         , [t| Int32 |]),  -- relname        | name      | not null@@ -55,4 +53,4 @@  -- relacl         | aclitem[] |  -- reloptions     | text[]    |          <= since 8.2   ]-  [derivingShow])+  [''Show])

@@ -13,12 +13,10 @@  import Data.Int (Int32) -import Database.Record.TH (derivingShow)-import Database.Relational.Query.TH (defineTableTypesAndRecordDefault)-+import Database.Relational.Query.TH (defineTableTypesAndRecord) import Database.Relational.Schema.PgCatalog8.Config (config) -$(defineTableTypesAndRecordDefault config+$(defineTableTypesAndRecord config   "PG_CATALOG" "pg_constraint"   [ -- ("oid"    , [t| Int32 |]),  -- conname       | name         | not null@@ -49,4 +47,4 @@  -- conbin        | pg_node_tree |  -- consrc        | text         |   ]-  [derivingShow])+  [''Show])

@@ -13,12 +13,10 @@  import Data.Int (Int32) -import Database.Record.TH (derivingShow)-import Database.Relational.Query.TH (defineTableTypesAndRecordDefault)-+import Database.Relational.Query.TH (defineTableTypesAndRecord) import Database.Relational.Schema.PgCatalog8.Config (config) -$(defineTableTypesAndRecordDefault config+$(defineTableTypesAndRecord config   "PG_CATALOG" "pg_namespace"   [("oid"    , [t| Int32 |]),  -- nspname  | name      | not null@@ -26,4 +24,4 @@  -- nspowner | oid       | not null  -- nspacl   | aclitem[] |   ]-  [derivingShow])+  [''Show])

@@ -13,14 +13,11 @@  import Data.Int (Int16, Int32) -import Database.Record.TH (derivingShow)-import Database.Relational.Query.TH (defineTableTypesAndRecordDefault)-+import Database.Relational.Query.TH (defineTableTypesAndRecord) import Database.Relational.Schema.PgCatalog8.Config (config) -$(defineTableTypesAndRecordDefault config+$(defineTableTypesAndRecord config   "PG_CATALOG" "pg_type"-   [     ("oid", [t|Int32|]), -- Table "pg_catalog.pg_type"@@ -87,4 +84,4 @@     ("typdefault", [t|Maybe String|]) --  typacl         | aclitem[]    |          <= since 9.2   ]-  [derivingShow])+  [''Show])