{-# LANGUAGE PolyKinds #-}
module Database.Beam.Postgres.Debug where

import           Database.Beam.Query
import           Database.Beam.Postgres.Types (Postgres(..))
import           Database.Beam.Postgres.Connection
  ( Pg
  , liftIOWithHandle
  , pgRenderSyntax )
import           Database.Beam.Postgres.Full
  ( PgInsertReturning(..)
  , PgUpdateReturning(..)
  , PgDeleteReturning(..) )
import Database.Beam.Postgres.Syntax
  ( PgSyntax
  , PgSelectSyntax(..)
  , PgInsertSyntax(..)
  , PgUpdateSyntax(..)
  , PgDeleteSyntax(..) )

import qualified Data.ByteString.Char8 as BC

import qualified Database.PostgreSQL.Simple as Pg

-- | Type class for @Sql*@ types that can be turned into Postgres
-- syntax, for use in the following debugging functions
--
-- These include
--
--    * 'SqlSelect'
--    * 'SqlInsert'
--    * 'SqlUpdate'
--    * 'SqlDelete'
--    * 'PgInsertReturning'
--    * 'PgUpdateReturning'
--    * 'PgDeleteReturning'
class PgDebugStmt statement where
  pgStmtSyntax :: statement -> Maybe PgSyntax

instance PgDebugStmt (SqlSelect Postgres a) where
  pgStmtSyntax :: SqlSelect Postgres a -> Maybe PgSyntax
pgStmtSyntax (SqlSelect (PgSelectSyntax e)) = PgSyntax -> Maybe PgSyntax
forall a. a -> Maybe a
Just PgSyntax
e
instance PgDebugStmt (SqlInsert Postgres a) where
  pgStmtSyntax :: SqlInsert Postgres a -> Maybe PgSyntax
pgStmtSyntax SqlInsert Postgres a
SqlInsertNoRows = Maybe PgSyntax
forall a. Maybe a
Nothing
  pgStmtSyntax (SqlInsert TableSettings a
_ (PgInsertSyntax e)) = PgSyntax -> Maybe PgSyntax
forall a. a -> Maybe a
Just PgSyntax
e
instance PgDebugStmt (SqlUpdate Postgres a) where
  pgStmtSyntax :: SqlUpdate Postgres a -> Maybe PgSyntax
pgStmtSyntax SqlUpdate Postgres a
SqlIdentityUpdate = Maybe PgSyntax
forall a. Maybe a
Nothing
  pgStmtSyntax (SqlUpdate TableSettings a
_ (PgUpdateSyntax e)) = PgSyntax -> Maybe PgSyntax
forall a. a -> Maybe a
Just PgSyntax
e
instance PgDebugStmt (SqlDelete Postgres a) where
  pgStmtSyntax :: SqlDelete Postgres a -> Maybe PgSyntax
pgStmtSyntax (SqlDelete TableSettings a
_ (PgDeleteSyntax e)) = PgSyntax -> Maybe PgSyntax
forall a. a -> Maybe a
Just PgSyntax
e
instance PgDebugStmt (PgInsertReturning a) where
  pgStmtSyntax :: PgInsertReturning a -> Maybe PgSyntax
pgStmtSyntax PgInsertReturning a
PgInsertReturningEmpty = Maybe PgSyntax
forall a. Maybe a
Nothing
  pgStmtSyntax (PgInsertReturning PgSyntax
e) = PgSyntax -> Maybe PgSyntax
forall a. a -> Maybe a
Just PgSyntax
e
instance PgDebugStmt (PgUpdateReturning a) where
  pgStmtSyntax :: PgUpdateReturning a -> Maybe PgSyntax
pgStmtSyntax PgUpdateReturning a
PgUpdateReturningEmpty = Maybe PgSyntax
forall a. Maybe a
Nothing
  pgStmtSyntax (PgUpdateReturning PgSyntax
e) = PgSyntax -> Maybe PgSyntax
forall a. a -> Maybe a
Just PgSyntax
e
instance PgDebugStmt (PgDeleteReturning a) where
  pgStmtSyntax :: PgDeleteReturning a -> Maybe PgSyntax
pgStmtSyntax (PgDeleteReturning PgSyntax
e) = PgSyntax -> Maybe PgSyntax
forall a. a -> Maybe a
Just PgSyntax
e

pgTraceStmtIO :: PgDebugStmt statement => Pg.Connection -> statement -> IO ()
pgTraceStmtIO :: Connection -> statement -> IO ()
pgTraceStmtIO Connection
conn statement
s =
  ByteString -> IO ()
BC.putStrLn (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> statement -> IO ByteString
forall statement.
PgDebugStmt statement =>
Connection -> statement -> IO ByteString
pgTraceStmtIO' Connection
conn statement
s

pgTraceStmtIO' :: PgDebugStmt statement => Pg.Connection -> statement -> IO BC.ByteString
pgTraceStmtIO' :: Connection -> statement -> IO ByteString
pgTraceStmtIO' Connection
conn statement
stmt =
  let syntax :: Maybe PgSyntax
syntax = statement -> Maybe PgSyntax
forall statement.
PgDebugStmt statement =>
statement -> Maybe PgSyntax
pgStmtSyntax statement
stmt
  in IO ByteString
-> (PgSyntax -> IO ByteString) -> Maybe PgSyntax -> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ByteString
BC.pack String
"(no statement)")) (Connection -> PgSyntax -> IO ByteString
pgRenderSyntax Connection
conn) Maybe PgSyntax
syntax

pgTraceStmt :: PgDebugStmt statement => statement -> Pg ()
pgTraceStmt :: statement -> Pg ()
pgTraceStmt statement
stmt =
  (Connection -> IO ()) -> Pg ()
forall a. (Connection -> IO a) -> Pg a
liftIOWithHandle ((Connection -> statement -> IO ())
-> statement -> Connection -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Connection -> statement -> IO ()
forall statement.
PgDebugStmt statement =>
Connection -> statement -> IO ()
pgTraceStmtIO statement
stmt)