{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
-- Copyright 2010, 2011, 2012, 2013 Chris Forno

-- |This module exposes the high-level Template Haskell interface for querying
-- and manipulating the PostgreSQL server.
-- 
-- All SQL string arguments support expression interpolation. Just enclose your
-- expression in @{}@ in the SQL string.
-- 
-- Note that transactions are messy and untested. Attempt to use them at your
-- own risk.

module Database.PostgreSQL.Typed.TemplatePG 
  ( queryTuples
  , queryTuple
  , execute
  , insertIgnore
  , withTransaction
  , rollback
  , PGException
  , pgConnect
#if !MIN_VERSION_network(2,7,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(2,7,0)
import           Data.Word (Word16)
#else
import           Network (PortID(..))
#endif
#if !defined(mingw32_HOST_OS)
import qualified Network.Socket as Net
#endif
import           System.Environment (lookupEnv)

import qualified Database.PostgreSQL.Typed.Protocol as PG
import Database.PostgreSQL.Typed.Query

-- |Convert a 'queryTuple'-style string with placeholders into a new style SQL string.
querySQL :: String -> String
querySQL :: String -> String
querySQL (Char
'{':String
s) = Char
'$'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'{'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
querySQL String
s
querySQL (Char
c:String
s) = Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
querySQL String
s
querySQL String
"" = String
""

-- |@queryTuples :: String -> (PGConnection -> IO [(column1, column2, ...)])@
-- 
-- Query a PostgreSQL server and return the results as a list of tuples.
-- 
-- Example (where @h@ is a handle from 'pgConnect'):
-- 
-- > $(queryTuples "SELECT usesysid, usename FROM pg_user") h :: IO [(Maybe String, Maybe Integer)]
queryTuples :: String -> TH.ExpQ
queryTuples :: String -> ExpQ
queryTuples String
sql = [| \c -> pgQuery c $(makePGQuery simpleQueryFlags $ querySQL sql) |]

-- |@queryTuple :: String -> (PGConnection -> IO (Maybe (column1, column2, ...)))@
-- 
-- Convenience function to query a PostgreSQL server and return the first
-- result as a tuple. If the query produces no results, return 'Nothing'.
-- 
-- Example (where @h@ is a handle from 'pgConnect'):
-- 
-- > let sysid = 10::Integer;
-- > $(queryTuple "SELECT usesysid, usename FROM pg_user WHERE usesysid = {sysid}") h :: IO (Maybe (Maybe String, Maybe Integer))
queryTuple :: String -> TH.ExpQ
queryTuple :: String -> ExpQ
queryTuple String
sql = [| liftM listToMaybe . $(queryTuples sql) |]

-- |@execute :: String -> (PGConnection -> IO ())@
-- 
-- Convenience function to execute a statement on the PostgreSQL server.
-- 
-- Example (where @h@ is a handle from 'pgConnect'):
execute :: String -> TH.ExpQ
execute :: String -> ExpQ
execute String
sql = [| \c -> void $ pgExecute c $(makePGQuery simpleQueryFlags $ querySQL sql) |]

-- |Run a sequence of IO actions (presumably SQL statements) wrapped in a
-- transaction. Unfortunately you're restricted to using this in the 'IO'
-- Monad for now due to the use of 'onException'. I'm debating adding a
-- 'MonadPeelIO' version.
withTransaction :: PG.PGConnection -> IO a -> IO a
withTransaction :: PGConnection -> IO a -> IO a
withTransaction = PGConnection -> IO a -> IO a
forall a. PGConnection -> IO a -> IO a
PG.pgTransaction

-- |Roll back a transaction.
rollback :: PG.PGConnection -> IO ()
rollback :: PGConnection -> IO ()
rollback PGConnection
h = IO (Int, [PGValues]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Int, [PGValues]) -> IO ()) -> IO (Int, [PGValues]) -> IO ()
forall a b. (a -> b) -> a -> b
$ PGConnection -> ByteString -> IO (Int, [PGValues])
PG.pgSimpleQuery PGConnection
h (ByteString -> IO (Int, [PGValues]))
-> ByteString -> IO (Int, [PGValues])
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BSLC.pack String
"ROLLBACK"

-- |Ignore duplicate key errors. This is also limited to the 'IO' Monad.
insertIgnore :: IO () -> IO ()
insertIgnore :: IO () -> IO ()
insertIgnore IO ()
q = (PGError -> Maybe ()) -> IO () -> (() -> IO ()) -> IO ()
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust PGError -> Maybe ()
forall (f :: * -> *). Alternative f => PGError -> f ()
uniquenessError IO ()
q (\ ()
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) where
  uniquenessError :: PGError -> f ()
uniquenessError PGError
e = Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (PGError -> ByteString
PG.pgErrorCode PGError
e ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BSC.pack String
"23505")

type PGException = PG.PGError

#if MIN_VERSION_network(2,7,0)
-- |For backwards compatibility with old network package.
data PortID
  = Service String
  | PortNumber Word16
#if !defined(mingw32_HOST_OS)
  | UnixSocket String
#endif
#endif

pgConnect :: String     -- ^ the host to connect to
          -> PortID     -- ^ the port to connect on
          -> ByteString -- ^ the database to connect to
          -> ByteString -- ^ the username to connect as
          -> ByteString -- ^ the password to connect with
          -> IO PG.PGConnection -- ^ a handle to communicate with the PostgreSQL server on
pgConnect :: String
-> PortID
-> ByteString
-> ByteString
-> ByteString
-> IO PGConnection
pgConnect String
h PortID
n ByteString
d ByteString
u ByteString
p = do
  Bool
debug <- Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` String -> IO (Maybe String)
lookupEnv String
"TPG_DEBUG"
  PGDatabase -> IO PGConnection
PG.pgConnect (PGDatabase -> IO PGConnection) -> PGDatabase -> IO PGConnection
forall a b. (a -> b) -> a -> b
$ PGDatabase
PG.defaultPGDatabase
    { pgDBAddr :: Either (String, String) SockAddr
PG.pgDBAddr = case PortID
n of
        PortNumber Word16
s -> (String, String) -> Either (String, String) SockAddr
forall a b. a -> Either a b
Left (String
h, Word16 -> String
forall a. Show a => a -> String
show Word16
s)
        Service    String
s -> (String, String) -> Either (String, String) SockAddr
forall a b. a -> Either a b
Left (String
h, String
s)
#if !defined(mingw32_HOST_OS)
        UnixSocket String
s -> SockAddr -> Either (String, String) SockAddr
forall a b. b -> Either a b
Right (String -> SockAddr
Net.SockAddrUnix String
s)
#endif
    , pgDBName :: ByteString
PG.pgDBName = ByteString
d
    , pgDBUser :: ByteString
PG.pgDBUser = ByteString
u
    , pgDBPass :: ByteString
PG.pgDBPass = ByteString
p
    , pgDBDebug :: Bool
PG.pgDBDebug = Bool
debug
    }