{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- These warnings are raised, although constraints are necessary.
{-# OPTIONS_GHC -Wno-unused-top-binds #-} -- These warnings are raised, although "builder", "parser" fields are necessary for IsLabel instances.

-- |
-- This is a client library for PostgreSQL Database which has following features.
--
--     - faster and less CPU load
--
--         - especially on multi-core environments
--
--     - pure Haskell implementations
--
--         - no libpq dependency
--         - easy to build even on Windows
--
--     - implements extended query protocol
--
--         - about extended query protocol, see <https://www.postgresql.org/docs/current/protocol-flow.html#PROTOCOL-FLOW-EXT-QUERY>
--
-- = Typical Example
--
-- Prepare a following table.
--
-- @
-- CREATE TABLE person (
--   id serial PRIMARY KEY,
--   name varchar(255) NOT NULL
-- );
-- INSERT INTO person (name) VALUES (\'Ada\');
-- @
--
-- You can run like following to get the record whose ID is 1.
--
-- >>> :set -XOverloadedStrings
-- >>> :set -XFlexibleContexts
-- >>> :set -XDataKinds
-- >>> :set -XTypeFamilies
-- >>> :set -XTypeApplications
-- >>>
-- >>> import Database.PostgreSQL.Pure
-- >>> import Data.Default.Class (def)
-- >>> import Data.Int (Int32)
-- >>> import Data.ByteString (ByteString)
-- >>> import Data.Tuple.Only (Only (Only))
-- >>> import Data.Tuple.Homotuple.Only ()
-- >>> import Data.Maybe (fromMaybe)
-- >>> import System.Environment (lookupEnv)
-- >>>
-- >>> getEnvDef name value = fromMaybe value <$> lookupEnv name
-- >>>
-- >>> host' <- getEnvDef "PURE_HOST" "127.0.0.1"
-- >>> port' <- getEnvDef "PURE_PORT" "5432"
-- >>> user' <- getEnvDef "PURE_USER" "postgres"
-- >>> password' <- getEnvDef "PURE_PASSWORD" ""
-- >>> database' <- getEnvDef "PURE_DATABASE" "postgres"
-- >>>
-- >>> conn <- connect def { address = AddressNotResolved host' port', user = user', password = password', database = database' }
-- >>> preparedStatementProcedure = parse "" "SELECT id, name FROM person WHERE id = $1" Nothing
-- >>> portalProcedure <- bind @_ @2 @_ @_ "" BinaryFormat BinaryFormat (parameters conn) (const $ fail "") (Only (1 :: Int32)) preparedStatementProcedure
-- >>> executedProcedure = execute @_ @_ @(Int32, ByteString) 0 (const $ fail "") portalProcedure
-- >>> ((_, _, e, _), _) <- sync conn executedProcedure
-- >>> records e
-- [(1,"Ada")]
module Database.PostgreSQL.Pure
  ( -- * Connection
    Config (..)
  , Connection
  , pid
  , parameters
  , config
  , Address (..)
  , BackendParameters
  , Pid
  , withConnection
  , connect
  , disconnect
    -- * Extended Query
  , parse
  , bind
  , execute
  , flush
  , sync
  , close
  , PreparedStatement
  , PreparedStatementProcedure
  , PreparedStatementName (..)
  , Portal
  , PortalProcedure
  , PortalName (..)
  , Executed
  , ExecutedProcedure
  , ExecuteResult (..)
  , CloseProcedure
  , CommandTag (..)
  , Query (..)
  , FormatCode (..)
  , ColumnInfo
  , Message
  , MessageResult
  , Bind
  , Execute
  , Close
  , StringEncoder
  , StringDecoder
  , HasName
  , Name
  , HasParameterOids
  , name
  , parameterOids
  , resultInfos
  , result
  , records
    -- * Transaction
  , begin
  , commit
  , rollback
  , TransactionState (..)
    -- * Record
  , FromField (..)
  , FromRecord (..)
  , ToField (..)
  , ToRecord (..)
  , Raw (..)
  , SqlIdentifier (..)
  , TimeOfDayWithTimeZone (..)
  , Length
    -- * Exception
  , Exception.Exception (..)
  , Exception.ErrorResponse (..)
  , Exception.ResponseParsingFailed (..)
    -- * OID
  , Oid
  ) where

import           Database.PostgreSQL.Pure.Internal.Connection (connect, disconnect, withConnection)
import           Database.PostgreSQL.Pure.Internal.Data       (Address (AddressNotResolved, AddressResolved),
                                                               BackendParameters, CloseProcedure, ColumnInfo,
                                                               CommandTag (BeginTag, CommitTag, CopyTag, CreateTableTag, DeleteTag, DropTableTag, FetchTag, InsertTag, MoveTag, RollbackTag, SelectTag, UpdateTag),
                                                               Config (Config, address, database, password, receptionBufferSize, sendingBufferSize, user),
                                                               Connection (config, parameters, pid), ErrorFields,
                                                               ExecuteResult (ExecuteComplete, ExecuteEmptyQuery, ExecuteSuspended),
                                                               FormatCode (BinaryFormat, TextFormat),
                                                               FromField (fromField), FromRecord (fromRecord),
                                                               MessageResult, Oid, Pid, PortalName (PortalName),
                                                               PreparedStatementName (PreparedStatementName),
                                                               Query (Query), Raw (Null, Value),
                                                               SqlIdentifier (SqlIdentifier), StringDecoder,
                                                               StringEncoder,
                                                               TimeOfDayWithTimeZone (TimeOfDayWithTimeZone, timeOfDay, timeZone),
                                                               ToField (toField), ToRecord (toRecord), TransactionState)
import qualified Database.PostgreSQL.Pure.Internal.Data       as Data
import qualified Database.PostgreSQL.Pure.Internal.Exception  as Exception
import           Database.PostgreSQL.Pure.Internal.Length     (Length)
import           Database.PostgreSQL.Pure.Internal.Query      (Close, Message, close, flush, sync)
import qualified Database.PostgreSQL.Pure.Internal.Query      as Query

import           Data.Bifunctor                               (bimap)
import           Data.Kind                                    (Type)
import           Data.Proxy                                   (Proxy (Proxy))
import           Data.Tuple.Homotuple                         (Homotuple)
import qualified Data.Tuple.List                              as Tuple
import           GHC.Exts                                     (IsList (Item, fromList, toList))
import           GHC.Records                                  (HasField (getField))
import           GHC.TypeLits                                 (KnownNat, Nat, natVal)

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

-- | This represents a prepared statement which is already processed by a server.
--
-- @parameterLength@ is the number of columns of the parameter and @resultLength@ is the number of columns of the results.
-- This is the same with 'PreparedStatementProcedure', 'Portal', 'PortalProcedure', 'Executed' and 'ExecutedProcedure'.
newtype PreparedStatement (parameterLength :: Nat) (resultLength :: Nat) =
  PreparedStatement Data.PreparedStatement
  deriving newtype (Int -> PreparedStatement parameterLength resultLength -> ShowS
[PreparedStatement parameterLength resultLength] -> ShowS
PreparedStatement parameterLength resultLength -> String
(Int -> PreparedStatement parameterLength resultLength -> ShowS)
-> (PreparedStatement parameterLength resultLength -> String)
-> ([PreparedStatement parameterLength resultLength] -> ShowS)
-> Show (PreparedStatement parameterLength resultLength)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (parameterLength :: Nat) (resultLength :: Nat).
Int -> PreparedStatement parameterLength resultLength -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat).
[PreparedStatement parameterLength resultLength] -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatement parameterLength resultLength -> String
showList :: [PreparedStatement parameterLength resultLength] -> ShowS
$cshowList :: forall (parameterLength :: Nat) (resultLength :: Nat).
[PreparedStatement parameterLength resultLength] -> ShowS
show :: PreparedStatement parameterLength resultLength -> String
$cshow :: forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatement parameterLength resultLength -> String
showsPrec :: Int -> PreparedStatement parameterLength resultLength -> ShowS
$cshowsPrec :: forall (parameterLength :: Nat) (resultLength :: Nat).
Int -> PreparedStatement parameterLength resultLength -> ShowS
Show, PreparedStatement parameterLength resultLength
-> PreparedStatement parameterLength resultLength -> Bool
(PreparedStatement parameterLength resultLength
 -> PreparedStatement parameterLength resultLength -> Bool)
-> (PreparedStatement parameterLength resultLength
    -> PreparedStatement parameterLength resultLength -> Bool)
-> Eq (PreparedStatement parameterLength resultLength)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatement parameterLength resultLength
-> PreparedStatement parameterLength resultLength -> Bool
/= :: PreparedStatement parameterLength resultLength
-> PreparedStatement parameterLength resultLength -> Bool
$c/= :: forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatement parameterLength resultLength
-> PreparedStatement parameterLength resultLength -> Bool
== :: PreparedStatement parameterLength resultLength
-> PreparedStatement parameterLength resultLength -> Bool
$c== :: forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatement parameterLength resultLength
-> PreparedStatement parameterLength resultLength -> Bool
Eq, PreparedStatement parameterLength resultLength -> CloseProcedure
(PreparedStatement parameterLength resultLength -> CloseProcedure)
-> Close (PreparedStatement parameterLength resultLength)
forall p. (p -> CloseProcedure) -> Close p
forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatement parameterLength resultLength -> CloseProcedure
close :: PreparedStatement parameterLength resultLength -> CloseProcedure
$cclose :: forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatement parameterLength resultLength -> CloseProcedure
Close)

instance HasField "name" (PreparedStatement n m) PreparedStatementName where
  getField :: PreparedStatement n m -> PreparedStatementName
getField (PreparedStatement Data.PreparedStatement { PreparedStatementName
$sel:name:PreparedStatement :: PreparedStatement -> PreparedStatementName
name :: PreparedStatementName
name }) = PreparedStatementName
name

instance (oids ~ Homotuple n Oid, Item oids ~ Oid, IsList oids) => HasField "parameterOids" (PreparedStatement n m) oids where
  getField :: PreparedStatement n m -> oids
getField (PreparedStatement Data.PreparedStatement { [Oid]
$sel:parameterOids:PreparedStatement :: PreparedStatement -> [Oid]
parameterOids :: [Oid]
parameterOids }) = [Item oids] -> oids
forall l. IsList l => [Item l] -> l
fromList [Item oids]
[Oid]
parameterOids

-- | To get a list of column infos of the result record.
resultInfos :: (IsList (Homotuple m ColumnInfo), ColumnInfo ~ Item (Homotuple m ColumnInfo)) => PreparedStatement n m -> Homotuple m ColumnInfo
resultInfos :: PreparedStatement n m -> Homotuple m ColumnInfo
resultInfos (PreparedStatement Data.PreparedStatement { [ColumnInfo]
$sel:resultInfos:PreparedStatement :: PreparedStatement -> [ColumnInfo]
resultInfos :: [ColumnInfo]
resultInfos }) = [Item (Homotuple m ColumnInfo)] -> Homotuple m ColumnInfo
forall l. IsList l => [Item l] -> l
fromList [Item (Homotuple m ColumnInfo)]
[ColumnInfo]
resultInfos

-- | This represents a prepared statement which is not yet processed by a server.
newtype PreparedStatementProcedure (parameterLength :: Nat) (resultLength :: Nat) =
  PreparedStatementProcedure Data.PreparedStatementProcedure
  deriving newtype (Int
-> PreparedStatementProcedure parameterLength resultLength -> ShowS
[PreparedStatementProcedure parameterLength resultLength] -> ShowS
PreparedStatementProcedure parameterLength resultLength -> String
(Int
 -> PreparedStatementProcedure parameterLength resultLength
 -> ShowS)
-> (PreparedStatementProcedure parameterLength resultLength
    -> String)
-> ([PreparedStatementProcedure parameterLength resultLength]
    -> ShowS)
-> Show (PreparedStatementProcedure parameterLength resultLength)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (parameterLength :: Nat) (resultLength :: Nat).
Int
-> PreparedStatementProcedure parameterLength resultLength -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat).
[PreparedStatementProcedure parameterLength resultLength] -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatementProcedure parameterLength resultLength -> String
showList :: [PreparedStatementProcedure parameterLength resultLength] -> ShowS
$cshowList :: forall (parameterLength :: Nat) (resultLength :: Nat).
[PreparedStatementProcedure parameterLength resultLength] -> ShowS
show :: PreparedStatementProcedure parameterLength resultLength -> String
$cshow :: forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatementProcedure parameterLength resultLength -> String
showsPrec :: Int
-> PreparedStatementProcedure parameterLength resultLength -> ShowS
$cshowsPrec :: forall (parameterLength :: Nat) (resultLength :: Nat).
Int
-> PreparedStatementProcedure parameterLength resultLength -> ShowS
Show, PreparedStatementProcedure parameterLength resultLength -> Builder
PreparedStatementProcedure parameterLength resultLength
-> Parser
     (MessageResult
        (PreparedStatementProcedure parameterLength resultLength))
(PreparedStatementProcedure parameterLength resultLength
 -> Builder)
-> (PreparedStatementProcedure parameterLength resultLength
    -> Parser
         (MessageResult
            (PreparedStatementProcedure parameterLength resultLength)))
-> Message
     (PreparedStatementProcedure parameterLength resultLength)
forall m.
(m -> Builder) -> (m -> Parser (MessageResult m)) -> Message m
forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatementProcedure parameterLength resultLength -> Builder
forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatementProcedure parameterLength resultLength
-> Parser
     (MessageResult
        (PreparedStatementProcedure parameterLength resultLength))
parser :: PreparedStatementProcedure parameterLength resultLength
-> Parser
     (MessageResult
        (PreparedStatementProcedure parameterLength resultLength))
$cparser :: forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatementProcedure parameterLength resultLength
-> Parser
     (MessageResult
        (PreparedStatementProcedure parameterLength resultLength))
builder :: PreparedStatementProcedure parameterLength resultLength -> Builder
$cbuilder :: forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatementProcedure parameterLength resultLength -> Builder
Message)

instance HasField "name" (PreparedStatementProcedure n m) PreparedStatementName where
  getField :: PreparedStatementProcedure n m -> PreparedStatementName
getField (PreparedStatementProcedure Data.PreparedStatementProcedure { PreparedStatementName
$sel:name:PreparedStatementProcedure :: PreparedStatementProcedure -> PreparedStatementName
name :: PreparedStatementName
name }) = PreparedStatementName
name

instance (oids ~ Homotuple n Oid, Item oids ~ Oid, IsList oids) => HasField "parameterOids" (PreparedStatementProcedure n m) (Maybe oids) where
  getField :: PreparedStatementProcedure n m -> Maybe oids
getField (PreparedStatementProcedure Data.PreparedStatementProcedure { Maybe [Oid]
$sel:parameterOids:PreparedStatementProcedure :: PreparedStatementProcedure -> Maybe [Oid]
parameterOids :: Maybe [Oid]
parameterOids }) = [Oid] -> oids
forall l. IsList l => [Item l] -> l
fromList ([Oid] -> oids) -> Maybe [Oid] -> Maybe oids
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Oid]
parameterOids

type instance MessageResult (PreparedStatementProcedure n m) = (PreparedStatement n m)

-- | This represents a portal which is already processed by a server.
newtype Portal (parameterLength :: Nat) (resultLength :: Nat) =
  Portal Data.Portal
  deriving newtype (Int -> Portal parameterLength resultLength -> ShowS
[Portal parameterLength resultLength] -> ShowS
Portal parameterLength resultLength -> String
(Int -> Portal parameterLength resultLength -> ShowS)
-> (Portal parameterLength resultLength -> String)
-> ([Portal parameterLength resultLength] -> ShowS)
-> Show (Portal parameterLength resultLength)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (parameterLength :: Nat) (resultLength :: Nat).
Int -> Portal parameterLength resultLength -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat).
[Portal parameterLength resultLength] -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat).
Portal parameterLength resultLength -> String
showList :: [Portal parameterLength resultLength] -> ShowS
$cshowList :: forall (parameterLength :: Nat) (resultLength :: Nat).
[Portal parameterLength resultLength] -> ShowS
show :: Portal parameterLength resultLength -> String
$cshow :: forall (parameterLength :: Nat) (resultLength :: Nat).
Portal parameterLength resultLength -> String
showsPrec :: Int -> Portal parameterLength resultLength -> ShowS
$cshowsPrec :: forall (parameterLength :: Nat) (resultLength :: Nat).
Int -> Portal parameterLength resultLength -> ShowS
Show, Portal parameterLength resultLength
-> Portal parameterLength resultLength -> Bool
(Portal parameterLength resultLength
 -> Portal parameterLength resultLength -> Bool)
-> (Portal parameterLength resultLength
    -> Portal parameterLength resultLength -> Bool)
-> Eq (Portal parameterLength resultLength)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (parameterLength :: Nat) (resultLength :: Nat).
Portal parameterLength resultLength
-> Portal parameterLength resultLength -> Bool
/= :: Portal parameterLength resultLength
-> Portal parameterLength resultLength -> Bool
$c/= :: forall (parameterLength :: Nat) (resultLength :: Nat).
Portal parameterLength resultLength
-> Portal parameterLength resultLength -> Bool
== :: Portal parameterLength resultLength
-> Portal parameterLength resultLength -> Bool
$c== :: forall (parameterLength :: Nat) (resultLength :: Nat).
Portal parameterLength resultLength
-> Portal parameterLength resultLength -> Bool
Eq, Portal parameterLength resultLength -> CloseProcedure
(Portal parameterLength resultLength -> CloseProcedure)
-> Close (Portal parameterLength resultLength)
forall p. (p -> CloseProcedure) -> Close p
forall (parameterLength :: Nat) (resultLength :: Nat).
Portal parameterLength resultLength -> CloseProcedure
close :: Portal parameterLength resultLength -> CloseProcedure
$cclose :: forall (parameterLength :: Nat) (resultLength :: Nat).
Portal parameterLength resultLength -> CloseProcedure
Close)

instance HasField "name" (Portal n m) PortalName where
  getField :: Portal n m -> PortalName
getField (Portal Data.Portal { PortalName
$sel:name:Portal :: Portal -> PortalName
name :: PortalName
name }) = PortalName
name

-- | This represents a portal which is not yet processed by a server.
newtype PortalProcedure (parameterLength :: Nat) (resultLength :: Nat) =
  PortalProcedure Data.PortalProcedure
  deriving newtype (Int -> PortalProcedure parameterLength resultLength -> ShowS
[PortalProcedure parameterLength resultLength] -> ShowS
PortalProcedure parameterLength resultLength -> String
(Int -> PortalProcedure parameterLength resultLength -> ShowS)
-> (PortalProcedure parameterLength resultLength -> String)
-> ([PortalProcedure parameterLength resultLength] -> ShowS)
-> Show (PortalProcedure parameterLength resultLength)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (parameterLength :: Nat) (resultLength :: Nat).
Int -> PortalProcedure parameterLength resultLength -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat).
[PortalProcedure parameterLength resultLength] -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat).
PortalProcedure parameterLength resultLength -> String
showList :: [PortalProcedure parameterLength resultLength] -> ShowS
$cshowList :: forall (parameterLength :: Nat) (resultLength :: Nat).
[PortalProcedure parameterLength resultLength] -> ShowS
show :: PortalProcedure parameterLength resultLength -> String
$cshow :: forall (parameterLength :: Nat) (resultLength :: Nat).
PortalProcedure parameterLength resultLength -> String
showsPrec :: Int -> PortalProcedure parameterLength resultLength -> ShowS
$cshowsPrec :: forall (parameterLength :: Nat) (resultLength :: Nat).
Int -> PortalProcedure parameterLength resultLength -> ShowS
Show, PortalProcedure parameterLength resultLength -> Builder
PortalProcedure parameterLength resultLength
-> Parser
     (MessageResult (PortalProcedure parameterLength resultLength))
(PortalProcedure parameterLength resultLength -> Builder)
-> (PortalProcedure parameterLength resultLength
    -> Parser
         (MessageResult (PortalProcedure parameterLength resultLength)))
-> Message (PortalProcedure parameterLength resultLength)
forall m.
(m -> Builder) -> (m -> Parser (MessageResult m)) -> Message m
forall (parameterLength :: Nat) (resultLength :: Nat).
PortalProcedure parameterLength resultLength -> Builder
forall (parameterLength :: Nat) (resultLength :: Nat).
PortalProcedure parameterLength resultLength
-> Parser
     (MessageResult (PortalProcedure parameterLength resultLength))
parser :: PortalProcedure parameterLength resultLength
-> Parser
     (MessageResult (PortalProcedure parameterLength resultLength))
$cparser :: forall (parameterLength :: Nat) (resultLength :: Nat).
PortalProcedure parameterLength resultLength
-> Parser
     (MessageResult (PortalProcedure parameterLength resultLength))
builder :: PortalProcedure parameterLength resultLength -> Builder
$cbuilder :: forall (parameterLength :: Nat) (resultLength :: Nat).
PortalProcedure parameterLength resultLength -> Builder
Message)

instance HasField "name" (PortalProcedure n m) PortalName where
  getField :: PortalProcedure n m -> PortalName
getField (PortalProcedure Data.PortalProcedure { PortalName
$sel:name:PortalProcedure :: PortalProcedure -> PortalName
name :: PortalName
name }) = PortalName
name

type instance MessageResult (PortalProcedure n m) = (PreparedStatement n m, Portal n m)

-- | This represents a result of a "Execute" message which is already processed by a server.
newtype Executed (parameterLength :: Nat) (resultLength :: Nat) r =
  Executed (Data.Executed r)
  deriving newtype (Int -> Executed parameterLength resultLength r -> ShowS
[Executed parameterLength resultLength r] -> ShowS
Executed parameterLength resultLength r -> String
(Int -> Executed parameterLength resultLength r -> ShowS)
-> (Executed parameterLength resultLength r -> String)
-> ([Executed parameterLength resultLength r] -> ShowS)
-> Show (Executed parameterLength resultLength r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (parameterLength :: Nat) (resultLength :: Nat) r.
Show r =>
Int -> Executed parameterLength resultLength r -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat) r.
Show r =>
[Executed parameterLength resultLength r] -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat) r.
Show r =>
Executed parameterLength resultLength r -> String
showList :: [Executed parameterLength resultLength r] -> ShowS
$cshowList :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
Show r =>
[Executed parameterLength resultLength r] -> ShowS
show :: Executed parameterLength resultLength r -> String
$cshow :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
Show r =>
Executed parameterLength resultLength r -> String
showsPrec :: Int -> Executed parameterLength resultLength r -> ShowS
$cshowsPrec :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
Show r =>
Int -> Executed parameterLength resultLength r -> ShowS
Show, Executed parameterLength resultLength r
-> Executed parameterLength resultLength r -> Bool
(Executed parameterLength resultLength r
 -> Executed parameterLength resultLength r -> Bool)
-> (Executed parameterLength resultLength r
    -> Executed parameterLength resultLength r -> Bool)
-> Eq (Executed parameterLength resultLength r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (parameterLength :: Nat) (resultLength :: Nat) r.
Eq r =>
Executed parameterLength resultLength r
-> Executed parameterLength resultLength r -> Bool
/= :: Executed parameterLength resultLength r
-> Executed parameterLength resultLength r -> Bool
$c/= :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
Eq r =>
Executed parameterLength resultLength r
-> Executed parameterLength resultLength r -> Bool
== :: Executed parameterLength resultLength r
-> Executed parameterLength resultLength r -> Bool
$c== :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
Eq r =>
Executed parameterLength resultLength r
-> Executed parameterLength resultLength r -> Bool
Eq)

-- | To get the result of 'Executed'.
result :: Executed n m r -> ExecuteResult
result :: Executed n m r -> ExecuteResult
result (Executed Data.Executed { ExecuteResult
$sel:result:Executed :: forall r. Executed r -> ExecuteResult
result :: ExecuteResult
result }) = ExecuteResult
result

-- | To get the records of 'Executed'.
records :: Executed n m r -> [r]
records :: Executed n m r -> [r]
records (Executed Data.Executed { [r]
$sel:records:Executed :: forall r. Executed r -> [r]
records :: [r]
records }) = [r]
records

-- | This represents a result of a "Execute" message which is not yet processed by a server.
newtype ExecutedProcedure (parameterLength :: Nat) (resultLength :: Nat) r =
  ExecutedProcedure (Data.ExecutedProcedure r)
  deriving newtype (Int -> ExecutedProcedure parameterLength resultLength r -> ShowS
[ExecutedProcedure parameterLength resultLength r] -> ShowS
ExecutedProcedure parameterLength resultLength r -> String
(Int -> ExecutedProcedure parameterLength resultLength r -> ShowS)
-> (ExecutedProcedure parameterLength resultLength r -> String)
-> ([ExecutedProcedure parameterLength resultLength r] -> ShowS)
-> Show (ExecutedProcedure parameterLength resultLength r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (parameterLength :: Nat) (resultLength :: Nat) r.
Int -> ExecutedProcedure parameterLength resultLength r -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat) r.
[ExecutedProcedure parameterLength resultLength r] -> ShowS
forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure parameterLength resultLength r -> String
showList :: [ExecutedProcedure parameterLength resultLength r] -> ShowS
$cshowList :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
[ExecutedProcedure parameterLength resultLength r] -> ShowS
show :: ExecutedProcedure parameterLength resultLength r -> String
$cshow :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure parameterLength resultLength r -> String
showsPrec :: Int -> ExecutedProcedure parameterLength resultLength r -> ShowS
$cshowsPrec :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
Int -> ExecutedProcedure parameterLength resultLength r -> ShowS
Show, ExecutedProcedure parameterLength resultLength r -> Builder
ExecutedProcedure parameterLength resultLength r
-> Parser
     (MessageResult (ExecutedProcedure parameterLength resultLength r))
(ExecutedProcedure parameterLength resultLength r -> Builder)
-> (ExecutedProcedure parameterLength resultLength r
    -> Parser
         (MessageResult (ExecutedProcedure parameterLength resultLength r)))
-> Message (ExecutedProcedure parameterLength resultLength r)
forall m.
(m -> Builder) -> (m -> Parser (MessageResult m)) -> Message m
forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure parameterLength resultLength r -> Builder
forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure parameterLength resultLength r
-> Parser
     (MessageResult (ExecutedProcedure parameterLength resultLength r))
parser :: ExecutedProcedure parameterLength resultLength r
-> Parser
     (MessageResult (ExecutedProcedure parameterLength resultLength r))
$cparser :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure parameterLength resultLength r
-> Parser
     (MessageResult (ExecutedProcedure parameterLength resultLength r))
builder :: ExecutedProcedure parameterLength resultLength r -> Builder
$cbuilder :: forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure parameterLength resultLength r -> Builder
Message)

type instance MessageResult (ExecutedProcedure n m r) = (PreparedStatement n m, Portal n m, Executed n m r, Maybe ErrorFields) -- TODO don't error fields themselves

-- | This means that @r@ has a 'name' accessor.
class HasName r where
  -- | Type of name of @r@.
  type Name r :: Type

  -- | To get a name of @r@.
  name :: r -> Name r
  default name :: HasField "name" r (Name r) => r -> Name r
  name = forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "name" r a => r -> a
getField @"name"

instance HasName (PreparedStatement n m) where
  type Name (PreparedStatement n m) = PreparedStatementName

instance HasName (PreparedStatementProcedure n m) where
  type Name (PreparedStatementProcedure n m) = PreparedStatementName

instance HasName (Portal n m) where
  type Name (Portal n m) = PortalName

instance HasName (PortalProcedure n m) where
  type Name (PortalProcedure n m) = PortalName

-- | This means that @r@ has a 'parameterOids' accessor.
class HasParameterOids r a where
  -- | To get OIDs of a parameter.
  parameterOids :: r -> a
  default parameterOids :: HasField "parameterOids" r a => r -> a
  parameterOids = forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "parameterOids" r a => r -> a
getField @"parameterOids"

instance (oids ~ Homotuple n Oid, Item oids ~ Oid, IsList oids) => HasParameterOids (PreparedStatement n m) oids

instance (oids ~ Homotuple n Oid, Item oids ~ Oid, IsList oids) => HasParameterOids (PreparedStatementProcedure n m) (Maybe oids)

-- Values

-- | To get the procedure to build the message of parsing SQL query and to parse its response.
parse
  :: forall plen rlen.
     ( KnownNat plen
     , KnownNat rlen
     , Item (Homotuple plen Oid) ~ Oid
     , Item (Homotuple rlen ColumnInfo) ~ ColumnInfo
     , Item (Homotuple rlen Oid) ~ Oid
     , IsList (Homotuple rlen Oid)
     , IsList (Homotuple plen Oid)
     , IsList (Homotuple rlen ColumnInfo)
     )
  => PreparedStatementName -- ^ A new name of prepared statement.
  -> Query -- ^ SQL whose placeholder style is dollar style.
  -> Maybe (Homotuple plen Oid, Homotuple rlen Oid) -- ^ On 'Nothing' an additional pair of a request and a response is necessary.
                                                    -- If concrete OIDs are given, it will be pass over.
  -> PreparedStatementProcedure plen rlen
parse :: PreparedStatementName
-> Query
-> Maybe (Homotuple plen Oid, Homotuple rlen Oid)
-> PreparedStatementProcedure plen rlen
parse PreparedStatementName
name Query
query Maybe (Homotuple plen Oid, Homotuple rlen Oid)
oids =
  let
    lensOrOids :: Either (Word, Word) ([Oid], [Oid])
lensOrOids =
      case Maybe (Homotuple plen Oid, Homotuple rlen Oid)
oids of
        Maybe (Homotuple plen Oid, Homotuple rlen Oid)
Nothing -> (Word, Word) -> Either (Word, Word) ([Oid], [Oid])
forall a b. a -> Either a b
Left (Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Integer -> Word) -> Integer -> Word
forall a b. (a -> b) -> a -> b
$ Proxy plen -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy plen
forall k (t :: k). Proxy t
Proxy :: Proxy plen), Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Integer -> Word) -> Integer -> Word
forall a b. (a -> b) -> a -> b
$ Proxy rlen -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy rlen
forall k (t :: k). Proxy t
Proxy :: Proxy rlen))
        Just (Homotuple plen Oid, Homotuple rlen Oid)
v  -> ([Oid], [Oid]) -> Either (Word, Word) ([Oid], [Oid])
forall a b. b -> Either a b
Right (([Oid], [Oid]) -> Either (Word, Word) ([Oid], [Oid]))
-> ([Oid], [Oid]) -> Either (Word, Word) ([Oid], [Oid])
forall a b. (a -> b) -> a -> b
$ (Homotuple plen Oid -> [Oid])
-> (Homotuple rlen Oid -> [Oid])
-> (Homotuple plen Oid, Homotuple rlen Oid)
-> ([Oid], [Oid])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Homotuple plen Oid -> [Oid]
forall l. IsList l => l -> [Item l]
toList Homotuple rlen Oid -> [Oid]
forall l. IsList l => l -> [Item l]
toList (Homotuple plen Oid, Homotuple rlen Oid)
v
  in
    PreparedStatementProcedure -> PreparedStatementProcedure plen rlen
forall (parameterLength :: Nat) (resultLength :: Nat).
PreparedStatementProcedure
-> PreparedStatementProcedure parameterLength resultLength
PreparedStatementProcedure (PreparedStatementProcedure
 -> PreparedStatementProcedure plen rlen)
-> PreparedStatementProcedure
-> PreparedStatementProcedure plen rlen
forall a b. (a -> b) -> a -> b
$ PreparedStatementName
-> Query
-> Either (Word, Word) ([Oid], [Oid])
-> PreparedStatementProcedure
Query.parse PreparedStatementName
name Query
query Either (Word, Word) ([Oid], [Oid])
lensOrOids

-- | This means that @ps@ is a objective of 'bind'.
class Bind ps where
  -- | To get the procedure to build the message of binding the parameter and to parse its response.
  bind
    :: forall rlen param m.
       ( ToRecord param
       , KnownNat rlen
       , Tuple.HasLength (Homotuple rlen ColumnInfo)
       , MonadFail m
       )
    => PortalName -- ^ A new name of portal.
    -> FormatCode -- ^ Binary format or text format for the parameter.
    -> FormatCode -- ^ Binary format or text format for the results.
    -> BackendParameters -- ^ The set of the server parameters.
    -> StringEncoder -- ^ How to encode strings.
    -> param -- ^ Parameter for this query.
    -> ps (Length param) rlen -- ^ Prepared statement.
    -> m (PortalProcedure (Length param) rlen)

instance Bind PreparedStatement where
  bind
    :: forall rlen param m.
       ( ToRecord param
       , Tuple.HasLength (Homotuple rlen ColumnInfo)
       , MonadFail m
       )
    => PortalName -> FormatCode -> FormatCode -> BackendParameters -> StringEncoder -> param -> PreparedStatement (Length param) rlen -> m (PortalProcedure (Length param) rlen)
  bind :: PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> PreparedStatement (Length param) rlen
-> m (PortalProcedure (Length param) rlen)
bind PortalName
name FormatCode
parameterFormat FormatCode
resultFormat BackendParameters
backendParams StringEncoder
encode param
parameters (PreparedStatement PreparedStatement
ps) = PortalProcedure -> PortalProcedure (Length param) rlen
forall (parameterLength :: Nat) (resultLength :: Nat).
PortalProcedure -> PortalProcedure parameterLength resultLength
PortalProcedure (PortalProcedure -> PortalProcedure (Length param) rlen)
-> m PortalProcedure -> m (PortalProcedure (Length param) rlen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> PreparedStatement
-> m PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
Query.bind PortalName
name FormatCode
parameterFormat FormatCode
resultFormat BackendParameters
backendParams StringEncoder
encode param
parameters PreparedStatement
ps

instance Bind PreparedStatementProcedure where
  bind
    :: forall rlen param m.
       ( ToRecord param
       , KnownNat rlen
       , MonadFail m
       )
    => PortalName -> FormatCode -> FormatCode -> BackendParameters -> StringEncoder -> param -> PreparedStatementProcedure (Length param) rlen -> m (PortalProcedure (Length param) rlen)
  bind :: PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> PreparedStatementProcedure (Length param) rlen
-> m (PortalProcedure (Length param) rlen)
bind PortalName
name FormatCode
parameterFormat FormatCode
resultFormat BackendParameters
backendParams StringEncoder
encode param
parameters (PreparedStatementProcedure PreparedStatementProcedure
psProc) = PortalProcedure -> PortalProcedure (Length param) rlen
forall (parameterLength :: Nat) (resultLength :: Nat).
PortalProcedure -> PortalProcedure parameterLength resultLength
PortalProcedure (PortalProcedure -> PortalProcedure (Length param) rlen)
-> m PortalProcedure -> m (PortalProcedure (Length param) rlen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> PreparedStatementProcedure
-> m PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
Query.bind PortalName
name FormatCode
parameterFormat FormatCode
resultFormat BackendParameters
backendParams StringEncoder
encode param
parameters PreparedStatementProcedure
psProc

-- | This means that @p@ is a objective of 'execute'.
class Execute p where
  -- | To get the procedure to build the message of execution and to parse its response.
  execute
    :: forall plen result.
       ( FromRecord result
       , ColumnInfo ~ Item (Homotuple (Length result) ColumnInfo)
       , IsList (Homotuple (Length result) ColumnInfo)
       )
    => Word -- ^ How many records to get. "0" means unlimited.
    -> StringDecoder -- ^ How to decode strings.
    -> p plen (Length result) -- ^ Portal.
    -> ExecutedProcedure plen (Length result) result

instance Execute Portal where
  execute :: Word
-> StringDecoder
-> Portal plen (Length result)
-> ExecutedProcedure plen (Length result) result
execute Word
rowLimit StringDecoder
decode (Portal Portal
p) = ExecutedProcedure result
-> ExecutedProcedure plen (Length result) result
forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure r
-> ExecutedProcedure parameterLength resultLength r
ExecutedProcedure (ExecutedProcedure result
 -> ExecutedProcedure plen (Length result) result)
-> ExecutedProcedure result
-> ExecutedProcedure plen (Length result) result
forall a b. (a -> b) -> a -> b
$ Word -> StringDecoder -> Portal -> ExecutedProcedure result
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Query.execute Word
rowLimit StringDecoder
decode Portal
p

instance Execute PortalProcedure where
  execute :: Word
-> StringDecoder
-> PortalProcedure plen (Length result)
-> ExecutedProcedure plen (Length result) result
execute Word
rowLimit StringDecoder
decode (PortalProcedure PortalProcedure
pProc) = ExecutedProcedure result
-> ExecutedProcedure plen (Length result) result
forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure r
-> ExecutedProcedure parameterLength resultLength r
ExecutedProcedure (ExecutedProcedure result
 -> ExecutedProcedure plen (Length result) result)
-> ExecutedProcedure result
-> ExecutedProcedure plen (Length result) result
forall a b. (a -> b) -> a -> b
$ Word
-> StringDecoder -> PortalProcedure -> ExecutedProcedure result
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Query.execute Word
rowLimit StringDecoder
decode PortalProcedure
pProc

-- | To send @BEGIN@ SQL statement.
begin :: ExecutedProcedure 0 0 ()
begin :: ExecutedProcedure 0 0 ()
begin = ExecutedProcedure () -> ExecutedProcedure 0 0 ()
forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure r
-> ExecutedProcedure parameterLength resultLength r
ExecutedProcedure ExecutedProcedure ()
Query.begin

-- | To send @COMMIT@ SQL statement.
commit :: ExecutedProcedure 0 0 ()
commit :: ExecutedProcedure 0 0 ()
commit = ExecutedProcedure () -> ExecutedProcedure 0 0 ()
forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure r
-> ExecutedProcedure parameterLength resultLength r
ExecutedProcedure ExecutedProcedure ()
Query.commit

-- | To send @ROLLBACK@ SQL statement.
rollback :: ExecutedProcedure 0 0 ()
rollback :: ExecutedProcedure 0 0 ()
rollback = ExecutedProcedure () -> ExecutedProcedure 0 0 ()
forall (parameterLength :: Nat) (resultLength :: Nat) r.
ExecutedProcedure r
-> ExecutedProcedure parameterLength resultLength r
ExecutedProcedure ExecutedProcedure ()
Query.rollback