module Database.PostgreSQL.Query.Functions
(
pgQuery
, pgExecute
, pgQueryEntities
, pgWithTransaction
, pgWithSavepoint
, pgInsertEntity
, pgInsertManyEntities
, pgInsertManyEntitiesId
, pgSelectEntities
, pgSelectJustEntities
, pgSelectEntitiesBy
, pgGetEntity
, pgGetEntityBy
, pgDeleteEntity
, pgUpdateEntity
, pgSelectCount
, pgRepsertRow
) where
import Prelude
import Control.Applicative
import Control.Monad
import Control.Monad.Base
import Control.Monad.Logger
import Control.Monad.Trans.Control
import Data.Int ( Int64 )
import Data.Maybe ( listToMaybe )
import Data.Monoid
import Data.Proxy ( Proxy(..) )
import Data.Text ( Text )
import Data.Typeable ( Typeable )
import Database.PostgreSQL.Query.Entity
( Entity(..), Ent )
import Database.PostgreSQL.Query.Internal
( insertEntity, selectEntity, entityFieldsId,
entityFields, selectEntitiesBy, insertManyEntities,
updateTable, insertInto )
import Database.PostgreSQL.Query.SqlBuilder
( ToSqlBuilder(..), runSqlBuilder, mkIdent )
import Database.PostgreSQL.Query.TH
( sqlExp )
import Database.PostgreSQL.Query.Types
( FN, HasPostgres(..), TransactionSafe,
ToMarkedRow(..), MarkedRow(..), mrToBuilder )
import Database.PostgreSQL.Simple
( ToRow, FromRow, execute_, query_,
withTransaction, withSavepoint )
import Database.PostgreSQL.Simple.FromField
( FromField )
import Database.PostgreSQL.Simple.ToField
( ToField )
import Database.PostgreSQL.Simple.Types
( Query(..), Only(..), (:.)(..) )
import qualified Data.List as L
import qualified Data.List.NonEmpty as NL
import qualified Data.Text.Encoding as T
pgWithTransaction :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)
=> m a
-> m a
pgWithTransaction action = withPGConnection $ \con -> do
control $ \runInIO -> do
withTransaction con $ runInIO action
pgWithSavepoint :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m) => m a -> m a
pgWithSavepoint action = withPGConnection $ \con -> do
control $ \runInIO -> do
withSavepoint con $ runInIO action
pgQuery :: (HasPostgres m, MonadLogger m, ToSqlBuilder q, FromRow r)
=> q -> m [r]
pgQuery q = withPGConnection $ \c -> do
b <- liftBase $ runSqlBuilder c $ toSqlBuilder q
logDebugN $ T.decodeUtf8 $ fromQuery b
liftBase $ query_ c b
pgExecute :: (HasPostgres m, MonadLogger m, ToSqlBuilder q)
=> q -> m Int64
pgExecute q = withPGConnection $ \c -> do
b <- liftBase $ runSqlBuilder c $ toSqlBuilder q
logDebugN $ T.decodeUtf8 $ fromQuery b
liftBase $ execute_ c b
pgQueryEntities :: ( ToSqlBuilder q, HasPostgres m, MonadLogger m, Entity a
, FromRow a, FromField (EntityId a))
=> q -> m [Ent a]
pgQueryEntities q =
map toTuples <$> pgQuery q
where
toTuples ((Only eid) :. entity) = (eid, entity)
pgInsertEntity :: forall a m. (HasPostgres m, MonadLogger m, Entity a,
ToRow a, FromField (EntityId a))
=> a
-> m (EntityId a)
pgInsertEntity a = do
pgQuery [sqlExp|^{insertEntity a} RETURNING id|] >>= \case
((Only ret):_) -> return ret
_ -> fail "Query did not return any response"
pgSelectEntities :: forall m a q. ( Functor m, HasPostgres m, MonadLogger m, Entity a
, FromRow a, ToSqlBuilder q, FromField (EntityId a) )
=> (FN -> FN)
-> q
-> m [Ent a]
pgSelectEntities fpref q = do
let p = Proxy :: Proxy a
pgQueryEntities [sqlExp|^{selectEntity (entityFieldsId fpref) p} ^{q}|]
pgSelectJustEntities :: forall m a q. ( Functor m, HasPostgres m, MonadLogger m, Entity a
, FromRow a, ToSqlBuilder q )
=> (FN -> FN)
-> q
-> m [a]
pgSelectJustEntities fpref q = do
let p = Proxy :: Proxy a
pgQuery [sqlExp|^{selectEntity (entityFields id fpref) p} ^{q}|]
pgSelectEntitiesBy :: forall a m b.( Functor m, HasPostgres m, MonadLogger m, Entity a, ToMarkedRow b
, FromRow a, FromField (EntityId a) )
=> b
-> m [Ent a]
pgSelectEntitiesBy b =
let p = Proxy :: Proxy a
in pgQueryEntities $ selectEntitiesBy ("id":) p b
pgGetEntity :: forall m a. (ToField (EntityId a), Entity a,
HasPostgres m, MonadLogger m, FromRow a, Functor m)
=> EntityId a
-> m (Maybe a)
pgGetEntity eid = do
listToMaybe <$> pgSelectJustEntities id [sqlExp|WHERE id = #{eid} LIMIT 1|]
pgGetEntityBy :: forall m a b. ( Entity a, HasPostgres m, MonadLogger m, ToMarkedRow b
, FromField (EntityId a), FromRow a, Functor m )
=> b
-> m (Maybe (Ent a))
pgGetEntityBy b =
let p = Proxy :: Proxy a
in fmap listToMaybe
$ pgQueryEntities
[sqlExp|^{selectEntitiesBy ("id":) p b} LIMIT 1|]
pgInsertManyEntitiesId :: forall a m. ( Entity a, HasPostgres m, MonadLogger m
, ToRow a, FromField (EntityId a))
=> [a]
-> m [EntityId a]
pgInsertManyEntitiesId [] = return []
pgInsertManyEntitiesId ents' =
let ents = NL.fromList ents'
q = [sqlExp|^{insertManyEntities ents} RETURNING id|]
in map fromOnly <$> pgQuery q
pgInsertManyEntities :: forall a m. (Entity a, HasPostgres m, MonadLogger m, ToRow a)
=> [a]
-> m Int64
pgInsertManyEntities [] = return 0
pgInsertManyEntities ents' =
let ents = NL.fromList ents'
in pgExecute $ insertManyEntities ents
pgDeleteEntity :: forall a m. (Entity a, HasPostgres m, MonadLogger m, ToField (EntityId a), Functor m)
=> EntityId a
-> m Bool
pgDeleteEntity eid =
let p = Proxy :: Proxy a
in fmap (1 ==)
$ pgExecute [sqlExp|DELETE FROM ^{mkIdent $ tableName p}
WHERE id = #{eid}|]
pgUpdateEntity :: forall a b m. (ToMarkedRow b, Entity a, HasPostgres m, MonadLogger m,
ToField (EntityId a), Functor m, Typeable a, Typeable b)
=> EntityId a
-> b
-> m Bool
pgUpdateEntity eid b =
let p = Proxy :: Proxy a
mr = toMarkedRow b
in if L.null $ unMR mr
then return False
else fmap (1 ==)
$ pgExecute [sqlExp|UPDATE ^{mkIdent $ tableName p}
SET ^{mrToBuilder ", " mr}
WHERE id = #{eid}|]
pgSelectCount :: forall m a q. ( Entity a, HasPostgres m, MonadLogger m, ToSqlBuilder q )
=> Proxy a
-> q
-> m Integer
pgSelectCount p q = do
[[c]] <- pgQuery [sqlExp|SELECT count(id) FROM ^{mkIdent $ tableName p} ^{q}|]
return c
pgRepsertRow :: (HasPostgres m, MonadLogger m, ToMarkedRow wrow, ToMarkedRow urow)
=> Text
-> wrow
-> urow
-> m ()
pgRepsertRow tname wrow urow = do
let wmr = toMarkedRow wrow
aff <- pgExecute $ updateTable tname urow
[sqlExp|WHERE ^{mrToBuilder "AND" wmr}|]
when (aff == 0) $ do
let umr = toMarkedRow urow
imr = wmr <> umr
_ <- pgExecute $ insertInto tname imr
return ()