-- | Hipsql interop for @postgresql-tx-simple@.
--
-- N.B. The 'MonadHipsql' instance for 'TxM' is derived by defining
-- a 'MonadHipsqlAdapter' instance and importing the orphan from
-- "Hipsql.Server.Adapter".
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hipsql.Tx.Simple
  ( hipsql
  ) where

import Database.PostgreSQL.Tx (TxEnv, TxM, askTxEnv)
import Database.PostgreSQL.Tx.Unsafe (unsafeRunIOInTxM)
import Hipsql.Monad (MonadHipsql(hipsql), MonadHipsqlAdapter(hipsqlAcquireLibPQ))
import Hipsql.Server.Adapter ()

import qualified Database.PostgreSQL.Simple as Simple
import qualified Database.PostgreSQL.Simple.Internal as Simple.Internal

instance (TxEnv Simple.Connection r) => MonadHipsqlAdapter (TxM r) where
  hipsqlAcquireLibPQ :: (Connection -> IO a) -> TxM r a
hipsqlAcquireLibPQ Connection -> IO a
f = do
    Connection
conn <- TxM r Connection
forall a r. TxEnv a r => TxM r a
askTxEnv
    IO a -> TxM r a
forall a r. IO a -> TxM r a
unsafeRunIOInTxM (IO a -> TxM r a) -> IO a -> TxM r a
forall a b. (a -> b) -> a -> b
$ Connection -> (Connection -> IO a) -> IO a
forall a. Connection -> (Connection -> IO a) -> IO a
Simple.Internal.withConnection Connection
conn Connection -> IO a
f