{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module Database.PostgreSQL.Typed.TemplatePG
( queryTuples
, queryTuple
, execute
, insertIgnore
, withTransaction
, rollback
, PGException
, pgConnect
#if !MIN_VERSION_network(3,0,0)
, PortID(..)
#endif
, PG.pgDisconnect
) where
import Control.Exception (catchJust)
import Control.Monad (liftM, void, guard)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy.Char8 as BSLC
import Data.Maybe (listToMaybe, isJust)
import qualified Language.Haskell.TH as TH
#if MIN_VERSION_network(3,0,0)
import Data.Word (Word16)
#else
import Network (PortID(..))
#endif
import qualified Network.Socket as Net
import System.Environment (lookupEnv)
import qualified Database.PostgreSQL.Typed.Protocol as PG
import Database.PostgreSQL.Typed.Query
querySQL :: String -> String
querySQL ('{':s) = '$':'{':querySQL s
querySQL (c:s) = c:querySQL s
querySQL "" = ""
queryTuples :: String -> TH.ExpQ
queryTuples sql = [| \c -> pgQuery c $(makePGQuery simpleQueryFlags $ querySQL sql) |]
queryTuple :: String -> TH.ExpQ
queryTuple sql = [| liftM listToMaybe . $(queryTuples sql) |]
execute :: String -> TH.ExpQ
execute sql = [| \c -> void $ pgExecute c $(makePGQuery simpleQueryFlags $ querySQL sql) |]
withTransaction :: PG.PGConnection -> IO a -> IO a
withTransaction = PG.pgTransaction
rollback :: PG.PGConnection -> IO ()
rollback h = void $ PG.pgSimpleQuery h $ BSLC.pack "ROLLBACK"
insertIgnore :: IO () -> IO ()
insertIgnore q = catchJust uniquenessError q (\ _ -> return ()) where
uniquenessError e = guard (PG.pgErrorCode e == BSC.pack "23505")
type PGException = PG.PGError
#if MIN_VERSION_network(3,0,0)
data PortID = Service String | PortNumber Word16 | UnixSocket String
#endif
pgConnect :: String
-> PortID
-> ByteString
-> ByteString
-> ByteString
-> IO PG.PGConnection
pgConnect h n d u p = do
debug <- isJust `liftM` lookupEnv "TPG_DEBUG"
PG.pgConnect $ PG.defaultPGDatabase
{ PG.pgDBAddr = case n of
PortNumber s -> Left (h, show s)
Service s -> Left (h, s)
UnixSocket s -> Right (Net.SockAddrUnix s)
, PG.pgDBName = d
, PG.pgDBUser = u
, PG.pgDBPass = p
, PG.pgDBDebug = debug
}