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

module Database.GP.GenericPersistenceSafe
  ( selectById,
    select,
    entitiesFromRows,
    sql,
    persist,
    insert,
    insertReturning,
    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                (elemIndex, 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
(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 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 <- 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 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
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 <- 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
    let stmt :: String
stmt = forall a. Entity a => WhereClauseExpr -> String
selectFromStmt @a WhereClauseExpr
byIdColumn
    Conn -> String -> [SqlValue] -> IO [[SqlValue]]
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery Conn
conn String
stmt [SqlValue
eid] IO [[SqlValue]]
-> ([[SqlValue]] -> IO (Either PersistenceException ()))
-> IO (Either PersistenceException ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      \case
        []           -> Conn -> a -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
insert Conn
conn a
entity
        [[SqlValue]
_singleRow] -> Conn -> a -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
update Conn
conn a
entity
        [[SqlValue]]
_            -> 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
$ String -> PersistenceException
NoUniqueKey (String -> PersistenceException) -> String -> PersistenceException
forall a b. (a -> b) -> a -> b
$ String
"More than one entity found for id " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SqlValue -> String
forall a. Show a => a -> String
show SqlValue
eid
  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 ()
res -> Either PersistenceException ()
-> IO (Either PersistenceException ())
forall a. a -> IO a
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 = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Conn -> Bool
implicitCommit Conn
conn) (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.
insert :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException ())
insert :: forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
insert Conn
conn a
entity = 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]
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
insertStmtFor @a) [SqlValue]
row
    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 ()

insertReturning :: forall a. (Entity a) => Conn -> a -> IO (Either PersistenceException a)
insertReturning :: forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException a)
insertReturning Conn
conn a
entity = do
  Either SomeException a
eitherExUnit <- 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]]
rowInserted <- Conn -> String -> [SqlValue] -> IO [[SqlValue]]
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery Conn
conn (forall a. Entity a => String
insertReturningStmtFor @a) ([SqlValue] -> [SqlValue]
forall a. HasCallStack => [a] -> [a]
tail [SqlValue]
row)
    --commitIfAutoCommit conn
    case [[SqlValue]]
rowInserted of
      [[SqlValue]
singleRow] -> Conn -> [SqlValue] -> IO a
forall a. Entity a => Conn -> [SqlValue] -> IO a
fromRow Conn
conn [SqlValue]
singleRow
      [[SqlValue]]
_     -> String -> IO a
forall a. HasCallStack => String -> a
error String
"insertReturning: more than one row inserted"
  case Either SomeException a
eitherExUnit 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    

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]]
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.
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 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 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
  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
$ 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 <- 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)

-- | returns the index of a field of an entity.
--   The index is the position of the field in the list of fields of the entity.
--   If no such field exists, an error is thrown.
--   The function takes an field name as parameters,
--   the type of the entity is determined by the context.
fieldIndex :: forall a. (Entity a) => String -> Int
fieldIndex :: forall a. Entity a => String -> Int
fieldIndex String
fieldName =
  String -> Maybe Int -> Int
forall a. String -> Maybe a -> a
expectJust
    (String
"Field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not present in type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeInfo a -> String
forall {k} (a :: k). TypeInfo a -> String
constructorName TypeInfo a
ti)
    (String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
fieldName [String]
fieldList)
  where
    ti :: TypeInfo a
ti = forall a.
(HasConstructor (Rep a), HasSelectors (Rep a), Generic a) =>
TypeInfo a
typeInfo @a
    fieldList :: [String]
fieldList = TypeInfo a -> [String]
forall {k} (a :: k). TypeInfo a -> [String]
fieldNames TypeInfo a
ti

expectJust :: String -> Maybe a -> a
expectJust :: forall a. String -> Maybe a -> a
expectJust String
_ (Just a
x)  = a
x
expectJust String
err Maybe a
Nothing = String -> a
forall a. HasCallStack => String -> a
error (String
"expectJust " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err)

-- 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