{-# 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
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
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 :: forall a b. Exception a => a -> Conversion b
left = forall a b. Exception a => a -> Conversion b
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 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
Oid
Column
column :: Field -> Column
result :: Field -> Result
typeOid :: Oid
column :: Column
result :: Result
typeOid :: Field -> Oid
..} = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                       forall a. a -> Ok a
Ok 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 = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                      forall a. a -> Ok a
Ok 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
Oid
Column
typeOid :: Oid
column :: Column
result :: Result
column :: Field -> Column
result :: Field -> Result
typeOid :: Field -> Oid
..} = 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
Oid
Column
typeOid :: Oid
column :: Column
result :: Result
column :: Field -> Column
result :: Field -> Result
typeOid :: Field -> Oid
..} = Oid -> Maybe Oid
toMaybeOid (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 forall a. Eq a => a -> a -> Bool
== Oid
PQ.invalidOid
         then forall a. Maybe a
Nothing
         else 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
Oid
Column
typeOid :: Oid
column :: Column
result :: Result
column :: Field -> Column
result :: Field -> Result
typeOid :: Field -> Oid
..} = forall {b}. Num b => Column -> b
fromCol (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) = 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
Oid
Column
typeOid :: Oid
column :: Column
result :: Result
column :: Field -> Column
result :: Field -> Result
typeOid :: Field -> Oid
..} = 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 forall a. Eq a => a -> a -> Bool
/= Oid
TI.voidOid = 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 = 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 = forall {k} a (b :: k). a -> Const a b
Const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. FieldParser a -> FieldParser (Maybe a)
optionalField 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 :: forall a. FieldParser a -> FieldParser (Maybe a)
optionalField FieldParser a
p Field
f Maybe ByteString
mv =
    case Maybe ByteString
mv of
      Maybe ByteString
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      Just ByteString
_  -> forall a. a -> Maybe a
Just 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  = forall (f :: * -> *) a. Applicative f => a -> f a
pure Null
Null
    fromField Field
f (Just 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
"data is not null"

-- | bool
instance FromField Bool where
    fromField :: FieldParser Bool
fromField Field
f Maybe ByteString
bs
      | Field -> Oid
typeOid Field
f forall a. Eq a => a -> a -> Bool
/= Oid
TI.boolOid       = 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 forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing                 = 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 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ByteString
"t"                = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      | Maybe ByteString
bs forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ByteString
"f"                = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      | Bool
otherwise                     = 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 -> 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 forall a. Eq a => a -> a -> Bool
/= Int
1
                          then 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 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (ByteString -> Char
B.head ByteString
bs)
        else 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 = forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok16 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Parser a -> Parser a
signed forall a. Integral a => Parser a
decimal

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

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

-- | int2, int4, int8
instance FromField Integer where
    fromField :: FieldParser Integer
fromField = forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok64 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Parser a -> Parser a
signed 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 = forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 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 = forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok Parser 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 Rational
fromField = forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok Parser Rational
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 = forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
ok 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 :: forall t. Binary t -> t
unBinary (Binary t
x) = t
x

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

pg_rational :: Parser Rational
pg_rational :: Parser Rational
pg_rational
    =   (ByteString -> Parser ByteString
string ByteString
"NaN"       forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
notANumber )
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"Infinity"  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
infinity   )
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"-Infinity" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Rational
infinity))
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 forall a. Eq a => a -> a -> Bool
== Oid
TI.byteaOid
                      then forall t. Binary t -> t
unBinary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat
                      else forall a.
Typeable a =>
Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
doFromField Field
f Oid -> Bool
okText' 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser (forall a. Eq a => a -> a -> Bool
== Oid
TI.oidOid) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. IO a -> a
unsafeDupablePerformIO (ByteString -> IO (Maybe ByteString)
PQ.unescapeBytea ByteString
str') of
       Maybe ByteString
Nothing  -> 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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   -> 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 -> forall a.
Typeable a =>
Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
doFromField Field
f Oid -> Bool
okBinary (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> Binary a
Binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LB.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Binary t -> t
unBinary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a.
Typeable a =>
Field
-> (Oid -> Bool)
-> (ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion a
doFromField Field
f Oid -> Bool
okText forall a b. (a -> b) -> a -> b
$ (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. Exception a => a -> Conversion b
left forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Eq a => a -> a -> Bool
/= ByteString
"citext"
         then 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  -> 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 -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. Exception a => a -> Conversion b
left (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
/= ByteString
"citext"
         then 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  -> 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 -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. Exception a => a -> Conversion b
left (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FoldCase s => s -> CI s
CI.mk 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat

-- | timestamptz
instance FromField UTCTime where
  fromField :: FieldParser UTCTime
fromField = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 :: forall a.
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 forall a. Eq a => a -> a -> Bool
/= Oid
compatOid
  then 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 -> 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 -> 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 -> 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
     forall a b. Exception a => a -> Conversion b
left 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)
                 (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 =   (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
dat)
                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. a -> Either a b
Left  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. Typeable a => FieldParser a -> FieldParser (PGArray a)
pgArrayFieldParser forall a. FromField a => FieldParser a
fromField

pgArrayFieldParser :: Typeable a => FieldParser a -> FieldParser (PGArray a)
pgArrayFieldParser :: forall a. Typeable a => 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  -> 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 forall a. Parser a -> ByteString -> Either String a
parseOnly (forall a.
FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])
fromArray FieldParser a
fieldParser TypeInfo
info Field
f) ByteString
dat of
                     Left  String
err  -> 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 -> forall a. [a] -> PGArray a
PGArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Conversion [a]
conv
          TypeInfo
_ -> 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 :: forall a.
FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])
fromArray FieldParser a
fieldParser TypeInfo
typInfo Field
f = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayFormat -> Conversion a
parseIt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser [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' forall a b. (a -> b) -> a -> b
$ if ArrayFormat
item forall a. Eq a => a -> a -> Bool
== ByteString -> ArrayFormat
Arrays.Plain ByteString
"NULL" then forall a. Maybe a
Nothing else 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]
_ <- 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 = forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PGArray a -> [a]
fromPGArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. IO a -> Conversion a
liftConversion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 forall a. Eq a => a -> a -> Bool
/= Oid
TI.uuidOid
      then 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 -> 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 -> 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 -> 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 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 forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ByteString Value
JSON.value' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput) ByteString
bs of
                   Left  String
err -> 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 -> 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 forall a. Eq a => a -> a -> Bool
/= Oid
TI.jsonOid Bool -> Bool -> Bool
&& Field -> Oid
typeOid Field
f forall a. Eq a => a -> a -> Bool
/= Oid
TI.jsonbOid
      then 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 -> 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 -> 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 :: forall a. (FromJSON a, Typeable a) => FieldParser a
fromJSONField Field
f Maybe ByteString
mbBs = do
    Value
value <- forall a. FromField a => FieldParser a
fromField Field
f Maybe ByteString
mbBs
    case forall a. FromJSON a => Value -> IResult a
JSON.ifromJSON Value
value of
        JSON.IError JSONPath
path String
err -> 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 forall a b. (a -> b) -> a -> b
$
                            String
"JSON decoding error: " forall a. [a] -> [a] -> [a]
++ (JSONPath -> ShowS
JSON.formatError JSONPath
path String
err)
        JSON.ISuccess a
x -> 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 = forall a. IO a -> Conversion a
liftConversion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO (IORef a)
newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 = forall a. IO a -> Conversion a
liftConversion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO (MVar a)
newMVar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 = 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 :: forall a.
Typeable a =>
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 = 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
_ = 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 :: 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 -> err
mkErr Field
f String
msg = do
  ByteString
typnam <- Field -> Conversion ByteString
typename Field
f
  forall a b. Exception a => a -> Conversion b
left 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)
               (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ByteString -> String
B.unpack (Field -> Maybe ByteString
name Field
f))
               (forall a. Show a => a -> String
show (forall a. Typeable a => a -> TypeRep
typeOf (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 :: forall a. Typeable a => (Oid -> Bool) -> Parser a -> FieldParser a
attoFieldParser Oid -> Bool
types Parser a
p0 Field
f Maybe ByteString
dat = 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 forall a. Parser a -> ByteString -> Either String a
parseOnly Parser a
p ByteString
s of
          Left String
err -> 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v