{-# 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 PgSyntax
e)) = 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 = forall a. Maybe a
Nothing
  pgStmtSyntax (SqlInsert TableSettings a
_ (PgInsertSyntax PgSyntax
e)) = 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 = forall a. Maybe a
Nothing
  pgStmtSyntax (SqlUpdate TableSettings a
_ (PgUpdateSyntax PgSyntax
e)) = 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 PgSyntax
e)) = forall a. a -> Maybe a
Just PgSyntax
e
instance PgDebugStmt (PgInsertReturning a) where
  pgStmtSyntax :: PgInsertReturning a -> Maybe PgSyntax
pgStmtSyntax PgInsertReturning a
PgInsertReturningEmpty = forall a. Maybe a
Nothing
  pgStmtSyntax (PgInsertReturning PgSyntax
e) = forall a. a -> Maybe a
Just PgSyntax
e
instance PgDebugStmt (PgUpdateReturning a) where
  pgStmtSyntax :: PgUpdateReturning a -> Maybe PgSyntax
pgStmtSyntax PgUpdateReturning a
PgUpdateReturningEmpty = forall a. Maybe a
Nothing
  pgStmtSyntax (PgUpdateReturning PgSyntax
e) = forall a. a -> Maybe a
Just PgSyntax
e
instance PgDebugStmt (PgDeleteReturning a) where
  pgStmtSyntax :: PgDeleteReturning a -> Maybe PgSyntax
pgStmtSyntax (PgDeleteReturning PgSyntax
e) = forall a. a -> Maybe a
Just PgSyntax
e

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

pgTraceStmtIO' :: PgDebugStmt statement => Pg.Connection -> statement -> IO BC.ByteString
pgTraceStmtIO' :: forall statement.
PgDebugStmt statement =>
Connection -> statement -> IO ByteString
pgTraceStmtIO' Connection
conn statement
stmt =
  let syntax :: Maybe PgSyntax
syntax = forall statement.
PgDebugStmt statement =>
statement -> Maybe PgSyntax
pgStmtSyntax statement
stmt
  in forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 :: forall statement. PgDebugStmt statement => statement -> Pg ()
pgTraceStmt statement
stmt =
  forall a. (Connection -> IO a) -> Pg a
liftIOWithHandle (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall statement.
PgDebugStmt statement =>
Connection -> statement -> IO ()
pgTraceStmtIO statement
stmt)