{-# LANGUAGE AllowAmbiguousTypes #-}
module Database.GP.GenericPersistence
  ( selectById,
    select,
    entitiesFromRows,
    persist,
    insert,
    insertMany,
    update,
    updateMany,
    delete,
    deleteMany,
    setupTableFor,
    idValue,
    Conn(..),
    connect,
    Database(..),
    ConnectionPool,
    createConnPool,
    withResource,
    Entity (..),
    GToRow,
    GFromRow,
    columnNameFor,
    maybeFieldTypeFor,
    toString,
    TypeInfo (..),
    typeInfo,
    PersistenceException(..),
    WhereClauseExpr,
    Field,
    field,
    (&&.),
    (||.),
    (=.),
    (>.),
    (<.),
    (>=.),
    (<=.),
    (<>.),
    like,
    contains,
    between,
    in',  
    isNull,
    not',
    sqlFun,
    allEntries,
    byId,
  )
where

import           Control.Exception
import           Control.Monad                      (when)
import           Data.Convertible                   (Convertible)
import           Data.List                          (elemIndex)
import           Database.GP.Conn
import           Database.GP.Entity
import           Database.GP.GenericPersistenceSafe (PersistenceException)
import qualified Database.GP.GenericPersistenceSafe as GpSafe
import           Database.GP.SqlGenerator
import           Database.GP.TypeInfo
import           Database.HDBC

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

-- | 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 (Maybe a)
selectById :: forall a id.
(Entity a, Convertible id SqlValue) =>
Conn -> id -> IO (Maybe a)
selectById Conn
conn id
idx = do
  Either PersistenceException a
eitherExEntity <- Conn -> id -> IO (Either PersistenceException a)
forall a id.
(Entity a, Convertible id SqlValue) =>
Conn -> id -> IO (Either PersistenceException a)
GpSafe.selectById Conn
conn id
idx
  case Either PersistenceException a
eitherExEntity of
    Left (GpSafe.EntityNotFound String
_) -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Left PersistenceException
ex                        -> PersistenceException -> IO (Maybe a)
forall a e. Exception e => e -> a
throw PersistenceException
ex
    Right a
entity                   -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
entity

-- | This function retrieves all entities of type `a` from a database.
--  The function takes an HDBC connection as parameter.
--  The type `a` is determined by the context of the function call.
-- retrieveAll :: forall a. (Entity a) => Conn -> IO [a]
-- retrieveAll conn = do
--   eitherExRow <- GpSafe.retrieveAll @a conn
--   case eitherExRow of
--     Left ex    -> throw ex
--     Right rows -> pure rows

-- | 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 [a]
select :: forall a. Entity a => Conn -> WhereClauseExpr -> IO [a]
select Conn
conn WhereClauseExpr
whereClause = do
  Either PersistenceException [a]
eitherExEntities <- forall a.
Entity a =>
Conn -> WhereClauseExpr -> IO (Either PersistenceException [a])
GpSafe.select @a Conn
conn WhereClauseExpr
whereClause
  case Either PersistenceException [a]
eitherExEntities of
    Left PersistenceException
ex        -> PersistenceException -> IO [a]
forall a e. Exception e => e -> a
throw PersistenceException
ex
    Right [a]
entities -> [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
entities

-- | 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 [a]
entitiesFromRows :: forall a. Entity a => Conn -> [[SqlValue]] -> IO [a]
entitiesFromRows Conn
conn [[SqlValue]]
rows = do
  Either PersistenceException [a]
eitherExEntities <- forall a.
Entity a =>
Conn -> [[SqlValue]] -> IO (Either PersistenceException [a])
GpSafe.entitiesFromRows @a Conn
conn [[SqlValue]]
rows
  case Either PersistenceException [a]
eitherExEntities of
    Left PersistenceException
ex        -> PersistenceException -> IO [a]
forall a e. Exception e => e -> a
throw PersistenceException
ex
    Right [a]
entities -> [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
entities

fromEitherExUnit :: IO (Either PersistenceException ()) -> IO ()
fromEitherExUnit :: IO (Either PersistenceException ()) -> IO ()
fromEitherExUnit IO (Either PersistenceException ())
ioEitherExUnit = do
  Either PersistenceException ()
eitherExUnit <- IO (Either PersistenceException ())
ioEitherExUnit
  case Either PersistenceException ()
eitherExUnit of
    Left PersistenceException
ex -> PersistenceException -> IO ()
forall a e. Exception e => e -> a
throw PersistenceException
ex
    Right ()
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | 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 ()
persist :: forall a. Entity a => Conn -> a -> IO ()
persist = (IO (Either PersistenceException ()) -> IO ()
fromEitherExUnit .) ((a -> IO (Either PersistenceException ())) -> a -> IO ())
-> (Conn -> a -> IO (Either PersistenceException ()))
-> Conn
-> a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conn -> a -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
GpSafe.persist

-- | A function that explicitely inserts an entity into a database.
insert :: forall a. (Entity a) => Conn -> a -> IO ()
insert :: forall a. Entity a => Conn -> a -> IO ()
insert = (IO (Either PersistenceException ()) -> IO ()
fromEitherExUnit .) ((a -> IO (Either PersistenceException ())) -> a -> IO ())
-> (Conn -> a -> IO (Either PersistenceException ()))
-> Conn
-> a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conn -> a -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
GpSafe.insert

-- | 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 ()
insertMany :: forall a. Entity a => Conn -> [a] -> IO ()
insertMany = (IO (Either PersistenceException ()) -> IO ()
fromEitherExUnit .) (([a] -> IO (Either PersistenceException ())) -> [a] -> IO ())
-> (Conn -> [a] -> IO (Either PersistenceException ()))
-> Conn
-> [a]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conn -> [a] -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> [a] -> IO (Either PersistenceException ())
GpSafe.insertMany

-- | A function that explicitely updates an entity in a database.
update :: forall a. (Entity a) => Conn -> a -> IO ()
update :: forall a. Entity a => Conn -> a -> IO ()
update = (IO (Either PersistenceException ()) -> IO ()
fromEitherExUnit .) ((a -> IO (Either PersistenceException ())) -> a -> IO ())
-> (Conn -> a -> IO (Either PersistenceException ()))
-> Conn
-> a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conn -> a -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
GpSafe.update

-- | 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 ()
updateMany :: forall a. Entity a => Conn -> [a] -> IO ()
updateMany = (IO (Either PersistenceException ()) -> IO ()
fromEitherExUnit .) (([a] -> IO (Either PersistenceException ())) -> [a] -> IO ())
-> (Conn -> [a] -> IO (Either PersistenceException ()))
-> Conn
-> [a]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conn -> [a] -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> [a] -> IO (Either PersistenceException ())
GpSafe.updateMany

-- | 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 ()
delete :: forall a. Entity a => Conn -> a -> IO ()
delete = (IO (Either PersistenceException ()) -> IO ()
fromEitherExUnit .) ((a -> IO (Either PersistenceException ())) -> a -> IO ())
-> (Conn -> a -> IO (Either PersistenceException ()))
-> Conn
-> a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conn -> a -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> a -> IO (Either PersistenceException ())
GpSafe.delete

-- | 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 ()
deleteMany :: forall a. Entity a => Conn -> [a] -> IO ()
deleteMany = (IO (Either PersistenceException ()) -> IO ()
fromEitherExUnit .) (([a] -> IO (Either PersistenceException ())) -> [a] -> IO ())
-> (Conn -> [a] -> IO (Either PersistenceException ()))
-> Conn
-> [a]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conn -> [a] -> IO (Either PersistenceException ())
forall a.
Entity a =>
Conn -> [a] -> IO (Either PersistenceException ())
GpSafe.deleteMany

-- | 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) => Conn -> IO ()
setupTableFor :: forall a. Entity a => Conn -> IO ()
setupTableFor Conn
conn = 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 => Database -> String
createTableStmtFor @a (Conn -> Database
db 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 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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not present in type " String -> String -> String
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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)