-- | Definition of internal DBT state.
module Database.PostgreSQL.PQTypes.Internal.State
  ( DBState(..)
  , updateStateWith
  ) where

import Foreign.ForeignPtr

import Database.PostgreSQL.PQTypes.FromRow
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Connection
import Database.PostgreSQL.PQTypes.Internal.QueryResult
import Database.PostgreSQL.PQTypes.SQL.Class
import Database.PostgreSQL.PQTypes.Transaction.Settings

-- | Internal DB state.
data DBState m = DBState
  { -- | Active connection.
    forall (m :: * -> *). DBState m -> Connection
dbConnection          :: !Connection
    -- | Supplied connection source.
  , forall (m :: * -> *). DBState m -> ConnectionSourceM m
dbConnectionSource    :: !(ConnectionSourceM m)
    -- | Current transaction settings.
  , forall (m :: * -> *). DBState m -> TransactionSettings
dbTransactionSettings :: !TransactionSettings
    -- | Last SQL query that was executed.
  , forall (m :: * -> *). DBState m -> SomeSQL
dbLastQuery           :: !SomeSQL
    -- | Whether running query should override 'dbLastQuery'.
  , forall (m :: * -> *). DBState m -> Bool
dbRecordLastQuery     :: !Bool
    -- | Current query result.
  , forall (m :: * -> *).
DBState m -> forall row. FromRow row => Maybe (QueryResult row)
dbQueryResult         :: !(forall row. FromRow row => Maybe (QueryResult row))
  }

updateStateWith :: IsSQL sql => DBState m -> sql -> ForeignPtr PGresult -> DBState m
updateStateWith :: forall sql (m :: * -> *).
IsSQL sql =>
DBState m -> sql -> ForeignPtr PGresult -> DBState m
updateStateWith DBState m
st sql
sql ForeignPtr PGresult
res = DBState m
st
  { dbLastQuery :: SomeSQL
dbLastQuery = if forall (m :: * -> *). DBState m -> Bool
dbRecordLastQuery DBState m
st then forall sql. IsSQL sql => sql -> SomeSQL
SomeSQL sql
sql else forall (m :: * -> *). DBState m -> SomeSQL
dbLastQuery DBState m
st
  , dbQueryResult :: forall row. FromRow row => Maybe (QueryResult row)
dbQueryResult = forall a. a -> Maybe a
Just QueryResult
    { qrSQL :: SomeSQL
qrSQL = forall sql. IsSQL sql => sql -> SomeSQL
SomeSQL sql
sql
    , qrResult :: ForeignPtr PGresult
qrResult = ForeignPtr PGresult
res
    , qrFromRow :: row -> row
qrFromRow = forall a. a -> a
id
    }
  }