{-# LANGUAGE CPP, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses, FlexibleContexts, DataKinds, KindSignatures, TypeFamilies, DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE UndecidableSuperClasses #-}
#endif
-- |
-- Module: Database.PostgreSQL.Typed.Types
-- Copyright: 2015 Dylan Simon
-- 
-- Classes to support type inference, value encoding/decoding, and instances to support built-in PostgreSQL types.

module Database.PostgreSQL.Typed.Types 
  (
  -- * Basic types
    OID
  , PGValue(..)
  , PGValues
  , PGTypeID(..)
  , PGTypeEnv(..), unknownPGTypeEnv
  , PGName(..), pgNameBS, pgNameString
  , PGRecord(..)

  -- * Marshalling classes
  , PGType(..)
  , PGParameter(..)
  , PGColumn(..)
  , PGStringType
  , PGRecordType

  -- * Marshalling interface
  , pgEncodeParameter
  , pgEscapeParameter
  , pgDecodeColumn
  , pgDecodeColumnNotNull

  -- * Conversion utilities
  , pgQuote
  , pgDQuote
  , pgDQuoteFrom
  , parsePGDQuote
  , buildPGValue
  ) where

import qualified Codec.Binary.UTF8.String as UTF8
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<$), (<*), (*>))
#endif
import Control.Arrow ((&&&))
#ifdef VERSION_aeson
import qualified Data.Aeson as JSON
#endif
import qualified Data.Attoparsec.ByteString as P (anyWord8)
import qualified Data.Attoparsec.ByteString.Char8 as P
import Data.Bits (shiftL, (.|.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Builder.Prim as BSBP
import qualified Data.ByteString.Char8 as BSC
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.UTF8 as BSU
import Data.Char (isSpace, isDigit, digitToInt, intToDigit, toLower)
import Data.Data (Data)
import Data.Int
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mempty, mconcat)
#endif
import Data.Ratio ((%), numerator, denominator)
#ifdef VERSION_scientific
import Data.Scientific (Scientific)
#endif
import Data.String (IsString(..))
#ifdef VERSION_text
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
#endif
import qualified Data.Time as Time
#if MIN_VERSION_time(1,5,0)
import Data.Time (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
import Data.Typeable (Typeable)
#ifdef VERSION_uuid
import qualified Data.UUID as UUID
#endif
import Data.Word (Word8, Word32)
import GHC.TypeLits (Symbol, symbolVal, KnownSymbol)
import Numeric (readFloat)
#ifdef VERSION_postgresql_binary
#if MIN_VERSION_postgresql_binary(0,12,0)
import qualified PostgreSQL.Binary.Decoding as BinD
import qualified PostgreSQL.Binary.Encoding as BinE
#else
import qualified PostgreSQL.Binary.Decoder as BinD
import qualified PostgreSQL.Binary.Encoder as BinE
#endif
#endif

type PGTextValue = BS.ByteString
type PGBinaryValue = BS.ByteString
-- |A value passed to or from PostgreSQL in raw format.
data PGValue
  = PGNullValue
  | PGTextValue { PGValue -> ByteString
pgTextValue :: PGTextValue } -- ^ The standard text encoding format (also used for unknown formats)
  | PGBinaryValue { PGValue -> ByteString
pgBinaryValue :: PGBinaryValue } -- ^ Special binary-encoded data.  Not supported in all cases.
  deriving (Int -> PGValue -> ShowS
[PGValue] -> ShowS
PGValue -> [Char]
(Int -> PGValue -> ShowS)
-> (PGValue -> [Char]) -> ([PGValue] -> ShowS) -> Show PGValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGValue -> ShowS
showsPrec :: Int -> PGValue -> ShowS
$cshow :: PGValue -> [Char]
show :: PGValue -> [Char]
$cshowList :: [PGValue] -> ShowS
showList :: [PGValue] -> ShowS
Show, PGValue -> PGValue -> Bool
(PGValue -> PGValue -> Bool)
-> (PGValue -> PGValue -> Bool) -> Eq PGValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGValue -> PGValue -> Bool
== :: PGValue -> PGValue -> Bool
$c/= :: PGValue -> PGValue -> Bool
/= :: PGValue -> PGValue -> Bool
Eq)
-- |A list of (nullable) data values, e.g. a single row or query parameters.
type PGValues = [PGValue]

-- |Parameters that affect how marshalling happens.
-- Currenly we force all other relevant parameters at connect time.
-- Nothing values represent unknown.
data PGTypeEnv = PGTypeEnv
  { PGTypeEnv -> Maybe Bool
pgIntegerDatetimes :: Maybe Bool -- ^ If @integer_datetimes@ is @on@; only relevant for binary encoding.
  , PGTypeEnv -> Maybe ByteString
pgServerVersion :: Maybe BS.ByteString -- ^ The @server_version@ parameter
  } deriving (Int -> PGTypeEnv -> ShowS
[PGTypeEnv] -> ShowS
PGTypeEnv -> [Char]
(Int -> PGTypeEnv -> ShowS)
-> (PGTypeEnv -> [Char])
-> ([PGTypeEnv] -> ShowS)
-> Show PGTypeEnv
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGTypeEnv -> ShowS
showsPrec :: Int -> PGTypeEnv -> ShowS
$cshow :: PGTypeEnv -> [Char]
show :: PGTypeEnv -> [Char]
$cshowList :: [PGTypeEnv] -> ShowS
showList :: [PGTypeEnv] -> ShowS
Show)

unknownPGTypeEnv :: PGTypeEnv
unknownPGTypeEnv :: PGTypeEnv
unknownPGTypeEnv = PGTypeEnv
  { pgIntegerDatetimes :: Maybe Bool
pgIntegerDatetimes = Maybe Bool
forall a. Maybe a
Nothing
  , pgServerVersion :: Maybe ByteString
pgServerVersion = Maybe ByteString
forall a. Maybe a
Nothing
  }

-- |A PostgreSQL literal identifier, generally corresponding to the \"name\" type (63-byte strings), but as it would be entered in a query, so may include double-quoting for special characters or schema-qualification.
newtype PGName = PGName
  { PGName -> [Word8]
pgNameBytes :: [Word8] -- ^Raw bytes of the identifier (should really be a 'BS.ByteString', but we need a working 'Data' instance for annotations).
  }
  deriving (PGName -> PGName -> Bool
(PGName -> PGName -> Bool)
-> (PGName -> PGName -> Bool) -> Eq PGName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGName -> PGName -> Bool
== :: PGName -> PGName -> Bool
$c/= :: PGName -> PGName -> Bool
/= :: PGName -> PGName -> Bool
Eq, Eq PGName
Eq PGName =>
(PGName -> PGName -> Ordering)
-> (PGName -> PGName -> Bool)
-> (PGName -> PGName -> Bool)
-> (PGName -> PGName -> Bool)
-> (PGName -> PGName -> Bool)
-> (PGName -> PGName -> PGName)
-> (PGName -> PGName -> PGName)
-> Ord PGName
PGName -> PGName -> Bool
PGName -> PGName -> Ordering
PGName -> PGName -> PGName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PGName -> PGName -> Ordering
compare :: PGName -> PGName -> Ordering
$c< :: PGName -> PGName -> Bool
< :: PGName -> PGName -> Bool
$c<= :: PGName -> PGName -> Bool
<= :: PGName -> PGName -> Bool
$c> :: PGName -> PGName -> Bool
> :: PGName -> PGName -> Bool
$c>= :: PGName -> PGName -> Bool
>= :: PGName -> PGName -> Bool
$cmax :: PGName -> PGName -> PGName
max :: PGName -> PGName -> PGName
$cmin :: PGName -> PGName -> PGName
min :: PGName -> PGName -> PGName
Ord, Typeable, Typeable PGName
Typeable PGName =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PGName -> c PGName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PGName)
-> (PGName -> Constr)
-> (PGName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PGName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGName))
-> ((forall b. Data b => b -> b) -> PGName -> PGName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PGName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PGName -> r)
-> (forall u. (forall d. Data d => d -> u) -> PGName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PGName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PGName -> m PGName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PGName -> m PGName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PGName -> m PGName)
-> Data PGName
PGName -> Constr
PGName -> DataType
(forall b. Data b => b -> b) -> PGName -> PGName
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PGName -> u
forall u. (forall d. Data d => d -> u) -> PGName -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGName -> c PGName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGName -> c PGName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PGName -> c PGName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PGName
$ctoConstr :: PGName -> Constr
toConstr :: PGName -> Constr
$cdataTypeOf :: PGName -> DataType
dataTypeOf :: PGName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PGName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PGName)
$cgmapT :: (forall b. Data b => b -> b) -> PGName -> PGName
gmapT :: (forall b. Data b => b -> b) -> PGName -> PGName
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PGName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PGName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PGName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PGName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PGName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PGName -> m PGName
Data)

-- |The literal identifier as used in a query.
pgNameBS :: PGName -> BS.ByteString
pgNameBS :: PGName -> ByteString
pgNameBS = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (PGName -> [Word8]) -> PGName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGName -> [Word8]
pgNameBytes

-- |Applies utf-8 encoding.
instance IsString PGName where
  fromString :: [Char] -> PGName
fromString = [Word8] -> PGName
PGName ([Word8] -> PGName) -> ([Char] -> [Word8]) -> [Char] -> PGName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Word8]
UTF8.encode
-- |Unquoted 'pgNameString'.
instance Show PGName where
  show :: PGName -> [Char]
show = PGName -> [Char]
pgNameString

-- |Reverses the 'IsString' instantce.
pgNameString :: PGName -> String
pgNameString :: PGName -> [Char]
pgNameString = [Word8] -> [Char]
UTF8.decode ([Word8] -> [Char]) -> (PGName -> [Word8]) -> PGName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGName -> [Word8]
pgNameBytes

-- |A proxy type for PostgreSQL types.  The type argument should be an (internal) name of a database type, as per @format_type(OID)@ (usually the same as @\\dT+@).
-- When the type's namespace (schema) is not in @search_path@, this will be explicitly qualified, so you should be sure to have a consistent @search_path@ for all database connections.
-- The underlying 'Symbol' should be considered a lifted 'PGName'.
data PGTypeID (t :: Symbol) = PGTypeProxy

-- |A valid PostgreSQL type, its metadata, and corresponding Haskell representation.
-- For conversion the other way (from Haskell type to PostgreSQL), see 'Database.PostgreSQL.Typed.Dynamic.PGRep'.
-- Unfortunately any instances of this will be orphans.
class (KnownSymbol t
#if __GLASGOW_HASKELL__ >= 800
    , PGParameter t (PGVal t), PGColumn t (PGVal t)
#endif
    ) => PGType t where
  -- |The default, native Haskell representation of this type, which should be as close as possible to the PostgreSQL representation.
  type PGVal t :: *
  -- |The string name of this type: specialized version of 'symbolVal'.
  pgTypeName :: PGTypeID t -> PGName
  pgTypeName = [Char] -> PGName
forall a. IsString a => [Char] -> a
fromString ([Char] -> PGName)
-> (PGTypeID t -> [Char]) -> PGTypeID t -> PGName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal
  -- |Does this type support binary decoding?
  -- If so, 'pgDecodeBinary' must be implemented for every 'PGColumn' instance of this type.
  pgBinaryColumn :: PGTypeEnv -> PGTypeID t -> Bool
  pgBinaryColumn PGTypeEnv
_ PGTypeID t
_ = Bool
False

-- |A @PGParameter t a@ instance describes how to encode a PostgreSQL type @t@ from @a@.
class PGType t => PGParameter t a where
  -- |Encode a value to a PostgreSQL text representation.
  pgEncode :: PGTypeID t -> a -> PGTextValue
  -- |Encode a value to a (quoted) literal value for use in SQL statements.
  -- Defaults to a quoted version of 'pgEncode'
  pgLiteral :: PGTypeID t -> a -> BS.ByteString
  pgLiteral PGTypeID t
t = ByteString -> ByteString
pgQuote (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> a -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID t
t
  -- |Encode a value to a PostgreSQL representation.
  -- Defaults to the text representation by pgEncode
  pgEncodeValue :: PGTypeEnv -> PGTypeID t -> a -> PGValue
  pgEncodeValue PGTypeEnv
_ PGTypeID t
t = ByteString -> PGValue
PGTextValue (ByteString -> PGValue) -> (a -> ByteString) -> a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> a -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID t
t

-- |A @PGColumn t a@ instance describes how te decode a PostgreSQL type @t@ to @a@.
class PGType t => PGColumn t a where
  -- |Decode the PostgreSQL text representation into a value.
  pgDecode :: PGTypeID t -> PGTextValue -> a
  -- |Decode the PostgreSQL binary representation into a value.
  -- Only needs to be implemented if 'pgBinaryColumn' is true.
  pgDecodeBinary :: PGTypeEnv -> PGTypeID t -> PGBinaryValue -> a
  pgDecodeBinary PGTypeEnv
_ PGTypeID t
t ByteString
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"pgDecodeBinary " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PGName -> [Char]
forall a. Show a => a -> [Char]
show (PGTypeID t -> PGName
forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": not supported"
  pgDecodeValue :: PGTypeEnv -> PGTypeID t -> PGValue -> a
  pgDecodeValue PGTypeEnv
_ PGTypeID t
t (PGTextValue ByteString
v) = PGTypeID t -> ByteString -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeID t -> ByteString -> a
pgDecode PGTypeID t
t ByteString
v
  pgDecodeValue PGTypeEnv
e PGTypeID t
t (PGBinaryValue ByteString
v) = PGTypeEnv -> PGTypeID t -> ByteString -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> ByteString -> a
pgDecodeBinary PGTypeEnv
e PGTypeID t
t ByteString
v
  pgDecodeValue PGTypeEnv
_ PGTypeID t
t PGValue
PGNullValue = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"NULL in " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PGName -> [Char]
forall a. Show a => a -> [Char]
show (PGTypeID t -> PGName
forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" column (use Maybe or COALESCE)"

instance PGParameter t a => PGParameter t (Maybe a) where
  pgEncode :: PGTypeID t -> Maybe a -> ByteString
pgEncode PGTypeID t
t = ByteString -> (a -> ByteString) -> Maybe a -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"pgEncode " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PGName -> [Char]
forall a. Show a => a -> [Char]
show (PGTypeID t -> PGName
forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": Nothing") (PGTypeID t -> a -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID t
t)
  pgLiteral :: PGTypeID t -> Maybe a -> ByteString
pgLiteral = ByteString -> (a -> ByteString) -> Maybe a -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ByteString
BSC.pack [Char]
"NULL") ((a -> ByteString) -> Maybe a -> ByteString)
-> (PGTypeID t -> a -> ByteString)
-> PGTypeID t
-> Maybe a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> a -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgLiteral
  pgEncodeValue :: PGTypeEnv -> PGTypeID t -> Maybe a -> PGValue
pgEncodeValue PGTypeEnv
e = PGValue -> (a -> PGValue) -> Maybe a -> PGValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PGValue
PGNullValue ((a -> PGValue) -> Maybe a -> PGValue)
-> (PGTypeID t -> a -> PGValue) -> PGTypeID t -> Maybe a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeEnv -> PGTypeID t -> a -> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeValue PGTypeEnv
e

instance PGColumn t a => PGColumn t (Maybe a) where
  pgDecode :: PGTypeID t -> ByteString -> Maybe a
pgDecode PGTypeID t
t = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (ByteString -> a) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> ByteString -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeID t -> ByteString -> a
pgDecode PGTypeID t
t
  pgDecodeBinary :: PGTypeEnv -> PGTypeID t -> ByteString -> Maybe a
pgDecodeBinary PGTypeEnv
e PGTypeID t
t = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (ByteString -> a) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeEnv -> PGTypeID t -> ByteString -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> ByteString -> a
pgDecodeBinary PGTypeEnv
e PGTypeID t
t
  pgDecodeValue :: PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
pgDecodeValue PGTypeEnv
_ PGTypeID t
_ PGValue
PGNullValue = Maybe a
forall a. Maybe a
Nothing
  pgDecodeValue PGTypeEnv
e PGTypeID t
t PGValue
v = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ PGTypeEnv -> PGTypeID t -> PGValue -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue PGTypeEnv
e PGTypeID t
t PGValue
v

-- |Final parameter encoding function used when a (nullable) parameter is passed to a prepared query.
pgEncodeParameter :: PGParameter t a => PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeParameter :: forall (t :: Symbol) a.
PGParameter t a =>
PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeParameter = PGTypeEnv -> PGTypeID t -> a -> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeEnv -> PGTypeID t -> a -> PGValue
pgEncodeValue

-- |Final parameter escaping function used when a (nullable) parameter is passed to be substituted into a simple query.
pgEscapeParameter :: PGParameter t a => PGTypeEnv -> PGTypeID t -> a -> BS.ByteString
pgEscapeParameter :: forall (t :: Symbol) a.
PGParameter t a =>
PGTypeEnv -> PGTypeID t -> a -> ByteString
pgEscapeParameter PGTypeEnv
_ = PGTypeID t -> a -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgLiteral

-- |Final column decoding function used for a nullable result value.
pgDecodeColumn :: PGColumn t (Maybe a) => PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
pgDecodeColumn :: forall (t :: Symbol) a.
PGColumn t (Maybe a) =>
PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
pgDecodeColumn = PGTypeEnv -> PGTypeID t -> PGValue -> Maybe a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue

-- |Final column decoding function used for a non-nullable result value.
pgDecodeColumnNotNull :: PGColumn t a => PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeColumnNotNull :: forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeColumnNotNull = PGTypeEnv -> PGTypeID t -> PGValue -> a
forall (t :: Symbol) a.
PGColumn t a =>
PGTypeEnv -> PGTypeID t -> PGValue -> a
pgDecodeValue


pgQuoteUnsafe :: BS.ByteString -> BS.ByteString
pgQuoteUnsafe :: ByteString -> ByteString
pgQuoteUnsafe = (ByteString -> Char -> ByteString
`BSC.snoc` Char
'\'') (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
BSC.cons Char
'\''

-- |Produce a SQL string literal by wrapping (and escaping) a string with single quotes.
pgQuote :: BS.ByteString -> BS.ByteString
pgQuote :: ByteString -> ByteString
pgQuote ByteString
s
  | Char
'\0' Char -> ByteString -> Bool
`BSC.elem` ByteString
s = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"pgQuote: unhandled null in literal"
  | Bool
otherwise = ByteString -> ByteString
pgQuoteUnsafe (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
BSC.intercalate ([Char] -> ByteString
BSC.pack [Char]
"''") ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
BSC.split Char
'\'' ByteString
s

-- |Shorthand for @'BSL.toStrict' . 'BSB.toLazyByteString'@
buildPGValue :: BSB.Builder -> BS.ByteString
buildPGValue :: Builder -> ByteString
buildPGValue = LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (Builder -> LazyByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
BSB.toLazyByteString

-- |Double-quote a value (e.g., as an identifier).
-- Does not properly handle unicode escaping (yet).
pgDQuote :: BS.ByteString -> BSB.Builder
pgDQuote :: ByteString -> Builder
pgDQuote ByteString
s = Builder
dq Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BoundedPrim Word8 -> ByteString -> Builder
BSBP.primMapByteStringBounded BoundedPrim Word8
ec ByteString
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
dq where
  dq :: Builder
dq = Char -> Builder
BSB.char7 Char
'"'
  ec :: BoundedPrim Word8
ec = (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BSBP.condB (\Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'"' Bool -> Bool -> Bool
|| Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\\') BoundedPrim Word8
bs (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BSBP.liftFixedToBounded FixedPrim Word8
BSBP.word8)
  bs :: BoundedPrim Word8
bs = FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BSBP.liftFixedToBounded (FixedPrim Word8 -> BoundedPrim Word8)
-> FixedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ ((,) Char
'\\') (Word8 -> (Char, Word8))
-> FixedPrim (Char, Word8) -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BSBP.>$< (FixedPrim Char
BSBP.char7 FixedPrim Char -> FixedPrim Word8 -> FixedPrim (Char, Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BSBP.>*< FixedPrim Word8
BSBP.word8)

-- |Double-quote a value if it's \"\", \"null\", or contains any whitespace, \'\"\', \'\\\', or the characters given in the first argument.
pgDQuoteFrom :: [Char] -> BS.ByteString -> BSB.Builder
pgDQuoteFrom :: [Char] -> ByteString -> Builder
pgDQuoteFrom [Char]
unsafe ByteString
s
  | ByteString -> Bool
BS.null ByteString
s Bool -> Bool -> Bool
|| (Char -> Bool) -> ByteString -> Bool
BSC.any (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
unsafe) ByteString
s Bool -> Bool -> Bool
|| (Char -> Char) -> ByteString -> ByteString
BSC.map Char -> Char
toLower ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
BSC.pack [Char]
"null" = ByteString -> Builder
pgDQuote ByteString
s
  | Bool
otherwise = ByteString -> Builder
BSB.byteString ByteString
s

-- |Parse double-quoted values ala 'pgDQuote'.
parsePGDQuote :: Bool -> [Char] -> (BS.ByteString -> Bool) -> P.Parser (Maybe BS.ByteString)
parsePGDQuote :: Bool -> [Char] -> (ByteString -> Bool) -> Parser (Maybe ByteString)
parsePGDQuote Bool
blank [Char]
unsafe ByteString -> Bool
isnul = (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Parser ByteString ByteString -> Parser (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
q) Parser (Maybe ByteString)
-> Parser (Maybe ByteString) -> Parser (Maybe ByteString)
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Maybe ByteString
mnul (ByteString -> Maybe ByteString)
-> Parser ByteString ByteString -> Parser (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
uq) where
  q :: Parser ByteString ByteString
q = Char -> Parser Char
P.char Char
'"' Parser Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [ByteString]
qs)
  qs :: Parser ByteString [ByteString]
qs = do
    p <- (Char -> Bool) -> Parser ByteString ByteString
P.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')
    e <- P.anyChar
    if e == '"'
      then return [p]
      else do
        c <- P.anyWord8
        (p :) . (BS.singleton c :) <$> qs
  uq :: Parser ByteString ByteString
uq = (if Bool
blank then (Char -> Bool) -> Parser ByteString ByteString
P.takeWhile else (Char -> Bool) -> Parser ByteString ByteString
P.takeWhile1) (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Char
'"'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
unsafe))
  mnul :: ByteString -> Maybe ByteString
mnul ByteString
s
    | ByteString -> Bool
isnul ByteString
s = Maybe ByteString
forall a. Maybe a
Nothing
    | Bool
otherwise = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s

#ifdef VERSION_postgresql_binary
binEnc :: BinEncoder a -> a -> BS.ByteString
binEnc :: forall a. BinEncoder a -> a -> ByteString
binEnc = (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
#if MIN_VERSION_postgresql_binary(0,12,0)
  Encoding -> ByteString
BinE.encodingBytes

type BinDecoder = BinD.Value
type BinEncoder a = a -> BinE.Encoding
#else
  buildPGValue

type BinDecoder = BinD.Decoder
type BinEncoder a = BinE.Encoder a
#endif

binDec :: PGType t => BinDecoder a -> PGTypeID t -> PGBinaryValue -> a
binDec :: forall (t :: Symbol) a.
PGType t =>
BinDecoder a -> PGTypeID t -> ByteString -> a
binDec BinDecoder a
d PGTypeID t
t = (Text -> a) -> (a -> a) -> Either Text a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Text
e -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"pgDecodeBinary " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PGName -> [Char]
forall a. Show a => a -> [Char]
show (PGTypeID t -> PGName
forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName PGTypeID t
t) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
e) a -> a
forall a. a -> a
id (Either Text a -> a)
-> (ByteString -> Either Text a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
#if MIN_VERSION_postgresql_binary(0,12,0)
  BinDecoder a -> ByteString -> Either Text a
forall a. Value a -> ByteString -> Either Text a
BinD.valueParser
#else
  BinD.run
#endif
  BinDecoder a
d

#define BIN_COL pgBinaryColumn _ _ = True
#define BIN_ENC(F) pgEncodeValue _ _ = PGBinaryValue . binEnc (F)
#define BIN_DEC(F) pgDecodeBinary _ = binDec (F)
#else
#define BIN_COL
#define BIN_ENC(F)
#define BIN_DEC(F)
#endif

instance PGType "any" where
  type PGVal "any" = PGValue
instance PGType t => PGColumn t PGValue where
  pgDecode :: PGTypeID t -> ByteString -> PGValue
pgDecode PGTypeID t
_ = ByteString -> PGValue
PGTextValue
  pgDecodeBinary :: PGTypeEnv -> PGTypeID t -> ByteString -> PGValue
pgDecodeBinary PGTypeEnv
_ PGTypeID t
_ = ByteString -> PGValue
PGBinaryValue
  pgDecodeValue :: PGTypeEnv -> PGTypeID t -> PGValue -> PGValue
pgDecodeValue PGTypeEnv
_ PGTypeID t
_ = PGValue -> PGValue
forall a. a -> a
id
instance PGParameter "any" PGValue where
  pgEncode :: PGTypeID "any" -> PGValue -> ByteString
pgEncode PGTypeID "any"
_ (PGTextValue ByteString
v) = ByteString
v
  pgEncode PGTypeID "any"
_ PGValue
PGNullValue = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"pgEncode any: NULL"
  pgEncode PGTypeID "any"
_ (PGBinaryValue ByteString
_) = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"pgEncode any: binary"
  pgEncodeValue :: PGTypeEnv -> PGTypeID "any" -> PGValue -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID "any"
_ = PGValue -> PGValue
forall a. a -> a
id

instance PGType "void" where
  type PGVal "void" = ()
instance PGParameter "void" () where
  pgEncode :: PGTypeID "void" -> () -> ByteString
pgEncode PGTypeID "void"
_ ()
_ = ByteString
BSC.empty
instance PGColumn "void" () where
  pgDecode :: PGTypeID "void" -> ByteString -> ()
pgDecode PGTypeID "void"
_ ByteString
_ = ()
  pgDecodeBinary :: PGTypeEnv -> PGTypeID "void" -> ByteString -> ()
pgDecodeBinary PGTypeEnv
_ PGTypeID "void"
_ ByteString
_ = ()
  pgDecodeValue :: PGTypeEnv -> PGTypeID "void" -> PGValue -> ()
pgDecodeValue PGTypeEnv
_ PGTypeID "void"
_ PGValue
_ = ()

instance PGType "boolean" where
  type PGVal "boolean" = Bool
  BIN_COL
instance PGParameter "boolean" Bool where
  pgEncode :: PGTypeID "boolean" -> Bool -> ByteString
pgEncode PGTypeID "boolean"
_ Bool
False = Char -> ByteString
BSC.singleton Char
'f'
  pgEncode PGTypeID "boolean"
_ Bool
True = Char -> ByteString
BSC.singleton Char
't'
  pgLiteral :: PGTypeID "boolean" -> Bool -> ByteString
pgLiteral PGTypeID "boolean"
_ Bool
False = [Char] -> ByteString
BSC.pack [Char]
"false"
  pgLiteral PGTypeID "boolean"
_ Bool
True = [Char] -> ByteString
BSC.pack [Char]
"true"
  BIN_ENC(BinE.bool)
instance PGColumn "boolean" Bool where
  pgDecode :: PGTypeID "boolean" -> ByteString -> Bool
pgDecode PGTypeID "boolean"
_ ByteString
s = case ByteString -> Char
BSC.head ByteString
s of
    Char
'f' -> Bool
False
    Char
't' -> Bool
True
    Char
c -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"pgDecode boolean: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c]
  BIN_DEC(BinD.bool)

type OID = Word32
instance PGType "oid" where
  type PGVal "oid" = OID
  BIN_COL
instance PGParameter "oid" OID where
  pgEncode :: PGTypeID "oid" -> OID -> ByteString
pgEncode PGTypeID "oid"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> (OID -> [Char]) -> OID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OID -> [Char]
forall a. Show a => a -> [Char]
show
  pgLiteral :: PGTypeID "oid" -> OID -> ByteString
pgLiteral = PGTypeID "oid" -> OID -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
  BIN_ENC(BinE.int4_word32)
instance PGColumn "oid" OID where
  pgDecode :: PGTypeID "oid" -> ByteString -> OID
pgDecode PGTypeID "oid"
_ = [Char] -> OID
forall a. Read a => [Char] -> a
read ([Char] -> OID) -> (ByteString -> [Char]) -> ByteString -> OID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
  BIN_DEC(BinD.int)

instance PGType "smallint" where
  type PGVal "smallint" = Int16
  BIN_COL
instance PGParameter "smallint" Int16 where
  pgEncode :: PGTypeID "smallint" -> Int16 -> ByteString
pgEncode PGTypeID "smallint"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> (Int16 -> [Char]) -> Int16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> [Char]
forall a. Show a => a -> [Char]
show
  pgLiteral :: PGTypeID "smallint" -> Int16 -> ByteString
pgLiteral = PGTypeID "smallint" -> Int16 -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
  BIN_ENC(BinE.int2_int16)
instance PGColumn "smallint" Int16 where
  pgDecode :: PGTypeID "smallint" -> ByteString -> Int16
pgDecode PGTypeID "smallint"
_ = [Char] -> Int16
forall a. Read a => [Char] -> a
read ([Char] -> Int16) -> (ByteString -> [Char]) -> ByteString -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
  BIN_DEC(BinD.int)

instance PGType "integer" where 
  type PGVal "integer" = Int32
  BIN_COL
instance PGParameter "integer" Int32 where
  pgEncode :: PGTypeID "integer" -> Int32 -> ByteString
pgEncode PGTypeID "integer"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> (Int32 -> [Char]) -> Int32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> [Char]
forall a. Show a => a -> [Char]
show
  pgLiteral :: PGTypeID "integer" -> Int32 -> ByteString
pgLiteral = PGTypeID "integer" -> Int32 -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
  BIN_ENC(BinE.int4_int32)
instance PGColumn "integer" Int32 where
  pgDecode :: PGTypeID "integer" -> ByteString -> Int32
pgDecode PGTypeID "integer"
_ = [Char] -> Int32
forall a. Read a => [Char] -> a
read ([Char] -> Int32) -> (ByteString -> [Char]) -> ByteString -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
  BIN_DEC(BinD.int)

instance PGType "bigint" where
  type PGVal "bigint" = Int64
  BIN_COL
instance PGParameter "bigint" Int64 where
  pgEncode :: PGTypeID "bigint" -> Int64 -> ByteString
pgEncode PGTypeID "bigint"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> (Int64 -> [Char]) -> Int64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> [Char]
forall a. Show a => a -> [Char]
show
  pgLiteral :: PGTypeID "bigint" -> Int64 -> ByteString
pgLiteral = PGTypeID "bigint" -> Int64 -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
  BIN_ENC(BinE.int8_int64)
instance PGColumn "bigint" Int64 where
  pgDecode :: PGTypeID "bigint" -> ByteString -> Int64
pgDecode PGTypeID "bigint"
_ = [Char] -> Int64
forall a. Read a => [Char] -> a
read ([Char] -> Int64) -> (ByteString -> [Char]) -> ByteString -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
  BIN_DEC(BinD.int)

instance PGType "real" where
  type PGVal "real" = Float
  BIN_COL
instance PGParameter "real" Float where
  pgEncode :: PGTypeID "real" -> Float -> ByteString
pgEncode PGTypeID "real"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> (Float -> [Char]) -> Float -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> [Char]
forall a. Show a => a -> [Char]
show
  pgLiteral :: PGTypeID "real" -> Float -> ByteString
pgLiteral = PGTypeID "real" -> Float -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
  BIN_ENC(BinE.float4)
instance PGColumn "real" Float where
  pgDecode :: PGTypeID "real" -> ByteString -> Float
pgDecode PGTypeID "real"
_ = [Char] -> Float
forall a. Read a => [Char] -> a
read ([Char] -> Float) -> (ByteString -> [Char]) -> ByteString -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
  BIN_DEC(BinD.float4)
instance PGColumn "real" Double where
  pgDecode :: PGTypeID "real" -> ByteString -> Double
pgDecode PGTypeID "real"
_ = [Char] -> Double
forall a. Read a => [Char] -> a
read ([Char] -> Double)
-> (ByteString -> [Char]) -> ByteString -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
  BIN_DEC(realToFrac <$> BinD.float4)

instance PGType "double precision" where
  type PGVal "double precision" = Double
  BIN_COL
instance PGParameter "double precision" Double where
  pgEncode :: PGTypeID "double precision" -> Double -> ByteString
pgEncode PGTypeID "double precision"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString)
-> (Double -> [Char]) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Char]
forall a. Show a => a -> [Char]
show
  pgLiteral :: PGTypeID "double precision" -> Double -> ByteString
pgLiteral = PGTypeID "double precision" -> Double -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
  BIN_ENC(BinE.float8)
instance PGParameter "double precision" Float where
  pgEncode :: PGTypeID "double precision" -> Float -> ByteString
pgEncode PGTypeID "double precision"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> (Float -> [Char]) -> Float -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> [Char]
forall a. Show a => a -> [Char]
show
  pgLiteral :: PGTypeID "double precision" -> Float -> ByteString
pgLiteral = PGTypeID "double precision" -> Float -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
  BIN_ENC(BinE.float8 . realToFrac)
instance PGColumn "double precision" Double where
  pgDecode :: PGTypeID "double precision" -> ByteString -> Double
pgDecode PGTypeID "double precision"
_ = [Char] -> Double
forall a. Read a => [Char] -> a
read ([Char] -> Double)
-> (ByteString -> [Char]) -> ByteString -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
  BIN_DEC(BinD.float8)

-- XXX need real encoding as text
-- but then no one should be using this type really...
instance PGType "\"char\"" where
  type PGVal "\"char\"" = Word8
  BIN_COL
instance PGParameter "\"char\"" Word8 where
  pgEncode :: PGTypeID "\"char\"" -> Word8 -> ByteString
pgEncode PGTypeID "\"char\""
_ = Word8 -> ByteString
BS.singleton
  pgEncodeValue :: PGTypeEnv -> PGTypeID "\"char\"" -> Word8 -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID "\"char\""
_ = ByteString -> PGValue
PGBinaryValue (ByteString -> PGValue)
-> (Word8 -> ByteString) -> Word8 -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString
BS.singleton
instance PGColumn "\"char\"" Word8 where
  pgDecode :: PGTypeID "\"char\"" -> ByteString -> Word8
pgDecode PGTypeID "\"char\""
_ = HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head
  pgDecodeBinary :: PGTypeEnv -> PGTypeID "\"char\"" -> ByteString -> Word8
pgDecodeBinary PGTypeEnv
_ PGTypeID "\"char\""
_ = HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head
instance PGParameter "\"char\"" Char where
  pgEncode :: PGTypeID "\"char\"" -> Char -> ByteString
pgEncode PGTypeID "\"char\""
_ = Char -> ByteString
BSC.singleton
  pgEncodeValue :: PGTypeEnv -> PGTypeID "\"char\"" -> Char -> PGValue
pgEncodeValue PGTypeEnv
_ PGTypeID "\"char\""
_ = ByteString -> PGValue
PGBinaryValue (ByteString -> PGValue) -> (Char -> ByteString) -> Char -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
BSC.singleton
instance PGColumn "\"char\"" Char where
  pgDecode :: PGTypeID "\"char\"" -> ByteString -> Char
pgDecode PGTypeID "\"char\""
_ = ByteString -> Char
BSC.head
  pgDecodeBinary :: PGTypeEnv -> PGTypeID "\"char\"" -> ByteString -> Char
pgDecodeBinary PGTypeEnv
_ PGTypeID "\"char\""
_ = ByteString -> Char
BSC.head


class PGType t => PGStringType t

instance PGStringType t => PGParameter t String where
  pgEncode :: PGTypeID t -> [Char] -> ByteString
pgEncode PGTypeID t
_ = [Char] -> ByteString
BSU.fromString
  BIN_ENC(BinE.text_strict . T.pack)
instance PGStringType t => PGColumn t String where
  pgDecode :: PGTypeID t -> ByteString -> [Char]
pgDecode PGTypeID t
_ = ByteString -> [Char]
BSU.toString
  BIN_DEC(T.unpack <$> BinD.text_strict)

instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPABLE #-}
#endif
    PGStringType t => PGParameter t BS.ByteString where
  pgEncode :: PGTypeID t -> ByteString -> ByteString
pgEncode PGTypeID t
_ = ByteString -> ByteString
forall a. a -> a
id
  BIN_ENC(BinE.text_strict . TE.decodeUtf8)
instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPABLE #-}
#endif
    PGStringType t => PGColumn t BS.ByteString where
  pgDecode :: PGTypeID t -> ByteString -> ByteString
pgDecode PGTypeID t
_ = ByteString -> ByteString
forall a. a -> a
id
  BIN_DEC(TE.encodeUtf8 <$> BinD.text_strict)

instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPABLE #-}
#endif
    PGStringType t => PGParameter t PGName where
  pgEncode :: PGTypeID t -> PGName -> ByteString
pgEncode PGTypeID t
_ = PGName -> ByteString
pgNameBS
  BIN_ENC(BinE.text_strict . TE.decodeUtf8 . pgNameBS)
instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPABLE #-}
#endif
    PGStringType t => PGColumn t PGName where
  pgDecode :: PGTypeID t -> ByteString -> PGName
pgDecode PGTypeID t
_ = [Word8] -> PGName
PGName ([Word8] -> PGName)
-> (ByteString -> [Word8]) -> ByteString -> PGName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
  BIN_DEC(PGName PGTypeEnv
. BS.unpack . TE.encodeUtf8 <$> BinD.text_strict)

instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPABLE #-}
#endif
    PGStringType t => PGParameter t BSL.ByteString where
  pgEncode :: PGTypeID t -> LazyByteString -> ByteString
pgEncode PGTypeID t
_ = LazyByteString -> ByteString
BSL.toStrict
  BIN_ENC(BinE.text_lazy . TLE.decodeUtf8)
instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPABLE #-}
#endif
    PGStringType t => PGColumn t BSL.ByteString where
  pgDecode :: PGTypeID t -> ByteString -> LazyByteString
pgDecode PGTypeID t
_ = ByteString -> LazyByteString
BSL.fromStrict
  BIN_DEC(TLE.encodeUtf8 <$> BinD.text_lazy)

#ifdef VERSION_text
instance PGStringType t => PGParameter t T.Text where
  pgEncode :: PGTypeID t -> Text -> ByteString
pgEncode PGTypeID t
_ = Text -> ByteString
TE.encodeUtf8
  BIN_ENC(BinE.text_strict)
instance PGStringType t => PGColumn t T.Text where
  pgDecode :: PGTypeID t -> ByteString -> Text
pgDecode PGTypeID t
_ = ByteString -> Text
TE.decodeUtf8
  BIN_DEC(BinD.text_strict)

instance PGStringType t => PGParameter t TL.Text where
  pgEncode :: PGTypeID t -> Text -> ByteString
pgEncode PGTypeID t
_ = LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (Text -> LazyByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LazyByteString
TLE.encodeUtf8
  BIN_ENC(BinE.text_lazy)
instance PGStringType t => PGColumn t TL.Text where
  pgDecode :: PGTypeID t -> ByteString -> Text
pgDecode PGTypeID t
_ = Text -> Text
TL.fromStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8
  BIN_DEC(BinD.text_lazy)
#define PGVALSTRING T.Text
#else
#define PGVALSTRING String
#endif

instance PGType "text" where
  type PGVal "text" = PGVALSTRING
  BIN_COL
instance PGType "character varying" where
  type PGVal "character varying" = PGVALSTRING
  BIN_COL
instance PGType "name" where
  type PGVal "name" = PGVALSTRING
  BIN_COL
instance PGType "bpchar" where
  type PGVal "bpchar" = PGVALSTRING
  BIN_COL
instance PGStringType "text"
instance PGStringType "character varying"
instance PGStringType "name" -- limit 63 characters; not strictly textsend but essentially the same
instance PGStringType "bpchar" -- blank padded


encodeBytea :: BSB.Builder -> PGTextValue
encodeBytea :: Builder -> ByteString
encodeBytea Builder
h = Builder -> ByteString
buildPGValue (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> Builder
BSB.string7 [Char]
"\\x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
h

decodeBytea :: PGTextValue -> [Word8]
decodeBytea :: ByteString -> [Word8]
decodeBytea ByteString
s
  | [Char]
sm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"\\x" = [Char] -> [Word8]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Word8]) -> [Char] -> [Word8]
forall a b. (a -> b) -> a -> b
$ [Char]
"pgDecode bytea: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
sm
  | Bool
otherwise = [Word8] -> [Word8]
pd ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
d where
  (ByteString
m, ByteString
d) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
2 ByteString
s
  sm :: [Char]
sm = ByteString -> [Char]
BSC.unpack ByteString
m
  pd :: [Word8] -> [Word8]
pd [] = []
  pd (Word8
h:Word8
l:[Word8]
r) = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word8
unhex Word8
h) Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8 -> Word8
unhex Word8
l) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8] -> [Word8]
pd [Word8]
r
  pd [Word8
x] = [Char] -> [Word8]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Word8]) -> [Char] -> [Word8]
forall a b. (a -> b) -> a -> b
$ [Char]
"pgDecode bytea: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
x
  unhex :: Word8 -> Word8
unhex = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Word8 -> Int) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt (Char -> Int) -> (Word8 -> Char) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c

instance PGType "bytea" where
  type PGVal "bytea" = BS.ByteString
  BIN_COL
instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPING #-}
#endif
    PGParameter "bytea" BSL.ByteString where
  pgEncode :: PGTypeID "bytea" -> LazyByteString -> ByteString
pgEncode PGTypeID "bytea"
_ = Builder -> ByteString
encodeBytea (Builder -> ByteString)
-> (LazyByteString -> Builder) -> LazyByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> Builder
BSB.lazyByteStringHex
  pgLiteral :: PGTypeID "bytea" -> LazyByteString -> ByteString
pgLiteral PGTypeID "bytea"
t = ByteString -> ByteString
pgQuoteUnsafe (ByteString -> ByteString)
-> (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "bytea" -> LazyByteString -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "bytea"
t
  BIN_ENC(BinE.bytea_lazy)
instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPING #-}
#endif
    PGColumn "bytea" BSL.ByteString where
  pgDecode :: PGTypeID "bytea" -> ByteString -> LazyByteString
pgDecode PGTypeID "bytea"
_ = [Word8] -> LazyByteString
BSL.pack ([Word8] -> LazyByteString)
-> (ByteString -> [Word8]) -> ByteString -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
decodeBytea
  BIN_DEC(BinD.bytea_lazy)
instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPING #-}
#endif
    PGParameter "bytea" BS.ByteString where
  pgEncode :: PGTypeID "bytea" -> ByteString -> ByteString
pgEncode PGTypeID "bytea"
_ = Builder -> ByteString
encodeBytea (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BSB.byteStringHex
  pgLiteral :: PGTypeID "bytea" -> ByteString -> ByteString
pgLiteral PGTypeID "bytea"
t = ByteString -> ByteString
pgQuoteUnsafe (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "bytea" -> ByteString -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "bytea"
t
  BIN_ENC(BinE.bytea_strict)
instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPING #-}
#endif
    PGColumn "bytea" BS.ByteString where
  pgDecode :: PGTypeID "bytea" -> ByteString -> ByteString
pgDecode PGTypeID "bytea"
_ = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
decodeBytea
  BIN_DEC(BinD.bytea_strict)

readTime :: Time.ParseTime t => String -> String -> t
readTime :: forall t. ParseTime t => [Char] -> [Char] -> t
readTime =
#if MIN_VERSION_time(1,5,0)
  Bool -> TimeLocale -> [Char] -> [Char] -> t
forall t.
ParseTime t =>
Bool -> TimeLocale -> [Char] -> [Char] -> t
Time.parseTimeOrError Bool
False
#else
  Time.readTime
#endif
    TimeLocale
defaultTimeLocale

instance PGType "date" where
  type PGVal "date" = Time.Day
  BIN_COL
instance PGParameter "date" Time.Day where
  pgEncode :: PGTypeID "date" -> Day -> ByteString
pgEncode PGTypeID "date"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> (Day -> [Char]) -> Day -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> [Char]
Time.showGregorian
  pgLiteral :: PGTypeID "date" -> Day -> ByteString
pgLiteral PGTypeID "date"
t = ByteString -> ByteString
pgQuoteUnsafe (ByteString -> ByteString)
-> (Day -> ByteString) -> Day -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "date" -> Day -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "date"
t
  BIN_ENC(BinE.date)
instance PGColumn "date" Time.Day where
  pgDecode :: PGTypeID "date" -> ByteString -> Day
pgDecode PGTypeID "date"
_ = [Char] -> [Char] -> Day
forall t. ParseTime t => [Char] -> [Char] -> t
readTime [Char]
"%F" ([Char] -> Day) -> (ByteString -> [Char]) -> ByteString -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
  BIN_DEC(BinD.date)

binColDatetime :: PGTypeEnv -> PGTypeID t -> Bool
#ifdef VERSION_postgresql_binary
binColDatetime :: forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
_ } PGTypeID t
_ = Bool
True
#endif
binColDatetime PGTypeEnv
_ PGTypeID t
_ = Bool
False

#ifdef VERSION_postgresql_binary
binEncDatetime :: PGParameter t a => BinEncoder a -> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime :: forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder a
_ BinEncoder a
ff PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
False } PGTypeID t
_ = ByteString -> PGValue
PGBinaryValue (ByteString -> PGValue) -> (a -> ByteString) -> a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinEncoder a -> a -> ByteString
forall a. BinEncoder a -> a -> ByteString
binEnc BinEncoder a
ff
binEncDatetime BinEncoder a
fi BinEncoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
True } PGTypeID t
_ = ByteString -> PGValue
PGBinaryValue (ByteString -> PGValue) -> (a -> ByteString) -> a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinEncoder a -> a -> ByteString
forall a. BinEncoder a -> a -> ByteString
binEnc BinEncoder a
fi
binEncDatetime BinEncoder a
_ BinEncoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Maybe Bool
Nothing } PGTypeID t
t = ByteString -> PGValue
PGTextValue (ByteString -> PGValue) -> (a -> ByteString) -> a -> PGValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID t -> a -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID t
t

binDecDatetime :: PGColumn t a => BinDecoder a -> BinDecoder a -> PGTypeEnv -> PGTypeID t -> PGBinaryValue -> a
binDecDatetime :: forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime BinDecoder a
_ BinDecoder a
ff PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
False } = BinDecoder a -> PGTypeID t -> ByteString -> a
forall (t :: Symbol) a.
PGType t =>
BinDecoder a -> PGTypeID t -> ByteString -> a
binDec BinDecoder a
ff
binDecDatetime BinDecoder a
fi BinDecoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Just Bool
True } = BinDecoder a -> PGTypeID t -> ByteString -> a
forall (t :: Symbol) a.
PGType t =>
BinDecoder a -> PGTypeID t -> ByteString -> a
binDec BinDecoder a
fi
binDecDatetime BinDecoder a
_ BinDecoder a
_ PGTypeEnv{ pgIntegerDatetimes :: PGTypeEnv -> Maybe Bool
pgIntegerDatetimes = Maybe Bool
Nothing } = [Char] -> PGTypeID t -> ByteString -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"pgDecodeBinary: unknown integer_datetimes value"
#endif

-- PostgreSQL uses "[+-]HH[:MM]" timezone offsets, while "%z" uses "+HHMM" by default.
-- readTime can successfully parse both formats, but PostgreSQL needs the colon.
fixTZ :: String -> String
fixTZ :: ShowS
fixTZ [Char]
"" = [Char]
""
fixTZ [Char
'+',Char
h1,Char
h2] | Char -> Bool
isDigit Char
h1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
h2 = [Char
'+',Char
h1,Char
h2,Char
':',Char
'0',Char
'0']
fixTZ [Char
'-',Char
h1,Char
h2] | Char -> Bool
isDigit Char
h1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
h2 = [Char
'-',Char
h1,Char
h2,Char
':',Char
'0',Char
'0']
fixTZ [Char
'+',Char
h1,Char
h2,Char
m1,Char
m2] | Char -> Bool
isDigit Char
h1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
h2 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
m1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
m2 = [Char
'+',Char
h1,Char
h2,Char
':',Char
m1,Char
m2]
fixTZ [Char
'-',Char
h1,Char
h2,Char
m1,Char
m2] | Char -> Bool
isDigit Char
h1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
h2 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
m1 Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
m2 = [Char
'-',Char
h1,Char
h2,Char
':',Char
m1,Char
m2]
fixTZ (Char
c:[Char]
s) = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
fixTZ [Char]
s

instance PGType "time without time zone" where
  type PGVal "time without time zone" = Time.TimeOfDay
  pgBinaryColumn :: PGTypeEnv -> PGTypeID "time without time zone" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "time without time zone" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "time without time zone" Time.TimeOfDay where
  pgEncode :: PGTypeID "time without time zone" -> TimeOfDay -> ByteString
pgEncode PGTypeID "time without time zone"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString)
-> (TimeOfDay -> [Char]) -> TimeOfDay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> [Char] -> TimeOfDay -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
Time.formatTime TimeLocale
defaultTimeLocale [Char]
"%T%Q"
  pgLiteral :: PGTypeID "time without time zone" -> TimeOfDay -> ByteString
pgLiteral PGTypeID "time without time zone"
t = ByteString -> ByteString
pgQuoteUnsafe (ByteString -> ByteString)
-> (TimeOfDay -> ByteString) -> TimeOfDay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "time without time zone" -> TimeOfDay -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "time without time zone"
t
#ifdef VERSION_postgresql_binary
  pgEncodeValue :: PGTypeEnv
-> PGTypeID "time without time zone" -> TimeOfDay -> PGValue
pgEncodeValue = BinEncoder TimeOfDay
-> BinEncoder TimeOfDay
-> PGTypeEnv
-> PGTypeID "time without time zone"
-> TimeOfDay
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder TimeOfDay
BinE.time_int BinEncoder TimeOfDay
BinE.time_float
#endif
instance PGColumn "time without time zone" Time.TimeOfDay where
  pgDecode :: PGTypeID "time without time zone" -> ByteString -> TimeOfDay
pgDecode PGTypeID "time without time zone"
_ = [Char] -> [Char] -> TimeOfDay
forall t. ParseTime t => [Char] -> [Char] -> t
readTime [Char]
"%T%Q" ([Char] -> TimeOfDay)
-> (ByteString -> [Char]) -> ByteString -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
#ifdef VERSION_postgresql_binary
  pgDecodeBinary :: PGTypeEnv
-> PGTypeID "time without time zone" -> ByteString -> TimeOfDay
pgDecodeBinary = BinDecoder TimeOfDay
-> BinDecoder TimeOfDay
-> PGTypeEnv
-> PGTypeID "time without time zone"
-> ByteString
-> TimeOfDay
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime BinDecoder TimeOfDay
BinD.time_int BinDecoder TimeOfDay
BinD.time_float
#endif

instance PGType "time with time zone" where
  type PGVal "time with time zone" = (Time.TimeOfDay, Time.TimeZone)
  pgBinaryColumn :: PGTypeEnv -> PGTypeID "time with time zone" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "time with time zone" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "time with time zone" (Time.TimeOfDay, Time.TimeZone) where
  pgEncode :: PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone) -> ByteString
pgEncode PGTypeID "time with time zone"
_ (TimeOfDay
t, TimeZone
z) = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [Char] -> TimeOfDay -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
Time.formatTime TimeLocale
defaultTimeLocale [Char]
"%T%Q" TimeOfDay
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
fixTZ (TimeLocale -> [Char] -> TimeZone -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
Time.formatTime TimeLocale
defaultTimeLocale [Char]
"%z" TimeZone
z)
  pgLiteral :: PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone) -> ByteString
pgLiteral PGTypeID "time with time zone"
t = ByteString -> ByteString
pgQuoteUnsafe (ByteString -> ByteString)
-> ((TimeOfDay, TimeZone) -> ByteString)
-> (TimeOfDay, TimeZone)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone) -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "time with time zone"
t
#ifdef VERSION_postgresql_binary
  pgEncodeValue :: PGTypeEnv
-> PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone)
-> PGValue
pgEncodeValue = BinEncoder (TimeOfDay, TimeZone)
-> BinEncoder (TimeOfDay, TimeZone)
-> PGTypeEnv
-> PGTypeID "time with time zone"
-> (TimeOfDay, TimeZone)
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder (TimeOfDay, TimeZone)
BinE.timetz_int BinEncoder (TimeOfDay, TimeZone)
BinE.timetz_float
#endif
instance PGColumn "time with time zone" (Time.TimeOfDay, Time.TimeZone) where
  pgDecode :: PGTypeID "time with time zone"
-> ByteString -> (TimeOfDay, TimeZone)
pgDecode PGTypeID "time with time zone"
_ = (LocalTime -> TimeOfDay
Time.localTimeOfDay (LocalTime -> TimeOfDay)
-> (ZonedTime -> LocalTime) -> ZonedTime -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
Time.zonedTimeToLocalTime (ZonedTime -> TimeOfDay)
-> (ZonedTime -> TimeZone) -> ZonedTime -> (TimeOfDay, TimeZone)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ZonedTime -> TimeZone
Time.zonedTimeZone) (ZonedTime -> (TimeOfDay, TimeZone))
-> (ByteString -> ZonedTime) -> ByteString -> (TimeOfDay, TimeZone)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> ZonedTime
forall t. ParseTime t => [Char] -> [Char] -> t
readTime [Char]
"%T%Q%z" ([Char] -> ZonedTime)
-> (ByteString -> [Char]) -> ByteString -> ZonedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fixTZ ShowS -> (ByteString -> [Char]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
#ifdef VERSION_postgresql_binary
  pgDecodeBinary :: PGTypeEnv
-> PGTypeID "time with time zone"
-> ByteString
-> (TimeOfDay, TimeZone)
pgDecodeBinary = BinDecoder (TimeOfDay, TimeZone)
-> BinDecoder (TimeOfDay, TimeZone)
-> PGTypeEnv
-> PGTypeID "time with time zone"
-> ByteString
-> (TimeOfDay, TimeZone)
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime BinDecoder (TimeOfDay, TimeZone)
BinD.timetz_int BinDecoder (TimeOfDay, TimeZone)
BinD.timetz_float
#endif

instance PGType "timestamp without time zone" where
  type PGVal "timestamp without time zone" = Time.LocalTime
  pgBinaryColumn :: PGTypeEnv -> PGTypeID "timestamp without time zone" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "timestamp without time zone" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "timestamp without time zone" Time.LocalTime where
  pgEncode :: PGTypeID "timestamp without time zone" -> LocalTime -> ByteString
pgEncode PGTypeID "timestamp without time zone"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString)
-> (LocalTime -> [Char]) -> LocalTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> [Char] -> LocalTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
Time.formatTime TimeLocale
defaultTimeLocale [Char]
"%F %T%Q"
  pgLiteral :: PGTypeID "timestamp without time zone" -> LocalTime -> ByteString
pgLiteral PGTypeID "timestamp without time zone"
t = ByteString -> ByteString
pgQuoteUnsafe (ByteString -> ByteString)
-> (LocalTime -> ByteString) -> LocalTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "timestamp without time zone" -> LocalTime -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "timestamp without time zone"
t
#ifdef VERSION_postgresql_binary
  pgEncodeValue :: PGTypeEnv
-> PGTypeID "timestamp without time zone" -> LocalTime -> PGValue
pgEncodeValue = BinEncoder LocalTime
-> BinEncoder LocalTime
-> PGTypeEnv
-> PGTypeID "timestamp without time zone"
-> LocalTime
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder LocalTime
BinE.timestamp_int BinEncoder LocalTime
BinE.timestamp_float
#endif
instance PGColumn "timestamp without time zone" Time.LocalTime where
  pgDecode :: PGTypeID "timestamp without time zone" -> ByteString -> LocalTime
pgDecode PGTypeID "timestamp without time zone"
_ = [Char] -> [Char] -> LocalTime
forall t. ParseTime t => [Char] -> [Char] -> t
readTime [Char]
"%F %T%Q" ([Char] -> LocalTime)
-> (ByteString -> [Char]) -> ByteString -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
#ifdef VERSION_postgresql_binary
  pgDecodeBinary :: PGTypeEnv
-> PGTypeID "timestamp without time zone"
-> ByteString
-> LocalTime
pgDecodeBinary = BinDecoder LocalTime
-> BinDecoder LocalTime
-> PGTypeEnv
-> PGTypeID "timestamp without time zone"
-> ByteString
-> LocalTime
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime BinDecoder LocalTime
BinD.timestamp_int BinDecoder LocalTime
BinD.timestamp_float
#endif

instance PGType "timestamp with time zone" where
  type PGVal "timestamp with time zone" = Time.UTCTime
  pgBinaryColumn :: PGTypeEnv -> PGTypeID "timestamp with time zone" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "timestamp with time zone" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "timestamp with time zone" Time.UTCTime where
  pgEncode :: PGTypeID "timestamp with time zone" -> UTCTime -> ByteString
pgEncode PGTypeID "timestamp with time zone"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString)
-> (UTCTime -> [Char]) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fixTZ ShowS -> (UTCTime -> [Char]) -> UTCTime -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> [Char] -> UTCTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
Time.formatTime TimeLocale
defaultTimeLocale [Char]
"%F %T%Q%z"
  -- pgLiteral t = pgQuoteUnsafe . pgEncode t
#ifdef VERSION_postgresql_binary
  pgEncodeValue :: PGTypeEnv
-> PGTypeID "timestamp with time zone" -> UTCTime -> PGValue
pgEncodeValue = BinEncoder UTCTime
-> BinEncoder UTCTime
-> PGTypeEnv
-> PGTypeID "timestamp with time zone"
-> UTCTime
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder UTCTime
BinE.timestamptz_int BinEncoder UTCTime
BinE.timestamptz_float
#endif
instance PGColumn "timestamp with time zone" Time.UTCTime where
  pgDecode :: PGTypeID "timestamp with time zone" -> ByteString -> UTCTime
pgDecode PGTypeID "timestamp with time zone"
_ = [Char] -> [Char] -> UTCTime
forall t. ParseTime t => [Char] -> [Char] -> t
readTime [Char]
"%F %T%Q%z" ([Char] -> UTCTime)
-> (ByteString -> [Char]) -> ByteString -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fixTZ ShowS -> (ByteString -> [Char]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
#ifdef VERSION_postgresql_binary
  pgDecodeBinary :: PGTypeEnv
-> PGTypeID "timestamp with time zone" -> ByteString -> UTCTime
pgDecodeBinary = BinDecoder UTCTime
-> BinDecoder UTCTime
-> PGTypeEnv
-> PGTypeID "timestamp with time zone"
-> ByteString
-> UTCTime
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime BinDecoder UTCTime
BinD.timestamptz_int BinDecoder UTCTime
BinD.timestamptz_float
#endif

instance PGType "interval" where
  type PGVal "interval" = Time.DiffTime
  pgBinaryColumn :: PGTypeEnv -> PGTypeID "interval" -> Bool
pgBinaryColumn = PGTypeEnv -> PGTypeID "interval" -> Bool
forall (t :: Symbol). PGTypeEnv -> PGTypeID t -> Bool
binColDatetime
instance PGParameter "interval" Time.DiffTime where
  pgEncode :: PGTypeID "interval" -> DiffTime -> ByteString
pgEncode PGTypeID "interval"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString)
-> (DiffTime -> [Char]) -> DiffTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> [Char]
forall a. Show a => a -> [Char]
show
  pgLiteral :: PGTypeID "interval" -> DiffTime -> ByteString
pgLiteral PGTypeID "interval"
t = ByteString -> ByteString
pgQuoteUnsafe (ByteString -> ByteString)
-> (DiffTime -> ByteString) -> DiffTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "interval" -> DiffTime -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "interval"
t
#ifdef VERSION_postgresql_binary
  pgEncodeValue :: PGTypeEnv -> PGTypeID "interval" -> DiffTime -> PGValue
pgEncodeValue = BinEncoder DiffTime
-> BinEncoder DiffTime
-> PGTypeEnv
-> PGTypeID "interval"
-> DiffTime
-> PGValue
forall (t :: Symbol) a.
PGParameter t a =>
BinEncoder a
-> BinEncoder a -> PGTypeEnv -> PGTypeID t -> a -> PGValue
binEncDatetime BinEncoder DiffTime
BinE.interval_int BinEncoder DiffTime
BinE.interval_float
#endif
-- |Representation of DiffTime as interval.
-- PostgreSQL stores months and days separately in intervals, but DiffTime does not.
-- We collapse all interval fields into seconds
instance PGColumn "interval" Time.DiffTime where
  pgDecode :: PGTypeID "interval" -> ByteString -> DiffTime
pgDecode PGTypeID "interval"
_ ByteString
a = ([Char] -> DiffTime)
-> (Scientific -> DiffTime) -> Either [Char] Scientific -> DiffTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> DiffTime
forall a. HasCallStack => [Char] -> a
error ([Char] -> DiffTime) -> ShowS -> [Char] -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"pgDecode interval (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Char]
"): " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BSC.unpack ByteString
a))) Scientific -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Either [Char] Scientific -> DiffTime)
-> Either [Char] Scientific -> DiffTime
forall a b. (a -> b) -> a -> b
$ Parser ByteString Scientific
-> ByteString -> Either [Char] Scientific
forall a. Parser a -> ByteString -> Either [Char] a
P.parseOnly Parser ByteString Scientific
ps ByteString
a where
    ps :: Parser ByteString Scientific
ps = do
      _ <- Char -> Parser Char
P.char Char
'P'
      d <- units [('Y', 12*month), ('M', month), ('W', 7*day), ('D', day)]
      ((d +) <$> pt) <> (d <$ P.endOfInput)
    pt :: Parser ByteString Scientific
pt = do
      _ <- Char -> Parser Char
P.char Char
'T'
      t <- units [('H', 3600), ('M', 60), ('S', 1)]
      P.endOfInput
      return t
    units :: [(Char, Scientific)] -> Parser ByteString Scientific
units [(Char, Scientific)]
l = ([Scientific] -> Scientific)
-> Parser ByteString [Scientific] -> Parser ByteString Scientific
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Scientific] -> Scientific
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Parser ByteString [Scientific] -> Parser ByteString Scientific)
-> Parser ByteString [Scientific] -> Parser ByteString Scientific
forall a b. (a -> b) -> a -> b
$ Parser ByteString Scientific -> Parser ByteString [Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Parser ByteString Scientific -> Parser ByteString [Scientific])
-> Parser ByteString Scientific -> Parser ByteString [Scientific]
forall a b. (a -> b) -> a -> b
$ do
      x <- Parser ByteString Scientific -> Parser ByteString Scientific
forall a. Num a => Parser a -> Parser a
P.signed Parser ByteString Scientific
P.scientific
      u <- P.choice $ map (\(Char
c, Scientific
u) -> Scientific
u Scientific -> Parser Char -> Parser ByteString Scientific
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
P.char Char
c) l
      return $ x * u
    day :: Scientific
day = Scientific
86400
    month :: Scientific
month = Scientific
2629746
#ifdef VERSION_postgresql_binary
  pgDecodeBinary :: PGTypeEnv -> PGTypeID "interval" -> ByteString -> DiffTime
pgDecodeBinary = BinDecoder DiffTime
-> BinDecoder DiffTime
-> PGTypeEnv
-> PGTypeID "interval"
-> ByteString
-> DiffTime
forall (t :: Symbol) a.
PGColumn t a =>
BinDecoder a
-> BinDecoder a -> PGTypeEnv -> PGTypeID t -> ByteString -> a
binDecDatetime BinDecoder DiffTime
BinD.interval_int BinDecoder DiffTime
BinD.interval_float
#endif

instance PGType "numeric" where
  type PGVal "numeric" = 
#ifdef VERSION_scientific
    Scientific
#else
    Rational
#endif
  BIN_COL
instance PGParameter "numeric" Rational where
  pgEncode :: PGTypeID "numeric" -> Rational -> ByteString
pgEncode PGTypeID "numeric"
_ Rational
r
    | Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [Char] -> ByteString
BSC.pack [Char]
"NaN" -- this can't happen
    | Bool
otherwise = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
30 (Rational -> [Char]
showRational (Rational
r Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Rational
10 Rational -> Int -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Int
e))) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'e' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
e where
    e :: Int
e = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Double
10 :: Double) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
forall a. Num a => a -> a
abs Rational
r :: Int -- not great, and arbitrarily truncate somewhere
  pgLiteral :: PGTypeID "numeric" -> Rational -> ByteString
pgLiteral PGTypeID "numeric"
_ Rational
r
    | Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [Char] -> ByteString
BSC.pack [Char]
"'NaN'" -- this can't happen
    | Bool
otherwise = [Char] -> ByteString
BSC.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> [Char]
forall a. Show a => a -> [Char]
show (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> [Char]
forall a. Show a => a -> [Char]
show (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"::numeric)"
  BIN_ENC(BinE.numeric . realToFrac)
-- |High-precision representation of Rational as numeric.
-- Unfortunately, numeric has an NaN, while Rational does not.
-- NaN numeric values will produce exceptions.
instance PGColumn "numeric" Rational where
  pgDecode :: PGTypeID "numeric" -> ByteString -> Rational
pgDecode PGTypeID "numeric"
_ ByteString
bs
    | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"NaN" = Integer
0 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0 -- this won't work
    | Bool
otherwise = [(Rational, [Char])] -> Rational
ur ([(Rational, [Char])] -> Rational)
-> [(Rational, [Char])] -> Rational
forall a b. (a -> b) -> a -> b
$ ReadS Rational
forall a. RealFrac a => ReadS a
readFloat [Char]
s where
    ur :: [(Rational, [Char])] -> Rational
ur [(Rational
x,[Char]
"")] = Rational
x
    ur [(Rational, [Char])]
_ = [Char] -> Rational
forall a. HasCallStack => [Char] -> a
error ([Char] -> Rational) -> [Char] -> Rational
forall a b. (a -> b) -> a -> b
$ [Char]
"pgDecode numeric: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
    s :: [Char]
s = ByteString -> [Char]
BSC.unpack ByteString
bs
  BIN_DEC(realToFrac <$> BinD.numeric)

-- This will produce infinite(-precision) strings
showRational :: Rational -> String
showRational :: Rational -> [Char]
showRational Rational
r = Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer
ri :: Integer) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: Rational -> [Char]
forall {t}. RealFrac t => t -> [Char]
frac (Rational -> Rational
forall a. Num a => a -> a
abs Rational
rf) where
  (Integer
ri, Rational
rf) = Rational -> (Integer, Rational)
forall b. Integral b => Rational -> (b, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Rational
r
  frac :: t -> [Char]
frac t
0 = [Char]
""
  frac t
f = Int -> Char
intToDigit Int
i Char -> ShowS
forall a. a -> [a] -> [a]
: t -> [Char]
frac t
f' where (Int
i, t
f') = t -> (Int, t)
forall b. Integral b => t -> (b, t)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (t
10 t -> t -> t
forall a. Num a => a -> a -> a
* t
f)

#ifdef VERSION_scientific
instance PGParameter "numeric" Scientific where
  pgEncode :: PGTypeID "numeric" -> Scientific -> ByteString
pgEncode PGTypeID "numeric"
_ = [Char] -> ByteString
BSC.pack ([Char] -> ByteString)
-> (Scientific -> [Char]) -> Scientific -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> [Char]
forall a. Show a => a -> [Char]
show
  pgLiteral :: PGTypeID "numeric" -> Scientific -> ByteString
pgLiteral = PGTypeID "numeric" -> Scientific -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode
  BIN_ENC(BinE.numeric)
instance PGColumn "numeric" Scientific where
  pgDecode :: PGTypeID "numeric" -> ByteString -> Scientific
pgDecode PGTypeID "numeric"
_ = [Char] -> Scientific
forall a. Read a => [Char] -> a
read ([Char] -> Scientific)
-> (ByteString -> [Char]) -> ByteString -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSC.unpack
  BIN_DEC(BinD.numeric)
#endif

#ifdef VERSION_uuid
instance PGType "uuid" where
  type PGVal "uuid" = UUID.UUID
  BIN_COL
instance PGParameter "uuid" UUID.UUID where
  pgEncode :: PGTypeID "uuid" -> UUID -> ByteString
pgEncode PGTypeID "uuid"
_ = UUID -> ByteString
UUID.toASCIIBytes
  pgLiteral :: PGTypeID "uuid" -> UUID -> ByteString
pgLiteral PGTypeID "uuid"
t = ByteString -> ByteString
pgQuoteUnsafe (ByteString -> ByteString)
-> (UUID -> ByteString) -> UUID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGTypeID "uuid" -> UUID -> ByteString
forall (t :: Symbol) a.
PGParameter t a =>
PGTypeID t -> a -> ByteString
pgEncode PGTypeID "uuid"
t
  BIN_ENC(BinE.uuid)
instance PGColumn "uuid" UUID.UUID where
  pgDecode :: PGTypeID "uuid" -> ByteString -> UUID
pgDecode PGTypeID "uuid"
_ ByteString
u = UUID -> Maybe UUID -> UUID
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> UUID
forall a. HasCallStack => [Char] -> a
error ([Char] -> UUID) -> [Char] -> UUID
forall a b. (a -> b) -> a -> b
$ [Char]
"pgDecode uuid: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BSC.unpack ByteString
u) (Maybe UUID -> UUID) -> Maybe UUID -> UUID
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UUID
UUID.fromASCIIBytes ByteString
u
  BIN_DEC(BinD.uuid)
#endif

-- |Generic class of composite (row or record) types.
newtype PGRecord = PGRecord [Maybe PGTextValue]
class PGType t => PGRecordType t
instance PGRecordType t => PGParameter t PGRecord where
  pgEncode :: PGTypeID t -> PGRecord -> ByteString
pgEncode PGTypeID t
_ (PGRecord [Maybe ByteString]
l) =
    Builder -> ByteString
buildPGValue (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> Builder
BSB.char7 Char
'(' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
BSB.char7 Char
',') ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Maybe ByteString -> Builder) -> [Maybe ByteString] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> (ByteString -> Builder) -> Maybe ByteString -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty ([Char] -> ByteString -> Builder
pgDQuoteFrom [Char]
"(),")) [Maybe ByteString]
l) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BSB.char7 Char
')'
  pgLiteral :: PGTypeID t -> PGRecord -> ByteString
pgLiteral PGTypeID t
_ (PGRecord [Maybe ByteString]
l) =
    [Char] -> ByteString
BSC.pack [Char]
"ROW(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
BS.intercalate (Char -> ByteString
BSC.singleton Char
',') ((Maybe ByteString -> ByteString)
-> [Maybe ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> ByteString
BSC.pack [Char]
"NULL") ByteString -> ByteString
pgQuote) [Maybe ByteString]
l) ByteString -> Char -> ByteString
`BSC.snoc` Char
')'
instance PGRecordType t => PGColumn t PGRecord where
  pgDecode :: PGTypeID t -> ByteString -> PGRecord
pgDecode PGTypeID t
_ ByteString
a = ([Char] -> PGRecord)
-> ([Maybe ByteString] -> PGRecord)
-> Either [Char] [Maybe ByteString]
-> PGRecord
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> PGRecord
forall a. HasCallStack => [Char] -> a
error ([Char] -> PGRecord) -> ShowS -> [Char] -> PGRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"pgDecode record (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Char]
"): " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BSC.unpack ByteString
a))) [Maybe ByteString] -> PGRecord
PGRecord (Either [Char] [Maybe ByteString] -> PGRecord)
-> Either [Char] [Maybe ByteString] -> PGRecord
forall a b. (a -> b) -> a -> b
$ Parser [Maybe ByteString]
-> ByteString -> Either [Char] [Maybe ByteString]
forall a. Parser a -> ByteString -> Either [Char] a
P.parseOnly Parser [Maybe ByteString]
pa ByteString
a where
    pa :: Parser [Maybe ByteString]
pa = Char -> Parser Char
P.char Char
'(' Parser Char
-> Parser [Maybe ByteString] -> Parser [Maybe ByteString]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Maybe ByteString)
-> Parser Char -> Parser [Maybe ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
P.sepBy Parser (Maybe ByteString)
el (Char -> Parser Char
P.char Char
',') Parser [Maybe ByteString]
-> Parser Char -> Parser [Maybe ByteString]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
P.char Char
')' Parser [Maybe ByteString]
-> Parser ByteString () -> Parser [Maybe ByteString]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
P.endOfInput
    el :: Parser (Maybe ByteString)
el = Bool -> [Char] -> (ByteString -> Bool) -> Parser (Maybe ByteString)
parsePGDQuote Bool
True [Char]
"()," ByteString -> Bool
BS.null

instance PGType "record" where
  type PGVal "record" = PGRecord
-- |The generic anonymous record type, as created by @ROW@.
-- In this case we can not know the types, and in fact, PostgreSQL does not accept values of this type regardless (except as literals).
instance PGRecordType "record"

#ifdef VERSION_aeson
instance PGType "json" where
  type PGVal "json" = JSON.Value
  BIN_COL
instance PGParameter "json" JSON.Value where
  pgEncode :: PGTypeID "json" -> Value -> ByteString
pgEncode PGTypeID "json"
_ = LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (Value -> LazyByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
JSON.encode
  BIN_ENC(BinE.json_ast)
instance PGColumn "json" JSON.Value where
  pgDecode :: PGTypeID "json" -> ByteString -> Value
pgDecode PGTypeID "json"
_ ByteString
j = ([Char] -> Value)
-> (Value -> Value) -> Either [Char] Value -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Value
forall a. HasCallStack => [Char] -> a
error ([Char] -> Value) -> ShowS -> [Char] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"pgDecode json (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Char]
"): " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BSC.unpack ByteString
j))) Value -> Value
forall a. a -> a
id (Either [Char] Value -> Value) -> Either [Char] Value -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] Value
forall a. FromJSON a => ByteString -> Either [Char] a
JSON.eitherDecodeStrict ByteString
j
  BIN_DEC(BinD.json_ast)

instance PGType "jsonb" where
  type PGVal "jsonb" = JSON.Value
  BIN_COL
instance PGParameter "jsonb" JSON.Value where
  pgEncode :: PGTypeID "jsonb" -> Value -> ByteString
pgEncode PGTypeID "jsonb"
_ = LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (Value -> LazyByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
JSON.encode
  BIN_ENC(BinE.jsonb_ast)
instance PGColumn "jsonb" JSON.Value where
  pgDecode :: PGTypeID "jsonb" -> ByteString -> Value
pgDecode PGTypeID "jsonb"
_ ByteString
j = ([Char] -> Value)
-> (Value -> Value) -> Either [Char] Value -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Value
forall a. HasCallStack => [Char] -> a
error ([Char] -> Value) -> ShowS -> [Char] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"pgDecode jsonb (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Char]
"): " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BSC.unpack ByteString
j))) Value -> Value
forall a. a -> a
id (Either [Char] Value -> Value) -> Either [Char] Value -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] Value
forall a. FromJSON a => ByteString -> Either [Char] a
JSON.eitherDecodeStrict ByteString
j
  BIN_DEC(BinD.jsonb_ast)
#endif

{-
--, ( 142,  143, "xml",         ?)
--, ( 600, 1017, "point",       ?)
--, ( 650,  651, "cidr",        ?)
--, ( 790,  791, "money",       Centi? Fixed?)
--, ( 829, 1040, "macaddr",     ?)
--, ( 869, 1041, "inet",        ?)
--, (1266, 1270, "timetz",      ?)
--, (1560, 1561, "bit",         Bool?)
--, (1562, 1563, "varbit",      ?)
-}