hpqtypes 1.4.0 → 1.4.1

raw patch · 11 files changed

+245/−73 lines, 11 filesdep +aesondep +scientificdep +unordered-containersdep ~vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, scientific, unordered-containers

Dependency ranges changed: vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• hpqtypes.cabal +13/−1
• libpqtypes/src/handler.c +8/−4
• libpqtypes/src/libpqtypes-int.h +7/−0
• libpqtypes/src/varlena.c +63/−0
• src/Database/PostgreSQL/PQTypes.hs +2/−0
• src/Database/PostgreSQL/PQTypes/Format.hs +10/−2
• src/Database/PostgreSQL/PQTypes/FromSQL.hs +12/−0
• src/Database/PostgreSQL/PQTypes/JSON.hs +99/−0
• src/Database/PostgreSQL/PQTypes/ToSQL.hs +12/−0
• test/Main.hs +15/−66

@@ -1,3 +1,7 @@+# hpqtypes-1.4.1 (2015-05-15)+* add support for json and jsonb sql types+* add support for lazy ByteString and Text+ # hpqtypes-1.4.0 (2015-02-26) * add support for QuickCheck 2.7 * add support for notifications

@@ -1,5 +1,5 @@ name:                hpqtypes-version:             1.4.0+version:             1.4.1 synopsis:            Haskell bindings to libpqtypes  description:         Efficient and easy-to-use bindings to (slightly modified)@@ -23,6 +23,7 @@                      .                      Examples can be found in the <https://github.com/scrive/hpqtypes/tree/master/examples examples> directory. +homepage:            https://github.com/scrive/hpqtypes license:             BSD3 license-file:        LICENSE author:              Scrive@@ -56,6 +57,10 @@                   , libpqtypes/src/libpqtypes-int.h                   , libpqtypes/src/libpqtypes.h +Source-repository head+  Type:     git+  Location: git@github.com:scrive/log.git+ Flag tests   description: Build test suite   default: False@@ -70,6 +75,7 @@                      , Database.PostgreSQL.PQTypes.Array                      , Database.PostgreSQL.PQTypes.Fold                      , Database.PostgreSQL.PQTypes.FromRow+                     , Database.PostgreSQL.PQTypes.JSON                      , Database.PostgreSQL.PQTypes.ToSQL                      , Database.PostgreSQL.PQTypes.Transaction                      , Database.PostgreSQL.PQTypes.Class@@ -102,6 +108,7 @@    build-depends:       base >= 4.5 && < 5                      , text >= 0.11+                     , aeson >= 0.6.2.0                      , bytestring >= 0.9                      , time >= 1.4                      , vector >= 0.10@@ -156,6 +163,7 @@   build-depends:       hpqtypes                      , base >= 4.5                      , text >= 0.11+                     , aeson >= 0.6.2.0                      , bytestring >= 0.9                      , time >= 1.4                      , transformers-base >= 0.4@@ -168,5 +176,9 @@                      , test-framework-hunit >= 0.3                      , random >= 1.0                      , exceptions >= 0.6+                     , scientific+                     , unordered-containers+                     , vector    main-is:           Main.hs+

@@ -115,11 +115,15 @@  	/* text passed as bytea to avoid double copy with ByteStringS 	 * and silent truncation of strings containting NULL characters */-	{34, "pg_catalog", "btext", -1, TEXTOID, 1009, pqt_put_bytea,-                pqt_get_bytea, __HANDLER_DEFAULTS__},+	{34, "pg_catalog", "btext", -1, TEXTOID, 1009, pqt_put_btext,+                pqt_get_btext, __HANDLER_DEFAULTS__}, -	{35, "pg_catalog", "xml", -1, XMLOID, 143, pqt_put_bytea,-		pqt_get_bytea, __HANDLER_DEFAULTS__}, /* supports ptr */+	{35, "pg_catalog", "json", -1, JSONOID, 199, pqt_put_btext,+		pqt_get_btext, __HANDLER_DEFAULTS__},+	{36, "pg_catalog", "jsonb", -1, JSONBOID, 3807, pqt_put_jsonb,+		pqt_get_jsonb, __HANDLER_DEFAULTS__},+	{37, "pg_catalog", "xml", -1, XMLOID, 143, pqt_put_btext,+		pqt_get_btext, __HANDLER_DEFAULTS__}, };  static int

@@ -257,6 +257,8 @@ #define ZPBITOID         1560 /* not supported yet */ #define VARBITOID        1562 /* not supported yet */ #define BYTEAOID           17+#define JSONOID           114+#define JSONBOID         3802 #define XMLOID            142 /* date and time types */ #define DATEOID          1082@@ -527,6 +529,11 @@ int pqt_get_text(PGtypeArgs *args); /* handles varchar, bpchar and name */ int pqt_put_bytea(PGtypeArgs *args); int pqt_get_bytea(PGtypeArgs *args);++int pqt_put_btext(PGtypeArgs *args);+int pqt_get_btext(PGtypeArgs *args);+int pqt_put_jsonb(PGtypeArgs *args);+int pqt_get_jsonb(PGtypeArgs *args);  #ifdef __cplusplus }

@@ -84,5 +84,68 @@ 	return 0; } +/*********************************/ +/* btext, text with explicitly passed length */+int+pqt_put_btext(PGtypeArgs *args)+{+	PGbytea *btext = va_arg(args->ap, PGbytea *);+	PUTNULLCHK(args, btext);+	args->put.out = btext->data;+	return btext->len;+} +/* btext, text with explicitly passed length */+int+pqt_get_btext(PGtypeArgs *args)+{+	DECLVALUE(args);+	DECLLENGTH(args);+	PGbytea *btext = va_arg(args->ap, PGbytea *);+	CHKGETVALS(args, btext);+	btext->len = valuel;+	btext->data = value;+	return 0;+}++int+pqt_get_jsonb(PGtypeArgs *args)+{+	DECLVALUE(args);+	DECLLENGTH(args);+	PGbytea *jsonb = va_arg(args->ap, PGbytea *);+	CHKGETVALS(args, jsonb);++	if (args->format == TEXTFMT)+		return args->errorf(args, "text format is not supported");+	if (valuel == 0)+		return args->errorf(args, "raw jsonb cannot have length 0");++	// check version number+	int version = (unsigned char)value[0];+	if (version != 1)+		return args->errorf(args, "unsupported jsonb version number %d", version);++	jsonb->len = valuel-1;+	jsonb->data = value+1;+	return 0;+}++int+pqt_put_jsonb(PGtypeArgs *args)+{+	PGbytea *jsonb = va_arg(args->ap, PGbytea *);+	PUTNULLCHK(args, jsonb);++	int jsonb_len = jsonb->len+1;+	// make sure args->put.out is large enough+	if (args->put.expandBuffer(args, jsonb_len) == -1)+		return -1;++	// version number+	args->put.out[0] = 1;+	// data+	memcpy(&args->put.out[1], jsonb->data, jsonb->len);+	return jsonb_len;+}

@@ -45,6 +45,7 @@   , module Database.PostgreSQL.PQTypes.FromRow   , module Database.PostgreSQL.PQTypes.FromSQL   , module Database.PostgreSQL.PQTypes.Interval+  , module Database.PostgreSQL.PQTypes.JSON   , module Database.PostgreSQL.PQTypes.Notification   , module Database.PostgreSQL.PQTypes.SQL   , module Database.PostgreSQL.PQTypes.SQL.Class@@ -76,6 +77,7 @@ import Database.PostgreSQL.PQTypes.FromRow import Database.PostgreSQL.PQTypes.FromSQL import Database.PostgreSQL.PQTypes.Interval+import Database.PostgreSQL.PQTypes.JSON import Database.PostgreSQL.PQTypes.Notification import Database.PostgreSQL.PQTypes.SQL import Database.PostgreSQL.PQTypes.SQL.Class

@@ -8,10 +8,12 @@ import Data.Int import Data.Functor.Identity import Data.Time-import Data.Text (Text) import Data.Typeable import Data.Word import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL  u :: a u = undefined@@ -86,7 +88,13 @@ instance PQFormat BS.ByteString where   pqFormat = const $ BS.pack "%btext" -instance PQFormat Text where+instance PQFormat BSL.ByteString where+  pqFormat = const $ BS.pack "%btext"++instance PQFormat T.Text where+  pqFormat = const $ BS.pack "%btext"++instance PQFormat TL.Text where   pqFormat = const $ BS.pack "%btext"  -- DATE

@@ -14,7 +14,9 @@ import Foreign.Storable import qualified Control.Exception as E import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T+import qualified Data.Text.Lazy as TL  import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.Internal.C.Types@@ -83,11 +85,21 @@   fromSQL Nothing = unexpectedNULL   fromSQL (Just bytea) = BS.packCStringLen $ byteaToCStringLen bytea +instance FromSQL BSL.ByteString where+  type PQBase BSL.ByteString = PGbytea+  fromSQL = fmap BSL.fromStrict . fromSQL+ -- | Assumes that source C string is UTF-8, so if you are working -- with a different encoding, you should not rely on this instance. instance FromSQL T.Text where   type PQBase T.Text = PGbytea   fromSQL mbytea = either E.throwIO return . decodeUtf8' =<< fromSQL mbytea++-- | Assumes that source C string is UTF-8, so if you are working+-- with a different encoding, you should not rely on this instance+instance FromSQL TL.Text where+  type PQBase TL.Text = PGbytea+  fromSQL = fmap TL.fromStrict . fromSQL  -- | Assumes that source C string is UTF-8, so if you are working -- with a different encoding, you should not rely on this instance.

@@ -0,0 +1,99 @@+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances+  , RankNTypes, TypeFamilies #-}+module Database.PostgreSQL.PQTypes.JSON (+    JSON(..)+  , JSONB(..)+  ) where++import Control.Applicative+import Data.Aeson+import Data.Typeable+import Foreign.Ptr+import qualified Control.Exception as E+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL++import Database.PostgreSQL.PQTypes.Format+import Database.PostgreSQL.PQTypes.FromSQL+import Database.PostgreSQL.PQTypes.Internal.C.Types+import Database.PostgreSQL.PQTypes.ToSQL++-- | Wrapper for (de)serializing underlying type as 'json'.+newtype JSON json = JSON { unJSON :: json }+  deriving (Eq, Functor, Ord, Show, Typeable)++instance PQFormat (JSON json) where+  pqFormat = const $ BS.pack "%json"++instance FromSQL (JSON BS.ByteString) where+  type PQBase (JSON BS.ByteString) = PGbytea+  fromSQL = fmap JSON . fromSQL++instance FromSQL (JSON BSL.ByteString) where+  type PQBase (JSON BSL.ByteString) = PGbytea+  fromSQL = fmap JSON . fromSQL++instance ToSQL (JSON BS.ByteString) where+  type PQDest (JSON BS.ByteString) = PGbytea+  toSQL = toSQL . unJSON++instance ToSQL (JSON BSL.ByteString) where+  type PQDest (JSON BSL.ByteString) = PGbytea+  toSQL = toSQL . unJSON++instance FromSQL (JSON Value) where+  type PQBase (JSON Value) = PGbytea+  fromSQL = valueFromSQL JSON++instance ToSQL (JSON Value) where+  type PQDest (JSON Value) = PGbytea+  toSQL = valueToSQL unJSON++----------------------------------------++-- | Wrapper for (de)serializing underlying type as 'jsonb'.+newtype JSONB jsonb = JSONB { unJSONB :: jsonb }+  deriving (Eq, Functor, Ord, Show, Typeable)++instance PQFormat (JSONB jsonb) where+  pqFormat = const $ BS.pack "%jsonb"++instance FromSQL (JSONB BS.ByteString) where+  type PQBase (JSONB BS.ByteString) = PGbytea+  fromSQL = fmap JSONB . fromSQL++instance FromSQL (JSONB BSL.ByteString) where+  type PQBase (JSONB BSL.ByteString) = PGbytea+  fromSQL = fmap JSONB . fromSQL++instance ToSQL (JSONB BS.ByteString) where+  type PQDest (JSONB BS.ByteString) = PGbytea+  toSQL = toSQL . unJSONB++instance ToSQL (JSONB BSL.ByteString) where+  type PQDest (JSONB BSL.ByteString) = PGbytea+  toSQL = toSQL . unJSONB++instance FromSQL (JSONB Value) where+  type PQBase (JSONB Value) = PGbytea+  fromSQL = valueFromSQL JSONB++instance ToSQL (JSONB Value) where+  type PQDest (JSONB Value) = PGbytea+  toSQL = valueToSQL unJSONB++----------------------------------------++valueFromSQL :: (Value -> json) -> Maybe PGbytea -> IO json+valueFromSQL jsonCon mbase = do+  evalue <- eitherDecodeStrict' <$> fromSQL mbase+  case evalue of+    Left err -> E.throwIO . E.ErrorCall $ "valueFromSQL: " ++ err+    Right value -> return $ jsonCon value++valueToSQL :: (json -> Value)+           -> json+           -> ParamAllocator+           -> (Ptr PGbytea -> IO r)+           -> IO r+valueToSQL jsonDecon = toSQL . BSL.toStrict . encode . jsonDecon

@@ -16,7 +16,9 @@ import Foreign.Ptr import Foreign.Storable import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T+import qualified Data.Text.Lazy as TL  import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.Internal.C.Interface@@ -105,11 +107,21 @@         then nullStringCStringLen         else cslen +instance ToSQL BSL.ByteString where+  type PQDest BSL.ByteString = PGbytea+  toSQL = toSQL . BSL.toStrict+ -- | Encodes underlying C string as UTF-8, so if you are working -- with a different encoding, you should not rely on this instance. instance ToSQL T.Text where   type PQDest T.Text = PGbytea   toSQL = toSQL . encodeUtf8++-- | Encodes underlying C string as UTF-8, so if you are working+-- with a different encoding, you should not rely on this instance.+instance ToSQL TL.Text where+  type PQDest TL.Text = PGbytea+  toSQL = toSQL . TL.toStrict  -- | Encodes underlying C string as UTF-8, so if you are working -- with a different encoding, you should not rely on this instance.

@@ -1,8 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable-  , FlexibleContexts, GeneralizedNewtypeDeriving, MultiParamTypeClasses-  , OverloadedStrings, RecordWildCards, ScopedTypeVariables-  , TypeFamilies, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, FlexibleContexts, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Main where  import Control.Applicative@@ -12,7 +9,7 @@ import Control.Monad.Catch import Control.Monad.State import Control.Monad.Trans.Control-import Data.Char+import Data.Aeson import Data.Int import Data.Maybe import Data.Time@@ -34,7 +31,7 @@ import Data.Monoid.Utils import Database.PostgreSQL.PQTypes import Prelude.Instances ()-import Test.QuickCheck.Arbitrary.Instances ()+import Test.QuickCheck.Arbitrary.Instances  type InnerTestEnv = StateT QCGen (DBT IO) @@ -74,37 +71,6 @@  ---------------------------------------- -newtype String0 = String0 { unString0 :: String }-  deriving (Eq, Ord, Show, Typeable, PQFormat)--instance FromSQL String0 where-  type PQBase String0 = PQBase String-  fromSQL = fmap String0 . fromSQL--instance ToSQL String0 where-  type PQDest String0 = PQDest String-  toSQL (String0 s) = toSQL s--instance Arbitrary String0 where-  arbitrary = String0 . map (chr . fromIntegral . unWord0) <$> arbitrary--newtype Word0 = Word0 { unWord0 :: Word8 }-  deriving (Enum, Eq, Integral, Num, Ord, Real)--instance Bounded Word0 where-  minBound = 1-  maxBound = 255--instance Arbitrary Word0 where-  arbitrary = arbitrarySizedBoundedIntegral-  shrink = shrinkIntegral--instance Arbitrary BS.ByteString where-  arbitrary = BS.pack . map unWord0 <$> arbitrary--instance Arbitrary T.Text where-  arbitrary = T.pack . unString0 <$> arbitrary- instance Arbitrary Interval where   arbitrary = Interval     <$> abs `fmap` arbitrary@@ -115,33 +81,6 @@     <*> choose (0, 59)     <*> choose (0, 999999) -instance Arbitrary Day where-  arbitrary = ModifiedJulianDay <$> arbitrary--instance Arbitrary TimeOfDay where-  arbitrary = do-    hours <- choose (0, 23)-    mins <- choose (0, 59)-    secs :: Double <- choose (0, 60)-    return $ TimeOfDay hours mins (realToFrac secs)--instance Arbitrary LocalTime where-  arbitrary = LocalTime <$> arbitrary <*> arbitrary--instance Arbitrary UTCTime where-  arbitrary = do-    day <- arbitrary-    secs :: Double <- choose (0, 86401)-    return $ UTCTime day (realToFrac secs)--instance Arbitrary TimeZone where-  arbitrary = elements $ map hoursToTimeZone [-12..14]--instance Arbitrary ZonedTime where-  arbitrary = ZonedTime <$> arbitrary <*> arbitrary------------------------------------------- instance (Arbitrary a1, Arbitrary a2) => Arbitrary (a1 :*: a2) where   arbitrary = (:*:) <$> arbitrary <*> arbitrary @@ -151,9 +90,12 @@ instance Arbitrary a => Arbitrary (Composite a) where   arbitrary = Composite <$> arbitrary -instance Arbitrary a => Arbitrary (Identity a) where-  arbitrary = Identity <$> arbitrary+instance Arbitrary json => Arbitrary (JSON json) where+  arbitrary = JSON <$> arbitrary +instance Arbitrary jsonb => Arbitrary (JSONB jsonb) where+  arbitrary = JSONB <$> arbitrary+ instance Arbitrary a => Arbitrary (Array1 a) where   arbitrary = arbitraryArray1 Array1 @@ -414,6 +356,9 @@   , nullTest td (u::BS.ByteString)   , nullTest td (u::T.Text)   , nullTest td (u::Binary BS.ByteString)+  , nullTest td (u::JSON Value)+  , nullTest td (u::JSONB Value)+  , nullTest td (u::XML)   , nullTest td (u::Interval)   , nullTest td (u::Day)   , nullTest td (u::TimeOfDay)@@ -438,6 +383,10 @@   , putGetTest td 1000 (u::BS.ByteString) (==)   , putGetTest td 1000 (u::T.Text) (==)   , putGetTest td 1000 (u::Binary BS.ByteString) (==)+  , putGetTest td 50 (u::JSON Value) (==)+  , putGetTest td 50 (u::JSONB Value) (==)+  , putGetTest td 20 (u::Array1 (JSON Value)) (==)+  , putGetTest td 20 (u::Array1 (JSONB Value)) (==)   , putGetTest td 50 (u::Interval) (==)   , putGetTest td 1000000 (u::Day) (==)   , putGetTest td 10000 (u::TimeOfDay) eqTOD