relational-query 0.8.0.5 → 0.8.1.0

raw patch · 5 files changed

+35/−17 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• relational-query.cabal +1/−1
• src/Database/Relational/Query.hs +1/−1
• src/Database/Relational/Query/Component.hs +15/−5
• src/Database/Relational/Query/TH.hs +14/−10

@@ -1,5 +1,9 @@ <!-- -*- Markdown -*- --> +## 0.8.1.0++- Add schemaNameMode configuration.+ ## 0.8.0.5  - Update tests along with deprecations.

@@ -1,5 +1,5 @@ name:                relational-query-version:             0.8.0.5+version:             0.8.1.0 synopsis:            Typeful, Modular, Relational, algebraic query engine description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can

@@ -50,7 +50,7 @@    Primary, Unique, NotNull) import Database.Relational.Query.Context import Database.Relational.Query.Component-  (NameConfig (..), Config (..), defaultConfig, ProductUnitSupport (..), Order (..))+  (NameConfig (..), SchemaNameMode (..), Config (..), defaultConfig, ProductUnitSupport (..), Order (..)) import Database.Relational.Query.Sub (SubQuery, unitSQL, queryWidth) import Database.Relational.Query.Projection (Projection, list) import Database.Relational.Query.Projectable

@@ -18,8 +18,10 @@           -- * Configuration type for query          NameConfig (..),+         SchemaNameMode (..),          Config ( productUnitSupport                 , chunksInsertSize+                , schemaNameMode                 , normalizedTableName                 , verboseAsCompilerWarning                 , nameConfig),@@ -101,14 +103,21 @@ instance Show NameConfig where   show = const "<NameConfig>" +-- | Schema name qualify mode in SQL string.+data SchemaNameMode+  = SchemaQualified     -- ^ Schema qualified table name in SQL string+  | SchemaNotQualified  -- ^ Not qualified table name in SQL string+  deriving (Eq, Show)+ -- | Configuration type. data Config =   Config-  { productUnitSupport        ::  ProductUnitSupport-  , chunksInsertSize          ::  Int-  , normalizedTableName       ::  Bool-  , verboseAsCompilerWarning  ::  Bool-  , nameConfig                ::  NameConfig+  { productUnitSupport        ::  !ProductUnitSupport+  , chunksInsertSize          ::  !Int+  , schemaNameMode            ::  !SchemaNameMode+  , normalizedTableName       ::  !Bool+  , verboseAsCompilerWarning  ::  !Bool+  , nameConfig                ::  !NameConfig   } deriving Show  -- | Default configuration.@@ -116,6 +125,7 @@ defaultConfig =   Config { productUnitSupport        =  PUSupported          , chunksInsertSize          =  256+         , schemaNameMode            =  SchemaQualified          , normalizedTableName       =  True          , verboseAsCompilerWarning  =  False          , nameConfig                =  NameConfig { recordConfig     =  RecordTH.defaultNameConfig

@@ -85,7 +85,8 @@  import Database.Relational.Query   (Table, Pi, id', Relation, ProductConstructor (..),-   NameConfig (..), Config (normalizedTableName, nameConfig), defaultConfig,+   NameConfig (..), SchemaNameMode (..),+   Config (normalizedTableName, schemaNameMode, nameConfig), defaultConfig,    relationalQuerySQL, Query, relationalQuery, KeyUpdate,    Insert, derivedInsert, InsertQuery, derivedInsertQuery,    HasConstraintKey(constraintKey), Primary, NotNull, primary, primaryUpdate)@@ -258,14 +259,17 @@   dDs <- defineTableDerivations tableVar' relVar' insVar' insQVar' recordType'   return $ iDs ++ dDs -tableSQL :: Bool -> String -> String -> String-tableSQL normalize schema table = normalizeS schema ++ '.' : normalizeT table  where-  normalizeS-    | normalize = map toUpper-    | otherwise = id-  normalizeT-    | normalize = map toLower-    | otherwise = id+tableSQL :: Bool -> SchemaNameMode -> String -> String -> String+tableSQL normalize snm schema table = case snm of+  SchemaQualified     ->  normalizeS ++ '.' : normalizeT+  SchemaNotQualified  ->  normalizeT+  where+    normalizeS+      | normalize = map toUpper schema+      | otherwise = schema+    normalizeT+      | normalize = map toLower table+      | otherwise = table  derivationVarNameDefault :: String -> VarName derivationVarNameDefault =  (`varNameWithPrefix` "derivationFrom")@@ -328,7 +332,7 @@              (table `varNameWithPrefix` "insert")              (table `varNameWithPrefix` "insertQuery")              (recordType recConfig schema table)-             (tableSQL (normalizedTableName config) schema table)+             (tableSQL (normalizedTableName config) (schemaNameMode config) schema table)              (map (fst . fst) columns)   colsDs <- defineColumnsDefault (recordTypeName recConfig schema table) columns   return $ tableDs ++ colsDs