@@ -2,7 +2,6 @@
2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
3{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
3{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
4{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE RecordWildCards #-}
5−{-# LANGUAGE PolyKinds #-}
8Module: Database.PostgreSQL.Simple.FromField
7Module: Database.PostgreSQL.Simple.FromField
@@ -107,7 +106,6 @@ module Database.PostgreSQL.Simple.FromField
107 , PQ.Oid(..)
106 , PQ.Oid(..)
108 , PQ.Format(..)
107 , PQ.Format(..)
109 , pgArrayFieldParser
108 , pgArrayFieldParser
112 , optionalField
110 , optionalField
113 , fromJSONField
111 , fromJSONField
@@ -116,18 +114,19 @@ module Database.PostgreSQL.Simple.FromField
117#include "MachDeps.h"
115#include "MachDeps.h"
119−import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
117+import Control.Applicative ( (<|>), (<$>), pure, (*>), (<*) )
120import Control.Concurrent.MVar (MVar, newMVar)
118import Control.Concurrent.MVar (MVar, newMVar)
121−import Control.Exception (Exception (toException, fromException))
119+import Control.Exception (Exception)
122import qualified Data.Aeson as JSON
120import qualified Data.Aeson as JSON
121+import qualified Data.Aeson.Internal as JSON
122+import qualified Data.Aeson.Parser as JSON (value')
123import Data.Attoparsec.ByteString.Char8 hiding (Result)
123import Data.Attoparsec.ByteString.Char8 hiding (Result)
124import Data.ByteString (ByteString)
124import Data.ByteString (ByteString)
125import qualified Data.ByteString.Char8 as B
125import qualified Data.ByteString.Char8 as B
126−import Data.Functor.Identity (Identity(Identity))
127import Data.Int (Int16, Int32, Int64)
126import Data.Int (Int16, Int32, Int64)
128import Data.IORef (IORef, newIORef)
127import Data.IORef (IORef, newIORef)
129import Data.Ratio (Ratio)
128import Data.Ratio (Ratio)
130−import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )
129+import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )
131import Data.Typeable (Typeable, typeOf)
130import Data.Typeable (Typeable, typeOf)
132import Data.Vector (Vector)
131import Data.Vector (Vector)
133import Data.Vector.Mutable (IOVector)
132import Data.Vector.Mutable (IOVector)
@@ -154,8 +153,6 @@ import qualified Data.UUID.Types as UUID
154import Data.Scientific (Scientific)
153import Data.Scientific (Scientific)
155import GHC.Real (infinity, notANumber)
154import GHC.Real (infinity, notANumber)
157−import qualified Data.Aeson.Types as JSON
159-- | Exception thrown if conversion from a SQL value to a Haskell
156-- | Exception thrown if conversion from a SQL value to a Haskell
160-- value fails.
157-- value fails.
161data ResultError = Incompatible { errSQLType :: String
158data ResultError = Incompatible { errSQLType :: String
@@ -182,9 +179,7 @@ data ResultError = Incompatible { errSQLType :: String
182 -- between metadata and actual data in a row).
179 -- between metadata and actual data in a row).
183 deriving (Eq, Show, Typeable)
180 deriving (Eq, Show, Typeable)
185−instance Exception ResultError where
182+instance Exception ResultError
186− toException = postgresqlExceptionToException
187− fromException = postgresqlExceptionFromException
189left :: Exception a => a -> Conversion b
184left :: Exception a => a -> Conversion b
190left = conversionError
185left = conversionError
@@ -273,12 +268,6 @@ instance FromField () where
273 | typeOid f /= TI.voidOid = returnError Incompatible f ""
268 | typeOid f /= TI.voidOid = returnError Incompatible f ""
274 | otherwise = pure ()
269 | otherwise = pure ()
276−instance (FromField a) => FromField (Const a b) where
277− fromField f bs = Const <$> fromField f bs
279−instance (FromField a) => FromField (Identity a) where
280− fromField f bs = Identity <$> fromField f bs
282-- | For dealing with null values. Compatible with any postgresql type
271-- | For dealing with null values. Compatible with any postgresql type
283-- compatible with type @a@. Note that the type is not checked if
272-- compatible with type @a@. Note that the type is not checked if
284-- the value is null, although it is inadvisable to rely on this
273-- the value is null, although it is inadvisable to rely on this
@@ -325,11 +314,11 @@ instance FromField Char where
327instance FromField Int16 where
316instance FromField Int16 where
328− fromField = attoFieldParser ok16 $ signed decimal
317+ fromField = atto ok16 $ signed decimal
330-- | int2, int4
319-- | int2, int4
331instance FromField Int32 where
320instance FromField Int32 where
332− fromField = attoFieldParser ok32 $ signed decimal
321+ fromField = atto ok32 $ signed decimal
334#if WORD_SIZE_IN_BITS < 64
323#if WORD_SIZE_IN_BITS < 64
335-- | int2, int4, and if compiled as 64-bit code, int8 as well.
324-- | int2, int4, and if compiled as 64-bit code, int8 as well.
@@ -339,36 +328,36 @@ instance FromField Int32 where
339-- This library was compiled as 64-bit code.
328-- This library was compiled as 64-bit code.
341instance FromField Int where
330instance FromField Int where
342− fromField = attoFieldParser okInt $ signed decimal
331+ fromField = atto okInt $ signed decimal
344-- | int2, int4, int8
333-- | int2, int4, int8
345instance FromField Int64 where
334instance FromField Int64 where
346− fromField = attoFieldParser ok64 $ signed decimal
335+ fromField = atto ok64 $ signed decimal
348-- | int2, int4, int8
337-- | int2, int4, int8
349instance FromField Integer where
338instance FromField Integer where
350− fromField = attoFieldParser ok64 $ signed decimal
339+ fromField = atto ok64 $ signed decimal
352-- | int2, float4 (Uses attoparsec's 'double' routine, for
341-- | int2, float4 (Uses attoparsec's 'double' routine, for
353-- better accuracy convert to 'Scientific' or 'Rational' first)
342-- better accuracy convert to 'Scientific' or 'Rational' first)
354instance FromField Float where
343instance FromField Float where
355− fromField = attoFieldParser ok (realToFrac <$> pg_double)
344+ fromField = atto ok (realToFrac <$> pg_double)
356 where ok = eq TI.float4Oid \/ eq TI.int2Oid
345 where ok = eq TI.float4Oid \/ eq TI.int2Oid
358-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for
347-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for
359-- better accuracy convert to 'Scientific' or 'Rational' first)
348-- better accuracy convert to 'Scientific' or 'Rational' first)
360instance FromField Double where
349instance FromField Double where
361− fromField = attoFieldParser ok pg_double
350+ fromField = atto ok pg_double
362 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid
351 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid
364-- | int2, int4, int8, float4, float8, numeric
353-- | int2, int4, int8, float4, float8, numeric
365instance FromField (Ratio Integer) where
354instance FromField (Ratio Integer) where
366− fromField = attoFieldParser ok pg_rational
355+ fromField = atto ok pg_rational
367 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
356 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
369-- | int2, int4, int8, float4, float8, numeric
358-- | int2, int4, int8, float4, float8, numeric
370instance FromField Scientific where
359instance FromField Scientific where
371− fromField = attoFieldParser ok rational
360+ fromField = atto ok rational
372 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
361 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
374unBinary :: Binary t -> t
363unBinary :: Binary t -> t
@@ -396,7 +385,7 @@ instance FromField SB.ByteString where
398instance FromField PQ.Oid where
387instance FromField PQ.Oid where
399− fromField f dat = PQ.Oid <$> attoFieldParser (== TI.oidOid) decimal f dat
388+ fromField f dat = PQ.Oid <$> atto (== TI.oidOid) decimal f dat
401-- | bytea, name, text, \"char\", bpchar, varchar, unknown
390-- | bytea, name, text, \"char\", bpchar, varchar, unknown
402instance FromField LB.ByteString where
391instance FromField LB.ByteString where
@@ -489,15 +478,6 @@ instance FromField LocalTimestamp where
489instance FromField Date where
478instance FromField Date where
490 fromField = ff TI.dateOid "Date" parseDate
479 fromField = ff TI.dateOid "Date" parseDate
492−-- | interval. Requires you to configure intervalstyle as @iso_8601@.
494−-- You can configure intervalstyle on every connection with a @SET@ command,
495−-- but for better performance you may want to configure it permanently in the
496−-- file found with @SHOW config_file;@ .
498−instance FromField CalendarDiffTime where
499− fromField = ff TI.intervalOid "CalendarDiffTime" parseCalendarDiffTime
501ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
481ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
502 -> Field -> Maybe B8.ByteString -> Conversion a
482 -> Field -> Maybe B8.ByteString -> Conversion a
503ff compatOid hsType parseBS f mstr =
483ff compatOid hsType parseBS f mstr =
@@ -576,13 +556,11 @@ instance FromField UUID where
576-- | json, jsonb
556-- | json, jsonb
577instance FromField JSON.Value where
557instance FromField JSON.Value where
578 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
558 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
579− where parseBS bs = case JSON.eitherDecodeStrict' bs of
559+ where parseBS bs = case parseOnly (JSON.value' <* endOfInput) bs of
580 Left err -> returnError ConversionFailed f err
560 Left err -> returnError ConversionFailed f err
581 Right val -> pure val
561 Right val -> pure val
583-- | Return the JSON ByteString directly
563-- | Return the JSON ByteString directly
586fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString
564fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString
587fromFieldJSONByteString f mbs =
565fromFieldJSONByteString f mbs =
588 if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid
566 if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid
@@ -684,22 +662,10 @@ returnError mkErr f msg = do
684 (show (typeOf (undefined :: a)))
662 (show (typeOf (undefined :: a)))
687−-- | Construct a field parser from an attoparsec parser. An 'Incompatible' error is thrown if the
688−-- PostgreSQL oid does not match the specified predicate.
691−-- instance FromField Int16 where
692−-- fromField = attoFieldParser ok16 (signed decimal)
696−attoFieldParser :: forall a. (Typeable a)
665+atto :: forall a. (Typeable a)
697− => (PQ.Oid -> Bool)
666+ => Compat -> Parser a -> Field -> Maybe ByteString
698− -- ^ Predicate for whether the postgresql type oid is compatible with this parser
667+ -> Conversion a
700− -- ^ An attoparsec parser.
702−attoFieldParser types p0 f dat = doFromField f types (go p0) dat
668+atto types p0 f dat = doFromField f types (go p0) dat
704 go :: Parser a -> ByteString -> Conversion a
670 go :: Parser a -> ByteString -> Conversion a