module RFC.Psql
( module Database.PostgreSQL.Typed
, module Database.PostgreSQL.Typed.Query
, module Database.PostgreSQL.Typed.Types
, module RFC.Psql
) where
import Data.Pool
import Database.PostgreSQL.Typed
import Database.PostgreSQL.Typed.Query
import Database.PostgreSQL.Typed.Types
import qualified RFC.Env as Env
import RFC.Prelude
type PGConnectionPool = Pool PGConnection
type ConnectionPool = PGConnectionPool
class HasPsql m where
getPsqlPool :: m PGConnectionPool
instance (Monad m) => HasPsql (ReaderT PGConnectionPool m) where
getPsqlPool = ask
withPsqlConnection :: (HasPsql m, MonadIO m) => (PGConnection -> IO a) -> m a
withPsqlConnection action = do
pool <- getPsqlPool
liftIO $ withResource pool action
withPsqlTransaction :: (HasPsql m, MonadIO m) => IO a -> m a
withPsqlTransaction action = withPsqlConnection $ \conn -> do
let newMonad = ReaderT (const action)
liftIO $ pgTransaction conn $ runReaderT newMonad conn
instance Env.DefConfig PGDatabase where
defConfig = defaultPGDatabase
instance Env.FromEnv PGDatabase where
fromEnv = PGDatabase <$> Env.env "PSQL_HOST"
<*> Env.env "PSQL_PORT"
<*> Env.env "PSQL_DATABASE"
<*> Env.env "PSQL_USERNAME"
<*> Env.env "PSQL_PASSWORD"
<*> pure []
<*> pure Env.isDevelopment
<*> pure (
if Env.isDevelopment then
print . PGError
else
const $ return ()
)
defaultConnectInfo :: (MonadIO m, MonadFail m) => m PGDatabase
defaultConnectInfo = do
result <- liftIO $ Env.decodeEnv
case result of
Left err -> fail $ "Could not retrieve psql connection info: " ++ err
Right connInfo -> return connInfo
createConnectionPool :: (MonadIO m) => PGDatabase -> m PGConnectionPool
createConnectionPool connInfo = liftIO $
createPool connect close 1 10 100
where
connect = pgConnect connInfo
close = pgDisconnect
query :: (MonadIO m, HasPsql m, PGQuery q a) => q -> m [a]
query q = withPsqlConnection $ \conn -> pgQuery conn q
query1 :: (MonadIO m, HasPsql m, PGQuery q a) => q -> m (Maybe a)
query1 qry = safeHead <$> query qry
query1Else :: (MonadIO m, HasPsql m, PGQuery q a, Exception e) => q -> e -> m (Maybe a)
query1Else qry e = do
result <- query1 qry
case result of
(Just _) -> return result
Nothing -> throwIO e
execute :: (MonadIO m, HasPsql m, PGQuery q ()) => q -> m Int
execute q = withPsqlConnection $ \conn -> pgExecute conn q
execute_ :: (MonadIO m, HasPsql m, PGQuery q ()) => q -> m ()
execute_ q = do
_ <- withPsqlConnection $ \conn -> pgExecute conn q
return ()