{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Database.GP.GenericPersistenceSafe
  ( selectById,
    select,
    count,
    entitiesFromRows,
    sql,
    persist,
    upsert,
    insert,
    insertMany,
    update,
    updateMany,
    delete,
    deleteById,
    deleteMany,
    deleteManyById,
    setupTable,
    defaultSqliteMapping,
    defaultPostgresMapping,
    Conn (..),
    connect,
    Database (..),
    TxHandling (..),
    ConnectionPool,
    createConnPool,
    withResource,
    Entity (..),
    GToRow,
    GFromRow,
    columnNameFor,
    maybeFieldTypeFor,
    TypeInfo (..),
    typeInfo,
    PersistenceException (..),
    WhereClauseExpr,
    Field,
    field,
    (&&.),
    (||.),
    (=.),
    (>.),
    (<.),
    (>=.),
    (<=.),
    (<>.),
    like,
    between,
    in',
    isNull,
    not',
    sqlFun,
    allEntries,
    byId,
    orderBy,
    SortOrder (..),
    limit,
    limitOffset,
    fieldIndex,
    handleDuplicateInsert,
    removeAutoIncIdField,
  )
where

import           Control.Exception         (Exception, SomeException, try)
import           Control.Monad             (when)
import           Data.Convertible          (ConvertResult, Convertible)
import           Data.Convertible.Base     (Convertible (safeConvert))
import           Data.List                 (isInfixOf)
import           Database.GP.Conn
import           Database.GP.Entity
import           Database.GP.SqlGenerator
import           Database.GP.TypeInfo
import           Database.HDBC
import           Language.Haskell.TH.Quote (QuasiQuoter)
import           Text.RawString.QQ         (r)

-- |
-- This is the "safe" version of the module Database.GP.GenericPersistence. It uses Either to return errors.
--
-- This module defines RDBMS Persistence operations for Record Data Types that are instances of 'Data'.
-- I call instances of such a data type Entities.
--
-- The Persistence operations are using Haskell generics to provide compile time reflection capabilities.
-- HDBC is used to access the RDBMS.

-- | exceptions that may occur during persistence operations
data PersistenceException
  = EntityNotFound String
  | DuplicateInsert String
  | DatabaseError String
  | NoUniqueKey String
  deriving (Int -> PersistenceException -> ShowS
[PersistenceException] -> ShowS
PersistenceException -> String
(Int -> PersistenceException -> ShowS)
-> (PersistenceException -> String)
-> ([PersistenceException] -> ShowS)
-> Show PersistenceException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PersistenceException -> ShowS
showsPrec :: Int -> PersistenceException -> ShowS
$cshow :: PersistenceException -> String
show :: PersistenceException -> String
$cshowList :: [PersistenceException] -> ShowS
showList :: [PersistenceException] -> ShowS
Show, PersistenceException -> PersistenceException -> Bool
(PersistenceException -> PersistenceException -> Bool)
-> (PersistenceException -> PersistenceException -> Bool)
-> Eq PersistenceException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PersistenceException -> PersistenceException -> Bool
== :: PersistenceException -> PersistenceException -> Bool
$c/= :: PersistenceException -> PersistenceException -> Bool
/= :: PersistenceException -> PersistenceException -> Bool
Eq, Show PersistenceException
Typeable PersistenceException
(Typeable PersistenceException, Show PersistenceException) =>
(PersistenceException -> SomeException)
-> (SomeException -> Maybe PersistenceException)
-> (PersistenceException -> String)
-> Exception PersistenceException
SomeException -> Maybe PersistenceException
PersistenceException -> String
PersistenceException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: PersistenceException -> SomeException
toException :: PersistenceException -> SomeException
$cfromException :: SomeException -> Maybe PersistenceException
fromException :: SomeException -> Maybe PersistenceException
$cdisplayException :: PersistenceException -> String
displayException :: PersistenceException -> String
Exception)

-- | A function that retrieves an entity from a database.
-- The function takes entity id as parameter.
-- If an entity with the given id exists in the database, it is returned as a Just value.
-- If no such entity exists, Nothing is returned.
-- An error is thrown if there are more than one entity with the given id.
selectById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> id -> IO (Either PersistenceException a)
selectById :: forall a id.
(Entity a, Convertible id SqlValue) =>
Conn -> id -> IO (Either PersistenceException a)
selectById Conn
conn id
idx = do
  -- print stmt
  Either SomeException [[SqlValue]]
eitherExResultRows <- IO [[SqlValue]] -> IO (Either SomeException [[SqlValue]])
forall e a. Exception e => IO a -> IO (Either e a)
try (IO [[SqlValue]] -> IO (Either SomeException [[SqlValue]]))
-> IO [[SqlValue]] -> IO (Either SomeException [[SqlValue]])
forall a b. (a -> b) -> a -> b
$ Conn -> String -> [SqlValue] -> IO [[SqlValue]]
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery Conn
conn String
stmt [SqlValue
eid]
  case Either SomeException [[SqlValue]]
eitherExResultRows of
    Left SomeException
ex -> Either PersistenceException a -> IO (Either PersistenceException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException a
 -> IO (Either PersistenceException a))
-> Either PersistenceException a
-> IO (Either PersistenceException a)
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException a
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException a)
-> PersistenceException -> Either PersistenceException a
forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right [[SqlValue]]
resultRowsSqlValues ->
      case [[SqlValue]]
resultRowsSqlValues of
        [] -> Either PersistenceException a -> IO (Either PersistenceException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException a
 -> IO (Either PersistenceException a))
-> Either PersistenceException a
-> IO (Either PersistenceException a)
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException a
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException a)
-> PersistenceException -> Either PersistenceException a
forall a b. (a -> b) -> a -> b
$ String -> PersistenceException
EntityNotFound (String -> PersistenceException) -> String -> PersistenceException
forall a b. (a -> b) -> a -> b
$ TypeInfo a -> String
forall {k} (a :: k). TypeInfo a -> String
constructorName TypeInfo a
ti String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SqlValue -> String
forall a. Show a => a -> String
show SqlValue
eid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found"
        [[SqlValue]
singleRow] -> do
          Either SomeException a
eitherExEntity <- IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO (Either SomeException a))
-> IO a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ Conn -> [SqlValue] -> IO a
forall a. Entity a => Conn -> [SqlValue] -> IO a
fromRow Conn
conn [SqlValue]
singleRow
          case Either SomeException a
eitherExEntity of
            Left SomeException
ex      -> Either PersistenceException a -> IO (Either PersistenceException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException a
 -> IO (Either PersistenceException a))
-> Either PersistenceException a
-> IO (Either PersistenceException a)
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException a
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException a)
-> PersistenceException -> Either PersistenceException a
forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
            Right a
entity -> Either PersistenceException a -> IO (Either PersistenceException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException a
 -> IO (Either PersistenceException a))
-> Either PersistenceException a
-> IO (Either PersistenceException a)
forall a b. (a -> b) -> a -> b
$ a -> Either PersistenceException a
forall a b. b -> Either a b
Right a
entity
        [[SqlValue]]
_ -> Either PersistenceException a -> IO (Either PersistenceException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException a
 -> IO (Either PersistenceException a))
-> Either PersistenceException a
-> IO (Either PersistenceException a)
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException a
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException a)
-> PersistenceException -> Either PersistenceException a
forall a b. (a -> b) -> a -> b
$ String -> PersistenceException
NoUniqueKey (String -> PersistenceException) -> String -> PersistenceException
forall a b. (a -> b) -> a -> b
$ String
"More than one " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeInfo a -> String
forall {k} (a :: k). TypeInfo a -> String
constructorName TypeInfo a
ti String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" found for id " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SqlValue -> String
forall a. Show a => a -> String
show SqlValue
eid
  where
    ti :: TypeInfo a
ti = forall a.
(HasConstructor (Rep a), HasSelectors (Rep a), Generic a) =>
TypeInfo a
typeInfo @a
    stmt :: String
stmt = forall a. Entity a => WhereClauseExpr -> String
selectFromStmt @a WhereClauseExpr
byIdColumn
    eid :: SqlValue
eid = id -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql id
idx

fromException :: SomeException -> PersistenceException
fromException :: SomeException -> PersistenceException
fromException SomeException
ex = String -> PersistenceException
DatabaseError (String -> PersistenceException) -> String -> PersistenceException
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
ex

-- | This function retrieves all entities of type `a` that match some query criteria.
--   The function takes an HDBC connection and a `WhereClauseExpr` as parameters.
--   The type `a` is determined by the context of the function call.
--   The function returns a (possibly empty) list of all matching entities.
--   The `WhereClauseExpr` is typically constructed using a tiny query dsl based on infix operators.
select :: forall a. (Entity a) => Conn -> WhereClauseExpr -> IO (Either PersistenceException [a])
select :: forall a.
Entity a =>
Conn -> WhereClauseExpr -> IO (Either PersistenceException [a])
select Conn
conn WhereClauseExpr
whereClause = do
  -- print stmt
  Either PersistenceException [[SqlValue]]
eitherExRows <- IO [[SqlValue]] -> IO (Either PersistenceException [[SqlValue]])
forall a. IO a -> IO (Either PersistenceException a)
tryPE (IO [[SqlValue]] -> IO (Either PersistenceException [[SqlValue]]))
-> IO [[SqlValue]] -> IO (Either PersistenceException [[SqlValue]])
forall a b. (a -> b) -> a -> b
$ Conn -> String -> [SqlValue] -> IO [[SqlValue]]
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery Conn
conn String
stmt [SqlValue]
values
  case Either PersistenceException [[SqlValue]]
eitherExRows of
    Left PersistenceException
ex          -> Either PersistenceException [a]
-> IO (Either PersistenceException [a])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException [a]
 -> IO (Either PersistenceException [a]))
-> Either PersistenceException [a]
-> IO (Either PersistenceException [a])
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException [a]
forall a b. a -> Either a b
Left PersistenceException
ex
    Right [[SqlValue]]
resultRows -> Conn -> [[SqlValue]] -> IO (Either PersistenceException [a])
forall a.
Entity a =>
Conn -> [[SqlValue]] -> IO (Either PersistenceException [a])
entitiesFromRows Conn
conn [[SqlValue]]
resultRows
  where
    stmt :: String
stmt = forall a. Entity a => WhereClauseExpr -> String
selectFromStmt @a WhereClauseExpr
whereClause
    values :: [SqlValue]
values = WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
whereClause

-- | This function retrieves the number of entities of type `a` that match some query criteria.
--   The function takes an HDBC connection and a `WhereClauseExpr` as parameters.
--   The type `a` is determined by the context of the function call.
--   The function returns the number of all matching entities.
--   The `WhereClauseExpr` is typically constructed using a tiny query dsl based on infix operators.
count :: forall a. (Entity a) => Conn -> WhereClauseExpr -> IO (Either PersistenceException Int)
count :: forall a.
Entity a =>
Conn -> WhereClauseExpr -> IO (Either PersistenceException Int)
count Conn
conn WhereClauseExpr
whereClause = do
  Either PersistenceException [[SqlValue]]
eitherExRows <- IO [[SqlValue]] -> IO (Either PersistenceException [[SqlValue]])
forall a. IO a -> IO (Either PersistenceException a)
tryPE (IO [[SqlValue]] -> IO (Either PersistenceException [[SqlValue]]))
-> IO [[SqlValue]] -> IO (Either PersistenceException [[SqlValue]])
forall a b. (a -> b) -> a -> b
$ Conn -> String -> [SqlValue] -> IO [[SqlValue]]
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery Conn
conn String
stmt [SqlValue]
values
  case Either PersistenceException [[SqlValue]]
eitherExRows of
    Left PersistenceException
ex          -> Either PersistenceException Int
-> IO (Either PersistenceException Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException Int
 -> IO (Either PersistenceException Int))
-> Either PersistenceException Int
-> IO (Either PersistenceException Int)
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException Int
forall a b. a -> Either a b
Left PersistenceException
ex
    Right [[SqlValue]]
resultRows -> Either PersistenceException Int
-> IO (Either PersistenceException Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException Int
 -> IO (Either PersistenceException Int))
-> Either PersistenceException Int
-> IO (Either PersistenceException Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either PersistenceException Int
forall a b. b -> Either a b
Right (Int -> Either PersistenceException Int)
-> Int -> Either PersistenceException Int
forall a b. (a -> b) -> a -> b
$ SqlValue -> Int
forall a. Convertible SqlValue a => SqlValue -> a
fromSql (SqlValue -> Int) -> SqlValue -> Int
forall a b. (a -> b) -> a -> b
$ [SqlValue] -> SqlValue
forall a. HasCallStack => [a] -> a
head ([SqlValue] -> SqlValue) -> [SqlValue] -> SqlValue
forall a b. (a -> b) -> a -> b
$ [[SqlValue]] -> [SqlValue]
forall a. HasCallStack => [a] -> a
head [[SqlValue]]
resultRows -- using head twice is safe here
  where
    stmt :: String
stmt = forall a. Entity a => WhereClauseExpr -> String
countStmtFor @a WhereClauseExpr
whereClause
    values :: [SqlValue]
values = WhereClauseExpr -> [SqlValue]
whereClauseValues WhereClauseExpr
whereClause

-- | This function converts a list of database rows, represented as a `[[SqlValue]]` to a list of entities.
--   The function takes an HDBC connection and a list of database rows as parameters.
--   The type `a` is determined by the context of the function call.
--   The function returns a (possibly empty) list of all matching entities.
--   The function is used internally by `retrieveAll` and `retrieveAllWhere`.
--   But it can also be used to convert the result of a custom SQL query to a list of entities.
entitiesFromRows :: forall a. (Entity a) => Conn -> [[SqlValue]] -> IO (Either PersistenceException [a])
entitiesFromRows :: forall a.
Entity a =>
Conn -> [[SqlValue]] -> IO (Either PersistenceException [a])
entitiesFromRows = (IO [a] -> IO (Either PersistenceException [a])
forall a. IO a -> IO (Either PersistenceException a)
tryPE .) (([[SqlValue]] -> IO [a])
 -> [[SqlValue]] -> IO (Either PersistenceException [a]))
-> (Conn -> [[SqlValue]] -> IO [a])
-> Conn
-> [[SqlValue]]
-> IO (Either PersistenceException [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SqlValue] -> IO a) -> [[SqlValue]] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([SqlValue] -> IO a) -> [[SqlValue]] -> IO [a])
-> (Conn -> [SqlValue] -> IO a) -> Conn -> [[SqlValue]] -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conn -> [SqlValue] -> IO a
forall a. Entity a => Conn -> [SqlValue] -> IO a
fromRow

-- | A function that persists an entity to a database.
-- The function takes an HDBC connection and an entity as parameters.
-- The entity is either inserted or updated, depending on whether it already exists in the database.
-- The required SQL statements are generated dynamically using Haskell generics and reflection
upsert :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ())
upsert :: forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
upsert Conn
conn a
entity = do
  Either SomeException ()
eitherExOrA <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ do
    [SqlValue]
row <- Conn -> a -> IO [SqlValue]
forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn a
entity
    [[SqlValue]]
_ <- Conn -> String -> [SqlValue] -> IO [[SqlValue]]
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery' Conn
conn (forall a. Entity a => String
upsertStmtFor @a) ([SqlValue]
row [SqlValue] -> [SqlValue] -> [SqlValue]
forall a. Semigroup a => a -> a -> a
<> [SqlValue]
row)
    Conn -> IO ()
commitIfAutoCommit Conn
conn
  case Either SomeException ()
eitherExOrA of
    Left SomeException
ex -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException ()
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException ())
-> PersistenceException -> Either PersistenceException ()
forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right ()
_ -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ () -> Either PersistenceException ()
forall a b. b -> Either a b
Right ()

-- | A function that persists an entity to a database.
-- The function takes an HDBC connection and an entity as parameters.
-- The entity is either inserted or updated, depending on whether it already exists in the database.
-- The required SQL statements are generated dynamically using Haskell generics and reflection
-- deprecated: use upsert instead
{-# DEPRECATED persist "use upsert instead" #-}
persist :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ())
persist :: forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
persist = Conn -> a -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
upsert


-- | A function that commits a transaction if the connection is in auto commit mode.
--   The function takes an HDBC connection as parameter.
commitIfAutoCommit :: Conn -> IO ()
commitIfAutoCommit :: Conn -> IO ()
commitIfAutoCommit (Conn Bool
autoCommit conn
conn) = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
autoCommit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ conn -> IO ()
forall conn. IConnection conn => conn -> IO ()
commit conn
conn

-- | A function that explicitely inserts an entity into a database.
--   The function takes an HDBC connection and an entity as parameters.
--   The entity, as retrieved from the database, is returned as a Right value if the entity was successfully inserted.
--   (this allows to handle automatically updated fields like auto-incremented primary keys)
--   If the entity could not be inserted, a Left value is returned, containing a PersistenceException.
insert :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException a)
insert :: forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException a)
insert Conn
conn a
entity = do
  Either SomeException a
eitherExOrA <- IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO (Either SomeException a))
-> IO a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ do
    [SqlValue]
row <- Conn -> a -> IO [SqlValue]
forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn a
entity
    [[SqlValue]
singleRow] <- Conn -> String -> [SqlValue] -> IO [[SqlValue]]
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery' Conn
conn (forall a. Entity a => String
insertReturningStmtFor @a) (forall a. Entity a => [SqlValue] -> [SqlValue]
removeAutoIncIdField @a [SqlValue]
row)
    Conn -> IO ()
commitIfAutoCommit Conn
conn
    forall a. Entity a => Conn -> [SqlValue] -> IO a
fromRow @a Conn
conn [SqlValue]
singleRow
  case Either SomeException a
eitherExOrA of
    Left SomeException
ex -> Either PersistenceException a -> IO (Either PersistenceException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException a
 -> IO (Either PersistenceException a))
-> Either PersistenceException a
-> IO (Either PersistenceException a)
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException a
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException a)
-> PersistenceException -> Either PersistenceException a
forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
handleDuplicateInsert SomeException
ex
    Right a
a -> Either PersistenceException a -> IO (Either PersistenceException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException a
 -> IO (Either PersistenceException a))
-> Either PersistenceException a
-> IO (Either PersistenceException a)
forall a b. (a -> b) -> a -> b
$ a -> Either PersistenceException a
forall a b. b -> Either a b
Right a
a

removeAutoIncIdField :: forall a. (Entity a) => [SqlValue] -> [SqlValue]
removeAutoIncIdField :: forall a. Entity a => [SqlValue] -> [SqlValue]
removeAutoIncIdField [SqlValue]
row =
  if forall a. Entity a => Bool
autoIncrement @a
    then case forall a. Entity a => Maybe Int
maybeIdFieldIndex @a of
      Maybe Int
Nothing      -> [SqlValue]
row
      Just Int
idIndex -> Int -> [SqlValue] -> [SqlValue]
forall a. Int -> [a] -> [a]
take Int
idIndex [SqlValue]
row [SqlValue] -> [SqlValue] -> [SqlValue]
forall a. [a] -> [a] -> [a]
++ Int -> [SqlValue] -> [SqlValue]
forall a. Int -> [a] -> [a]
drop (Int
idIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [SqlValue]
row
    else [SqlValue]
row

handleDuplicateInsert :: SomeException -> PersistenceException
handleDuplicateInsert :: SomeException -> PersistenceException
handleDuplicateInsert SomeException
ex =
  if String
"UNIQUE constraint failed"
    String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` SomeException -> String
forall a. Show a => a -> String
show SomeException
ex
    Bool -> Bool -> Bool
|| String
"duplicate key value violates unique constraint"
    String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` SomeException -> String
forall a. Show a => a -> String
show SomeException
ex
    then String -> PersistenceException
DuplicateInsert String
"Entity already exists in DB, use update instead"
    else SomeException -> PersistenceException
fromException SomeException
ex

tryPE :: IO a -> IO (Either PersistenceException a)
tryPE :: forall a. IO a -> IO (Either PersistenceException a)
tryPE IO a
action = do
  Either SomeException a
eitherExResult <- IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action
  case Either SomeException a
eitherExResult of
    Left SomeException
ex      -> Either PersistenceException a -> IO (Either PersistenceException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException a
 -> IO (Either PersistenceException a))
-> Either PersistenceException a
-> IO (Either PersistenceException a)
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException a
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException a)
-> PersistenceException -> Either PersistenceException a
forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right a
result -> Either PersistenceException a -> IO (Either PersistenceException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException a
 -> IO (Either PersistenceException a))
-> Either PersistenceException a
-> IO (Either PersistenceException a)
forall a b. (a -> b) -> a -> b
$ a -> Either PersistenceException a
forall a b. b -> Either a b
Right a
result

-- | A function that inserts a list of entities into a database.
--   The function takes an HDBC connection and a list of entities as parameters.
--   The insert-statement is compiled only once and then executed for each entity.
insertMany :: forall a. (Entity a) => Conn -> [a] -> IO (Either PersistenceException ())
insertMany :: forall a.
Entity a =>
Conn -> [a] -> IO (Either PersistenceException ())
insertMany Conn
conn [a]
entities = do
  Either SomeException ()
eitherExUnit <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ do
    [[SqlValue]]
rows <- (a -> IO [SqlValue]) -> [a] -> IO [[SqlValue]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Conn -> a -> IO [SqlValue]
forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn) [a]
entities
    Statement
stmt <- Conn -> String -> IO Statement
forall conn. IConnection conn => conn -> String -> IO Statement
prepare Conn
conn (forall a. Entity a => String
insertStmtFor @a)
    Statement -> [[SqlValue]] -> IO ()
executeMany Statement
stmt (([SqlValue] -> [SqlValue]) -> [[SqlValue]] -> [[SqlValue]]
forall a b. (a -> b) -> [a] -> [b]
map (forall a. Entity a => [SqlValue] -> [SqlValue]
removeAutoIncIdField @a) [[SqlValue]]
rows)
    Conn -> IO ()
commitIfAutoCommit Conn
conn
  case Either SomeException ()
eitherExUnit of
    Left SomeException
ex -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException ()
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException ())
-> PersistenceException -> Either PersistenceException ()
forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
handleDuplicateInsert SomeException
ex
    Right ()
_ -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ () -> Either PersistenceException ()
forall a b. b -> Either a b
Right ()

-- | A function that explicitely updates an entity in a database.
--  The function takes an HDBC connection and an entity as parameters.
update :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ())
update :: forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
update Conn
conn a
entity = do
  Either SomeException (Either PersistenceException ())
eitherExUnit <- IO (Either PersistenceException ())
-> IO (Either SomeException (Either PersistenceException ()))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Either PersistenceException ())
 -> IO (Either SomeException (Either PersistenceException ())))
-> IO (Either PersistenceException ())
-> IO (Either SomeException (Either PersistenceException ()))
forall a b. (a -> b) -> a -> b
$ do
    SqlValue
eid <- Conn -> a -> IO SqlValue
forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn a
entity
    [SqlValue]
row <- Conn -> a -> IO [SqlValue]
forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn a
entity
    Integer
rowcount <- Conn -> String -> [SqlValue] -> IO Integer
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO Integer
run Conn
conn (forall a. Entity a => String
updateStmtFor @a) ([SqlValue]
row [SqlValue] -> [SqlValue] -> [SqlValue]
forall a. [a] -> [a] -> [a]
++ [SqlValue
eid])
    if Integer
rowcount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
      then Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistenceException -> Either PersistenceException ()
forall a b. a -> Either a b
Left (String -> PersistenceException
EntityNotFound (TypeInfo a -> String
forall {k} (a :: k). TypeInfo a -> String
constructorName (forall a.
(HasConstructor (Rep a), HasSelectors (Rep a), Generic a) =>
TypeInfo a
typeInfo @a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SqlValue -> String
forall a. Show a => a -> String
show SqlValue
eid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not exist")))
      else do
        Conn -> IO ()
commitIfAutoCommit Conn
conn
        Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ () -> Either PersistenceException ()
forall a b. b -> Either a b
Right ()
  case Either SomeException (Either PersistenceException ())
eitherExUnit of
    Left SomeException
ex      -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException ()
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException ())
-> PersistenceException -> Either PersistenceException ()
forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right Either PersistenceException ()
result -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either PersistenceException ()
result

-- | A function that updates a list of entities in a database.
--   The function takes an HDBC connection and a list of entities as parameters.
--   The update-statement is compiled only once and then executed for each entity.
updateMany :: forall a. (Entity a) => Conn -> [a] -> IO (Either PersistenceException ())
updateMany :: forall a.
Entity a =>
Conn -> [a] -> IO (Either PersistenceException ())
updateMany Conn
conn [a]
entities = IO () -> IO (Either PersistenceException ())
forall a. IO a -> IO (Either PersistenceException a)
tryPE (IO () -> IO (Either PersistenceException ()))
-> IO () -> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ do
  [SqlValue]
eids <- (a -> IO SqlValue) -> [a] -> IO [SqlValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Conn -> a -> IO SqlValue
forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn) [a]
entities
  [[SqlValue]]
rows <- (a -> IO [SqlValue]) -> [a] -> IO [[SqlValue]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Conn -> a -> IO [SqlValue]
forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn) [a]
entities
  Statement
stmt <- Conn -> String -> IO Statement
forall conn. IConnection conn => conn -> String -> IO Statement
prepare Conn
conn (forall a. Entity a => String
updateStmtFor @a)
  -- the update statement has one more parameter than the row: the id value for the where clause
  Statement -> [[SqlValue]] -> IO ()
executeMany Statement
stmt (([SqlValue] -> SqlValue -> [SqlValue])
-> [[SqlValue]] -> [SqlValue] -> [[SqlValue]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[SqlValue]
l SqlValue
x -> [SqlValue]
l [SqlValue] -> [SqlValue] -> [SqlValue]
forall a. [a] -> [a] -> [a]
++ [SqlValue
x]) [[SqlValue]]
rows [SqlValue]
eids)
  Conn -> IO ()
commitIfAutoCommit Conn
conn

-- | A function that deletes an entity from a database.
--   The function takes an HDBC connection and an entity as parameters.
delete :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ())
delete :: forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
delete Conn
conn a
entity = do
  Either SomeException (Either PersistenceException ())
eitherExRes <- IO (Either PersistenceException ())
-> IO (Either SomeException (Either PersistenceException ()))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Either PersistenceException ())
 -> IO (Either SomeException (Either PersistenceException ())))
-> IO (Either PersistenceException ())
-> IO (Either SomeException (Either PersistenceException ()))
forall a b. (a -> b) -> a -> b
$ do
    SqlValue
eid <- Conn -> a -> IO SqlValue
forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn a
entity
    Integer
rowCount <- Conn -> String -> [SqlValue] -> IO Integer
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO Integer
run Conn
conn (forall a. Entity a => String
deleteStmtFor @a) [SqlValue
eid]
    if Integer
rowCount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
      then Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistenceException -> Either PersistenceException ()
forall a b. a -> Either a b
Left (String -> PersistenceException
EntityNotFound (TypeInfo a -> String
forall {k} (a :: k). TypeInfo a -> String
constructorName (forall a.
(HasConstructor (Rep a), HasSelectors (Rep a), Generic a) =>
TypeInfo a
typeInfo @a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SqlValue -> String
forall a. Show a => a -> String
show SqlValue
eid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not exist")))
      else do
        Conn -> IO ()
commitIfAutoCommit Conn
conn
        Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ () -> Either PersistenceException ()
forall a b. b -> Either a b
Right ()
  case Either SomeException (Either PersistenceException ())
eitherExRes of
    Left SomeException
ex      -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException ()
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException ())
-> PersistenceException -> Either PersistenceException ()
forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right Either PersistenceException ()
result -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either PersistenceException ()
result

-- | A function that deletes an entity from a database by its id.
--   The function takes an HDBC connection and an entity id as parameters.
deleteById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> id -> IO (Either PersistenceException ())
deleteById :: forall a id.
(Entity a, Convertible id SqlValue) =>
Conn -> id -> IO (Either PersistenceException ())
deleteById Conn
conn id
idx = do
  Either SomeException (Either PersistenceException ())
eitherExRes <- IO (Either PersistenceException ())
-> IO (Either SomeException (Either PersistenceException ()))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Either PersistenceException ())
 -> IO (Either SomeException (Either PersistenceException ())))
-> IO (Either PersistenceException ())
-> IO (Either SomeException (Either PersistenceException ()))
forall a b. (a -> b) -> a -> b
$ do
    let eid :: SqlValue
eid = id -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql id
idx
    Integer
rowCount <- Conn -> String -> [SqlValue] -> IO Integer
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO Integer
run Conn
conn (forall a. Entity a => String
deleteStmtFor @a) [SqlValue
eid]
    if Integer
rowCount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
      then Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistenceException -> Either PersistenceException ()
forall a b. a -> Either a b
Left (String -> PersistenceException
EntityNotFound (TypeInfo a -> String
forall {k} (a :: k). TypeInfo a -> String
constructorName (forall a.
(HasConstructor (Rep a), HasSelectors (Rep a), Generic a) =>
TypeInfo a
typeInfo @a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SqlValue -> String
forall a. Show a => a -> String
show SqlValue
eid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not exist")))
      else do
        Conn -> IO ()
commitIfAutoCommit Conn
conn
        Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ () -> Either PersistenceException ()
forall a b. b -> Either a b
Right ()
  case Either SomeException (Either PersistenceException ())
eitherExRes of
    Left SomeException
ex      -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PersistenceException ()
 -> IO (Either PersistenceException ()))
-> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ PersistenceException -> Either PersistenceException ()
forall a b. a -> Either a b
Left (PersistenceException -> Either PersistenceException ())
-> PersistenceException -> Either PersistenceException ()
forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right Either PersistenceException ()
result -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either PersistenceException ()
result

-- | A function that deletes a list of entities from a database by their ids.
--   The function takes an HDBC connection and a list of entity ids as parameters.
deleteManyById :: forall a id. (Entity a, Convertible id SqlValue) => Conn -> [id] -> IO (Either PersistenceException ())
deleteManyById :: forall a id.
(Entity a, Convertible id SqlValue) =>
Conn -> [id] -> IO (Either PersistenceException ())
deleteManyById Conn
conn [id]
ids = IO () -> IO (Either PersistenceException ())
forall a. IO a -> IO (Either PersistenceException a)
tryPE (IO () -> IO (Either PersistenceException ()))
-> IO () -> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ do
  Statement
stmt <- Conn -> String -> IO Statement
forall conn. IConnection conn => conn -> String -> IO Statement
prepare Conn
conn (forall a. Entity a => String
deleteStmtFor @a)
  Statement -> [[SqlValue]] -> IO ()
executeMany Statement
stmt ((id -> [SqlValue]) -> [id] -> [[SqlValue]]
forall a b. (a -> b) -> [a] -> [b]
map ((SqlValue -> [SqlValue] -> [SqlValue]
forall a. a -> [a] -> [a]
: []) (SqlValue -> [SqlValue]) -> (id -> SqlValue) -> id -> [SqlValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. id -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql) [id]
ids)
  Conn -> IO ()
commitIfAutoCommit Conn
conn

-- | A function that deletes a list of entities from a database.
--   The function takes an HDBC connection and a list of entities as parameters.
--   The delete-statement is compiled only once and then executed for each entity.
deleteMany :: forall a. (Entity a) => Conn -> [a] -> IO (Either PersistenceException ())
deleteMany :: forall a.
Entity a =>
Conn -> [a] -> IO (Either PersistenceException ())
deleteMany Conn
conn [a]
entities = IO () -> IO (Either PersistenceException ())
forall a. IO a -> IO (Either PersistenceException a)
tryPE (IO () -> IO (Either PersistenceException ()))
-> IO () -> IO (Either PersistenceException ())
forall a b. (a -> b) -> a -> b
$ do
  [SqlValue]
eids <- (a -> IO SqlValue) -> [a] -> IO [SqlValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Conn -> a -> IO SqlValue
forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn) [a]
entities
  Statement
stmt <- Conn -> String -> IO Statement
forall conn. IConnection conn => conn -> String -> IO Statement
prepare Conn
conn (forall a. Entity a => String
deleteStmtFor @a)
  Statement -> [[SqlValue]] -> IO ()
executeMany Statement
stmt ((SqlValue -> [SqlValue]) -> [SqlValue] -> [[SqlValue]]
forall a b. (a -> b) -> [a] -> [b]
map (SqlValue -> [SqlValue] -> [SqlValue]
forall a. a -> [a] -> [a]
: []) [SqlValue]
eids)
  Conn -> IO ()
commitIfAutoCommit Conn
conn

-- | set up a table for a given entity type. The table is dropped (if existing) and recreated.
--   The function takes an HDBC connection and a column type mapping as parameters.
setupTable :: forall a. (Entity a) => Conn -> ColumnTypeMapping -> IO ()
setupTable :: forall a. Entity a => Conn -> ShowS -> IO ()
setupTable Conn
conn ShowS
mapping = do
  Conn -> String -> IO ()
forall conn. IConnection conn => conn -> String -> IO ()
runRaw Conn
conn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ forall a. Entity a => String
dropTableStmtFor @a
  Conn -> String -> IO ()
forall conn. IConnection conn => conn -> String -> IO ()
runRaw Conn
conn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ forall a. Entity a => ShowS -> String
createTableStmtFor @a ShowS
mapping
  Conn -> IO ()
commitIfAutoCommit Conn
conn

-- | A function that returns the primary key value of an entity as a SqlValue.
--   The function takes an HDBC connection and an entity as parameters.
idValue :: forall a. (Entity a) => Conn -> a -> IO SqlValue
idValue :: forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn a
x = do
  [SqlValue]
sqlValues <- Conn -> a -> IO [SqlValue]
forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn a
x
  SqlValue -> IO SqlValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SqlValue]
sqlValues [SqlValue] -> Int -> SqlValue
forall a. HasCallStack => [a] -> Int -> a
!! Int
idFieldIndex)
  where
    idFieldIndex :: Int
idFieldIndex = forall a. Entity a => String -> Int
fieldIndex @a (forall a. Entity a => String
idField @a)

-- | an alias for a simple quasiqouter
sql :: QuasiQuoter
sql :: QuasiQuoter
sql = QuasiQuoter
r

-- | These instances are needed to make the Convertible type class work with Enum types out of the box.
--   This is needed because the Convertible type class is used to convert SqlValues to Haskell types.
instance {-# OVERLAPS #-} forall a. (Enum a) => Convertible SqlValue a where
  safeConvert :: SqlValue -> ConvertResult a
  safeConvert :: SqlValue -> ConvertResult a
safeConvert = a -> ConvertResult a
forall a b. b -> Either a b
Right (a -> ConvertResult a)
-> (SqlValue -> a) -> SqlValue -> ConvertResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (SqlValue -> Int) -> SqlValue -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlValue -> Int
forall a. Convertible SqlValue a => SqlValue -> a
fromSql

instance {-# OVERLAPS #-} forall a. (Enum a) => Convertible a SqlValue where
  safeConvert :: a -> ConvertResult SqlValue
  safeConvert :: a -> ConvertResult SqlValue
safeConvert = SqlValue -> ConvertResult SqlValue
forall a b. b -> Either a b
Right (SqlValue -> ConvertResult SqlValue)
-> (a -> SqlValue) -> a -> ConvertResult SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql (Int -> SqlValue) -> (a -> Int) -> a -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum