pg-schema 0.6.0.0 → 0.6.1.0
raw patch · 7 files changed
+79/−14 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- pg-schema.cabal +33/−7
- src/PgSchema/DML.hs +1/−1
- src/PgSchema/DML/InsertJSON.hs +9/−5
- src/PgSchema/Types.hs +12/−0
- test-pgs/Main.hs +1/−0
- test-pgs/Tests/BaseConverts.hs +19/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for pg-schema +## 0.6.1.0++- Bug fixing (ins/upsertJSON for json db-fields)+ ## 0.6.0.0 - Using Renamer for QueryParams and Cond
pg-schema.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.12 name: pg-schema-version: 0.6.0.0+version: 0.6.1.0 category: Database author: Dmitry Olshansky maintainer: olshanskydr@gmail.com@@ -35,6 +35,8 @@ Then we can write a function to insert an order with order positions. And select orders with order positions and articles in one request using some conditions for orders and order positions that return in order. + Note that all table names, field names and foreign key constraint names are checked in compile time!+ @ data Order = Order { num :: Text, createdAt :: Day, items :: [OrdPos] } deriving Generic data OrdPos = OrdPos { id :: Int32, num :: Int32, article :: Article, price :: Double } deriving Generic@@ -78,8 +80,23 @@ type: git location: https://github.com/odr/pg-schema +flag time+ description: Make CanConvert1 instances for Time types+ manual: True+ default: True++flag uuid+ description: Make CanConvert1 instances for UUID type+ manual: True+ default: True++flag case-insensitive+ description: Make CanConvert1 instances for CaseInsensitive type+ manual: True+ default: True+ flag arbitrary- description: Make Arbitrary instances for all types (Enums, PgTag, SchList)+ description: Make Arbitrary instances for all types (Enums, PgTag) manual: True default: False @@ -89,12 +106,12 @@ default: False flag flat- description: Make Flat instances for all types (Enums, PgTag, SchList)+ description: Make Flat instances for all types (Enums, PgTag) manual: True default: False flag hashable- description: Make Hashable instances for all types (Enums, PgTag, SchList)+ description: Make Hashable instances for all types (Enums, PgTag) manual: True default: False @@ -134,7 +151,6 @@ base >= 4.20 && < 5 , aeson >= 2.0 && < 2.3 , bytestring >= 0.10 && < 0.13- , case-insensitive >= 1.0 && < 1.3 , containers >= 0.7 && < 0.9 , directory >= 1.3 && < 1.5 , exceptions >= 0.9 && < 0.11@@ -144,8 +160,18 @@ , singletons >= 3.0.3 && < 3.1 , singletons-th >= 3.4 && < 3.6 , text >= 2.0 && < 2.2- , time >= 1.12 && < 2- , uuid-types >= 1.0 && < 1.1+ if flag(time)+ build-depends:+ time >= 1.12 && < 2+ cpp-options: -DMK_TIME+ if flag(uuid)+ build-depends:+ uuid-types >= 1.0 && < 1.1+ cpp-options: -DMK_UUID+ if flag(case-insensitive)+ build-depends:+ case-insensitive >= 1.0 && < 1.3+ cpp-options: -DMK_CASE_INSENSITIVE if flag(flat) build-depends: flat >= 0.6 && < 0.7 cpp-options: -DMK_FLAT
src/PgSchema/DML.hs view
@@ -108,7 +108,7 @@ -- * Types , Ann(..), ToStar -- ** Renamers- , RenamerId, CamelToSnake, Renamer, ApplyRenamer, ApplyRenamerNS+ , RenamerId, CamelToSnake, Renamer, ApplyRenamer -- , ApplyRenamerNS -- ** PgTag types , type (:=), (=:), PgTag(..), -- | Re-export from postgresql-simple
src/PgSchema/DML/InsertJSON.hs view
@@ -226,12 +226,16 @@ (plainsPK, plainsOthers) = L.partition ((`L.elem` foldMap fst mbKeyMand) . fst) plains jsonFld ip = case mapTypes M.!? ip.info.fdType of Just (TypDef "A" (Just t) _) ->- "case when jsonb_typeof(" <> rowN <> ".value->'" <> fromText ip.jsonName <> "') = 'array'"+ "case when jsonb_typeof(" <> rowN <> ".value->'" <> fld <> "') = 'array'" <> " then (select coalesce(array_agg(__x)::" <> fromText (qualName t) <> "[], '{}')"- <> " from jsonb_array_elements_text(" <> rowN <> ".value->'" <> fromText ip.jsonName <> "') __x) else null end"- _ ->- "(" <> rowN <> ".value->>'" <> fromText ip.jsonName <> "')::"- <> fromText (qualName ip.info.fdType)+ <> " from jsonb_array_elements_text(" <> rowN <> ".value->'" <> fld <> "') __x) else null end"+ _+ | tn == "json" || tn == "jsonb" -> "(" <> rowN <> ".value->'" <> fld <> "')"+ | otherwise -> "(" <> rowN <> ".value->>'" <> fld <> "')::" <> ty+ where+ fld = fromText ip.jsonName+ ty = fromText (qualName ip.info.fdType)+ tn = ip.info.fdType.nnsName rets | noRets = [] | otherwise = [" returning " <> intercalate' ", " qretFlds
src/PgSchema/Types.hs view
@@ -21,7 +21,9 @@ import Data.Aeson import Data.ByteString as BS import Data.ByteString.Lazy as BSL+#ifdef MK_CASE_INSENSITIVE import Data.CaseInsensitive+#endif import Data.Coerce import Data.Fixed import Data.Kind@@ -31,8 +33,12 @@ import Data.Singletons.TH import Data.Text as T import Data.Text.Encoding as T+#ifdef MK_TIME import Data.Time+#endif+#ifdef MK_UUID import Data.UUID.Types+#endif import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.FromField import Database.PostgreSQL.Simple.ToField@@ -338,25 +344,31 @@ type instance CanConvert1 sch tab fld (PGC "numeric") ('TypDef "N" x y) Scientific = () type instance CanConvert1 sch tab fld (PGC "oid") ('TypDef "N" x y) PgOid = () +#ifdef MK_TIME type instance CanConvert1 sch tab fld (PGC "date") ('TypDef "D" x y) Day = () type instance CanConvert1 sch tab fld (PGC "time") ('TypDef "D" x y) TimeOfDay = () type instance CanConvert1 sch tab fld (PGC "timestamp") ('TypDef "D" x y) LocalTime = () type instance CanConvert1 sch tab fld (PGC "timestamptz") ('TypDef "D" x y) ZonedTime = () type instance CanConvert1 sch tab fld (PGC "timestamptz") ('TypDef "D" x y) UTCTime = ()+#endif type instance CanConvert1 sch tab fld (PGC "char") ('TypDef "S" x y) PgChar = () type instance CanConvert1 sch tab fld (PGC "text") ('TypDef "S" x y) Text = () type instance CanConvert1 sch tab fld (PGC "varchar") ('TypDef "S" x y) Text = () type instance CanConvert1 sch tab fld (PGC "name") ('TypDef "S" x y) Text = ()+#if MK_CASE_INSENSITIVE type instance CanConvert1 sch tab fld (PGC "citext") ('TypDef "S" Nothing '[]) (CI Text) = () type instance CanConvert1 sch tab fld ("public" ->> "citext") ('TypDef "S" Nothing '[]) (CI Text) = ()+#endif type instance CanConvert1 sch tab fld (PGC "bytea") ('TypDef "U" x y) (Binary BS.ByteString) = () type instance CanConvert1 sch tab fld (PGC "bytea") ('TypDef "U" x y) (Binary BSL.ByteString) = () -- ^ Binary ByteString has no 'FromJSON'/'ToJSON' instances, so it can -- be used only in the root table. type instance CanConvert1 sch tab fld (PGC "jsonb") ('TypDef "U" x y) a = (FromJSON a, ToJSON a) type instance CanConvert1 sch tab fld (PGC "json") ('TypDef "U" x y) a = (FromJSON a, ToJSON a)+#ifdef MK_UUID type instance CanConvert1 sch tab fld (PGC "uuid") ('TypDef "U" x y) UUID = ()+#endif type instance CanConvert1 sch tab fld n ('TypDef "E" 'Nothing es) (PGEnum sch n) = ( TTypDef sch n ~ 'TypDef "E" 'Nothing es
test-pgs/Main.hs view
@@ -25,6 +25,7 @@ , testProperty "Array of base types" $ prop_base_arr_converts pool , testProperty "Extra types (bytea, jsonb, enums, uuid)" $ prop_ext_converts pool , testProperty "Array of extra types" $ prop_ext_arr_converts pool+ , testProperty "InsertJSON: json/jsonb string values use -> operator" $ prop_ext_converts_json_string_via_upsertjson pool ] , testGroup "Hierarchy (test_dml)" [ testProperty "Insert/Upsert/Select root with children (simple FK)" $ prop_hier_insert_simple_fk pool
test-pgs/Tests/BaseConverts.hs view
@@ -20,7 +20,7 @@ import qualified Data.Vector as Vec import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.Types (PGArray(..))-import Hedgehog+import Hedgehog as H import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Prelude as P@@ -107,3 +107,21 @@ recs <- forAll (genData ExtArrConverts) evalIO $ withPool pool \conn -> do void $ insSch_ "ext_arr_converts" conn recs++prop_ext_converts_json_string_via_upsertjson :: Pool Connection -> Property+prop_ext_converts_json_string_via_upsertjson pool = withTests 1 $ property do+ (sql, outSel) <- evalIO $ withPool pool \conn -> do+ delByCond "ext_converts" conn mempty+ sql' <- upsJSON_ "ext_converts" conn recs+ (xs, _) <- selSch "ext_converts" conn qpEmpty+ pure (sql', xs)+ H.assert $ "->'cjson'" `T.isInfixOf` sql+ H.assert $ "->'cjsonb'" `T.isInfixOf` sql+ H.assert $ not $ "->>'cjson'" `T.isInfixOf` sql+ H.assert $ not $ "->>'cjsonb'" `T.isInfixOf` sql+ L.sort outSel === L.sort recs+ where+ recs :: ["cjsonb" := Maybe Value :. "cjson" := Maybe Value]+ recs =+ [ "cjsonb" =: Just (String "Test")+ :. "cjson" =: Just (String "Test") ]