{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor  #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE PatternGuards, ScopedTypeVariables      #-}
{-# LANGUAGE RecordWildCards                         #-}
{-# LANGUAGE PolyKinds #-}

{- |
Module:      Database.PostgreSQL.Simple.FromField
Copyright:   (c) 2011 MailRank, Inc.
             (c) 2011-2013 Leon P Smith
License:     BSD3
Maintainer:  Leon P Smith <leon@melding-monads.com>
Stability:   experimental

The 'FromField' typeclass, for converting a single value in a row
returned by a SQL query into a more useful Haskell representation.
Note that each instance of 'FromField' is documented by a list of
compatible postgresql types.

A Haskell numeric type is considered to be compatible with all
PostgreSQL numeric types that are less accurate than it. For instance,
the Haskell 'Double' type is compatible with the PostgreSQL's 32-bit
@int@ type because it can represent a @int@ exactly.  On the other hand,
since a 'Double' might lose precision if representing PostgreSQL's 64-bit
@bigint@, the two are /not/ considered compatible.

Note that the 'Float' and 'Double' instances use attoparsec's 'double'
conversion routine,  which sacrifices some accuracy for speed.   If you
need accuracy,  consider first converting data to a 'Scientific' or 'Rational'
type,  and then converting to a floating-point type.   If you are defining
your own 'Database.PostgreSQL.Simple.FromRow.FromRow' instances,  this can be
achieved simply by
@'fromRational' '<$>' 'Database.PostgreSQL.Simple.FromRow.field'@,  although
this idiom is additionally compatible with PostgreSQL's @int8@ and @numeric@
types.  If this is unacceptable,  you may find
'Database.PostgreSQL.Simple.FromRow.fieldWith' useful.

Also note that while converting to a 'Double' through the 'Scientific' type
is likely somewhat faster than converting through the 'Rational' type,
the 'Scientific' type has no way to represent @NaN@ and @±Infinity@ values.
Thus,  if you need precision conversion of regular floating point values
and the possibility of receiving these special values from the backend,
stick with 'Rational'.

Because 'FromField' is a typeclass,  one may provide conversions to
additional Haskell types without modifying postgresql-simple.  This is
particularly useful for supporting PostgreSQL types that postgresql-simple
does not support out-of-box.  Here's an example of what such an instance
might look like for a UUID type that implements the @Read@ class:

@
import Data.UUID ( UUID )
import Database.PostgreSQL.Simple.FromField
       ( FromField (fromField) , typeOid, returnError, ResultError (..) )
import Database.PostgreSQL.Simple.TypeInfo.Static (typoid, uuid)
import qualified Data.ByteString.Char8 as B

instance FromField UUID where
   fromField f mdata =
      if typeOid f /= typoid uuid
        then returnError Incompatible f \"\"
        else case B.unpack \`fmap\` mdata of
               Nothing  -> returnError UnexpectedNull f \"\"
               Just dat ->
                  case [ x | (x,t) <- reads dat, (\"\",\"\") <- lex t ] of
                    [x] -> return x
                    _   -> returnError ConversionFailed f dat
@

Note that because PostgreSQL's @uuid@ type is built into postgres and is
not provided by an extension,  the 'typeOid' of @uuid@ does not change and
thus we can examine it directly.  One could hard-code the type oid,  or
obtain it by other means, but in this case we simply pull it out of the
static table provided by postgresql-simple.

On the other hand if the type is provided by an extension,  such as
@PostGIS@ or @hstore@,  then the 'typeOid' is not stable and can vary from
database to database. In this case it is recommended that FromField
instances use 'typename' instead.

-}


module Database.PostgreSQL.Simple.FromField
    (
      FromField(..)
    , FieldParser
    , Conversion()

    , runConversion
    , conversionMap
    , conversionError
    , ResultError(..)
    , returnError

    , Field
    , typename
    , TypeInfo(..)
    , Attribute(..)
    , typeInfo
    , typeInfoByOid
    , name
    , tableOid
    , tableColumn
    , format
    , typeOid
    , PQ.Oid(..)
    , PQ.Format(..)
    , pgArrayFieldParser
    , attoFieldParser

    , optionalField
    , fromJSONField
    , fromFieldJSONByteString
    ) where

#include "MachDeps.h"

import           Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
import           Control.Concurrent.MVar (MVar, newMVar)
import           Control.Exception (Exception)
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Internal as JSON
import qualified Data.Aeson.Parser as JSON (value')
import           Data.Attoparsec.ByteString.Char8 hiding (Result)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import           Data.Functor.Identity (Identity(Identity))
import           Data.Int (Int16, Int32, Int64)
import           Data.IORef (IORef, newIORef)
import           Data.Ratio (Ratio)
import           Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )
import           Data.Typeable (Typeable, typeOf)
import           Data.Vector (Vector)
import           Data.Vector.Mutable (IOVector)
import qualified Data.Vector as V
import           Database.PostgreSQL.Simple.Internal
import           Database.PostgreSQL.Simple.Compat
import           Database.PostgreSQL.Simple.Ok
import           Database.PostgreSQL.Simple.Types
import           Database.PostgreSQL.Simple.TypeInfo as TI
import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI
import           Database.PostgreSQL.Simple.Time
import           Database.PostgreSQL.Simple.Arrays as Arrays
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified Data.ByteString as SB
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as ST
import qualified Data.Text.Encoding as ST
import qualified Data.Text.Lazy as LT
import           Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import           Data.UUID.Types   (UUID)
import qualified Data.UUID.Types as UUID
import           Data.Scientific (Scientific)
import           GHC.Real (infinity, notANumber)

-- | Exception thrown if conversion from a SQL value to a Haskell
-- value fails.
data ResultError = Incompatible { ResultError -> String
errSQLType :: String
                                , ResultError -> Maybe Oid
errSQLTableOid :: Maybe PQ.Oid
                                , ResultError -> String
errSQLField :: String
                                , ResultError -> String
errHaskellType :: String
                                , ResultError -> String
errMessage :: String }
                 -- ^ The SQL and Haskell types are not compatible.
                 | UnexpectedNull { errSQLType :: String
                                  , errSQLTableOid :: Maybe PQ.Oid
                                  , errSQLField :: String
                                  , errHaskellType :: String
                                  , errMessage :: String }
                 -- ^ A SQL @NULL@ was encountered when the Haskell
                 -- type did not permit it.
                 | ConversionFailed { errSQLType :: String
                                    , errSQLTableOid :: Maybe PQ.Oid
                                    , errSQLField :: String
                                    , errHaskellType :: String
                                    , errMessage :: String }
                 -- ^ The SQL value could not be parsed, or could not
                 -- be represented as a valid Haskell value, or an
                 -- unexpected low-level error occurred (e.g. mismatch
                 -- between metadata and actual data in a row).
                   deriving (ResultError -> ResultError -> Bool
(ResultError -> ResultError -> Bool)
-> (ResultError -> ResultError -> Bool) -> Eq ResultError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultError -> ResultError -> Bool
$c/= :: ResultError -> ResultError -> Bool
== :: ResultError -> ResultError -> Bool
$c== :: ResultError -> ResultError -> Bool
Eq, Int -> ResultError -> ShowS
[ResultError] -> ShowS
ResultError -> String
(Int -> ResultError -> ShowS)
-> (ResultError -> String)
-> ([ResultError] -> ShowS)
-> Show ResultError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultError] -> ShowS
$cshowList :: [ResultError] -> ShowS
show :: ResultError -> String
$cshow :: ResultError -> String
showsPrec :: Int -> ResultError -> ShowS
$cshowsPrec :: Int -> ResultError -> ShowS
Show, Typeable)

instance Exception ResultError

left :: Exception a => a -> Conversion b
left :: a -> Conversion b
left = a -> Conversion b
forall err a. Exception err => err -> Conversion a
conversionError

type FieldParser a = Field -> Maybe ByteString -> Conversion a

-- | A type that may be converted from a SQL type.
class FromField a where
    fromField :: FieldParser a
    -- ^ Convert a SQL value to a Haskell value.
    --
    -- Returns a list of exceptions if the conversion fails.  In the case of
    -- library instances,  this will usually be a single 'ResultError',  but
    -- may be a 'UnicodeException'.
    --
    -- Note that retaining any reference to the 'Field' argument causes
    -- the entire @LibPQ.'PQ.Result'@ to be retained.  Thus, implementations
    -- of 'fromField' should return results that do not refer to this value
    -- after the result have been evaluated to WHNF.
    --
    -- Note that as of @postgresql-simple-0.4.0.0@,  the 'ByteString' value
    -- has already been copied out of the @LibPQ.'PQ.Result'@ before it has
    -- been passed to 'fromField'.  This is because for short strings, it's
    -- cheaper to copy the string than to set up a finalizer.

-- | Returns the data type name.  This is the preferred way of identifying
--   types that do not have a stable type oid, such as types provided by
--   extensions to PostgreSQL.
--
--   More concretely,  it returns the @typname@ column associated with the
--   type oid in the @pg_type@ table.  First, postgresql-simple will check
--   the built-in, static table.   If the type oid is not there,
--   postgresql-simple will check a per-connection cache,  and then
--   finally query the database's meta-schema.

typename :: Field -> Conversion ByteString
typename :: Field -> Conversion ByteString
typename Field
field = TypeInfo -> ByteString
typname (TypeInfo -> ByteString)
-> Conversion TypeInfo -> Conversion ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field -> Conversion TypeInfo
typeInfo Field
field

typeInfo :: Field -> Conversion TypeInfo
typeInfo :: Field -> Conversion TypeInfo
typeInfo Field{Result
Column
Oid
column :: Field -> Column
result :: Field -> Result
typeOid :: Oid
column :: Column
result :: Result
typeOid :: Field -> Oid
..} = (Connection -> IO (Ok TypeInfo)) -> Conversion TypeInfo
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok TypeInfo)) -> Conversion TypeInfo)
-> (Connection -> IO (Ok TypeInfo)) -> Conversion TypeInfo
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                       TypeInfo -> Ok TypeInfo
forall a. a -> Ok a
Ok (TypeInfo -> Ok TypeInfo) -> IO TypeInfo -> IO (Ok TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> Oid -> IO TypeInfo
getTypeInfo Connection
conn Oid
typeOid)

typeInfoByOid :: PQ.Oid -> Conversion TypeInfo
typeInfoByOid :: Oid -> Conversion TypeInfo
typeInfoByOid Oid
oid = (Connection -> IO (Ok TypeInfo)) -> Conversion TypeInfo
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok TypeInfo)) -> Conversion TypeInfo)
-> (Connection -> IO (Ok TypeInfo)) -> Conversion TypeInfo
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                      TypeInfo -> Ok TypeInfo
forall a. a -> Ok a
Ok (TypeInfo -> Ok TypeInfo) -> IO TypeInfo -> IO (Ok TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> Oid -> IO TypeInfo
getTypeInfo Connection
conn Oid
oid)

-- | Returns the name of the column.  This is often determined by a table
--   definition,  but it can be set using an @as@ clause.

name :: Field -> Maybe ByteString
name :: Field -> Maybe ByteString
name Field{Result
Column
Oid
typeOid :: Oid
column :: Column
result :: Result
column :: Field -> Column
result :: Field -> Result
typeOid :: Field -> Oid
..} = IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafeDupablePerformIO (Result -> Column -> IO (Maybe ByteString)
PQ.fname Result
result Column
column)

-- | Returns the name of the object id of the @table@ associated with the
--   column,  if any.  Returns 'Nothing' when there is no such table;
--   for example a computed column does not have a table associated with it.
--   Analogous to libpq's @PQftable@.

tableOid :: Field -> Maybe PQ.Oid
tableOid :: Field -> Maybe Oid
tableOid Field{Result
Column
Oid
typeOid :: Oid
column :: Column
result :: Result
column :: Field -> Column
result :: Field -> Result
typeOid :: Field -> Oid
..} = Oid -> Maybe Oid
toMaybeOid (IO Oid -> Oid
forall a. IO a -> a
unsafeDupablePerformIO (Result -> Column -> IO Oid
PQ.ftable Result
result Column
column))
  where
     toMaybeOid :: Oid -> Maybe Oid
toMaybeOid Oid
x
       = if   Oid
x Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
PQ.invalidOid
         then Maybe Oid
forall a. Maybe a
Nothing
         else Oid -> Maybe Oid
forall a. a -> Maybe a
Just Oid
x

-- | If the column has a table associated with it, this returns the
--   number of the associated table column.  Table columns have
--   nonzero numbers.  Zero is returned if the specified column is not
--   a simple reference to a table column, or when using pre-3.0
--   protocol. Analogous to libpq's @PQftablecol@.

tableColumn :: Field -> Int
tableColumn :: Field -> Int
tableColumn Field{Result
Column
Oid
typeOid :: Oid
column :: Column
result :: Result
column :: Field -> Column
result :: Field -> Result
typeOid :: Field -> Oid
..} = Column -> Int
forall b. Num b => Column -> b
fromCol (IO Column -> Column
forall a. IO a -> a
unsafeDupablePerformIO (Result -> Column -> IO Column
PQ.ftablecol Result
result Column
column))
  where
    fromCol :: Column -> b
fromCol (PQ.Col CInt
x) = CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x

-- | This returns whether the data was returned in a binary or textual format.
--   Analogous to libpq's @PQfformat@.

format :: Field -> PQ.Format
format :: Field -> Format
format Field{Result
Column
Oid
typeOid :: Oid
column :: Column
result :: Result
column :: Field -> Column
result :: Field -> Result
typeOid :: Field -> Oid
..} = IO Format -> Format
forall a. IO a -> a
unsafeDupablePerformIO (Result -> Column -> IO Format
PQ.fformat Result
result Column
column)

-- | void
instance FromField () where
  fromField :: FieldParser ()
fromField Field
f Maybe ByteString
_bs
     | Field -> Oid
typeOid Field
f Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
/= Oid
TI.voidOid = (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion ()
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""
     | Bool
otherwise = () -> Conversion ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance (FromField a) => FromField (Const a b) where
  fromField :: FieldParser (Const a b)
fromField Field
f Maybe ByteString
bs = a -> Const a b
forall k a (b :: k). a -> Const a b
Const (a -> Const a b) -> Conversion a -> Conversion (Const a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser a
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
bs

instance (FromField a) => FromField (Identity a) where
  fromField :: FieldParser (Identity a)
fromField Field
f Maybe ByteString
bs = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Conversion a -> Conversion (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser a
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
bs

-- | For dealing with null values.  Compatible with any postgresql type
--   compatible with type @a@.  Note that the type is not checked if
--   the value is null, although it is inadvisable to rely on this
--   behavior.
instance FromField a => FromField (Maybe a) where
    fromField :: FieldParser (Maybe a)
fromField = FieldParser a -> FieldParser (Maybe a)
forall a. FieldParser a -> FieldParser (Maybe a)
optionalField FieldParser a
forall a. FromField a => FieldParser a
fromField

-- | For dealing with SQL @null@ values outside of the 'FromField' class.
--   Alternatively, one could use 'Control.Applicative.optional',  but that
--   also turns type and conversion errors into 'Nothing',  whereas this is
--   more specific and turns only @null@ values into 'Nothing'.

optionalField :: FieldParser a -> FieldParser (Maybe a)
optionalField :: FieldParser a -> FieldParser (Maybe a)
optionalField FieldParser a
p Field
f Maybe ByteString
mv =
    case Maybe ByteString
mv of
      Maybe ByteString
Nothing -> Maybe a -> Conversion (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
      Just ByteString
_  -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Conversion a -> Conversion (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser a
p Field
f Maybe ByteString
mv
{-# INLINE optionalField #-}

-- | compatible with any data type,  but the value must be null
instance FromField Null where
    fromField :: FieldParser Null
fromField Field
_ Maybe ByteString
Nothing  = Null -> Conversion Null
forall (f :: * -> *) a. Applicative f => a -> f a
pure Null
Null
    fromField Field
f (Just ByteString
_) = (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Null
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
"data is not null"

-- | bool
instance FromField Bool where
    fromField :: FieldParser Bool
fromField Field
f Maybe ByteString
bs
      | Field -> Oid
typeOid Field
f Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
/= Oid
TI.boolOid       = (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Bool
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""
      | Maybe ByteString
bs Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ByteString
forall a. Maybe a
Nothing                 = (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Bool
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""
      | Maybe ByteString
bs Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"t"                = Bool -> Conversion Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      | Maybe ByteString
bs Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"f"                = Bool -> Conversion Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      | Bool
otherwise                     = (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Bool
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
""

-- | \"char\", bpchar
instance FromField Char where
    fromField :: FieldParser Char
fromField Field
f Maybe ByteString
bs0 =
        if (Oid -> Oid -> Bool
eq Oid
TI.charOid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.bpcharOid) (Field -> Oid
typeOid Field
f)
        then case Maybe ByteString
bs0 of
               Maybe ByteString
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Char
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""
               Just ByteString
bs -> if ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
                          then (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Char
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
"length not 1"
                          else Char -> Conversion Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Conversion Char) -> Char -> Conversion Char
forall a b. (a -> b) -> a -> b
$! (ByteString -> Char
B.head ByteString
bs)
        else (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Char
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""

-- | int2
instance FromField Int16 where
    fromField :: FieldParser Int16
fromField = (Oid -> Bool) -> Parser Int16 -> FieldParser Int16
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok16 (Parser Int16 -> FieldParser Int16)
-> Parser Int16 -> FieldParser Int16
forall a b. (a -> b) -> a -> b
$ Parser Int16 -> Parser Int16
forall a. Num a => Parser a -> Parser a
signed Parser Int16
forall a. Integral a => Parser a
decimal

-- | int2, int4
instance FromField Int32 where
    fromField :: FieldParser Int32
fromField = (Oid -> Bool) -> Parser Int32 -> FieldParser Int32
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok32 (Parser Int32 -> FieldParser Int32)
-> Parser Int32 -> FieldParser Int32
forall a b. (a -> b) -> a -> b
$ Parser Int32 -> Parser Int32
forall a. Num a => Parser a -> Parser a
signed Parser Int32
forall a. Integral a => Parser a
decimal

#if WORD_SIZE_IN_BITS < 64
-- | int2, int4,  and if compiled as 64-bit code,  int8 as well.
-- This library was compiled as 32-bit code.
#else
-- | int2, int4,  and if compiled as 64-bit code,  int8 as well.
-- This library was compiled as 64-bit code.
#endif
instance FromField Int where
    fromField :: FieldParser Int
fromField = (Oid -> Bool) -> Parser Int -> FieldParser Int
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
okInt (Parser Int -> FieldParser Int) -> Parser Int -> FieldParser Int
forall a b. (a -> b) -> a -> b
$ Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
signed Parser Int
forall a. Integral a => Parser a
decimal

-- | int2, int4, int8
instance FromField Int64 where
    fromField :: FieldParser Int64
fromField = (Oid -> Bool) -> Parser Int64 -> FieldParser Int64
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok64 (Parser Int64 -> FieldParser Int64)
-> Parser Int64 -> FieldParser Int64
forall a b. (a -> b) -> a -> b
$ Parser Int64 -> Parser Int64
forall a. Num a => Parser a -> Parser a
signed Parser Int64
forall a. Integral a => Parser a
decimal

-- | int2, int4, int8
instance FromField Integer where
    fromField :: FieldParser Integer
fromField = (Oid -> Bool) -> Parser Integer -> FieldParser Integer
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok64 (Parser Integer -> FieldParser Integer)
-> Parser Integer -> FieldParser Integer
forall a b. (a -> b) -> a -> b
$ Parser Integer -> Parser Integer
forall a. Num a => Parser a -> Parser a
signed Parser Integer
forall a. Integral a => Parser a
decimal

-- | int2, float4    (Uses attoparsec's 'double' routine,  for
--   better accuracy convert to 'Scientific' or 'Rational' first)
instance FromField Float where
    fromField :: FieldParser Float
fromField = (Oid -> Bool) -> Parser Float -> FieldParser Float
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Float) -> Parser ByteString Double -> Parser Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Double
pg_double)
      where ok :: Oid -> Bool
ok = Oid -> Oid -> Bool
eq Oid
TI.float4Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int2Oid

-- | int2, int4, float4, float8  (Uses attoparsec's 'double' routine,  for
--   better accuracy convert to 'Scientific' or 'Rational' first)
instance FromField Double where
    fromField :: FieldParser Double
fromField = (Oid -> Bool) -> Parser ByteString Double -> FieldParser Double
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok Parser ByteString Double
pg_double
      where ok :: Oid -> Bool
ok = Oid -> Oid -> Bool
eq Oid
TI.float4Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.float8Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int2Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int4Oid

-- | int2, int4, int8, float4, float8, numeric
instance FromField (Ratio Integer) where
    fromField :: FieldParser (Ratio Integer)
fromField = (Oid -> Bool)
-> Parser (Ratio Integer) -> FieldParser (Ratio Integer)
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok Parser (Ratio Integer)
pg_rational
      where ok :: Oid -> Bool
ok = Oid -> Oid -> Bool
eq Oid
TI.float4Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.float8Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int2Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int4Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int8Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/  Oid -> Oid -> Bool
eq Oid
TI.numericOid

-- | int2, int4, int8, float4, float8, numeric
instance FromField Scientific where
     fromField :: FieldParser Scientific
fromField = (Oid -> Bool) -> Parser Scientific -> FieldParser Scientific
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok Parser Scientific
forall a. Fractional a => Parser a
rational
      where ok :: Oid -> Bool
ok = Oid -> Oid -> Bool
eq Oid
TI.float4Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.float8Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int2Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int4Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int8Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/  Oid -> Oid -> Bool
eq Oid
TI.numericOid

unBinary :: Binary t -> t
unBinary :: Binary t -> t
unBinary (Binary t
x) = t
x

pg_double :: Parser Double
pg_double :: Parser ByteString Double
pg_double
    =   (ByteString -> Parser ByteString
string ByteString
"NaN"       Parser ByteString
-> Parser ByteString Double -> Parser ByteString Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Double -> Parser ByteString Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0))
    Parser ByteString Double
-> Parser ByteString Double -> Parser ByteString Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"Infinity"  Parser ByteString
-> Parser ByteString Double -> Parser ByteString Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Double -> Parser ByteString Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0))
    Parser ByteString Double
-> Parser ByteString Double -> Parser ByteString Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"-Infinity" Parser ByteString
-> Parser ByteString Double -> Parser ByteString Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Double -> Parser ByteString Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0))
    Parser ByteString Double
-> Parser ByteString Double -> Parser ByteString Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Double
double

pg_rational :: Parser Rational
pg_rational :: Parser (Ratio Integer)
pg_rational
    =   (ByteString -> Parser ByteString
string ByteString
"NaN"       Parser ByteString
-> Parser (Ratio Integer) -> Parser (Ratio Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ratio Integer -> Parser (Ratio Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ratio Integer
notANumber )
    Parser (Ratio Integer)
-> Parser (Ratio Integer) -> Parser (Ratio Integer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"Infinity"  Parser ByteString
-> Parser (Ratio Integer) -> Parser (Ratio Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ratio Integer -> Parser (Ratio Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ratio Integer
infinity   )
    Parser (Ratio Integer)
-> Parser (Ratio Integer) -> Parser (Ratio Integer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"-Infinity" Parser ByteString
-> Parser (Ratio Integer) -> Parser (Ratio Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ratio Integer -> Parser (Ratio Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Ratio Integer
infinity))
    Parser (Ratio Integer)
-> Parser (Ratio Integer) -> Parser (Ratio Integer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Ratio Integer)
forall a. Fractional a => Parser a
rational

-- | bytea, name, text, \"char\", bpchar, varchar, unknown
instance FromField SB.ByteString where
    fromField :: FieldParser ByteString
fromField Field
f Maybe ByteString
dat = if Field -> Oid
typeOid Field
f Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
TI.byteaOid
                      then Binary ByteString -> ByteString
forall t. Binary t -> t
unBinary (Binary ByteString -> ByteString)
-> Conversion (Binary ByteString) -> Conversion ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser (Binary ByteString)
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat
                      else Field
-> (Oid -> Bool)
-> (ByteString -> Conversion ByteString)
-> Maybe ByteString
-> Conversion ByteString
forall a.
Typeable a =>
Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
doFromField Field
f Oid -> Bool
okText' ByteString -> Conversion ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
dat

-- | oid
instance FromField PQ.Oid where
    fromField :: FieldParser Oid
fromField Field
f Maybe ByteString
dat = CUInt -> Oid
PQ.Oid (CUInt -> Oid) -> Conversion CUInt -> Conversion Oid
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Oid -> Bool) -> Parser CUInt -> FieldParser CUInt
forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser (Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
TI.oidOid) Parser CUInt
forall a. Integral a => Parser a
decimal Field
f Maybe ByteString
dat

-- | bytea, name, text, \"char\", bpchar, varchar, unknown
instance FromField LB.ByteString where
    fromField :: FieldParser ByteString
fromField Field
f Maybe ByteString
dat = [ByteString] -> ByteString
LB.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> ByteString)
-> Conversion ByteString -> Conversion ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser ByteString
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat

unescapeBytea :: Field -> SB.ByteString
              -> Conversion (Binary SB.ByteString)
unescapeBytea :: Field -> ByteString -> Conversion (Binary ByteString)
unescapeBytea Field
f ByteString
str' = case IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafeDupablePerformIO (ByteString -> IO (Maybe ByteString)
PQ.unescapeBytea ByteString
str') of
       Maybe ByteString
Nothing  -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion (Binary ByteString)
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
"unescapeBytea failed"
       Just ByteString
str -> Binary ByteString -> Conversion (Binary ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Binary ByteString
forall a. a -> Binary a
Binary ByteString
str)

-- | bytea
instance FromField (Binary SB.ByteString) where
    fromField :: FieldParser (Binary ByteString)
fromField Field
f Maybe ByteString
dat = case Field -> Format
format Field
f of
      Format
PQ.Text   -> Field
-> (Oid -> Bool)
-> (ByteString -> Conversion (Binary ByteString))
-> Maybe ByteString
-> Conversion (Binary ByteString)
forall a.
Typeable a =>
Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
doFromField Field
f Oid -> Bool
okBinary (Field -> ByteString -> Conversion (Binary ByteString)
unescapeBytea Field
f) Maybe ByteString
dat
      Format
PQ.Binary -> Field
-> (Oid -> Bool)
-> (ByteString -> Conversion (Binary ByteString))
-> Maybe ByteString
-> Conversion (Binary ByteString)
forall a.
Typeable a =>
Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
doFromField Field
f Oid -> Bool
okBinary (Binary ByteString -> Conversion (Binary ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Binary ByteString -> Conversion (Binary ByteString))
-> (ByteString -> Binary ByteString)
-> ByteString
-> Conversion (Binary ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary ByteString
forall a. a -> Binary a
Binary) Maybe ByteString
dat

-- | bytea
instance FromField (Binary LB.ByteString) where
    fromField :: FieldParser (Binary ByteString)
fromField Field
f Maybe ByteString
dat = ByteString -> Binary ByteString
forall a. a -> Binary a
Binary (ByteString -> Binary ByteString)
-> (Binary ByteString -> ByteString)
-> Binary ByteString
-> Binary ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LB.fromChunks ([ByteString] -> ByteString)
-> (Binary ByteString -> [ByteString])
-> Binary ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> [ByteString])
-> (Binary ByteString -> ByteString)
-> Binary ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary ByteString -> ByteString
forall t. Binary t -> t
unBinary (Binary ByteString -> Binary ByteString)
-> Conversion (Binary ByteString) -> Conversion (Binary ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser (Binary ByteString)
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat

-- | name, text, \"char\", bpchar, varchar
instance FromField ST.Text where
    fromField :: FieldParser Text
fromField Field
f = Field
-> (Oid -> Bool)
-> (ByteString -> Conversion Text)
-> Maybe ByteString
-> Conversion Text
forall a.
Typeable a =>
Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
doFromField Field
f Oid -> Bool
okText ((ByteString -> Conversion Text)
 -> Maybe ByteString -> Conversion Text)
-> (ByteString -> Conversion Text)
-> Maybe ByteString
-> Conversion Text
forall a b. (a -> b) -> a -> b
$ ((UnicodeException -> Conversion Text)
-> (Text -> Conversion Text)
-> Either UnicodeException Text
-> Conversion Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either UnicodeException -> Conversion Text
forall err a. Exception err => err -> Conversion a
left Text -> Conversion Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnicodeException Text -> Conversion Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Conversion Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
ST.decodeUtf8')
    -- FIXME:  check character encoding

-- | name, text, \"char\", bpchar, varchar
instance FromField LT.Text where
    fromField :: FieldParser Text
fromField Field
f Maybe ByteString
dat = Text -> Text
LT.fromStrict (Text -> Text) -> Conversion Text -> Conversion Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser Text
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat

-- | citext
instance FromField (CI ST.Text) where
    fromField :: FieldParser (CI Text)
fromField Field
f Maybe ByteString
mdat = do
       ByteString
typ <- Field -> Conversion ByteString
typename Field
f
       if ByteString
typ ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"citext"
         then (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion (CI Text)
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""
         else case Maybe ByteString
mdat of
                Maybe ByteString
Nothing  -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion (CI Text)
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""
                Just ByteString
dat -> (UnicodeException -> Conversion (CI Text))
-> (Text -> Conversion (CI Text))
-> Either UnicodeException Text
-> Conversion (CI Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either UnicodeException -> Conversion (CI Text)
forall err a. Exception err => err -> Conversion a
left (CI Text -> Conversion (CI Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CI Text -> Conversion (CI Text))
-> (Text -> CI Text) -> Text -> Conversion (CI Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk)
                                        (ByteString -> Either UnicodeException Text
ST.decodeUtf8' ByteString
dat)

-- | citext
instance FromField (CI LT.Text) where
    fromField :: FieldParser (CI Text)
fromField Field
f Maybe ByteString
mdat = do
       ByteString
typ <- Field -> Conversion ByteString
typename Field
f
       if ByteString
typ ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"citext"
         then (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion (CI Text)
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""
         else case Maybe ByteString
mdat of
                Maybe ByteString
Nothing  -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion (CI Text)
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""
                Just ByteString
dat -> (UnicodeException -> Conversion (CI Text))
-> (Text -> Conversion (CI Text))
-> Either UnicodeException Text
-> Conversion (CI Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either UnicodeException -> Conversion (CI Text)
forall err a. Exception err => err -> Conversion a
left (CI Text -> Conversion (CI Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CI Text -> Conversion (CI Text))
-> (Text -> CI Text) -> Text -> Conversion (CI Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> CI Text) -> (Text -> Text) -> Text -> CI Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict)
                                        (ByteString -> Either UnicodeException Text
ST.decodeUtf8' ByteString
dat)

-- | name, text, \"char\", bpchar, varchar
instance FromField [Char] where
    fromField :: FieldParser String
fromField Field
f Maybe ByteString
dat = Text -> String
ST.unpack (Text -> String) -> Conversion Text -> Conversion String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser Text
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat

-- | timestamptz
instance FromField UTCTime where
  fromField :: FieldParser UTCTime
fromField = Oid
-> String
-> (ByteString -> Either String UTCTime)
-> FieldParser UTCTime
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.timestamptzOid String
"UTCTime" ByteString -> Either String UTCTime
parseUTCTime

-- | timestamptz
instance FromField ZonedTime where
  fromField :: FieldParser ZonedTime
fromField = Oid
-> String
-> (ByteString -> Either String ZonedTime)
-> FieldParser ZonedTime
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.timestamptzOid String
"ZonedTime" ByteString -> Either String ZonedTime
parseZonedTime

-- | timestamp
instance FromField LocalTime where
  fromField :: FieldParser LocalTime
fromField = Oid
-> String
-> (ByteString -> Either String LocalTime)
-> FieldParser LocalTime
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.timestampOid String
"LocalTime" ByteString -> Either String LocalTime
parseLocalTime

-- | date
instance FromField Day where
  fromField :: FieldParser Day
fromField = Oid
-> String -> (ByteString -> Either String Day) -> FieldParser Day
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.dateOid String
"Day" ByteString -> Either String Day
parseDay

-- | time
instance FromField TimeOfDay where
  fromField :: FieldParser TimeOfDay
fromField = Oid
-> String
-> (ByteString -> Either String TimeOfDay)
-> FieldParser TimeOfDay
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.timeOid String
"TimeOfDay" ByteString -> Either String TimeOfDay
parseTimeOfDay

-- | timestamptz
instance FromField UTCTimestamp where
  fromField :: FieldParser UTCTimestamp
fromField = Oid
-> String
-> (ByteString -> Either String UTCTimestamp)
-> FieldParser UTCTimestamp
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.timestamptzOid String
"UTCTimestamp" ByteString -> Either String UTCTimestamp
parseUTCTimestamp

-- | timestamptz
instance FromField ZonedTimestamp where
  fromField :: FieldParser ZonedTimestamp
fromField = Oid
-> String
-> (ByteString -> Either String ZonedTimestamp)
-> FieldParser ZonedTimestamp
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.timestamptzOid String
"ZonedTimestamp" ByteString -> Either String ZonedTimestamp
parseZonedTimestamp

-- | timestamp
instance FromField LocalTimestamp where
  fromField :: FieldParser LocalTimestamp
fromField = Oid
-> String
-> (ByteString -> Either String LocalTimestamp)
-> FieldParser LocalTimestamp
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.timestampOid String
"LocalTimestamp" ByteString -> Either String LocalTimestamp
parseLocalTimestamp

-- | date
instance FromField Date where
  fromField :: FieldParser Date
fromField = Oid
-> String -> (ByteString -> Either String Date) -> FieldParser Date
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.dateOid String
"Date" ByteString -> Either String Date
parseDate

-- | interval. Requires you to configure intervalstyle as @iso_8601@.
--
--   You can configure intervalstyle on every connection with a @SET@ command,
--   but for better performance you may want to configure it permanently in the
--   file found with @SHOW config_file;@ .
--
instance FromField CalendarDiffTime where
  fromField :: FieldParser CalendarDiffTime
fromField = Oid
-> String
-> (ByteString -> Either String CalendarDiffTime)
-> FieldParser CalendarDiffTime
forall a.
Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
TI.intervalOid String
"CalendarDiffTime" ByteString -> Either String CalendarDiffTime
parseCalendarDiffTime

ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
   -> Field -> Maybe B8.ByteString -> Conversion a
ff :: Oid
-> String
-> (ByteString -> Either String a)
-> Field
-> Maybe ByteString
-> Conversion a
ff Oid
compatOid String
hsType ByteString -> Either String a
parseBS Field
f Maybe ByteString
mstr =
  if Field -> Oid
typeOid Field
f Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
/= Oid
compatOid
  then (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> String -> Conversion a
forall a t b.
Exception a =>
(String -> Maybe Oid -> String -> String -> t -> a)
-> t -> Conversion b
err String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible String
""
  else case Maybe ByteString
mstr of
         Maybe ByteString
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> String -> Conversion a
forall a t b.
Exception a =>
(String -> Maybe Oid -> String -> String -> t -> a)
-> t -> Conversion b
err String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull String
""
         Just ByteString
str -> case ByteString -> Either String a
parseBS ByteString
str of
                       Left String
msg -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> String -> Conversion a
forall a t b.
Exception a =>
(String -> Maybe Oid -> String -> String -> t -> a)
-> t -> Conversion b
err String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed String
msg
                       Right a
val -> a -> Conversion a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
 where
   err :: (String -> Maybe Oid -> String -> String -> t -> a)
-> t -> Conversion b
err String -> Maybe Oid -> String -> String -> t -> a
errC t
msg = do
     ByteString
typnam <- Field -> Conversion ByteString
typename Field
f
     a -> Conversion b
forall err a. Exception err => err -> Conversion a
left (a -> Conversion b) -> a -> Conversion b
forall a b. (a -> b) -> a -> b
$ String -> Maybe Oid -> String -> String -> t -> a
errC (ByteString -> String
B8.unpack ByteString
typnam)
                 (Field -> Maybe Oid
tableOid Field
f)
                 (String -> (ByteString -> String) -> Maybe ByteString -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ByteString -> String
B8.unpack (Field -> Maybe ByteString
name Field
f))
                 String
hsType
                 t
msg
{-# INLINE ff #-}

-- | Compatible with both types.  Conversions to type @b@ are
--   preferred,  the conversion to type @a@ will be tried after
--   the 'Right' conversion fails.
instance (FromField a, FromField b) => FromField (Either a b) where
    fromField :: FieldParser (Either a b)
fromField Field
f Maybe ByteString
dat =   (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Conversion b -> Conversion (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser b
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat)
                    Conversion (Either a b)
-> Conversion (Either a b) -> Conversion (Either a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Either a b
forall a b. a -> Either a b
Left  (a -> Either a b) -> Conversion a -> Conversion (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser a
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat)

-- | any postgresql array whose elements are compatible with type @a@
instance (FromField a, Typeable a) => FromField (PGArray a) where
  fromField :: FieldParser (PGArray a)
fromField = FieldParser a -> FieldParser (PGArray a)
forall a. Typeable a => FieldParser a -> FieldParser (PGArray a)
pgArrayFieldParser FieldParser a
forall a. FromField a => FieldParser a
fromField

pgArrayFieldParser :: Typeable a => FieldParser a -> FieldParser (PGArray a)
pgArrayFieldParser :: FieldParser a -> FieldParser (PGArray a)
pgArrayFieldParser FieldParser a
fieldParser Field
f Maybe ByteString
mdat = do
        TypeInfo
info <- Field -> Conversion TypeInfo
typeInfo Field
f
        case TypeInfo
info of
          TI.Array{} ->
              case Maybe ByteString
mdat of
                Maybe ByteString
Nothing  -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion (PGArray a)
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""
                Just ByteString
dat -> do
                   case Parser (Conversion [a])
-> ByteString -> Either String (Conversion [a])
forall a. Parser a -> ByteString -> Either String a
parseOnly (FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])
forall a.
FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])
fromArray FieldParser a
fieldParser TypeInfo
info Field
f) ByteString
dat of
                     Left  String
err  -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion (PGArray a)
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
err
                     Right Conversion [a]
conv -> [a] -> PGArray a
forall a. [a] -> PGArray a
PGArray ([a] -> PGArray a) -> Conversion [a] -> Conversion (PGArray a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Conversion [a]
conv
          TypeInfo
_ -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion (PGArray a)
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""

fromArray :: FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])
fromArray :: FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])
fromArray FieldParser a
fieldParser TypeInfo
typInfo Field
f = [Conversion a] -> Conversion [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Conversion a] -> Conversion [a])
-> ([ArrayFormat] -> [Conversion a])
-> [ArrayFormat]
-> Conversion [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayFormat -> Conversion a
parseIt (ArrayFormat -> Conversion a) -> [ArrayFormat] -> [Conversion a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([ArrayFormat] -> Conversion [a])
-> Parser ByteString [ArrayFormat] -> Parser (Conversion [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser ByteString [ArrayFormat]
array Char
delim
  where
    delim :: Char
delim = TypeInfo -> Char
typdelim (TypeInfo -> TypeInfo
typelem TypeInfo
typInfo)
    fElem :: Field
fElem = Field
f{ typeOid :: Oid
typeOid = TypeInfo -> Oid
typoid (TypeInfo -> TypeInfo
typelem TypeInfo
typInfo) }

    parseIt :: ArrayFormat -> Conversion a
parseIt ArrayFormat
item =
        FieldParser a
fieldParser Field
f' (Maybe ByteString -> Conversion a)
-> Maybe ByteString -> Conversion a
forall a b. (a -> b) -> a -> b
$ if ArrayFormat
item ArrayFormat -> ArrayFormat -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ArrayFormat
Arrays.Plain ByteString
"NULL" then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
item'
      where
        item' :: ByteString
item' = Char -> ArrayFormat -> ByteString
fmt Char
delim ArrayFormat
item
        f' :: Field
f' | Arrays.Array _ <- ArrayFormat
item = Field
f
           | Bool
otherwise              = Field
fElem

instance (FromField a, Typeable a) => FromField (Vector a) where
    fromField :: FieldParser (Vector a)
fromField Field
f Maybe ByteString
v = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> (PGArray a -> [a]) -> PGArray a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGArray a -> [a]
forall a. PGArray a -> [a]
fromPGArray (PGArray a -> Vector a)
-> Conversion (PGArray a) -> Conversion (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser (PGArray a)
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
v

instance (FromField a, Typeable a) => FromField (IOVector a) where
    fromField :: FieldParser (IOVector a)
fromField Field
f Maybe ByteString
v = IO (IOVector a) -> Conversion (IOVector a)
forall a. IO a -> Conversion a
liftConversion (IO (IOVector a) -> Conversion (IOVector a))
-> (Vector a -> IO (IOVector a))
-> Vector a
-> Conversion (IOVector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> IO (IOVector a)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw (Vector a -> Conversion (IOVector a))
-> Conversion (Vector a) -> Conversion (IOVector a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FieldParser (Vector a)
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
v

-- | uuid
instance FromField UUID where
    fromField :: FieldParser UUID
fromField Field
f Maybe ByteString
mbs =
      if Field -> Oid
typeOid Field
f Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
/= Oid
TI.uuidOid
      then (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion UUID
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""
      else case Maybe ByteString
mbs of
             Maybe ByteString
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion UUID
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""
             Just ByteString
bs ->
                 case ByteString -> Maybe UUID
UUID.fromASCIIBytes ByteString
bs of
                   Maybe UUID
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion UUID
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
"Invalid UUID"
                   Just UUID
uuid -> UUID -> Conversion UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure UUID
uuid

-- | json, jsonb
instance FromField JSON.Value where
    fromField :: FieldParser Value
fromField Field
f Maybe ByteString
mbs = ByteString -> Conversion Value
parseBS (ByteString -> Conversion Value)
-> Conversion ByteString -> Conversion Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FieldParser ByteString
fromFieldJSONByteString Field
f Maybe ByteString
mbs
      where parseBS :: ByteString -> Conversion Value
parseBS ByteString
bs = case Parser Value -> ByteString -> Either String Value
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser Value
JSON.value' Parser Value -> Parser ByteString () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput) ByteString
bs of
                   Left  String
err -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Value
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
err
                   Right Value
val -> Value -> Conversion Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
val

-- | Return the JSON ByteString directly
--
-- @since 0.6.3
fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString
fromFieldJSONByteString :: FieldParser ByteString
fromFieldJSONByteString Field
f Maybe ByteString
mbs =
      if Field -> Oid
typeOid Field
f Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
/= Oid
TI.jsonOid Bool -> Bool -> Bool
&& Field -> Oid
typeOid Field
f Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
/= Oid
TI.jsonbOid
      then (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion ByteString
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""
      else case Maybe ByteString
mbs of
             Maybe ByteString
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion ByteString
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""
             Just ByteString
bs -> ByteString -> Conversion ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs

-- | Parse a field to a JSON 'JSON.Value' and convert that into a
-- Haskell value using the 'JSON.FromJSON' instance.
--
-- This can be used as the default implementation for the 'fromField'
-- method for Haskell types that have a JSON representation in
-- PostgreSQL.
--
-- The 'Typeable' constraint is required to show more informative
-- error messages when parsing fails.
--
-- Note that @fromJSONField :: FieldParser ('Maybe' Foo)@ will return
-- @'Nothing'@ on the json @null@ value, and return an exception on SQL @null@
-- value.  Alternatively,  one could write @'optionalField' fromJSONField@
-- that will return @Nothing@ on SQL @null@,  and otherwise will call
-- @fromJSONField :: FieldParser Foo@ and then return @'Just'@ the
-- result value,  or return its exception.  If one would
-- like to return @Nothing@ on both the SQL @null@ and json @null@ values,
-- one way to do it would be to write
-- @\\f mv -> 'Control.Monad.join' '<$>' optionalField fromJSONField f mv@
fromJSONField :: (JSON.FromJSON a, Typeable a) => FieldParser a
fromJSONField :: FieldParser a
fromJSONField Field
f Maybe ByteString
mbBs = do
    Value
value <- FieldParser Value
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
mbBs
    case Value -> IResult a
forall a. FromJSON a => Value -> IResult a
JSON.ifromJSON Value
value of
        JSON.IError JSONPath
path String
err -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion a
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f (String -> Conversion a) -> String -> Conversion a
forall a b. (a -> b) -> a -> b
$
                            String
"JSON decoding error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (JSONPath -> ShowS
JSON.formatError JSONPath
path String
err)
        JSON.ISuccess a
x -> a -> Conversion a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | Compatible with the same set of types as @a@.  Note that
--   modifying the 'IORef' does not have any effects outside
--   the local process on the local machine.
instance FromField a => FromField (IORef a) where
    fromField :: FieldParser (IORef a)
fromField Field
f Maybe ByteString
v = IO (IORef a) -> Conversion (IORef a)
forall a. IO a -> Conversion a
liftConversion (IO (IORef a) -> Conversion (IORef a))
-> (a -> IO (IORef a)) -> a -> Conversion (IORef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef (a -> Conversion (IORef a)) -> Conversion a -> Conversion (IORef a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FieldParser a
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
v

-- | Compatible with the same set of types as @a@.  Note that
--   modifying the 'MVar' does not have any effects outside
--   the local process on the local machine.
instance FromField a => FromField (MVar a) where
    fromField :: FieldParser (MVar a)
fromField Field
f Maybe ByteString
v = IO (MVar a) -> Conversion (MVar a)
forall a. IO a -> Conversion a
liftConversion (IO (MVar a) -> Conversion (MVar a))
-> (a -> IO (MVar a)) -> a -> Conversion (MVar a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (MVar a)
forall a. a -> IO (MVar a)
newMVar (a -> Conversion (MVar a)) -> Conversion a -> Conversion (MVar a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FieldParser a
forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
v

type Compat = PQ.Oid -> Bool

okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat
okText :: Oid -> Bool
okText   = Oid -> Oid -> Bool
eq Oid
TI.nameOid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.textOid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.charOid
        (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.bpcharOid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.varcharOid
okText' :: Oid -> Bool
okText'  = Oid -> Oid -> Bool
eq Oid
TI.nameOid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.textOid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.charOid
        (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.bpcharOid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.varcharOid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.unknownOid
okBinary :: Oid -> Bool
okBinary = Oid -> Oid -> Bool
eq Oid
TI.byteaOid
ok16 :: Oid -> Bool
ok16 = Oid -> Oid -> Bool
eq Oid
TI.int2Oid
ok32 :: Oid -> Bool
ok32 = Oid -> Oid -> Bool
eq Oid
TI.int2Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int4Oid
ok64 :: Oid -> Bool
ok64 = Oid -> Oid -> Bool
eq Oid
TI.int2Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int4Oid (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Oid -> Bool
eq Oid
TI.int8Oid
#if WORD_SIZE_IN_BITS < 64
okInt = ok32
#else
okInt :: Oid -> Bool
okInt = Oid -> Bool
ok64
#endif

-- | eq and \/ are used to imlement what Macro stuff did,
-- i.e. mkCompats and inlineTypoid
eq :: PQ.Oid -> PQ.Oid -> Bool
eq :: Oid -> Oid -> Bool
eq = Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE eq #-}

infixr 2 \/
(\/) :: (PQ.Oid -> Bool)
     -> (PQ.Oid -> Bool)
     -> (PQ.Oid -> Bool)
Oid -> Bool
f \/ :: (Oid -> Bool) -> (Oid -> Bool) -> Oid -> Bool
\/ Oid -> Bool
g = \Oid
x -> Oid -> Bool
f Oid
x Bool -> Bool -> Bool
|| Oid -> Bool
g Oid
x
{-# INLINE (\/) #-}

doFromField :: forall a . (Typeable a)
          => Field -> Compat -> (ByteString -> Conversion a)
          -> Maybe ByteString -> Conversion a
doFromField :: Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
doFromField Field
f Oid -> Bool
isCompat ByteString -> Conversion a
cvt (Just ByteString
bs)
    | Oid -> Bool
isCompat (Field -> Oid
typeOid Field
f) = ByteString -> Conversion a
cvt ByteString
bs
    | Bool
otherwise = (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion a
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
"types incompatible"
doFromField Field
f Oid -> Bool
_ ByteString -> Conversion a
_ Maybe ByteString
_ = (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion a
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""


-- | Given one of the constructors from 'ResultError',  the field,
--   and an 'errMessage',  this fills in the other fields in the
--   exception value and returns it in a 'Left . SomeException'
--   constructor.
returnError :: forall a err . (Typeable a, Exception err)
            => (String -> Maybe PQ.Oid -> String -> String -> String -> err)
            -> Field -> String -> Conversion a
returnError :: (String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> err
mkErr Field
f String
msg = do
  ByteString
typnam <- Field -> Conversion ByteString
typename Field
f
  err -> Conversion a
forall err a. Exception err => err -> Conversion a
left (err -> Conversion a) -> err -> Conversion a
forall a b. (a -> b) -> a -> b
$ String -> Maybe Oid -> String -> String -> String -> err
mkErr (ByteString -> String
B.unpack ByteString
typnam)
               (Field -> Maybe Oid
tableOid Field
f)
               (String -> (ByteString -> String) -> Maybe ByteString -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ByteString -> String
B.unpack (Field -> Maybe ByteString
name Field
f))
               (TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined :: a)))
               String
msg

-- | Construct a field parser from an attoparsec parser. An 'Incompatible' error is thrown if the
-- PostgreSQL oid does not match the specified predicate.
--
-- @
-- instance FromField Int16 where
--   fromField = attoFieldParser ok16 (signed decimal)
-- @
--
-- @since 0.6.3
attoFieldParser :: forall a. (Typeable a)
     => (PQ.Oid -> Bool)
     -- ^ Predicate for whether the postgresql type oid is compatible with this parser
     -> Parser a
     -- ^ An attoparsec parser.
     -> FieldParser a
attoFieldParser :: (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
types Parser a
p0 Field
f Maybe ByteString
dat = Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
forall a.
Typeable a =>
Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
doFromField Field
f Oid -> Bool
types (Parser a -> ByteString -> Conversion a
go Parser a
p0) Maybe ByteString
dat
  where
    go :: Parser a -> ByteString -> Conversion a
    go :: Parser a -> ByteString -> Conversion a
go Parser a
p ByteString
s =
        case Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser a
p ByteString
s of
          Left String
err -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion a
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
err
          Right  a
v -> a -> Conversion a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v