992cbbf · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Merge pull request #79 from basvandijk/aeson

Provide aeson-based JSON support

commit992cbbfc6cc2f33011fd186ee2ffb8de6b067693 authorLeon P Smith <leon@melding-monads.com> dateWed 11 Sep 2013, 16:53 (13 years ago) parent0551b67 cb552f9

3 files changed+47−1

compare with master

unifiedsplit

postgresql-simple.cabal+2−1 src/Database/PostgreSQL/Simple/FromField.hs+31 src/Database/PostgreSQL/Simple/ToField.hs+14

postgresql-simple.cabal+2−1

@@ -52,11 +52,12 @@ Library

5252 Database.PostgreSQL.Simple.TypeInfo.Types

5353

5454 Build-depends:

55+ aeson >= 0.6,

5556 attoparsec >= 0.10.3,

5657 base < 5,

5758 blaze-builder,

5859 blaze-textual,

59− bytestring >= 0.9,

60+ bytestring >= 0.10,

6061 containers,

6162 postgresql-libpq >= 0.6.2,

6263 template-haskell,

src/Database/PostgreSQL/Simple/FromField.hs+31

@@ -87,6 +87,8 @@ module Database.PostgreSQL.Simple.FromField

8787 , typeOid

8888 , PQ.Oid(..)

8989 , PQ.Format(..)

90+

91+ , fromJSONField

9092 ) where

9193

9294#include "MachDeps.h"

@@ -94,6 +96,7 @@ module Database.PostgreSQL.Simple.FromField

9496import Control.Applicative

9597 ( Applicative, (<|>), (<$>), pure )

9698import Control.Exception (Exception)

99+import qualified Data.Aeson as JSON

97100import Data.Attoparsec.Char8 hiding (Result)

98101import Data.ByteString (ByteString)

99102import qualified Data.ByteString.Char8 as B

@@ -441,6 +444,34 @@ fromArray typeInfo f = sequence . (parseIt <$>) <$> array delim

441444 where f' | Arrays.Array _ <- item = f

442445 | otherwise = fElem

443446

447+-- | json

448+instance FromField JSON.Value where

449+ fromField f Nothing = returnError UnexpectedNull f ""

450+ fromField f (Just bs)

451+ | typeOid f /= $(inlineTypoid TI.json) =

452+ returnError Incompatible f ""

453+ | otherwise =

454+ case JSON.eitherDecode' $ LB.fromStrict bs of

455+ Left err -> returnError ConversionFailed f err

456+ Right val -> pure val

457+

458+-- | Parse a field to a JSON 'JSON.Value' and convert that into a

459+-- Haskell value using 'JSON.fromJSON'.

460+--

461+-- This can be used as the default implementation for the 'fromField'

462+-- method for Haskell types that have a JSON representation in

463+-- PostgreSQL.

464+--

465+-- The 'Typeable' constraint is required to show more informative

466+-- error messages when parsing fails.

467+fromJSONField :: (JSON.FromJSON a, Typeable a) => FieldParser a

468+fromJSONField f mbBs = do

469+ value <- fromField f mbBs

470+ case JSON.fromJSON value of

471+ JSON.Error err -> returnError ConversionFailed f $

472+ "JSON decoding error: " ++ err

473+ JSON.Success x -> pure x

474+

444475type Compat = PQ.Oid -> Bool

445476

446477okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat

src/Database/PostgreSQL/Simple/ToField.hs+14

@@ -18,12 +18,14 @@ module Database.PostgreSQL.Simple.ToField

1818 (

1919 Action(..)

2020 , ToField(..)

21+ , toJSONField

2122 , inQuotes

2223 ) where

2324

2425import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)

2526import Blaze.ByteString.Builder.Char8 (fromChar)

2627import Blaze.Text (integral, double, float)

28+import qualified Data.Aeson as JSON

2729import Data.ByteString (ByteString)

2830import Data.Int (Int8, Int16, Int32, Int64)

2931import Data.List (intersperse)

@@ -230,6 +232,18 @@ instance (ToField a) => ToField (Vector a) where

230232 -- Because the ARRAY[...] input syntax is being used, it is possible

231233 -- that the use of type-specific separator characters is unnecessary.

232234

235+instance ToField JSON.Value where

236+ toField = toField . JSON.encode

237+

238+-- | Convert a Haskell value to a JSON 'JSON.Value' using

239+-- 'JSON.toJSON' and convert that to a field using 'toField'.

240+--

241+-- This can be used as the default implementation for the 'toField'

242+-- method for Haskell types that have a JSON representation in

243+-- PostgreSQL.

244+toJSONField :: JSON.ToJSON a => a -> Action

245+toJSONField = toField . JSON.toJSON

246+

233247-- | Surround a string with single-quote characters: \"@'@\"

234248--

235249-- This function /does not/ perform any other escaping.