packages feed

persistent-sql-lifted-0.4.5.0: library/Database/Persist/Sql/Lifted.hs

{-# LANGUAGE CPP #-}

-- |
--
-- Re-exports from:
--
-- * "Database.Persist.Sql.Lifted.Core"
-- * "Database.Persist.Sql.Lifted.Persistent"
-- * "Database.Persist.Sql.Lifted.Esqueleto"
--
-- There are a few name conflicts between Persistent and Esqueleto. Where conflicts occur, this
-- module gives preference to Esqueleto. The following Persistent definitions are renamed:
--
-- * 'Database.Persist.Sql.Lifted.Persistent.delete' -> 'deleteKey'
-- * 'Database.Persist.Sql.Lifted.Persistent.update' -> 'update''
module Database.Persist.Sql.Lifted
  ( -- * Core concepts
    MonadSqlTx (..)
  , HasSqlBackend (..)
  , SqlBackend
  , MonadSqlBackend (..)
  , liftSql
  , Entity (..)

    -- * Getting by key
  , get
  , getBy
  , getByValue
  , getEntity
  , getJust
  , getJustEntity
  , getMany

    -- * Selecting by filter
  , select
  , selectOne
  , selectFirst
  , selectKeysList
  , selectList

    -- * Selecting counts/existence
  , selectCount
  , selectExists
  , count
  , exists
  , existsBy

    -- * Inserting
  , insertSelect
  , insertSelectCount
  , insert
  , insert_
  , insertBy
  , insertEntity
  , insertEntityMany
  , insertKey
  , insertMany
  , insertMany_
  , insertRecord
  , insertUnique
  , insertUnique_
  , insertUniqueEntity

    -- * Updating
  , update
  , updateCount
  , update'
  , updateGet
  , updateGetEntity
  , updateWhere
  , updateWhereCount

    -- * Insert/update combinations
  , replace
  , replaceUnique
  , repsert
  , repsertMany
  , upsert
  , upsertBy
  , putMany

    -- * Working with unique constraints
  , checkUnique
  , checkUniqueUpdateable
  , onlyUnique

    -- * Deleting
  , delete
  , deleteKey
  , deleteBy
  , deleteWhere
  , deleteCount
  , deleteWhereCount

    -- * Transactions
  , transactionSave
  , transactionSaveWithIsolation
  , transactionUndo
  , transactionUndoWithIsolation

    -- * Raw SQL
  , rawSql
  , rawExecute
  , rawExecuteCount

    -- * Getting names
  , getFieldName
  , getTableName

    -- * Rendering queries to text
  , renderQueryDelete
  , renderQueryInsertInto
  , renderQuerySelect
  , renderQueryToText
  , renderQueryUpdate
  ) where

#if MIN_VERSION_base(4,17,0)
import Data.Type.Equality (type (~))
#endif
import Prelude (Integral)

import Control.Applicative (pure)
import Data.Bool (Bool (..))
import Data.Function (($))
import Data.Functor (($>), (<$>))
import Data.Maybe (maybe)
import Database.Esqueleto.Experimental (PersistField, Value (..), countRows)
import Database.Persist (Key, PersistEntity (PersistEntityBackend), Update)
import Database.Persist.Sql.Lifted.Core
import Database.Persist.Sql.Lifted.Esqueleto
import Database.Persist.Sql.Lifted.Expression qualified as SqlExpr
import Database.Persist.Sql.Lifted.Persistent hiding (delete, update)
import Database.Persist.Sql.Lifted.Persistent qualified as Persistent
import Database.Persist.Sql.Lifted.Query (SqlQuery)
import Database.Persist.Types (Entity (..))
import GHC.Stack (HasCallStack)

-- | Update individual fields on a specific record
update'
  :: forall a m
   . ( HasCallStack
     , MonadSqlBackend m
     , PersistEntity a
     , PersistEntityBackend a ~ SqlBackend
     )
  => Key a
  -> [Update a]
  -> m ()
update' = Persistent.update

-- | Update individual fields on a specific record, and retrieve the updated 'Entity' from the database
--
-- This function will throw an exception if the given key is not found in the database.
updateGetEntity
  :: forall a m
   . ( HasCallStack
     , MonadSqlBackend m
     , PersistEntity a
     , PersistEntityBackend a ~ SqlBackend
     )
  => Key a
  -> [Update a]
  -> m (Entity a)
updateGetEntity k us = Entity k <$> updateGet k us

-- | Get only the number of rows that a 'SqlQuery' would select
selectCount
  :: forall a m
   . (HasCallStack, Integral a, MonadSqlBackend m, PersistField a)
  => SqlQuery ()
  -> m a
selectCount q =
  maybe 0 unValue <$> selectOne (q $> countRows)

-- | Get whether a 'SqlQuery' would select anything
selectExists
  :: forall m. (HasCallStack, MonadSqlBackend m) => SqlQuery () -> m Bool
selectExists q = maybe False unValue <$> selectOne (pure $ SqlExpr.exists q)