{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

module Database.PostgreSQL.Pure.Internal.Data
  ( Connection (..)
  , Config (..)
  , ColumnInfo (..)
  , Response (..)
  , AuthenticationResponse (..)
  , AuthenticationMD5Password (..)
  , BackendKeyData (..)
  , CommandComplete (..)
  , DataRow (..)
  , DataRowRaw (..)
  , Error (..)
  , Notice (..)
  , ParameterStatus (..)
  , ReadyForQuery (..)
  , RowDescription (..)
  , ParameterDescription (..)
  , Debug (..)
  , ExecuteResult (..)
  , DescribeResult (..)
  , AttributeNumber
  , TypeModifier
  , FormatCode (..)
  , BindParameterFormatCodes (..)
  , BindResultFormatCodes (..)
  , TypeLength (..)
  , CommandTag (..)
  , ErrorFields (..)
  , TransactionState (..)
  , Buffer (..)
  , Carry
  , Salt
  , Address (..)
  , BackendParameters
  , Pid
  , BackendKey
  , Oid (..)
  , Raw (Null, Value)
  , SqlIdentifier (..)
  , TimeOfDayWithTimeZone (..)
  , Query (..)
  , PreparedStatement (..)
  , PreparedStatementProcedure (..)
  , PreparedStatementName (..)
  , Portal (..)
  , PortalProcedure (..)
  , PortalName (..)
  , Executed (..)
  , ExecutedProcedure (..)
  , CloseProcedure (..)
  , MessageResult
  , StringDecoder
  , StringEncoder
  , FromField (..)
  , FromRecord (..)
  , GFromRecord (..)
  , ToField (..)
  , ToRecord (..)
  , GToRecord (..)
  , Pretty (..)
  ) where

import           Database.PostgreSQL.Pure.Oid (Oid (Oid))

import           Control.Applicative          ((<|>))
import           Control.DeepSeq              (NFData)
import qualified Data.Attoparsec.ByteString   as AP
import qualified Data.ByteString              as BS
import qualified Data.ByteString.Builder      as BSB
import qualified Data.ByteString.Short        as BSS
import qualified Data.ByteString.UTF8         as BSU
import           Data.Char                    (chr, isPrint, toLower)
import           Data.Default.Class           (Default (def))
import           Data.Int                     (Int16, Int32)
import           Data.Kind                    (Type)
import           Data.List                    (intercalate)
import           Data.Map.Strict              (Map)
import           Data.String                  (IsString)
import           Data.Time                    (TimeOfDay, TimeZone)
import           Data.Word                    (Word8)
import           Foreign                      (ForeignPtr)
import           GHC.Generics                 (Generic (Rep))
import qualified GHC.Generics                 as Generics
import           Hexdump                      (prettyHex, simpleHex)
import           Network.Socket               (Socket)
import qualified Network.Socket               as NS
import           Text.Read                    (Read (readPrec))
import qualified Text.Read                    as R
import qualified Text.Read.Lex                as R

#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail           (MonadFail)
#endif

-- | A configuration of a connection.
--
-- Default configuration is 'def', which is following.
--
-- >>> address def
-- AddressResolved 127.0.0.1:5432
-- >>> user def
-- "postgres"
-- >>> password def
-- ""
-- >>> database def
-- ""
-- >>> sendingBufferSize def
-- 4096
-- >>> receptionBufferSize def
-- 4096
data Config =
  Config
    { Config -> Address
address             :: Address -- ^ Server address.
    , Config -> String
user                :: String -- ^ User name.
    , Config -> String
password            :: String -- ^ Password of user.
    , Config -> String
database            :: String -- ^ Database name.
    , Config -> Int
sendingBufferSize   :: Int -- ^ The size of sending buffer in byte.
    , Config -> Int
receptionBufferSize :: Int -- ^ The size of receiving buffer in byte.
    }
  deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq)

instance Default Config where
  def :: Config
def =
    Config :: Address -> String -> String -> String -> Int -> Int -> Config
Config
      { $sel:address:Config :: Address
address = SockAddr -> Address
AddressResolved (SockAddr -> Address) -> SockAddr -> Address
forall a b. (a -> b) -> a -> b
$ PortNumber -> HostAddress -> SockAddr
NS.SockAddrInet PortNumber
5432 (HostAddress -> SockAddr) -> HostAddress -> SockAddr
forall a b. (a -> b) -> a -> b
$ (Word8, Word8, Word8, Word8) -> HostAddress
NS.tupleToHostAddress (Word8
127, Word8
0, Word8
0, Word8
1)
      , $sel:user:Config :: String
user = String
"postgres"
      , $sel:password:Config :: String
password = String
""
      , $sel:database:Config :: String
database = String
""
      , $sel:sendingBufferSize:Config :: Int
sendingBufferSize = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
12 :: Int)
      , $sel:receptionBufferSize:Config :: Int
receptionBufferSize = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
12 :: Int)
      }

-- | IP address.
data Address
  = AddressResolved NS.SockAddr -- ^ Address which is DNS resolved.
  | AddressNotResolved NS.HostName NS.ServiceName -- ^ Address which is not DNS resolved.
  deriving (Int -> Address -> ShowS
[Address] -> ShowS
Address -> String
(Int -> Address -> ShowS)
-> (Address -> String) -> ([Address] -> ShowS) -> Show Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Address] -> ShowS
$cshowList :: [Address] -> ShowS
show :: Address -> String
$cshow :: Address -> String
showsPrec :: Int -> Address -> ShowS
$cshowsPrec :: Int -> Address -> ShowS
Show, Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c== :: Address -> Address -> Bool
Eq)

-- | Set of server parameters.
type BackendParameters = Map BSS.ShortByteString BSS.ShortByteString

-- | PostgreSQL connection.
data Connection =
  Connection
    { Connection -> Socket
socket          :: Socket
    , Connection -> Pid
pid             :: Pid -- ^ The process ID of the server.
    , Connection -> Pid
backendKey      :: BackendKey
    , Connection -> BackendParameters
parameters      :: BackendParameters -- ^ Set of server parameters.
    , Connection -> Buffer
sendingBuffer   :: Buffer
    , Connection -> Buffer
receptionBuffer :: Buffer
    , Connection -> Config
config          :: Config -- ^ Configuration of this connection.
    }

data Buffer = Buffer (ForeignPtr Word8) Int

type Salt = BS.ByteString

-- | Transaction state of a server.
data TransactionState
  = Idle -- ^ Not in a transaction block.
  | Block -- ^ In a transaction block.
  | Failed -- ^ Transaction failed.
  deriving (Int -> TransactionState -> ShowS
[TransactionState] -> ShowS
TransactionState -> String
(Int -> TransactionState -> ShowS)
-> (TransactionState -> String)
-> ([TransactionState] -> ShowS)
-> Show TransactionState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionState] -> ShowS
$cshowList :: [TransactionState] -> ShowS
show :: TransactionState -> String
$cshow :: TransactionState -> String
showsPrec :: Int -> TransactionState -> ShowS
$cshowsPrec :: Int -> TransactionState -> ShowS
Show, ReadPrec [TransactionState]
ReadPrec TransactionState
Int -> ReadS TransactionState
ReadS [TransactionState]
(Int -> ReadS TransactionState)
-> ReadS [TransactionState]
-> ReadPrec TransactionState
-> ReadPrec [TransactionState]
-> Read TransactionState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TransactionState]
$creadListPrec :: ReadPrec [TransactionState]
readPrec :: ReadPrec TransactionState
$creadPrec :: ReadPrec TransactionState
readList :: ReadS [TransactionState]
$creadList :: ReadS [TransactionState]
readsPrec :: Int -> ReadS TransactionState
$creadsPrec :: Int -> ReadS TransactionState
Read, TransactionState -> TransactionState -> Bool
(TransactionState -> TransactionState -> Bool)
-> (TransactionState -> TransactionState -> Bool)
-> Eq TransactionState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionState -> TransactionState -> Bool
$c/= :: TransactionState -> TransactionState -> Bool
== :: TransactionState -> TransactionState -> Bool
$c== :: TransactionState -> TransactionState -> Bool
Eq, Int -> TransactionState
TransactionState -> Int
TransactionState -> [TransactionState]
TransactionState -> TransactionState
TransactionState -> TransactionState -> [TransactionState]
TransactionState
-> TransactionState -> TransactionState -> [TransactionState]
(TransactionState -> TransactionState)
-> (TransactionState -> TransactionState)
-> (Int -> TransactionState)
-> (TransactionState -> Int)
-> (TransactionState -> [TransactionState])
-> (TransactionState -> TransactionState -> [TransactionState])
-> (TransactionState -> TransactionState -> [TransactionState])
-> (TransactionState
    -> TransactionState -> TransactionState -> [TransactionState])
-> Enum TransactionState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TransactionState
-> TransactionState -> TransactionState -> [TransactionState]
$cenumFromThenTo :: TransactionState
-> TransactionState -> TransactionState -> [TransactionState]
enumFromTo :: TransactionState -> TransactionState -> [TransactionState]
$cenumFromTo :: TransactionState -> TransactionState -> [TransactionState]
enumFromThen :: TransactionState -> TransactionState -> [TransactionState]
$cenumFromThen :: TransactionState -> TransactionState -> [TransactionState]
enumFrom :: TransactionState -> [TransactionState]
$cenumFrom :: TransactionState -> [TransactionState]
fromEnum :: TransactionState -> Int
$cfromEnum :: TransactionState -> Int
toEnum :: Int -> TransactionState
$ctoEnum :: Int -> TransactionState
pred :: TransactionState -> TransactionState
$cpred :: TransactionState -> TransactionState
succ :: TransactionState -> TransactionState
$csucc :: TransactionState -> TransactionState
Enum)

-- | Process ID
type Pid = Int32

type BackendKey = Int32

type AttributeNumber = Int16

data TypeLength = VariableLength | FixedLength Int16 deriving (Int -> TypeLength -> ShowS
[TypeLength] -> ShowS
TypeLength -> String
(Int -> TypeLength -> ShowS)
-> (TypeLength -> String)
-> ([TypeLength] -> ShowS)
-> Show TypeLength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeLength] -> ShowS
$cshowList :: [TypeLength] -> ShowS
show :: TypeLength -> String
$cshow :: TypeLength -> String
showsPrec :: Int -> TypeLength -> ShowS
$cshowsPrec :: Int -> TypeLength -> ShowS
Show, ReadPrec [TypeLength]
ReadPrec TypeLength
Int -> ReadS TypeLength
ReadS [TypeLength]
(Int -> ReadS TypeLength)
-> ReadS [TypeLength]
-> ReadPrec TypeLength
-> ReadPrec [TypeLength]
-> Read TypeLength
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypeLength]
$creadListPrec :: ReadPrec [TypeLength]
readPrec :: ReadPrec TypeLength
$creadPrec :: ReadPrec TypeLength
readList :: ReadS [TypeLength]
$creadList :: ReadS [TypeLength]
readsPrec :: Int -> ReadS TypeLength
$creadsPrec :: Int -> ReadS TypeLength
Read, TypeLength -> TypeLength -> Bool
(TypeLength -> TypeLength -> Bool)
-> (TypeLength -> TypeLength -> Bool) -> Eq TypeLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeLength -> TypeLength -> Bool
$c/= :: TypeLength -> TypeLength -> Bool
== :: TypeLength -> TypeLength -> Bool
$c== :: TypeLength -> TypeLength -> Bool
Eq, Eq TypeLength
Eq TypeLength
-> (TypeLength -> TypeLength -> Ordering)
-> (TypeLength -> TypeLength -> Bool)
-> (TypeLength -> TypeLength -> Bool)
-> (TypeLength -> TypeLength -> Bool)
-> (TypeLength -> TypeLength -> Bool)
-> (TypeLength -> TypeLength -> TypeLength)
-> (TypeLength -> TypeLength -> TypeLength)
-> Ord TypeLength
TypeLength -> TypeLength -> Bool
TypeLength -> TypeLength -> Ordering
TypeLength -> TypeLength -> TypeLength
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
min :: TypeLength -> TypeLength -> TypeLength
$cmin :: TypeLength -> TypeLength -> TypeLength
max :: TypeLength -> TypeLength -> TypeLength
$cmax :: TypeLength -> TypeLength -> TypeLength
>= :: TypeLength -> TypeLength -> Bool
$c>= :: TypeLength -> TypeLength -> Bool
> :: TypeLength -> TypeLength -> Bool
$c> :: TypeLength -> TypeLength -> Bool
<= :: TypeLength -> TypeLength -> Bool
$c<= :: TypeLength -> TypeLength -> Bool
< :: TypeLength -> TypeLength -> Bool
$c< :: TypeLength -> TypeLength -> Bool
compare :: TypeLength -> TypeLength -> Ordering
$ccompare :: TypeLength -> TypeLength -> Ordering
$cp1Ord :: Eq TypeLength
Ord)

type TypeModifier = Int32

-- | Format code of parameters of results.
data FormatCode = TextFormat | BinaryFormat deriving (Int -> FormatCode -> ShowS
[FormatCode] -> ShowS
FormatCode -> String
(Int -> FormatCode -> ShowS)
-> (FormatCode -> String)
-> ([FormatCode] -> ShowS)
-> Show FormatCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatCode] -> ShowS
$cshowList :: [FormatCode] -> ShowS
show :: FormatCode -> String
$cshow :: FormatCode -> String
showsPrec :: Int -> FormatCode -> ShowS
$cshowsPrec :: Int -> FormatCode -> ShowS
Show, ReadPrec [FormatCode]
ReadPrec FormatCode
Int -> ReadS FormatCode
ReadS [FormatCode]
(Int -> ReadS FormatCode)
-> ReadS [FormatCode]
-> ReadPrec FormatCode
-> ReadPrec [FormatCode]
-> Read FormatCode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FormatCode]
$creadListPrec :: ReadPrec [FormatCode]
readPrec :: ReadPrec FormatCode
$creadPrec :: ReadPrec FormatCode
readList :: ReadS [FormatCode]
$creadList :: ReadS [FormatCode]
readsPrec :: Int -> ReadS FormatCode
$creadsPrec :: Int -> ReadS FormatCode
Read, FormatCode -> FormatCode -> Bool
(FormatCode -> FormatCode -> Bool)
-> (FormatCode -> FormatCode -> Bool) -> Eq FormatCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatCode -> FormatCode -> Bool
$c/= :: FormatCode -> FormatCode -> Bool
== :: FormatCode -> FormatCode -> Bool
$c== :: FormatCode -> FormatCode -> Bool
Eq, Int -> FormatCode
FormatCode -> Int
FormatCode -> [FormatCode]
FormatCode -> FormatCode
FormatCode -> FormatCode -> [FormatCode]
FormatCode -> FormatCode -> FormatCode -> [FormatCode]
(FormatCode -> FormatCode)
-> (FormatCode -> FormatCode)
-> (Int -> FormatCode)
-> (FormatCode -> Int)
-> (FormatCode -> [FormatCode])
-> (FormatCode -> FormatCode -> [FormatCode])
-> (FormatCode -> FormatCode -> [FormatCode])
-> (FormatCode -> FormatCode -> FormatCode -> [FormatCode])
-> Enum FormatCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FormatCode -> FormatCode -> FormatCode -> [FormatCode]
$cenumFromThenTo :: FormatCode -> FormatCode -> FormatCode -> [FormatCode]
enumFromTo :: FormatCode -> FormatCode -> [FormatCode]
$cenumFromTo :: FormatCode -> FormatCode -> [FormatCode]
enumFromThen :: FormatCode -> FormatCode -> [FormatCode]
$cenumFromThen :: FormatCode -> FormatCode -> [FormatCode]
enumFrom :: FormatCode -> [FormatCode]
$cenumFrom :: FormatCode -> [FormatCode]
fromEnum :: FormatCode -> Int
$cfromEnum :: FormatCode -> Int
toEnum :: Int -> FormatCode
$ctoEnum :: Int -> FormatCode
pred :: FormatCode -> FormatCode
$cpred :: FormatCode -> FormatCode
succ :: FormatCode -> FormatCode
$csucc :: FormatCode -> FormatCode
Enum)

data BindParameterFormatCodes
  = BindParameterFormatCodesAllDefault
  | BindParameterFormatCodesAll FormatCode
  | BindParameterFormatCodesEach [FormatCode]
  deriving (Int -> BindParameterFormatCodes -> ShowS
[BindParameterFormatCodes] -> ShowS
BindParameterFormatCodes -> String
(Int -> BindParameterFormatCodes -> ShowS)
-> (BindParameterFormatCodes -> String)
-> ([BindParameterFormatCodes] -> ShowS)
-> Show BindParameterFormatCodes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindParameterFormatCodes] -> ShowS
$cshowList :: [BindParameterFormatCodes] -> ShowS
show :: BindParameterFormatCodes -> String
$cshow :: BindParameterFormatCodes -> String
showsPrec :: Int -> BindParameterFormatCodes -> ShowS
$cshowsPrec :: Int -> BindParameterFormatCodes -> ShowS
Show, ReadPrec [BindParameterFormatCodes]
ReadPrec BindParameterFormatCodes
Int -> ReadS BindParameterFormatCodes
ReadS [BindParameterFormatCodes]
(Int -> ReadS BindParameterFormatCodes)
-> ReadS [BindParameterFormatCodes]
-> ReadPrec BindParameterFormatCodes
-> ReadPrec [BindParameterFormatCodes]
-> Read BindParameterFormatCodes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BindParameterFormatCodes]
$creadListPrec :: ReadPrec [BindParameterFormatCodes]
readPrec :: ReadPrec BindParameterFormatCodes
$creadPrec :: ReadPrec BindParameterFormatCodes
readList :: ReadS [BindParameterFormatCodes]
$creadList :: ReadS [BindParameterFormatCodes]
readsPrec :: Int -> ReadS BindParameterFormatCodes
$creadsPrec :: Int -> ReadS BindParameterFormatCodes
Read, BindParameterFormatCodes -> BindParameterFormatCodes -> Bool
(BindParameterFormatCodes -> BindParameterFormatCodes -> Bool)
-> (BindParameterFormatCodes -> BindParameterFormatCodes -> Bool)
-> Eq BindParameterFormatCodes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindParameterFormatCodes -> BindParameterFormatCodes -> Bool
$c/= :: BindParameterFormatCodes -> BindParameterFormatCodes -> Bool
== :: BindParameterFormatCodes -> BindParameterFormatCodes -> Bool
$c== :: BindParameterFormatCodes -> BindParameterFormatCodes -> Bool
Eq)

data BindResultFormatCodes
  = BindResultFormatCodesNothing
  | BindResultFormatCodesAllDefault
  | BindResultFormatCodesEach [FormatCode]
  deriving (Int -> BindResultFormatCodes -> ShowS
[BindResultFormatCodes] -> ShowS
BindResultFormatCodes -> String
(Int -> BindResultFormatCodes -> ShowS)
-> (BindResultFormatCodes -> String)
-> ([BindResultFormatCodes] -> ShowS)
-> Show BindResultFormatCodes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindResultFormatCodes] -> ShowS
$cshowList :: [BindResultFormatCodes] -> ShowS
show :: BindResultFormatCodes -> String
$cshow :: BindResultFormatCodes -> String
showsPrec :: Int -> BindResultFormatCodes -> ShowS
$cshowsPrec :: Int -> BindResultFormatCodes -> ShowS
Show, ReadPrec [BindResultFormatCodes]
ReadPrec BindResultFormatCodes
Int -> ReadS BindResultFormatCodes
ReadS [BindResultFormatCodes]
(Int -> ReadS BindResultFormatCodes)
-> ReadS [BindResultFormatCodes]
-> ReadPrec BindResultFormatCodes
-> ReadPrec [BindResultFormatCodes]
-> Read BindResultFormatCodes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BindResultFormatCodes]
$creadListPrec :: ReadPrec [BindResultFormatCodes]
readPrec :: ReadPrec BindResultFormatCodes
$creadPrec :: ReadPrec BindResultFormatCodes
readList :: ReadS [BindResultFormatCodes]
$creadList :: ReadS [BindResultFormatCodes]
readsPrec :: Int -> ReadS BindResultFormatCodes
$creadsPrec :: Int -> ReadS BindResultFormatCodes
Read, BindResultFormatCodes -> BindResultFormatCodes -> Bool
(BindResultFormatCodes -> BindResultFormatCodes -> Bool)
-> (BindResultFormatCodes -> BindResultFormatCodes -> Bool)
-> Eq BindResultFormatCodes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindResultFormatCodes -> BindResultFormatCodes -> Bool
$c/= :: BindResultFormatCodes -> BindResultFormatCodes -> Bool
== :: BindResultFormatCodes -> BindResultFormatCodes -> Bool
$c== :: BindResultFormatCodes -> BindResultFormatCodes -> Bool
Eq)

-- | Command tag, which means which SQL command is completed.
data CommandTag
  = InsertTag Oid Int
  | DeleteTag Int
  | UpdateTag Int
  | SelectTag Int
  | MoveTag Int
  | FetchTag Int
  | CopyTag Int -- since PostgreSQL 8.2
  | CreateTableTag
  | DropTableTag
  | BeginTag
  | CommitTag
  | RollbackTag
  | SetTag
  deriving (Int -> CommandTag -> ShowS
[CommandTag] -> ShowS
CommandTag -> String
(Int -> CommandTag -> ShowS)
-> (CommandTag -> String)
-> ([CommandTag] -> ShowS)
-> Show CommandTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandTag] -> ShowS
$cshowList :: [CommandTag] -> ShowS
show :: CommandTag -> String
$cshow :: CommandTag -> String
showsPrec :: Int -> CommandTag -> ShowS
$cshowsPrec :: Int -> CommandTag -> ShowS
Show, ReadPrec [CommandTag]
ReadPrec CommandTag
Int -> ReadS CommandTag
ReadS [CommandTag]
(Int -> ReadS CommandTag)
-> ReadS [CommandTag]
-> ReadPrec CommandTag
-> ReadPrec [CommandTag]
-> Read CommandTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommandTag]
$creadListPrec :: ReadPrec [CommandTag]
readPrec :: ReadPrec CommandTag
$creadPrec :: ReadPrec CommandTag
readList :: ReadS [CommandTag]
$creadList :: ReadS [CommandTag]
readsPrec :: Int -> ReadS CommandTag
$creadsPrec :: Int -> ReadS CommandTag
Read, CommandTag -> CommandTag -> Bool
(CommandTag -> CommandTag -> Bool)
-> (CommandTag -> CommandTag -> Bool) -> Eq CommandTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandTag -> CommandTag -> Bool
$c/= :: CommandTag -> CommandTag -> Bool
== :: CommandTag -> CommandTag -> Bool
$c== :: CommandTag -> CommandTag -> Bool
Eq)

data Response
  = AuthenticationResponse AuthenticationResponse
  | BackendKeyDataResponse BackendKeyData
  | CommandCompleteResponse CommandComplete
  | DataRowResponse DataRowRaw
  | ErrorResponse Error
  | NoticeResponse Notice
  | ParameterStatusResponse ParameterStatus
  | ReadyForQueryResponse ReadyForQuery
  | RowDescriptionResponse RowDescription
  | ParseCompleteResponse
  | BindCompleteResponse
  | EmptyQueryResponse
  | NoDataResponse
  | ParameterDescriptionResponse ParameterDescription
  | DebugResponse Debug -- XXX temporal implementation

data AuthenticationResponse
  = AuthenticationOkResponse
  | AuthenticationCleartextPasswordResponse
  | AuthenticationMD5PasswordResponse AuthenticationMD5Password
  deriving (Int -> AuthenticationResponse -> ShowS
[AuthenticationResponse] -> ShowS
AuthenticationResponse -> String
(Int -> AuthenticationResponse -> ShowS)
-> (AuthenticationResponse -> String)
-> ([AuthenticationResponse] -> ShowS)
-> Show AuthenticationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationResponse] -> ShowS
$cshowList :: [AuthenticationResponse] -> ShowS
show :: AuthenticationResponse -> String
$cshow :: AuthenticationResponse -> String
showsPrec :: Int -> AuthenticationResponse -> ShowS
$cshowsPrec :: Int -> AuthenticationResponse -> ShowS
Show, ReadPrec [AuthenticationResponse]
ReadPrec AuthenticationResponse
Int -> ReadS AuthenticationResponse
ReadS [AuthenticationResponse]
(Int -> ReadS AuthenticationResponse)
-> ReadS [AuthenticationResponse]
-> ReadPrec AuthenticationResponse
-> ReadPrec [AuthenticationResponse]
-> Read AuthenticationResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthenticationResponse]
$creadListPrec :: ReadPrec [AuthenticationResponse]
readPrec :: ReadPrec AuthenticationResponse
$creadPrec :: ReadPrec AuthenticationResponse
readList :: ReadS [AuthenticationResponse]
$creadList :: ReadS [AuthenticationResponse]
readsPrec :: Int -> ReadS AuthenticationResponse
$creadsPrec :: Int -> ReadS AuthenticationResponse
Read, AuthenticationResponse -> AuthenticationResponse -> Bool
(AuthenticationResponse -> AuthenticationResponse -> Bool)
-> (AuthenticationResponse -> AuthenticationResponse -> Bool)
-> Eq AuthenticationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticationResponse -> AuthenticationResponse -> Bool
$c/= :: AuthenticationResponse -> AuthenticationResponse -> Bool
== :: AuthenticationResponse -> AuthenticationResponse -> Bool
$c== :: AuthenticationResponse -> AuthenticationResponse -> Bool
Eq)

newtype AuthenticationMD5Password = AuthenticationMD5Password Salt deriving (Int -> AuthenticationMD5Password -> ShowS
[AuthenticationMD5Password] -> ShowS
AuthenticationMD5Password -> String
(Int -> AuthenticationMD5Password -> ShowS)
-> (AuthenticationMD5Password -> String)
-> ([AuthenticationMD5Password] -> ShowS)
-> Show AuthenticationMD5Password
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationMD5Password] -> ShowS
$cshowList :: [AuthenticationMD5Password] -> ShowS
show :: AuthenticationMD5Password -> String
$cshow :: AuthenticationMD5Password -> String
showsPrec :: Int -> AuthenticationMD5Password -> ShowS
$cshowsPrec :: Int -> AuthenticationMD5Password -> ShowS
Show, ReadPrec [AuthenticationMD5Password]
ReadPrec AuthenticationMD5Password
Int -> ReadS AuthenticationMD5Password
ReadS [AuthenticationMD5Password]
(Int -> ReadS AuthenticationMD5Password)
-> ReadS [AuthenticationMD5Password]
-> ReadPrec AuthenticationMD5Password
-> ReadPrec [AuthenticationMD5Password]
-> Read AuthenticationMD5Password
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthenticationMD5Password]
$creadListPrec :: ReadPrec [AuthenticationMD5Password]
readPrec :: ReadPrec AuthenticationMD5Password
$creadPrec :: ReadPrec AuthenticationMD5Password
readList :: ReadS [AuthenticationMD5Password]
$creadList :: ReadS [AuthenticationMD5Password]
readsPrec :: Int -> ReadS AuthenticationMD5Password
$creadsPrec :: Int -> ReadS AuthenticationMD5Password
Read, AuthenticationMD5Password -> AuthenticationMD5Password -> Bool
(AuthenticationMD5Password -> AuthenticationMD5Password -> Bool)
-> (AuthenticationMD5Password -> AuthenticationMD5Password -> Bool)
-> Eq AuthenticationMD5Password
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticationMD5Password -> AuthenticationMD5Password -> Bool
$c/= :: AuthenticationMD5Password -> AuthenticationMD5Password -> Bool
== :: AuthenticationMD5Password -> AuthenticationMD5Password -> Bool
$c== :: AuthenticationMD5Password -> AuthenticationMD5Password -> Bool
Eq)

data BackendKeyData = BackendKeyData Pid BackendKey deriving (Int -> BackendKeyData -> ShowS
[BackendKeyData] -> ShowS
BackendKeyData -> String
(Int -> BackendKeyData -> ShowS)
-> (BackendKeyData -> String)
-> ([BackendKeyData] -> ShowS)
-> Show BackendKeyData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackendKeyData] -> ShowS
$cshowList :: [BackendKeyData] -> ShowS
show :: BackendKeyData -> String
$cshow :: BackendKeyData -> String
showsPrec :: Int -> BackendKeyData -> ShowS
$cshowsPrec :: Int -> BackendKeyData -> ShowS
Show, ReadPrec [BackendKeyData]
ReadPrec BackendKeyData
Int -> ReadS BackendKeyData
ReadS [BackendKeyData]
(Int -> ReadS BackendKeyData)
-> ReadS [BackendKeyData]
-> ReadPrec BackendKeyData
-> ReadPrec [BackendKeyData]
-> Read BackendKeyData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BackendKeyData]
$creadListPrec :: ReadPrec [BackendKeyData]
readPrec :: ReadPrec BackendKeyData
$creadPrec :: ReadPrec BackendKeyData
readList :: ReadS [BackendKeyData]
$creadList :: ReadS [BackendKeyData]
readsPrec :: Int -> ReadS BackendKeyData
$creadsPrec :: Int -> ReadS BackendKeyData
Read, BackendKeyData -> BackendKeyData -> Bool
(BackendKeyData -> BackendKeyData -> Bool)
-> (BackendKeyData -> BackendKeyData -> Bool) -> Eq BackendKeyData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackendKeyData -> BackendKeyData -> Bool
$c/= :: BackendKeyData -> BackendKeyData -> Bool
== :: BackendKeyData -> BackendKeyData -> Bool
$c== :: BackendKeyData -> BackendKeyData -> Bool
Eq)

newtype CommandComplete = CommandComplete CommandTag deriving (Int -> CommandComplete -> ShowS
[CommandComplete] -> ShowS
CommandComplete -> String
(Int -> CommandComplete -> ShowS)
-> (CommandComplete -> String)
-> ([CommandComplete] -> ShowS)
-> Show CommandComplete
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandComplete] -> ShowS
$cshowList :: [CommandComplete] -> ShowS
show :: CommandComplete -> String
$cshow :: CommandComplete -> String
showsPrec :: Int -> CommandComplete -> ShowS
$cshowsPrec :: Int -> CommandComplete -> ShowS
Show, ReadPrec [CommandComplete]
ReadPrec CommandComplete
Int -> ReadS CommandComplete
ReadS [CommandComplete]
(Int -> ReadS CommandComplete)
-> ReadS [CommandComplete]
-> ReadPrec CommandComplete
-> ReadPrec [CommandComplete]
-> Read CommandComplete
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommandComplete]
$creadListPrec :: ReadPrec [CommandComplete]
readPrec :: ReadPrec CommandComplete
$creadPrec :: ReadPrec CommandComplete
readList :: ReadS [CommandComplete]
$creadList :: ReadS [CommandComplete]
readsPrec :: Int -> ReadS CommandComplete
$creadsPrec :: Int -> ReadS CommandComplete
Read, CommandComplete -> CommandComplete -> Bool
(CommandComplete -> CommandComplete -> Bool)
-> (CommandComplete -> CommandComplete -> Bool)
-> Eq CommandComplete
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandComplete -> CommandComplete -> Bool
$c/= :: CommandComplete -> CommandComplete -> Bool
== :: CommandComplete -> CommandComplete -> Bool
$c== :: CommandComplete -> CommandComplete -> Bool
Eq)

newtype DataRow r = DataRow r deriving (Int -> DataRow r -> ShowS
[DataRow r] -> ShowS
DataRow r -> String
(Int -> DataRow r -> ShowS)
-> (DataRow r -> String)
-> ([DataRow r] -> ShowS)
-> Show (DataRow r)
forall r. Show r => Int -> DataRow r -> ShowS
forall r. Show r => [DataRow r] -> ShowS
forall r. Show r => DataRow r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataRow r] -> ShowS
$cshowList :: forall r. Show r => [DataRow r] -> ShowS
show :: DataRow r -> String
$cshow :: forall r. Show r => DataRow r -> String
showsPrec :: Int -> DataRow r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> DataRow r -> ShowS
Show, ReadPrec [DataRow r]
ReadPrec (DataRow r)
Int -> ReadS (DataRow r)
ReadS [DataRow r]
(Int -> ReadS (DataRow r))
-> ReadS [DataRow r]
-> ReadPrec (DataRow r)
-> ReadPrec [DataRow r]
-> Read (DataRow r)
forall r. Read r => ReadPrec [DataRow r]
forall r. Read r => ReadPrec (DataRow r)
forall r. Read r => Int -> ReadS (DataRow r)
forall r. Read r => ReadS [DataRow r]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DataRow r]
$creadListPrec :: forall r. Read r => ReadPrec [DataRow r]
readPrec :: ReadPrec (DataRow r)
$creadPrec :: forall r. Read r => ReadPrec (DataRow r)
readList :: ReadS [DataRow r]
$creadList :: forall r. Read r => ReadS [DataRow r]
readsPrec :: Int -> ReadS (DataRow r)
$creadsPrec :: forall r. Read r => Int -> ReadS (DataRow r)
Read, DataRow r -> DataRow r -> Bool
(DataRow r -> DataRow r -> Bool)
-> (DataRow r -> DataRow r -> Bool) -> Eq (DataRow r)
forall r. Eq r => DataRow r -> DataRow r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataRow r -> DataRow r -> Bool
$c/= :: forall r. Eq r => DataRow r -> DataRow r -> Bool
== :: DataRow r -> DataRow r -> Bool
$c== :: forall r. Eq r => DataRow r -> DataRow r -> Bool
Eq)

newtype DataRowRaw = DataRowRaw [Raw] deriving (Int -> DataRowRaw -> ShowS
[DataRowRaw] -> ShowS
DataRowRaw -> String
(Int -> DataRowRaw -> ShowS)
-> (DataRowRaw -> String)
-> ([DataRowRaw] -> ShowS)
-> Show DataRowRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataRowRaw] -> ShowS
$cshowList :: [DataRowRaw] -> ShowS
show :: DataRowRaw -> String
$cshow :: DataRowRaw -> String
showsPrec :: Int -> DataRowRaw -> ShowS
$cshowsPrec :: Int -> DataRowRaw -> ShowS
Show, ReadPrec [DataRowRaw]
ReadPrec DataRowRaw
Int -> ReadS DataRowRaw
ReadS [DataRowRaw]
(Int -> ReadS DataRowRaw)
-> ReadS [DataRowRaw]
-> ReadPrec DataRowRaw
-> ReadPrec [DataRowRaw]
-> Read DataRowRaw
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DataRowRaw]
$creadListPrec :: ReadPrec [DataRowRaw]
readPrec :: ReadPrec DataRowRaw
$creadPrec :: ReadPrec DataRowRaw
readList :: ReadS [DataRowRaw]
$creadList :: ReadS [DataRowRaw]
readsPrec :: Int -> ReadS DataRowRaw
$creadsPrec :: Int -> ReadS DataRowRaw
Read, DataRowRaw -> DataRowRaw -> Bool
(DataRowRaw -> DataRowRaw -> Bool)
-> (DataRowRaw -> DataRowRaw -> Bool) -> Eq DataRowRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataRowRaw -> DataRowRaw -> Bool
$c/= :: DataRowRaw -> DataRowRaw -> Bool
== :: DataRowRaw -> DataRowRaw -> Bool
$c== :: DataRowRaw -> DataRowRaw -> Bool
Eq)

newtype Error = Error ErrorFields deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, ReadPrec [Error]
ReadPrec Error
Int -> ReadS Error
ReadS [Error]
(Int -> ReadS Error)
-> ReadS [Error]
-> ReadPrec Error
-> ReadPrec [Error]
-> Read Error
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Error]
$creadListPrec :: ReadPrec [Error]
readPrec :: ReadPrec Error
$creadPrec :: ReadPrec Error
readList :: ReadS [Error]
$creadList :: ReadS [Error]
readsPrec :: Int -> ReadS Error
$creadsPrec :: Int -> ReadS Error
Read, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq)

newtype Notice = Notice ErrorFields deriving (Int -> Notice -> ShowS
[Notice] -> ShowS
Notice -> String
(Int -> Notice -> ShowS)
-> (Notice -> String) -> ([Notice] -> ShowS) -> Show Notice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notice] -> ShowS
$cshowList :: [Notice] -> ShowS
show :: Notice -> String
$cshow :: Notice -> String
showsPrec :: Int -> Notice -> ShowS
$cshowsPrec :: Int -> Notice -> ShowS
Show, ReadPrec [Notice]
ReadPrec Notice
Int -> ReadS Notice
ReadS [Notice]
(Int -> ReadS Notice)
-> ReadS [Notice]
-> ReadPrec Notice
-> ReadPrec [Notice]
-> Read Notice
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Notice]
$creadListPrec :: ReadPrec [Notice]
readPrec :: ReadPrec Notice
$creadPrec :: ReadPrec Notice
readList :: ReadS [Notice]
$creadList :: ReadS [Notice]
readsPrec :: Int -> ReadS Notice
$creadsPrec :: Int -> ReadS Notice
Read, Notice -> Notice -> Bool
(Notice -> Notice -> Bool)
-> (Notice -> Notice -> Bool) -> Eq Notice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notice -> Notice -> Bool
$c/= :: Notice -> Notice -> Bool
== :: Notice -> Notice -> Bool
$c== :: Notice -> Notice -> Bool
Eq)

data ParameterStatus = ParameterStatus BSS.ShortByteString BSS.ShortByteString deriving (Int -> ParameterStatus -> ShowS
[ParameterStatus] -> ShowS
ParameterStatus -> String
(Int -> ParameterStatus -> ShowS)
-> (ParameterStatus -> String)
-> ([ParameterStatus] -> ShowS)
-> Show ParameterStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterStatus] -> ShowS
$cshowList :: [ParameterStatus] -> ShowS
show :: ParameterStatus -> String
$cshow :: ParameterStatus -> String
showsPrec :: Int -> ParameterStatus -> ShowS
$cshowsPrec :: Int -> ParameterStatus -> ShowS
Show, ReadPrec [ParameterStatus]
ReadPrec ParameterStatus
Int -> ReadS ParameterStatus
ReadS [ParameterStatus]
(Int -> ReadS ParameterStatus)
-> ReadS [ParameterStatus]
-> ReadPrec ParameterStatus
-> ReadPrec [ParameterStatus]
-> Read ParameterStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParameterStatus]
$creadListPrec :: ReadPrec [ParameterStatus]
readPrec :: ReadPrec ParameterStatus
$creadPrec :: ReadPrec ParameterStatus
readList :: ReadS [ParameterStatus]
$creadList :: ReadS [ParameterStatus]
readsPrec :: Int -> ReadS ParameterStatus
$creadsPrec :: Int -> ReadS ParameterStatus
Read, ParameterStatus -> ParameterStatus -> Bool
(ParameterStatus -> ParameterStatus -> Bool)
-> (ParameterStatus -> ParameterStatus -> Bool)
-> Eq ParameterStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterStatus -> ParameterStatus -> Bool
$c/= :: ParameterStatus -> ParameterStatus -> Bool
== :: ParameterStatus -> ParameterStatus -> Bool
$c== :: ParameterStatus -> ParameterStatus -> Bool
Eq)

newtype ReadyForQuery = ReadyForQuery TransactionState deriving (Int -> ReadyForQuery -> ShowS
[ReadyForQuery] -> ShowS
ReadyForQuery -> String
(Int -> ReadyForQuery -> ShowS)
-> (ReadyForQuery -> String)
-> ([ReadyForQuery] -> ShowS)
-> Show ReadyForQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadyForQuery] -> ShowS
$cshowList :: [ReadyForQuery] -> ShowS
show :: ReadyForQuery -> String
$cshow :: ReadyForQuery -> String
showsPrec :: Int -> ReadyForQuery -> ShowS
$cshowsPrec :: Int -> ReadyForQuery -> ShowS
Show, ReadPrec [ReadyForQuery]
ReadPrec ReadyForQuery
Int -> ReadS ReadyForQuery
ReadS [ReadyForQuery]
(Int -> ReadS ReadyForQuery)
-> ReadS [ReadyForQuery]
-> ReadPrec ReadyForQuery
-> ReadPrec [ReadyForQuery]
-> Read ReadyForQuery
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReadyForQuery]
$creadListPrec :: ReadPrec [ReadyForQuery]
readPrec :: ReadPrec ReadyForQuery
$creadPrec :: ReadPrec ReadyForQuery
readList :: ReadS [ReadyForQuery]
$creadList :: ReadS [ReadyForQuery]
readsPrec :: Int -> ReadS ReadyForQuery
$creadsPrec :: Int -> ReadS ReadyForQuery
Read, ReadyForQuery -> ReadyForQuery -> Bool
(ReadyForQuery -> ReadyForQuery -> Bool)
-> (ReadyForQuery -> ReadyForQuery -> Bool) -> Eq ReadyForQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadyForQuery -> ReadyForQuery -> Bool
$c/= :: ReadyForQuery -> ReadyForQuery -> Bool
== :: ReadyForQuery -> ReadyForQuery -> Bool
$c== :: ReadyForQuery -> ReadyForQuery -> Bool
Eq)

newtype RowDescription = RowDescription [ColumnInfo] deriving (Int -> RowDescription -> ShowS
[RowDescription] -> ShowS
RowDescription -> String
(Int -> RowDescription -> ShowS)
-> (RowDescription -> String)
-> ([RowDescription] -> ShowS)
-> Show RowDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowDescription] -> ShowS
$cshowList :: [RowDescription] -> ShowS
show :: RowDescription -> String
$cshow :: RowDescription -> String
showsPrec :: Int -> RowDescription -> ShowS
$cshowsPrec :: Int -> RowDescription -> ShowS
Show, ReadPrec [RowDescription]
ReadPrec RowDescription
Int -> ReadS RowDescription
ReadS [RowDescription]
(Int -> ReadS RowDescription)
-> ReadS [RowDescription]
-> ReadPrec RowDescription
-> ReadPrec [RowDescription]
-> Read RowDescription
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RowDescription]
$creadListPrec :: ReadPrec [RowDescription]
readPrec :: ReadPrec RowDescription
$creadPrec :: ReadPrec RowDescription
readList :: ReadS [RowDescription]
$creadList :: ReadS [RowDescription]
readsPrec :: Int -> ReadS RowDescription
$creadsPrec :: Int -> ReadS RowDescription
Read, RowDescription -> RowDescription -> Bool
(RowDescription -> RowDescription -> Bool)
-> (RowDescription -> RowDescription -> Bool) -> Eq RowDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowDescription -> RowDescription -> Bool
$c/= :: RowDescription -> RowDescription -> Bool
== :: RowDescription -> RowDescription -> Bool
$c== :: RowDescription -> RowDescription -> Bool
Eq)

newtype ParameterDescription = ParameterDescription [Oid] deriving (Int -> ParameterDescription -> ShowS
[ParameterDescription] -> ShowS
ParameterDescription -> String
(Int -> ParameterDescription -> ShowS)
-> (ParameterDescription -> String)
-> ([ParameterDescription] -> ShowS)
-> Show ParameterDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterDescription] -> ShowS
$cshowList :: [ParameterDescription] -> ShowS
show :: ParameterDescription -> String
$cshow :: ParameterDescription -> String
showsPrec :: Int -> ParameterDescription -> ShowS
$cshowsPrec :: Int -> ParameterDescription -> ShowS
Show, ReadPrec [ParameterDescription]
ReadPrec ParameterDescription
Int -> ReadS ParameterDescription
ReadS [ParameterDescription]
(Int -> ReadS ParameterDescription)
-> ReadS [ParameterDescription]
-> ReadPrec ParameterDescription
-> ReadPrec [ParameterDescription]
-> Read ParameterDescription
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParameterDescription]
$creadListPrec :: ReadPrec [ParameterDescription]
readPrec :: ReadPrec ParameterDescription
$creadPrec :: ReadPrec ParameterDescription
readList :: ReadS [ParameterDescription]
$creadList :: ReadS [ParameterDescription]
readsPrec :: Int -> ReadS ParameterDescription
$creadsPrec :: Int -> ReadS ParameterDescription
Read, ParameterDescription -> ParameterDescription -> Bool
(ParameterDescription -> ParameterDescription -> Bool)
-> (ParameterDescription -> ParameterDescription -> Bool)
-> Eq ParameterDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterDescription -> ParameterDescription -> Bool
$c/= :: ParameterDescription -> ParameterDescription -> Bool
== :: ParameterDescription -> ParameterDescription -> Bool
$c== :: ParameterDescription -> ParameterDescription -> Bool
Eq)

newtype Debug = Debug BS.ByteString deriving (Int -> Debug -> ShowS
[Debug] -> ShowS
Debug -> String
(Int -> Debug -> ShowS)
-> (Debug -> String) -> ([Debug] -> ShowS) -> Show Debug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Debug] -> ShowS
$cshowList :: [Debug] -> ShowS
show :: Debug -> String
$cshow :: Debug -> String
showsPrec :: Int -> Debug -> ShowS
$cshowsPrec :: Int -> Debug -> ShowS
Show, ReadPrec [Debug]
ReadPrec Debug
Int -> ReadS Debug
ReadS [Debug]
(Int -> ReadS Debug)
-> ReadS [Debug]
-> ReadPrec Debug
-> ReadPrec [Debug]
-> Read Debug
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Debug]
$creadListPrec :: ReadPrec [Debug]
readPrec :: ReadPrec Debug
$creadPrec :: ReadPrec Debug
readList :: ReadS [Debug]
$creadList :: ReadS [Debug]
readsPrec :: Int -> ReadS Debug
$creadsPrec :: Int -> ReadS Debug
Read, Debug -> Debug -> Bool
(Debug -> Debug -> Bool) -> (Debug -> Debug -> Bool) -> Eq Debug
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Debug -> Debug -> Bool
$c/= :: Debug -> Debug -> Bool
== :: Debug -> Debug -> Bool
$c== :: Debug -> Debug -> Bool
Eq) -- XXX temporal implementation

-- | Result of a “Execute” message.
data ExecuteResult
  = ExecuteComplete CommandTag -- ^ All records gotten.
  | ExecuteEmptyQuery -- ^ No records.
  | ExecuteSuspended -- ^ Records are left yet.
  deriving (Int -> ExecuteResult -> ShowS
[ExecuteResult] -> ShowS
ExecuteResult -> String
(Int -> ExecuteResult -> ShowS)
-> (ExecuteResult -> String)
-> ([ExecuteResult] -> ShowS)
-> Show ExecuteResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteResult] -> ShowS
$cshowList :: [ExecuteResult] -> ShowS
show :: ExecuteResult -> String
$cshow :: ExecuteResult -> String
showsPrec :: Int -> ExecuteResult -> ShowS
$cshowsPrec :: Int -> ExecuteResult -> ShowS
Show, ReadPrec [ExecuteResult]
ReadPrec ExecuteResult
Int -> ReadS ExecuteResult
ReadS [ExecuteResult]
(Int -> ReadS ExecuteResult)
-> ReadS [ExecuteResult]
-> ReadPrec ExecuteResult
-> ReadPrec [ExecuteResult]
-> Read ExecuteResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecuteResult]
$creadListPrec :: ReadPrec [ExecuteResult]
readPrec :: ReadPrec ExecuteResult
$creadPrec :: ReadPrec ExecuteResult
readList :: ReadS [ExecuteResult]
$creadList :: ReadS [ExecuteResult]
readsPrec :: Int -> ReadS ExecuteResult
$creadsPrec :: Int -> ReadS ExecuteResult
Read, ExecuteResult -> ExecuteResult -> Bool
(ExecuteResult -> ExecuteResult -> Bool)
-> (ExecuteResult -> ExecuteResult -> Bool) -> Eq ExecuteResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecuteResult -> ExecuteResult -> Bool
$c/= :: ExecuteResult -> ExecuteResult -> Bool
== :: ExecuteResult -> ExecuteResult -> Bool
$c== :: ExecuteResult -> ExecuteResult -> Bool
Eq)

data DescribeResult
  = DescribePreparedStatementResult [Oid] [ColumnInfo]
  | DescribePortalResult [ColumnInfo]
  deriving (Int -> DescribeResult -> ShowS
[DescribeResult] -> ShowS
DescribeResult -> String
(Int -> DescribeResult -> ShowS)
-> (DescribeResult -> String)
-> ([DescribeResult] -> ShowS)
-> Show DescribeResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeResult] -> ShowS
$cshowList :: [DescribeResult] -> ShowS
show :: DescribeResult -> String
$cshow :: DescribeResult -> String
showsPrec :: Int -> DescribeResult -> ShowS
$cshowsPrec :: Int -> DescribeResult -> ShowS
Show, ReadPrec [DescribeResult]
ReadPrec DescribeResult
Int -> ReadS DescribeResult
ReadS [DescribeResult]
(Int -> ReadS DescribeResult)
-> ReadS [DescribeResult]
-> ReadPrec DescribeResult
-> ReadPrec [DescribeResult]
-> Read DescribeResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeResult]
$creadListPrec :: ReadPrec [DescribeResult]
readPrec :: ReadPrec DescribeResult
$creadPrec :: ReadPrec DescribeResult
readList :: ReadS [DescribeResult]
$creadList :: ReadS [DescribeResult]
readsPrec :: Int -> ReadS DescribeResult
$creadsPrec :: Int -> ReadS DescribeResult
Read, DescribeResult -> DescribeResult -> Bool
(DescribeResult -> DescribeResult -> Bool)
-> (DescribeResult -> DescribeResult -> Bool) -> Eq DescribeResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeResult -> DescribeResult -> Bool
$c/= :: DescribeResult -> DescribeResult -> Bool
== :: DescribeResult -> DescribeResult -> Bool
$c== :: DescribeResult -> DescribeResult -> Bool
Eq)

-- https://www.postgresql.org/docs/current/protocol-error-fields.html
newtype ErrorFields = ErrorFields [(Char, BSS.ShortByteString)] deriving (Int -> ErrorFields -> ShowS
[ErrorFields] -> ShowS
ErrorFields -> String
(Int -> ErrorFields -> ShowS)
-> (ErrorFields -> String)
-> ([ErrorFields] -> ShowS)
-> Show ErrorFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorFields] -> ShowS
$cshowList :: [ErrorFields] -> ShowS
show :: ErrorFields -> String
$cshow :: ErrorFields -> String
showsPrec :: Int -> ErrorFields -> ShowS
$cshowsPrec :: Int -> ErrorFields -> ShowS
Show, ReadPrec [ErrorFields]
ReadPrec ErrorFields
Int -> ReadS ErrorFields
ReadS [ErrorFields]
(Int -> ReadS ErrorFields)
-> ReadS [ErrorFields]
-> ReadPrec ErrorFields
-> ReadPrec [ErrorFields]
-> Read ErrorFields
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ErrorFields]
$creadListPrec :: ReadPrec [ErrorFields]
readPrec :: ReadPrec ErrorFields
$creadPrec :: ReadPrec ErrorFields
readList :: ReadS [ErrorFields]
$creadList :: ReadS [ErrorFields]
readsPrec :: Int -> ReadS ErrorFields
$creadsPrec :: Int -> ReadS ErrorFields
Read, ErrorFields -> ErrorFields -> Bool
(ErrorFields -> ErrorFields -> Bool)
-> (ErrorFields -> ErrorFields -> Bool) -> Eq ErrorFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorFields -> ErrorFields -> Bool
$c/= :: ErrorFields -> ErrorFields -> Bool
== :: ErrorFields -> ErrorFields -> Bool
$c== :: ErrorFields -> ErrorFields -> Bool
Eq)

data TypeInfo
  = Basic Oid BS.ByteString
  deriving (Int -> TypeInfo -> ShowS
[TypeInfo] -> ShowS
TypeInfo -> String
(Int -> TypeInfo -> ShowS)
-> (TypeInfo -> String) -> ([TypeInfo] -> ShowS) -> Show TypeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeInfo] -> ShowS
$cshowList :: [TypeInfo] -> ShowS
show :: TypeInfo -> String
$cshow :: TypeInfo -> String
showsPrec :: Int -> TypeInfo -> ShowS
$cshowsPrec :: Int -> TypeInfo -> ShowS
Show, ReadPrec [TypeInfo]
ReadPrec TypeInfo
Int -> ReadS TypeInfo
ReadS [TypeInfo]
(Int -> ReadS TypeInfo)
-> ReadS [TypeInfo]
-> ReadPrec TypeInfo
-> ReadPrec [TypeInfo]
-> Read TypeInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypeInfo]
$creadListPrec :: ReadPrec [TypeInfo]
readPrec :: ReadPrec TypeInfo
$creadPrec :: ReadPrec TypeInfo
readList :: ReadS [TypeInfo]
$creadList :: ReadS [TypeInfo]
readsPrec :: Int -> ReadS TypeInfo
$creadsPrec :: Int -> ReadS TypeInfo
Read, TypeInfo -> TypeInfo -> Bool
(TypeInfo -> TypeInfo -> Bool)
-> (TypeInfo -> TypeInfo -> Bool) -> Eq TypeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeInfo -> TypeInfo -> Bool
$c/= :: TypeInfo -> TypeInfo -> Bool
== :: TypeInfo -> TypeInfo -> Bool
$c== :: TypeInfo -> TypeInfo -> Bool
Eq)

-- | Metadata of a column.
data ColumnInfo =
  ColumnInfo
    { ColumnInfo -> ByteString
name            :: BS.ByteString
    , ColumnInfo -> Oid
tableOid        :: Oid
    , ColumnInfo -> AttributeNumber
attributeNumber :: AttributeNumber
    , ColumnInfo -> Oid
typeOid         :: Oid
    , ColumnInfo -> TypeLength
typeLength      :: TypeLength
    , ColumnInfo -> Pid
typeModifier    :: TypeModifier
    , ColumnInfo -> FormatCode
formatCode      :: FormatCode
    }
    deriving (Int -> ColumnInfo -> ShowS
[ColumnInfo] -> ShowS
ColumnInfo -> String
(Int -> ColumnInfo -> ShowS)
-> (ColumnInfo -> String)
-> ([ColumnInfo] -> ShowS)
-> Show ColumnInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnInfo] -> ShowS
$cshowList :: [ColumnInfo] -> ShowS
show :: ColumnInfo -> String
$cshow :: ColumnInfo -> String
showsPrec :: Int -> ColumnInfo -> ShowS
$cshowsPrec :: Int -> ColumnInfo -> ShowS
Show, ReadPrec [ColumnInfo]
ReadPrec ColumnInfo
Int -> ReadS ColumnInfo
ReadS [ColumnInfo]
(Int -> ReadS ColumnInfo)
-> ReadS [ColumnInfo]
-> ReadPrec ColumnInfo
-> ReadPrec [ColumnInfo]
-> Read ColumnInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColumnInfo]
$creadListPrec :: ReadPrec [ColumnInfo]
readPrec :: ReadPrec ColumnInfo
$creadPrec :: ReadPrec ColumnInfo
readList :: ReadS [ColumnInfo]
$creadList :: ReadS [ColumnInfo]
readsPrec :: Int -> ReadS ColumnInfo
$creadsPrec :: Int -> ReadS ColumnInfo
Read, ColumnInfo -> ColumnInfo -> Bool
(ColumnInfo -> ColumnInfo -> Bool)
-> (ColumnInfo -> ColumnInfo -> Bool) -> Eq ColumnInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnInfo -> ColumnInfo -> Bool
$c/= :: ColumnInfo -> ColumnInfo -> Bool
== :: ColumnInfo -> ColumnInfo -> Bool
$c== :: ColumnInfo -> ColumnInfo -> Bool
Eq)

type Carry = BS.ByteString

-- | Data without encoding nor decoding of a field.
newtype Raw = Raw (Maybe BS.ByteString) deriving (Raw -> Raw -> Bool
(Raw -> Raw -> Bool) -> (Raw -> Raw -> Bool) -> Eq Raw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Raw -> Raw -> Bool
$c/= :: Raw -> Raw -> Bool
== :: Raw -> Raw -> Bool
$c== :: Raw -> Raw -> Bool
Eq, Eq Raw
Eq Raw
-> (Raw -> Raw -> Ordering)
-> (Raw -> Raw -> Bool)
-> (Raw -> Raw -> Bool)
-> (Raw -> Raw -> Bool)
-> (Raw -> Raw -> Bool)
-> (Raw -> Raw -> Raw)
-> (Raw -> Raw -> Raw)
-> Ord Raw
Raw -> Raw -> Bool
Raw -> Raw -> Ordering
Raw -> Raw -> Raw
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
min :: Raw -> Raw -> Raw
$cmin :: Raw -> Raw -> Raw
max :: Raw -> Raw -> Raw
$cmax :: Raw -> Raw -> Raw
>= :: Raw -> Raw -> Bool
$c>= :: Raw -> Raw -> Bool
> :: Raw -> Raw -> Bool
$c> :: Raw -> Raw -> Bool
<= :: Raw -> Raw -> Bool
$c<= :: Raw -> Raw -> Bool
< :: Raw -> Raw -> Bool
$c< :: Raw -> Raw -> Bool
compare :: Raw -> Raw -> Ordering
$ccompare :: Raw -> Raw -> Ordering
$cp1Ord :: Eq Raw
Ord)

instance Show Raw where
  show :: Raw -> String
show Raw
Null      = String
"NULL"
  show (Value ByteString
a) = [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
BS.unpack ByteString
a)

instance Read Raw where
  readPrec :: ReadPrec Raw
readPrec =
    ReadPrec Raw -> ReadPrec Raw
forall a. ReadPrec a -> ReadPrec a
R.parens
      ( ( do
            ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
R.lift (ReadP () -> ReadPrec ()) -> ReadP () -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ Lexeme -> ReadP ()
R.expect (Lexeme -> ReadP ()) -> Lexeme -> ReadP ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
R.Ident String
"NULL"
            Raw -> ReadPrec Raw
forall (f :: * -> *) a. Applicative f => a -> f a
pure Raw
Null
        )
        ReadPrec Raw -> ReadPrec Raw -> ReadPrec Raw
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Raw
Value (ByteString -> Raw) -> ([Word8] -> ByteString) -> [Word8] -> Raw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Raw) -> ReadPrec [Word8] -> ReadPrec Raw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [Word8]
forall a. Read a => ReadPrec a
readPrec)
      )

-- | @NULL@.
pattern Null :: Raw
pattern $bNull :: Raw
$mNull :: forall r. Raw -> (Void# -> r) -> (Void# -> r) -> r
Null = Raw Nothing

-- | Not @NULL@.
pattern Value :: BS.ByteString -> Raw
pattern $bValue :: ByteString -> Raw
$mValue :: forall r. Raw -> (ByteString -> r) -> (Void# -> r) -> r
Value a = Raw (Just a)

{-# COMPLETE Null, Value #-}

-- | SQL query.
--
-- This 'Data.String.fromString' counts only ASCII, because it is the same with 'BS.ByteString'.
newtype Query = Query BS.ByteString deriving (Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Query] -> ShowS
$cshowList :: [Query] -> ShowS
show :: Query -> String
$cshow :: Query -> String
showsPrec :: Int -> Query -> ShowS
$cshowsPrec :: Int -> Query -> ShowS
Show, ReadPrec [Query]
ReadPrec Query
Int -> ReadS Query
ReadS [Query]
(Int -> ReadS Query)
-> ReadS [Query]
-> ReadPrec Query
-> ReadPrec [Query]
-> Read Query
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Query]
$creadListPrec :: ReadPrec [Query]
readPrec :: ReadPrec Query
$creadPrec :: ReadPrec Query
readList :: ReadS [Query]
$creadList :: ReadS [Query]
readsPrec :: Int -> ReadS Query
$creadsPrec :: Int -> ReadS Query
Read, Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c== :: Query -> Query -> Bool
Eq, Eq Query
Eq Query
-> (Query -> Query -> Ordering)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Query)
-> (Query -> Query -> Query)
-> Ord Query
Query -> Query -> Bool
Query -> Query -> Ordering
Query -> Query -> Query
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
min :: Query -> Query -> Query
$cmin :: Query -> Query -> Query
max :: Query -> Query -> Query
$cmax :: Query -> Query -> Query
>= :: Query -> Query -> Bool
$c>= :: Query -> Query -> Bool
> :: Query -> Query -> Bool
$c> :: Query -> Query -> Bool
<= :: Query -> Query -> Bool
$c<= :: Query -> Query -> Bool
< :: Query -> Query -> Bool
$c< :: Query -> Query -> Bool
compare :: Query -> Query -> Ordering
$ccompare :: Query -> Query -> Ordering
$cp1Ord :: Eq Query
Ord, String -> Query
(String -> Query) -> IsString Query
forall a. (String -> a) -> IsString a
fromString :: String -> Query
$cfromString :: String -> Query
IsString)

-- | To convert a type which means that it is not processed by the server to a respective type which means that it is processed by the server.
type family MessageResult m :: Type

-- | This represents a prepared statement which is already processed by a server.
data PreparedStatement =
  PreparedStatement
    { PreparedStatement -> PreparedStatementName
name          :: PreparedStatementName
    , PreparedStatement -> [Oid]
parameterOids :: [Oid]
    , PreparedStatement -> [ColumnInfo]
resultInfos   :: [ColumnInfo]
    }

instance Show PreparedStatement where
  show :: PreparedStatement -> String
show (PreparedStatement PreparedStatementName
name [Oid]
parameterOids [ColumnInfo]
resultInfos) = String
"PreparedStatement " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PreparedStatementName -> String
forall a. Show a => a -> String
show PreparedStatementName
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Oid] -> String
forall a. Show a => a -> String
show [Oid]
parameterOids String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [ColumnInfo] -> String
forall a. Show a => a -> String
show [ColumnInfo]
resultInfos

instance Eq PreparedStatement where
  (PreparedStatement PreparedStatementName
name0 [Oid]
parameterOids0 [ColumnInfo]
resultInfos0) == :: PreparedStatement -> PreparedStatement -> Bool
== (PreparedStatement PreparedStatementName
name1 [Oid]
parameterOids1 [ColumnInfo]
resultInfos1) = (PreparedStatementName
name0, [Oid]
parameterOids0, [ColumnInfo]
resultInfos0) (PreparedStatementName, [Oid], [ColumnInfo])
-> (PreparedStatementName, [Oid], [ColumnInfo]) -> Bool
forall a. Eq a => a -> a -> Bool
== (PreparedStatementName
name1, [Oid]
parameterOids1, [ColumnInfo]
resultInfos1)

-- | This represents a prepared statement which is not yet processed by a server.
data PreparedStatementProcedure =
  PreparedStatementProcedure
    { PreparedStatementProcedure -> PreparedStatementName
name            :: PreparedStatementName
    , PreparedStatementProcedure -> Word
parameterLength :: Word
    , PreparedStatementProcedure -> Word
resultLength    :: Word
    , PreparedStatementProcedure -> Maybe [Oid]
parameterOids   :: Maybe [Oid]
    , PreparedStatementProcedure -> Builder
builder         :: BSB.Builder
    , PreparedStatementProcedure
-> Parser (MessageResult PreparedStatementProcedure)
parser          :: AP.Parser (MessageResult PreparedStatementProcedure)
    }

type instance MessageResult PreparedStatementProcedure = PreparedStatement

instance Show PreparedStatementProcedure where
  show :: PreparedStatementProcedure -> String
show (PreparedStatementProcedure PreparedStatementName
name Word
parameterLength Word
resultLength Maybe [Oid]
oids Builder
_ Parser (MessageResult PreparedStatementProcedure)
_) =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"PreparedStatementProcedure ", PreparedStatementName -> String
forall a. Show a => a -> String
show PreparedStatementName
name, String
" ", Word -> String
forall a. Show a => a -> String
show Word
parameterLength, String
" ", Word -> String
forall a. Show a => a -> String
show Word
resultLength, String
" ", Maybe [Oid] -> String
forall a. Show a => a -> String
show Maybe [Oid]
oids, String
" _ _"]

-- | Name of a prepared statement.
newtype PreparedStatementName =
  PreparedStatementName BS.ByteString
  deriving stock (PreparedStatementName -> PreparedStatementName -> Bool
(PreparedStatementName -> PreparedStatementName -> Bool)
-> (PreparedStatementName -> PreparedStatementName -> Bool)
-> Eq PreparedStatementName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreparedStatementName -> PreparedStatementName -> Bool
$c/= :: PreparedStatementName -> PreparedStatementName -> Bool
== :: PreparedStatementName -> PreparedStatementName -> Bool
$c== :: PreparedStatementName -> PreparedStatementName -> Bool
Eq, Eq PreparedStatementName
Eq PreparedStatementName
-> (PreparedStatementName -> PreparedStatementName -> Ordering)
-> (PreparedStatementName -> PreparedStatementName -> Bool)
-> (PreparedStatementName -> PreparedStatementName -> Bool)
-> (PreparedStatementName -> PreparedStatementName -> Bool)
-> (PreparedStatementName -> PreparedStatementName -> Bool)
-> (PreparedStatementName
    -> PreparedStatementName -> PreparedStatementName)
-> (PreparedStatementName
    -> PreparedStatementName -> PreparedStatementName)
-> Ord PreparedStatementName
PreparedStatementName -> PreparedStatementName -> Bool
PreparedStatementName -> PreparedStatementName -> Ordering
PreparedStatementName
-> PreparedStatementName -> PreparedStatementName
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
min :: PreparedStatementName
-> PreparedStatementName -> PreparedStatementName
$cmin :: PreparedStatementName
-> PreparedStatementName -> PreparedStatementName
max :: PreparedStatementName
-> PreparedStatementName -> PreparedStatementName
$cmax :: PreparedStatementName
-> PreparedStatementName -> PreparedStatementName
>= :: PreparedStatementName -> PreparedStatementName -> Bool
$c>= :: PreparedStatementName -> PreparedStatementName -> Bool
> :: PreparedStatementName -> PreparedStatementName -> Bool
$c> :: PreparedStatementName -> PreparedStatementName -> Bool
<= :: PreparedStatementName -> PreparedStatementName -> Bool
$c<= :: PreparedStatementName -> PreparedStatementName -> Bool
< :: PreparedStatementName -> PreparedStatementName -> Bool
$c< :: PreparedStatementName -> PreparedStatementName -> Bool
compare :: PreparedStatementName -> PreparedStatementName -> Ordering
$ccompare :: PreparedStatementName -> PreparedStatementName -> Ordering
$cp1Ord :: Eq PreparedStatementName
Ord)
  deriving newtype (Int -> PreparedStatementName -> ShowS
[PreparedStatementName] -> ShowS
PreparedStatementName -> String
(Int -> PreparedStatementName -> ShowS)
-> (PreparedStatementName -> String)
-> ([PreparedStatementName] -> ShowS)
-> Show PreparedStatementName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreparedStatementName] -> ShowS
$cshowList :: [PreparedStatementName] -> ShowS
show :: PreparedStatementName -> String
$cshow :: PreparedStatementName -> String
showsPrec :: Int -> PreparedStatementName -> ShowS
$cshowsPrec :: Int -> PreparedStatementName -> ShowS
Show, ReadPrec [PreparedStatementName]
ReadPrec PreparedStatementName
Int -> ReadS PreparedStatementName
ReadS [PreparedStatementName]
(Int -> ReadS PreparedStatementName)
-> ReadS [PreparedStatementName]
-> ReadPrec PreparedStatementName
-> ReadPrec [PreparedStatementName]
-> Read PreparedStatementName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PreparedStatementName]
$creadListPrec :: ReadPrec [PreparedStatementName]
readPrec :: ReadPrec PreparedStatementName
$creadPrec :: ReadPrec PreparedStatementName
readList :: ReadS [PreparedStatementName]
$creadList :: ReadS [PreparedStatementName]
readsPrec :: Int -> ReadS PreparedStatementName
$creadsPrec :: Int -> ReadS PreparedStatementName
Read, String -> PreparedStatementName
(String -> PreparedStatementName) -> IsString PreparedStatementName
forall a. (String -> a) -> IsString a
fromString :: String -> PreparedStatementName
$cfromString :: String -> PreparedStatementName
IsString)

-- | This represents a portal which is already processed by a server.
data Portal =
  Portal
    { Portal -> PortalName
name              :: PortalName
    , Portal -> [ColumnInfo]
infos             :: [ColumnInfo]
    , Portal -> PreparedStatement
preparedStatement :: PreparedStatement
    }

instance Show Portal where
  show :: Portal -> String
show (Portal PortalName
name [ColumnInfo]
infos PreparedStatement
ps) = String
"Portal " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PortalName -> String
forall a. Show a => a -> String
show PortalName
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [ColumnInfo] -> String
forall a. Show a => a -> String
show [ColumnInfo]
infos String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PreparedStatement -> String
forall a. Show a => a -> String
show PreparedStatement
ps String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

instance Eq Portal where
  (Portal PortalName
name0 [ColumnInfo]
infos0 PreparedStatement
ps0) == :: Portal -> Portal -> Bool
== (Portal PortalName
name1 [ColumnInfo]
infos1 PreparedStatement
ps1) = (PortalName
name0, [ColumnInfo]
infos0, PreparedStatement
ps0) (PortalName, [ColumnInfo], PreparedStatement)
-> (PortalName, [ColumnInfo], PreparedStatement) -> Bool
forall a. Eq a => a -> a -> Bool
== (PortalName
name1, [ColumnInfo]
infos1, PreparedStatement
ps1)

-- | This represents a portal which is not yet processed by a server.
data PortalProcedure =
  PortalProcedure
    { PortalProcedure -> PortalName
name    :: PortalName
    , PortalProcedure -> FormatCode
format  :: FormatCode
    , PortalProcedure -> Builder
builder :: BSB.Builder
    , PortalProcedure -> Parser (MessageResult PortalProcedure)
parser  :: AP.Parser (MessageResult PortalProcedure)
    }

type instance MessageResult PortalProcedure = (PreparedStatement, Portal)

instance Show PortalProcedure where
  show :: PortalProcedure -> String
show (PortalProcedure PortalName
name FormatCode
format Builder
_ Parser (MessageResult PortalProcedure)
_) = String
"PortalProcedure " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PortalName -> String
forall a. Show a => a -> String
show PortalName
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FormatCode -> String
forall a. Show a => a -> String
show FormatCode
format String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" _ _"

-- | Name of a portal.
newtype PortalName =
  PortalName BS.ByteString
  deriving stock (PortalName -> PortalName -> Bool
(PortalName -> PortalName -> Bool)
-> (PortalName -> PortalName -> Bool) -> Eq PortalName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortalName -> PortalName -> Bool
$c/= :: PortalName -> PortalName -> Bool
== :: PortalName -> PortalName -> Bool
$c== :: PortalName -> PortalName -> Bool
Eq, Eq PortalName
Eq PortalName
-> (PortalName -> PortalName -> Ordering)
-> (PortalName -> PortalName -> Bool)
-> (PortalName -> PortalName -> Bool)
-> (PortalName -> PortalName -> Bool)
-> (PortalName -> PortalName -> Bool)
-> (PortalName -> PortalName -> PortalName)
-> (PortalName -> PortalName -> PortalName)
-> Ord PortalName
PortalName -> PortalName -> Bool
PortalName -> PortalName -> Ordering
PortalName -> PortalName -> PortalName
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
min :: PortalName -> PortalName -> PortalName
$cmin :: PortalName -> PortalName -> PortalName
max :: PortalName -> PortalName -> PortalName
$cmax :: PortalName -> PortalName -> PortalName
>= :: PortalName -> PortalName -> Bool
$c>= :: PortalName -> PortalName -> Bool
> :: PortalName -> PortalName -> Bool
$c> :: PortalName -> PortalName -> Bool
<= :: PortalName -> PortalName -> Bool
$c<= :: PortalName -> PortalName -> Bool
< :: PortalName -> PortalName -> Bool
$c< :: PortalName -> PortalName -> Bool
compare :: PortalName -> PortalName -> Ordering
$ccompare :: PortalName -> PortalName -> Ordering
$cp1Ord :: Eq PortalName
Ord)
  deriving newtype (Int -> PortalName -> ShowS
[PortalName] -> ShowS
PortalName -> String
(Int -> PortalName -> ShowS)
-> (PortalName -> String)
-> ([PortalName] -> ShowS)
-> Show PortalName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortalName] -> ShowS
$cshowList :: [PortalName] -> ShowS
show :: PortalName -> String
$cshow :: PortalName -> String
showsPrec :: Int -> PortalName -> ShowS
$cshowsPrec :: Int -> PortalName -> ShowS
Show, ReadPrec [PortalName]
ReadPrec PortalName
Int -> ReadS PortalName
ReadS [PortalName]
(Int -> ReadS PortalName)
-> ReadS [PortalName]
-> ReadPrec PortalName
-> ReadPrec [PortalName]
-> Read PortalName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PortalName]
$creadListPrec :: ReadPrec [PortalName]
readPrec :: ReadPrec PortalName
$creadPrec :: ReadPrec PortalName
readList :: ReadS [PortalName]
$creadList :: ReadS [PortalName]
readsPrec :: Int -> ReadS PortalName
$creadsPrec :: Int -> ReadS PortalName
Read, String -> PortalName
(String -> PortalName) -> IsString PortalName
forall a. (String -> a) -> IsString a
fromString :: String -> PortalName
$cfromString :: String -> PortalName
IsString)

-- | This represents a result of a “Execute” message which is already processed by a server.
data Executed r =
  Executed
    { Executed r -> ExecuteResult
result  :: ExecuteResult
    , Executed r -> [r]
records :: [r]
    , Executed r -> Portal
portal  :: Portal
    }

instance Show r => Show (Executed r) where
  show :: Executed r -> String
show (Executed ExecuteResult
r [r]
rs Portal
p) = String
"Executed " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ExecuteResult -> String
forall a. Show a => a -> String
show ExecuteResult
r String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [r] -> String
forall a. Show a => a -> String
show [r]
rs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Portal -> String
forall a. Show a => a -> String
show Portal
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

instance Eq r => Eq (Executed r) where
  (Executed ExecuteResult
r0 [r]
rs0 Portal
p0) == :: Executed r -> Executed r -> Bool
== (Executed ExecuteResult
r1 [r]
rs1 Portal
p1) = (ExecuteResult
r0, [r]
rs0, Portal
p0) (ExecuteResult, [r], Portal)
-> (ExecuteResult, [r], Portal) -> Bool
forall a. Eq a => a -> a -> Bool
== (ExecuteResult
r1, [r]
rs1, Portal
p1)

-- | This represents a result of a “Execute” message which is not yet processed by a server.
data ExecutedProcedure r =
  ExecutedProcedure
    { ExecutedProcedure r -> Builder
builder :: BSB.Builder
    , ExecutedProcedure r -> Parser (MessageResult (ExecutedProcedure r))
parser  :: AP.Parser (MessageResult (ExecutedProcedure r))
    }

type instance MessageResult (ExecutedProcedure r) = (PreparedStatement, Portal, Executed r, Maybe ErrorFields)

instance Show (ExecutedProcedure r) where
  show :: ExecutedProcedure r -> String
show (ExecutedProcedure Builder
_ Parser (MessageResult (ExecutedProcedure r))
_) = String
"ExecutedProcedure _ _"

-- | This represents a result of a “Close” message which is not yet processed by a server.
data CloseProcedure =
  CloseProcedure
    { CloseProcedure -> Builder
builder :: BSB.Builder
    , CloseProcedure -> Parser (MessageResult CloseProcedure)
parser  :: AP.Parser (MessageResult CloseProcedure)
    }

type instance MessageResult CloseProcedure = ()

instance Show CloseProcedure where
  show :: CloseProcedure -> String
show (CloseProcedure Builder
_ Parser (MessageResult CloseProcedure)
_) = String
"CloseProcedure _ _"

-- | Decoder of strings which may fail.
type StringDecoder = BS.ByteString -> Either String String

-- | Encoder of strings which may fail.
type StringEncoder = String -> Either String BS.ByteString

-- | This means that a field can be decoded as @a@.
class FromField a where
  -- | Decoder of a field.
  fromField :: MonadFail m => StringDecoder -> ColumnInfo -> Maybe BS.ByteString -> m a

-- | This means that a record can be parsed as @a@.
class FromRecord a where
  -- | Decoder of a record.
  fromRecord :: StringDecoder -> [ColumnInfo] -> AP.Parser a
  default fromRecord :: (Generic a, GFromRecord (Rep a)) => StringDecoder -> [ColumnInfo] -> AP.Parser a
  fromRecord StringDecoder
decode [ColumnInfo]
infos = do
    (Rep a Any
rep, [ColumnInfo]
infos') <- StringDecoder -> [ColumnInfo] -> Parser (Rep a Any, [ColumnInfo])
forall (f :: * -> *) p.
GFromRecord f =>
StringDecoder -> [ColumnInfo] -> Parser (f p, [ColumnInfo])
gFromRecord StringDecoder
decode [ColumnInfo]
infos
    case [ColumnInfo]
infos' of
      [] -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$ Rep a Any -> a
forall a x. Generic a => Rep a x -> a
Generics.to Rep a Any
rep
      [ColumnInfo]
is -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"length mismatch: too many: actual: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([ColumnInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColumnInfo]
is)

class GFromRecord f where
  gFromRecord :: StringDecoder -> [ColumnInfo] -> AP.Parser (f p, [ColumnInfo])

-- | This means that @a@ can be encoded to a field.
class ToField a where
  -- | Encoder of a field.
  toField :: MonadFail m => BackendParameters -> StringEncoder -> Maybe Oid -> FormatCode -> a -> m (Maybe BS.ByteString)

-- | This means that @a@ can be encoded to a record.
class ToRecord a where
  -- | Encoder of a field.
  toRecord :: MonadFail m => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> a -> m [Maybe BS.ByteString]
  default toRecord :: (MonadFail m, Generic a, GToRecord (Rep a)) => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> a -> m [Maybe BS.ByteString]
  toRecord BackendParameters
backendParams StringEncoder
encode Maybe [Oid]
Nothing [FormatCode]
fs a
v = do
    ([Maybe ByteString]
record, Maybe [Oid]
os, [FormatCode]
fs') <- BackendParameters
-> StringEncoder
-> Maybe [Oid]
-> [FormatCode]
-> Rep a Any
-> m ([Maybe ByteString], Maybe [Oid], [FormatCode])
forall (f :: * -> *) (m :: * -> *) p.
(GToRecord f, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe [Oid]
-> [FormatCode]
-> f p
-> m ([Maybe ByteString], Maybe [Oid], [FormatCode])
gToRecord BackendParameters
backendParams StringEncoder
encode Maybe [Oid]
forall a. Maybe a
Nothing [FormatCode]
fs (Rep a Any -> m ([Maybe ByteString], Maybe [Oid], [FormatCode]))
-> Rep a Any -> m ([Maybe ByteString], Maybe [Oid], [FormatCode])
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
Generics.from a
v
    case (Maybe [Oid]
os, [FormatCode]
fs') of
      (Maybe [Oid]
Nothing, []) -> [Maybe ByteString] -> m [Maybe ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Maybe ByteString]
record
      (Maybe [Oid]
Nothing, [FormatCode]
_)  -> String -> m [Maybe ByteString]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"There are too many format codes"
      (Maybe [Oid]
_, [FormatCode]
_)        -> String -> m [Maybe ByteString]
forall a. HasCallStack => String -> a
error String
"can't reach here"
  toRecord BackendParameters
backendParams StringEncoder
encode Maybe [Oid]
os [FormatCode]
fs a
v = do
    ([Maybe ByteString]
record, Maybe [Oid]
os', [FormatCode]
fs') <- BackendParameters
-> StringEncoder
-> Maybe [Oid]
-> [FormatCode]
-> Rep a Any
-> m ([Maybe ByteString], Maybe [Oid], [FormatCode])
forall (f :: * -> *) (m :: * -> *) p.
(GToRecord f, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe [Oid]
-> [FormatCode]
-> f p
-> m ([Maybe ByteString], Maybe [Oid], [FormatCode])
gToRecord BackendParameters
backendParams StringEncoder
encode Maybe [Oid]
os [FormatCode]
fs (Rep a Any -> m ([Maybe ByteString], Maybe [Oid], [FormatCode]))
-> Rep a Any -> m ([Maybe ByteString], Maybe [Oid], [FormatCode])
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
Generics.from a
v
    case (Maybe [Oid]
os', [FormatCode]
fs') of
      (Just [], []) -> [Maybe ByteString] -> m [Maybe ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Maybe ByteString]
record
      (Just [Oid]
_, [])  -> String -> m [Maybe ByteString]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"There are too many OIDs"
      (Just [Oid]
_, [FormatCode]
_)   -> String -> m [Maybe ByteString]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"There are too many format codes"
      (Maybe [Oid]
_, [FormatCode]
_)        -> String -> m [Maybe ByteString]
forall a. HasCallStack => String -> a
error String
"can't reach here"

class GToRecord f where
  gToRecord :: (MonadFail m) => BackendParameters -> StringEncoder -> Maybe [Oid] -> [FormatCode] -> f p -> m ([Maybe BS.ByteString], Maybe [Oid], [FormatCode])

-- | Type of PostgreSQL @sql_identifier@ type.
newtype SqlIdentifier = SqlIdentifier BS.ByteString deriving (Int -> SqlIdentifier -> ShowS
[SqlIdentifier] -> ShowS
SqlIdentifier -> String
(Int -> SqlIdentifier -> ShowS)
-> (SqlIdentifier -> String)
-> ([SqlIdentifier] -> ShowS)
-> Show SqlIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqlIdentifier] -> ShowS
$cshowList :: [SqlIdentifier] -> ShowS
show :: SqlIdentifier -> String
$cshow :: SqlIdentifier -> String
showsPrec :: Int -> SqlIdentifier -> ShowS
$cshowsPrec :: Int -> SqlIdentifier -> ShowS
Show, ReadPrec [SqlIdentifier]
ReadPrec SqlIdentifier
Int -> ReadS SqlIdentifier
ReadS [SqlIdentifier]
(Int -> ReadS SqlIdentifier)
-> ReadS [SqlIdentifier]
-> ReadPrec SqlIdentifier
-> ReadPrec [SqlIdentifier]
-> Read SqlIdentifier
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SqlIdentifier]
$creadListPrec :: ReadPrec [SqlIdentifier]
readPrec :: ReadPrec SqlIdentifier
$creadPrec :: ReadPrec SqlIdentifier
readList :: ReadS [SqlIdentifier]
$creadList :: ReadS [SqlIdentifier]
readsPrec :: Int -> ReadS SqlIdentifier
$creadsPrec :: Int -> ReadS SqlIdentifier
Read, SqlIdentifier -> SqlIdentifier -> Bool
(SqlIdentifier -> SqlIdentifier -> Bool)
-> (SqlIdentifier -> SqlIdentifier -> Bool) -> Eq SqlIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqlIdentifier -> SqlIdentifier -> Bool
$c/= :: SqlIdentifier -> SqlIdentifier -> Bool
== :: SqlIdentifier -> SqlIdentifier -> Bool
$c== :: SqlIdentifier -> SqlIdentifier -> Bool
Eq)

data TimeOfDayWithTimeZone = TimeOfDayWithTimeZone { TimeOfDayWithTimeZone -> TimeOfDay
timeOfDay :: TimeOfDay, TimeOfDayWithTimeZone -> TimeZone
timeZone :: TimeZone } deriving (Int -> TimeOfDayWithTimeZone -> ShowS
[TimeOfDayWithTimeZone] -> ShowS
TimeOfDayWithTimeZone -> String
(Int -> TimeOfDayWithTimeZone -> ShowS)
-> (TimeOfDayWithTimeZone -> String)
-> ([TimeOfDayWithTimeZone] -> ShowS)
-> Show TimeOfDayWithTimeZone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeOfDayWithTimeZone] -> ShowS
$cshowList :: [TimeOfDayWithTimeZone] -> ShowS
show :: TimeOfDayWithTimeZone -> String
$cshow :: TimeOfDayWithTimeZone -> String
showsPrec :: Int -> TimeOfDayWithTimeZone -> ShowS
$cshowsPrec :: Int -> TimeOfDayWithTimeZone -> ShowS
Show, ReadPrec [TimeOfDayWithTimeZone]
ReadPrec TimeOfDayWithTimeZone
Int -> ReadS TimeOfDayWithTimeZone
ReadS [TimeOfDayWithTimeZone]
(Int -> ReadS TimeOfDayWithTimeZone)
-> ReadS [TimeOfDayWithTimeZone]
-> ReadPrec TimeOfDayWithTimeZone
-> ReadPrec [TimeOfDayWithTimeZone]
-> Read TimeOfDayWithTimeZone
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TimeOfDayWithTimeZone]
$creadListPrec :: ReadPrec [TimeOfDayWithTimeZone]
readPrec :: ReadPrec TimeOfDayWithTimeZone
$creadPrec :: ReadPrec TimeOfDayWithTimeZone
readList :: ReadS [TimeOfDayWithTimeZone]
$creadList :: ReadS [TimeOfDayWithTimeZone]
readsPrec :: Int -> ReadS TimeOfDayWithTimeZone
$creadsPrec :: Int -> ReadS TimeOfDayWithTimeZone
Read, TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
(TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool)
-> (TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool)
-> Eq TimeOfDayWithTimeZone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
$c/= :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
== :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
$c== :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
Eq, Eq TimeOfDayWithTimeZone
Eq TimeOfDayWithTimeZone
-> (TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Ordering)
-> (TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool)
-> (TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool)
-> (TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool)
-> (TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool)
-> (TimeOfDayWithTimeZone
    -> TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone)
-> (TimeOfDayWithTimeZone
    -> TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone)
-> Ord TimeOfDayWithTimeZone
TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Ordering
TimeOfDayWithTimeZone
-> TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone
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
min :: TimeOfDayWithTimeZone
-> TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone
$cmin :: TimeOfDayWithTimeZone
-> TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone
max :: TimeOfDayWithTimeZone
-> TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone
$cmax :: TimeOfDayWithTimeZone
-> TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone
>= :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
$c>= :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
> :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
$c> :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
<= :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
$c<= :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
< :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
$c< :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Bool
compare :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Ordering
$ccompare :: TimeOfDayWithTimeZone -> TimeOfDayWithTimeZone -> Ordering
$cp1Ord :: Eq TimeOfDayWithTimeZone
Ord, (forall x. TimeOfDayWithTimeZone -> Rep TimeOfDayWithTimeZone x)
-> (forall x. Rep TimeOfDayWithTimeZone x -> TimeOfDayWithTimeZone)
-> Generic TimeOfDayWithTimeZone
forall x. Rep TimeOfDayWithTimeZone x -> TimeOfDayWithTimeZone
forall x. TimeOfDayWithTimeZone -> Rep TimeOfDayWithTimeZone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeOfDayWithTimeZone x -> TimeOfDayWithTimeZone
$cfrom :: forall x. TimeOfDayWithTimeZone -> Rep TimeOfDayWithTimeZone x
Generic)

instance NFData TimeOfDayWithTimeZone

class Pretty a where
  pretty :: a -> String

instance Pretty Response where
  pretty :: Response -> String
pretty (AuthenticationResponse AuthenticationResponse
r)       = AuthenticationResponse -> String
forall a. Pretty a => a -> String
pretty AuthenticationResponse
r
  pretty (CommandCompleteResponse CommandComplete
r)      = CommandComplete -> String
forall a. Pretty a => a -> String
pretty CommandComplete
r
  pretty (DataRowResponse DataRowRaw
r)              = DataRowRaw -> String
forall a. Pretty a => a -> String
pretty DataRowRaw
r
  pretty (ErrorResponse Error
r)                = Error -> String
forall a. Pretty a => a -> String
pretty Error
r
  pretty (NoticeResponse Notice
r)               = Notice -> String
forall a. Pretty a => a -> String
pretty Notice
r
  pretty (ParameterStatusResponse ParameterStatus
r)      = ParameterStatus -> String
forall a. Pretty a => a -> String
pretty ParameterStatus
r
  pretty (BackendKeyDataResponse BackendKeyData
r)       = BackendKeyData -> String
forall a. Pretty a => a -> String
pretty BackendKeyData
r
  pretty (ReadyForQueryResponse ReadyForQuery
r)        = ReadyForQuery -> String
forall a. Pretty a => a -> String
pretty ReadyForQuery
r
  pretty (RowDescriptionResponse RowDescription
r)       = RowDescription -> String
forall a. Pretty a => a -> String
pretty RowDescription
r
  pretty Response
ParseCompleteResponse            = String
"parse complete"
  pretty Response
BindCompleteResponse             = String
"bind complete"
  pretty (ParameterDescriptionResponse ParameterDescription
r) = ParameterDescription -> String
forall a. Pretty a => a -> String
pretty ParameterDescription
r
  pretty Response
EmptyQueryResponse               = String
"empty query"
  pretty Response
NoDataResponse                   = String
"no data"
  pretty (DebugResponse Debug
r)                = Debug -> String
forall a. Pretty a => a -> String
pretty Debug
r

instance Pretty AuthenticationResponse where
  pretty :: AuthenticationResponse -> String
pretty AuthenticationResponse
AuthenticationOkResponse                = String
"authentication ok"
  pretty AuthenticationResponse
AuthenticationCleartextPasswordResponse = String
"authentication using cleartext"
  pretty (AuthenticationMD5PasswordResponse AuthenticationMD5Password
r)   = AuthenticationMD5Password -> String
forall a. Pretty a => a -> String
pretty AuthenticationMD5Password
r

instance Pretty AuthenticationMD5Password where
  pretty :: AuthenticationMD5Password -> String
pretty (AuthenticationMD5Password ByteString
salt) = String
"authentication MD5 password:\n\tsalt: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
simpleHex ByteString
salt

instance Pretty CommandComplete where
  pretty :: CommandComplete -> String
pretty (CommandComplete (InsertTag Oid
oid Int
rows)) = String
"command complete:\n\ttag: insert \n\t\toid: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Oid -> String
forall a. Show a => a -> String
show Oid
oid String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\t\trows: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
rows
  pretty (CommandComplete (DeleteTag Int
rows)) = String
"command complete:\n\ttag: delete\n\t\trows: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
rows
  pretty (CommandComplete (UpdateTag Int
rows)) = String
"command complete:\n\ttag: update\n\t\trows: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
rows
  pretty (CommandComplete (SelectTag Int
rows)) = String
"command complete:\n\ttag: select\n\t\trows: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
rows
  pretty (CommandComplete (MoveTag Int
rows)) = String
"command complete:\n\ttag: move\n\t\trows: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
rows
  pretty (CommandComplete (FetchTag Int
rows)) = String
"command complete:\n\ttag: fetch\n\t\trows: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
rows
  pretty (CommandComplete (CopyTag Int
rows)) = String
"command complete:\n\ttag: copy\n\t\trows: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
rows
  pretty (CommandComplete CommandTag
CreateTableTag) = String
"command complete:\n\ttag: create table"
  pretty (CommandComplete CommandTag
DropTableTag) = String
"command complete:\n\ttag: drop table"
  pretty (CommandComplete CommandTag
BeginTag) = String
"command complete:\n\ttag: begin"
  pretty (CommandComplete CommandTag
CommitTag) = String
"command complete:\n\ttag: commit"
  pretty (CommandComplete CommandTag
RollbackTag) = String
"command complete:\n\ttag: rollback"
  pretty (CommandComplete CommandTag
SetTag) = String
"command complete:\n\ttag: set"

instance Show r => Pretty (DataRow r) where
  pretty :: DataRow r -> String
pretty (DataRow r
record) = String
"data:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> r -> String
forall a. Show a => a -> String
show r
record

instance Pretty DataRowRaw where
  pretty :: DataRowRaw -> String
pretty (DataRowRaw [Raw]
values) =
    String
"data:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ((Int, Raw) -> String
forall a a. (Show a, Pretty a) => (a, a) -> String
go ((Int, Raw) -> String) -> [(Int, Raw)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Raw] -> [(Int, Raw)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Raw]
values)
    where
      go :: (a, a) -> String
go (a
idx, a
v) = String
"\t" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
idx String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Pretty a => a -> String
pretty a
v

instance Pretty Error where
  pretty :: Error -> String
pretty (Error ErrorFields
fields) = String
"error response:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
indent (ErrorFields -> String
forall a. Pretty a => a -> String
pretty ErrorFields
fields)

instance Pretty Notice where
  pretty :: Notice -> String
pretty (Notice ErrorFields
fields) = String
"notice response:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
indent (ErrorFields -> String
forall a. Pretty a => a -> String
pretty ErrorFields
fields)

instance Pretty ErrorFields where
  pretty :: ErrorFields -> String
pretty (ErrorFields [(Char, ShortByteString)]
errs) =
    let
      lookups :: [(Char, ShortByteString)]
-> (ShortByteString, ShortByteString, ShortByteString)
lookups = ((Char, ShortByteString)
 -> (ShortByteString, ShortByteString, ShortByteString)
 -> (ShortByteString, ShortByteString, ShortByteString))
-> (ShortByteString, ShortByteString, ShortByteString)
-> [(Char, ShortByteString)]
-> (ShortByteString, ShortByteString, ShortByteString)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Char, ShortByteString)
-> (ShortByteString, ShortByteString, ShortByteString)
-> (ShortByteString, ShortByteString, ShortByteString)
forall c. (Char, c) -> (c, c, c) -> (c, c, c)
go (ShortByteString
"", ShortByteString
"", ShortByteString
"") :: [(Char, BSS.ShortByteString)] -> (BSS.ShortByteString, BSS.ShortByteString, BSS.ShortByteString)
      go :: (Char, c) -> (c, c, c) -> (c, c, c)
go (Char
'S', c
largeS') (c
_, c
largeC', c
largeM') = (c
largeS', c
largeC', c
largeM')
      go (Char
'C', c
largeC') (c
largeS', c
_, c
largeM') = (c
largeS', c
largeC', c
largeM')
      go (Char
'M', c
largeM') (c
largeS', c
largeC', c
_) = (c
largeS', c
largeC', c
largeM')
      go (Char, c)
_ (c, c, c)
a                                  = (c, c, c)
a
      (ShortByteString
largeS, ShortByteString
largeC, ShortByteString
largeM) = [(Char, ShortByteString)]
-> (ShortByteString, ShortByteString, ShortByteString)
lookups [(Char, ShortByteString)]
errs
      pp :: (Char, ShortByteString) -> String
pp (Char
code, ShortByteString
message) = Char
code Char -> ShowS
forall a. a -> [a] -> [a]
: String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> String
shortByteStringToString ShortByteString
message
    in
      ShortByteString -> String
shortByteStringToString (ShortByteString
largeS ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> ShortByteString
" (" ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> ShortByteString
largeC ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> ShortByteString
"): " ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> ShortByteString
largeM) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ((Char, ShortByteString) -> String
pp ((Char, ShortByteString) -> String)
-> [(Char, ShortByteString)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Char, ShortByteString)]
errs))

instance Pretty TransactionState where
  pretty :: TransactionState -> String
pretty TransactionState
Idle   = String
"idle"
  pretty TransactionState
Block  = String
"block"
  pretty TransactionState
Failed = String
"failed"

instance Pretty ParameterStatus where
  pretty :: ParameterStatus -> String
pretty (ParameterStatus ShortByteString
key ShortByteString
value) = String
"parameter:\n\t" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> String
shortByteStringToString ShortByteString
key String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> String
shortByteStringToString ShortByteString
value

instance Pretty BackendKeyData where
  pretty :: BackendKeyData -> String
pretty (BackendKeyData Pid
pid Pid
bk) = String
"cancellation key:\n\tpid: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pid -> String
forall a. Show a => a -> String
show Pid
pid String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\tbackend key: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pid -> String
forall a. Show a => a -> String
show Pid
bk

instance Pretty ReadyForQuery where
  pretty :: ReadyForQuery -> String
pretty (ReadyForQuery TransactionState
ts) = String
"ready for query:\n\ttransaction state: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransactionState -> String
forall a. Show a => a -> String
show TransactionState
ts)

instance Pretty RowDescription where
  -- This uses decoder of UTF-8 although this should read client_encoding parameter, because this is used for debugging.
  pretty :: RowDescription -> String
pretty (RowDescription [ColumnInfo]
infos) =
    String
"row description:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (ColumnInfo -> String
go (ColumnInfo -> String) -> [ColumnInfo] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColumnInfo]
infos)
    where
      go :: ColumnInfo -> String
go (ColumnInfo ByteString
name Oid
tableOid AttributeNumber
attrNum Oid
typeOid TypeLength
len Pid
typeMod FormatCode
format) =
        String
"\t" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BSU.toString ByteString
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\t\ttable object ID: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Oid -> String
forall a. Show a => a -> String
show Oid
tableOid
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\t\tcolumn attribute number: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> AttributeNumber -> String
forall a. Show a => a -> String
show AttributeNumber
attrNum
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\t\tdata type object ID: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Oid -> String
forall a. Show a => a -> String
show Oid
typeOid
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\t\tdata type length: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeLength -> String
forall a. Pretty a => a -> String
pretty TypeLength
len
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\t\ttype modifier: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pid -> String
forall a. Show a => a -> String
show Pid
typeMod
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n\t\tformat: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FormatCode -> String
forall a. Pretty a => a -> String
pretty FormatCode
format

instance Pretty ParameterDescription where
  pretty :: ParameterDescription -> String
pretty (ParameterDescription [Oid]
oids) =
    String
"parameter description: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Oid] -> String
forall a. Show a => a -> String
show [Oid]
oids

instance Pretty Debug where
  pretty :: Debug -> String
pretty (Debug ByteString
bs) = String
"Debug:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
prettyHex ByteString
bs

instance Pretty TypeLength where
  pretty :: TypeLength -> String
pretty TypeLength
VariableLength  = String
"variable"
  pretty (FixedLength AttributeNumber
l) = AttributeNumber -> String
forall a. Show a => a -> String
show AttributeNumber
l

instance Pretty FormatCode where
  pretty :: FormatCode -> String
pretty FormatCode
TextFormat   = String
"text"
  pretty FormatCode
BinaryFormat = String
"binary"

instance Pretty Raw where
  pretty :: Raw -> String
pretty Raw
Null      = String
"NULL"
  pretty (Value ByteString
r) = String
"Value [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
simpleHex ByteString
r String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"] " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show (ByteString -> String
printableString ByteString
r)

-- This uses decoder of UTF-8 although this should read client_encoding parameter, because this is used for debugging.
printableString :: BS.ByteString -> String
printableString :: ByteString -> String
printableString ByteString
bytes =
  let
    replacePrintable :: Char -> Char
replacePrintable Char
c
      | Char -> Bool
isPrint Char
c = Char
c
      | Bool
otherwise = Char
'.'
  in
    Char -> Char
replacePrintable (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> String
BSU.toString ByteString
bytes

shortByteStringToString :: BSS.ShortByteString -> String
shortByteStringToString :: ShortByteString -> String
shortByteStringToString = ((Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word8 -> Char) -> [Word8] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Word8] -> String)
-> (ShortByteString -> [Word8]) -> ShortByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word8]
BSS.unpack

indent :: String -> String
indent :: ShowS
indent = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char
'\t' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines