992cbbf · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Merge pull request #79 from basvandijk/aeson

992cbbfLeon P Smith13 years ago

postgresql-simple.cabal+2−1

compare with master

unifiedsplit

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

52 Database.PostgreSQL.Simple.TypeInfo.Types

54 Build-depends:

55+ aeson >= 0.6,

55 attoparsec >= 0.10.3,

56 attoparsec >= 0.10.3,

56 base < 5,

57 base < 5,

57 blaze-builder,

58 blaze-builder,

58 blaze-textual,

59 blaze-textual,

59− bytestring >= 0.9,

60+ bytestring >= 0.10,

60 containers,

61 containers,

61 postgresql-libpq >= 0.6.2,

62 postgresql-libpq >= 0.6.2,

62 template-haskell,

63 template-haskell,

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

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

87 , typeOid

88 , PQ.Oid(..)

89 , PQ.Format(..)

90+

91+ , fromJSONField

90 ) where

92 ) where

92#include "MachDeps.h"

94#include "MachDeps.h"

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

94import Control.Applicative

96import Control.Applicative

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

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

96import Control.Exception (Exception)

98import Control.Exception (Exception)

99+import qualified Data.Aeson as JSON

97import Data.Attoparsec.Char8 hiding (Result)

100import Data.Attoparsec.Char8 hiding (Result)

98import Data.ByteString (ByteString)

101import Data.ByteString (ByteString)

99import qualified Data.ByteString.Char8 as B

102import qualified Data.ByteString.Char8 as B

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

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

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

442 | otherwise = fElem

445 | otherwise = fElem

443

446

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+

444type Compat = PQ.Oid -> Bool

475type Compat = PQ.Oid -> Bool

445

476

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

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

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

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

18 (

19 Action(..)

20 , ToField(..)

21+ , toJSONField

21 , inQuotes

22 , inQuotes

22 ) where

23 ) where

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

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

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

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

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

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

28+import qualified Data.Aeson as JSON

27import Data.ByteString (ByteString)

29import Data.ByteString (ByteString)

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

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

29import Data.List (intersperse)

31import Data.List (intersperse)

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

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

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

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

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

232

234

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+

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

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

234--

248--

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

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