summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorarybczak <>2020-09-15 12:56:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-09-15 12:56:00 (GMT)
commitea88df958fcf056ff2f75bdea01c9107b1011c68 (patch)
tree709e6611ad706ec6b10cb5fe092cce20300f8c70
parent502be8a9860b0c6ddc65bfbd4ce3cf331984e5bd (diff)
version 1.9.1.0HEAD1.9.1.0master
-rwxr-xr-xCHANGELOG.md3
-rw-r--r--hpqtypes.cabal2
-rw-r--r--src/Database/PostgreSQL/PQTypes/JSON.hs44
3 files changed, 31 insertions, 18 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index fcea4d8..d3aa279 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,6 @@
+# hpqtypes-1.9.1.0 (2020-09-14)
+* Expose aesonFromSQL and aesonToSQL for convenience.
+
# hpqtypes-1.9.0.1 (2020-09-04)
* Remove upper bounds of dependencies.
diff --git a/hpqtypes.cabal b/hpqtypes.cabal
index 5af784f..554bbb8 100644
--- a/hpqtypes.cabal
+++ b/hpqtypes.cabal
@@ -1,5 +1,5 @@
name: hpqtypes
-version: 1.9.0.1
+version: 1.9.1.0
synopsis: Haskell bindings to libpqtypes
description: Efficient and easy-to-use bindings to (slightly modified)
diff --git a/src/Database/PostgreSQL/PQTypes/JSON.hs b/src/Database/PostgreSQL/PQTypes/JSON.hs
index e7dd715..6aa67ae 100644
--- a/src/Database/PostgreSQL/PQTypes/JSON.hs
+++ b/src/Database/PostgreSQL/PQTypes/JSON.hs
@@ -1,6 +1,9 @@
-module Database.PostgreSQL.PQTypes.JSON (
- JSON(..)
+{-# LANGUAGE TypeApplications #-}
+module Database.PostgreSQL.PQTypes.JSON
+ ( JSON(..)
, JSONB(..)
+ , aesonFromSQL
+ , aesonToSQL
) where
import Data.Aeson
@@ -39,11 +42,11 @@ instance ToSQL (JSON BSL.ByteString) where
instance FromSQL (JSON Value) where
type PQBase (JSON Value) = PGbytea
- fromSQL = valueFromSQL JSON
+ fromSQL = fmap JSON . aesonFromSQL
instance ToSQL (JSON Value) where
type PQDest (JSON Value) = PGbytea
- toSQL = valueToSQL unJSON
+ toSQL = aesonToSQL . unJSON
----------------------------------------
@@ -72,24 +75,31 @@ instance ToSQL (JSONB BSL.ByteString) where
instance FromSQL (JSONB Value) where
type PQBase (JSONB Value) = PGbytea
- fromSQL = valueFromSQL JSONB
+ fromSQL = fmap JSONB . aesonFromSQL
instance ToSQL (JSONB Value) where
type PQDest (JSONB Value) = PGbytea
- toSQL = valueToSQL unJSONB
+ toSQL = aesonToSQL . unJSONB
----------------------------------------
-valueFromSQL :: (Value -> json) -> Maybe PGbytea -> IO json
-valueFromSQL jsonCon mbase = do
+-- | Helper for defining 'FromSQL' instance for a type with 'FromJSON' instance.
+--
+-- @since 1.9.1.0
+aesonFromSQL :: FromJSON t => Maybe PGbytea -> IO t
+aesonFromSQL 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
+ Left err -> E.throwIO . E.ErrorCall $ "aesonFromSQL: " ++ err
+ Right value -> return value
+
+-- | Helper for defining 'ToSQL' instance for a type with 'ToJSON' instance.
+--
+-- @since 1.9.1.0
+aesonToSQL
+ :: ToJSON t
+ => t
+ -> ParamAllocator
+ -> (Ptr PGbytea -> IO r)
+ -> IO r
+aesonToSQL = toSQL . BSL.toStrict . encode