{-# 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 OverloadedLabels #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Database.PostgreSQL.Pure
(
Config (..)
, Connection
, pid
, parameters
, config
, Address (..)
, BackendParameters
, Pid
, withConnection
, connect
, disconnect
, 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
, begin
, commit
, rollback
, TransactionState (..)
, FromField (..)
, FromRecord (..)
, ToField (..)
, ToRecord (..)
, Raw (..)
, Length
, Exception.Exception (..)
, Exception.ErrorResponse (..)
, Exception.ResponseParsingFailed (..)
, 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), StringDecoder,
StringEncoder, 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, IsHomolisttuple, IsHomotupleItem)
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
newtype PreparedStatement (parameterLength :: Nat) (resultLength :: Nat) =
PreparedStatement Data.PreparedStatement
deriving newtype (Show, Eq, Close)
instance HasField "name" (PreparedStatement n m) PreparedStatementName where
getField (PreparedStatement Data.PreparedStatement { name }) = name
instance (oids ~ Homotuple n Oid, Item oids ~ Oid, IsList oids) => HasField "parameterOids" (PreparedStatement n m) oids where
getField (PreparedStatement Data.PreparedStatement { parameterOids }) = fromList parameterOids
resultInfos :: (IsHomolisttuple m ColumnInfo, IsHomotupleItem m ColumnInfo) => PreparedStatement n m -> Homotuple m ColumnInfo
resultInfos (PreparedStatement Data.PreparedStatement { resultInfos }) = fromList resultInfos
newtype PreparedStatementProcedure (parameterLength :: Nat) (resultLength :: Nat) =
PreparedStatementProcedure Data.PreparedStatementProcedure
deriving newtype (Show, Message)
instance HasField "name" (PreparedStatementProcedure n m) PreparedStatementName where
getField (PreparedStatementProcedure Data.PreparedStatementProcedure { name }) = name
instance (oids ~ Homotuple n Oid, Item oids ~ Oid, IsList oids) => HasField "parameterOids" (PreparedStatementProcedure n m) (Maybe oids) where
getField (PreparedStatementProcedure Data.PreparedStatementProcedure { parameterOids }) = fromList <$> parameterOids
type instance MessageResult (PreparedStatementProcedure n m) = (PreparedStatement n m)
newtype Portal (parameterLength :: Nat) (resultLength :: Nat) =
Portal Data.Portal
deriving newtype (Show, Eq, Close)
instance HasField "name" (Portal n m) PortalName where
getField (Portal Data.Portal { name }) = name
newtype PortalProcedure (parameterLength :: Nat) (resultLength :: Nat) =
PortalProcedure Data.PortalProcedure
deriving newtype (Show, Message)
instance HasField "name" (PortalProcedure n m) PortalName where
getField (PortalProcedure Data.PortalProcedure { name }) = name
type instance MessageResult (PortalProcedure n m) = (PreparedStatement n m, Portal n m)
newtype Executed (parameterLength :: Nat) (resultLength :: Nat) r =
Executed (Data.Executed r)
deriving newtype (Show, Eq)
result :: Executed n m r -> ExecuteResult
result (Executed Data.Executed { result }) = result
records :: Executed n m r -> [r]
records (Executed Data.Executed { records }) = records
newtype ExecutedProcedure (parameterLength :: Nat) (resultLength :: Nat) r =
ExecutedProcedure (Data.ExecutedProcedure r)
deriving newtype (Show, Message)
type instance MessageResult (ExecutedProcedure n m r) = (PreparedStatement n m, Portal n m, Executed n m r, Maybe ErrorFields)
class HasName r where
type Name r :: Type
name :: r -> Name r
default name :: HasField "name" r (Name r) => r -> Name r
name = 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
class HasParameterOids r a where
parameterOids :: r -> a
default parameterOids :: HasField "parameterOids" r a => r -> a
parameterOids = 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)
parse
:: forall plen rlen.
( KnownNat plen
, KnownNat rlen
, IsHomotupleItem plen Oid
, IsHomotupleItem rlen ColumnInfo
, IsHomotupleItem rlen Oid
, IsHomolisttuple rlen Oid
, IsHomolisttuple plen Oid
, IsHomolisttuple rlen ColumnInfo
)
=> PreparedStatementName
-> Query
-> Maybe (Homotuple plen Oid, Homotuple rlen Oid)
-> PreparedStatementProcedure plen rlen
parse name query oids =
let
lensOrOids =
case oids of
Nothing -> Left (fromInteger $ natVal (Proxy :: Proxy plen), fromInteger $ natVal (Proxy :: Proxy rlen))
Just v -> Right $ bimap toList toList v
in
PreparedStatementProcedure $ Query.parse name query lensOrOids
class Bind ps where
bind
:: forall rlen param m.
( ToRecord param
, KnownNat rlen
, Tuple.HasLength (Homotuple rlen ColumnInfo)
, MonadFail m
)
=> PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps (Length param) rlen
-> 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 name parameterFormat resultFormat backendParams encode parameters (PreparedStatement ps) = PortalProcedure <$> Query.bind name parameterFormat resultFormat backendParams encode parameters 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 name parameterFormat resultFormat backendParams encode parameters (PreparedStatementProcedure psProc) = PortalProcedure <$> Query.bind name parameterFormat resultFormat backendParams encode parameters psProc
class Execute p where
execute
:: forall plen result.
( FromRecord result
, IsHomotupleItem (Length result) ColumnInfo
, IsHomolisttuple (Length result) ColumnInfo
)
=> Word
-> StringDecoder
-> p plen (Length result)
-> ExecutedProcedure plen (Length result) result
instance Execute Portal where
execute rowLimit decode (Portal p) = ExecutedProcedure $ Query.execute rowLimit decode p
instance Execute PortalProcedure where
execute rowLimit decode (PortalProcedure pProc) = ExecutedProcedure $ Query.execute rowLimit decode pProc
begin :: ExecutedProcedure 0 0 ()
begin = ExecutedProcedure Query.begin
commit :: ExecutedProcedure 0 0 ()
commit = ExecutedProcedure Query.commit
rollback :: ExecutedProcedure 0 0 ()
rollback = ExecutedProcedure Query.rollback