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

module Database.GP.GenericPersistenceSafe
  ( selectById,
    select,
    entitiesFromRows,
    sql,
    persist,
    insert,
    insertMany,
    update,
    updateMany,
    delete,
    deleteMany,
    setupTableFor,
    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
  )
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           Text.RawString.QQ
import           Language.Haskell.TH.Quote (QuasiQuoter)

{- |
 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistenceException] -> ShowS
$cshowList :: [PersistenceException] -> ShowS
show :: PersistenceException -> String
$cshow :: PersistenceException -> String
showsPrec :: Int -> PersistenceException -> ShowS
$cshowsPrec :: Int -> PersistenceException -> ShowS
Show, PersistenceException -> PersistenceException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersistenceException -> PersistenceException -> Bool
$c/= :: PersistenceException -> PersistenceException -> Bool
== :: PersistenceException -> PersistenceException -> Bool
$c== :: PersistenceException -> PersistenceException -> Bool
Eq, Show PersistenceException
Typeable PersistenceException
SomeException -> Maybe PersistenceException
PersistenceException -> String
PersistenceException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: PersistenceException -> String
$cdisplayException :: PersistenceException -> String
fromException :: SomeException -> Maybe PersistenceException
$cfromException :: SomeException -> Maybe PersistenceException
toException :: PersistenceException -> SomeException
$ctoException :: PersistenceException -> SomeException
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 <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right [[SqlValue]]
resultRowsSqlValues ->
      case [[SqlValue]]
resultRowsSqlValues of
        [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> PersistenceException
EntityNotFound forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). TypeInfo a -> String
constructorName TypeInfo a
ti forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SqlValue
eid forall a. [a] -> [a] -> [a]
++ String
" not found"
        [[SqlValue]
singleRow] -> do
          Either SomeException a
eitherExEntity <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall a. Entity a => Conn -> [SqlValue] -> IO a
fromRow Conn
conn [SqlValue]
singleRow
          case Either SomeException a
eitherExEntity of
            Left SomeException
ex      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
            Right a
entity -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
entity
        [[SqlValue]]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> PersistenceException
NoUniqueKey forall a b. (a -> b) -> a -> b
$ String
"More than one " forall a. [a] -> [a] -> [a]
++ forall {k} (a :: k). TypeInfo a -> String
constructorName TypeInfo a
ti forall a. [a] -> [a] -> [a]
++ String
" found for id " forall a. [a] -> [a] -> [a]
++ 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 = forall a. Convertible a SqlValue => a -> SqlValue
toSql id
idx

fromException :: SomeException -> PersistenceException
fromException :: SomeException -> PersistenceException
fromException SomeException
ex = String -> PersistenceException
DatabaseError forall a b. (a -> b) -> a -> b
$ 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 any 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 <- forall a. IO a -> IO (Either PersistenceException a)
tryPE forall a b. (a -> b) -> a -> b
$ 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          -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left PersistenceException
ex
    Right [[SqlValue]]
resultRows -> 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 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 = (forall a. IO a -> IO (Either PersistenceException a)
tryPE .) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
persist :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ())
persist :: forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
persist Conn
conn a
entity = do
  Either SomeException (Either PersistenceException ())
eitherExRes <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
    SqlValue
eid <- forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn a
entity
    let stmt :: String
stmt = forall a. Entity a => WhereClauseExpr -> String
selectFromStmt @a WhereClauseExpr
byIdColumn
    forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery Conn
conn String
stmt [SqlValue
eid] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      \case
        []           -> forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException a)
insert Conn
conn a
entity forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ())
        [[SqlValue]
_singleRow] -> forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
update Conn
conn a
entity
        [[SqlValue]]
_            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> PersistenceException
NoUniqueKey forall a b. (a -> b) -> a -> b
$ String
"More than one entity found for id " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SqlValue
eid
  case Either SomeException (Either PersistenceException ())
eitherExRes of
    Left SomeException
ex   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right Either PersistenceException ()
res -> forall (m :: * -> *) a. Monad m => a -> m a
return Either PersistenceException ()
res

-- | 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
conn = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Conn -> Bool
implicitCommit Conn
conn) forall a b. (a -> b) -> a -> b
$ forall conn. IConnection conn => conn -> IO ()
commit Conn
conn

-- | A function that explicitely inserts an entity into a database.
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 <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
    [SqlValue]
row <- forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn a
entity
    [[SqlValue]
singleRow] <- 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]
removeIdField @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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
handleDuplicateInsert SomeException
ex
    Right a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
a    

removeIdField :: forall a. (Entity a) => [SqlValue] -> [SqlValue]
removeIdField :: forall a. Entity a => [SqlValue] -> [SqlValue]
removeIdField [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 -> forall a. Int -> [a] -> [a]
take Int
idIndex [SqlValue]
row forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop (Int
idIndex 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" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` forall a. Show a => a -> String
show SomeException
ex Bool -> Bool -> Bool
||
     String
"duplicate key value violates unique constraint" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` 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 <- forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action
  case Either SomeException a
eitherExResult of
    Left SomeException
ex      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right a
result -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
    [[SqlValue]]
rows <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn) [a]
entities
    Statement
stmt <- forall conn. IConnection conn => conn -> String -> IO Statement
prepare Conn
conn (forall a. Entity a => String
insertStmtFor @a)
    Statement -> [[SqlValue]] -> IO ()
executeMany Statement
stmt (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Entity a => [SqlValue] -> [SqlValue]
removeIdField @a) [[SqlValue]]
rows)
    Conn -> IO ()
commitIfAutoCommit Conn
conn
  case Either SomeException ()
eitherExUnit of
    Left SomeException
ex -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
handleDuplicateInsert SomeException
ex
    Right ()
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()


-- | A function that explicitely updates an entity in a database.
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 <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
    SqlValue
eid <- forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn a
entity
    [SqlValue]
row <- forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn a
entity
    Integer
rowcount <- forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO Integer
run Conn
conn (forall a. Entity a => String
updateStmtFor @a) ([SqlValue]
row forall a. [a] -> [a] -> [a]
++ [SqlValue
eid])
    if Integer
rowcount forall a. Eq a => a -> a -> Bool
== Integer
0
      then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> PersistenceException
EntityNotFound (forall {k} (a :: k). TypeInfo a -> String
constructorName (forall a.
(HasConstructor (Rep a), HasSelectors (Rep a), Generic a) =>
TypeInfo a
typeInfo @a) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SqlValue
eid forall a. [a] -> [a] -> [a]
++ String
" does not exist")))
      else do
        Conn -> IO ()
commitIfAutoCommit Conn
conn
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
  case Either SomeException (Either PersistenceException ())
eitherExUnit of
    Left SomeException
ex      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right Either PersistenceException ()
result -> 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 = forall a. IO a -> IO (Either PersistenceException a)
tryPE forall a b. (a -> b) -> a -> b
$ do
  [SqlValue]
eids <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn) [a]
entities
  [[SqlValue]]
rows <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn) [a]
entities
  Statement
stmt <- 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 (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[SqlValue]
l SqlValue
x -> [SqlValue]
l 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 <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ do
    SqlValue
eid <- forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn a
entity
    Integer
rowCount <- forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO Integer
run Conn
conn (forall a. Entity a => String
deleteStmtFor @a) [SqlValue
eid]
    if Integer
rowCount forall a. Eq a => a -> a -> Bool
== Integer
0
      then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> PersistenceException
EntityNotFound (forall {k} (a :: k). TypeInfo a -> String
constructorName (forall a.
(HasConstructor (Rep a), HasSelectors (Rep a), Generic a) =>
TypeInfo a
typeInfo @a) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SqlValue
eid forall a. [a] -> [a] -> [a]
++ String
" does not exist")))
      else do
        Conn -> IO ()
commitIfAutoCommit Conn
conn
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
  case Either SomeException (Either PersistenceException ())
eitherExRes of
    Left SomeException
ex      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SomeException -> PersistenceException
fromException SomeException
ex
    Right Either PersistenceException ()
result -> forall (m :: * -> *) a. Monad m => a -> m a
return Either PersistenceException ()
result

-- | 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 = forall a. IO a -> IO (Either PersistenceException a)
tryPE forall a b. (a -> b) -> a -> b
$ do
  [SqlValue]
eids <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Entity a => Conn -> a -> IO SqlValue
idValue Conn
conn) [a]
entities
  Statement
stmt <- forall conn. IConnection conn => conn -> String -> IO Statement
prepare Conn
conn (forall a. Entity a => String
deleteStmtFor @a)
  Statement -> [[SqlValue]] -> IO ()
executeMany Statement
stmt (forall a b. (a -> b) -> [a] -> [b]
map (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 as parameter.
setupTableFor :: forall a. (Entity a) => Database -> Conn -> IO ()
setupTableFor :: forall a. Entity a => Database -> Conn -> IO ()
setupTableFor Database
db Conn
conn = do
  --print stmt
  forall conn. IConnection conn => conn -> String -> IO ()
runRaw Conn
conn forall a b. (a -> b) -> a -> b
$ forall a. Entity a => String
dropTableStmtFor @a
  forall conn. IConnection conn => conn -> String -> IO ()
runRaw Conn
conn forall a b. (a -> b) -> a -> b
$ String
stmt -- createTableStmtFor @a (db conn)
  Conn -> IO ()
commitIfAutoCommit Conn
conn
  where
    stmt :: String
stmt = forall a. Entity a => Database -> String
createTableStmtFor @a Database
db 

-- | 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 <- forall a. Entity a => Conn -> a -> IO [SqlValue]
toRow Conn
conn a
x
  forall (m :: * -> *) a. Monad m => a -> m a
return ([SqlValue]
sqlValues forall a. [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 = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Convertible a SqlValue => a -> SqlValue
toSql forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum