content: -- | MonadReader wrappers around postgresql-simple library.
  
  module IW.Db.Functions
         ( WithDb
         , initialisePool
  
           -- * Sql functions
         , query
         , queryNamed
         , queryRaw
         , execute
         , executeNamed
         , executeRaw
         , executeMany
         , returning
  
           -- * Error handling
         , asSingleRow
         , singleRowError
         ) where
  
  import PgNamed (NamedParam, PgNamedError)
  
  import IW.App.Env (DbPool, Has, grab)
  import IW.App.Error (AppErrorType (..), WithError, throwError, throwOnNothingM)
  
  import qualified Data.Pool as Pool
  import qualified Database.PostgreSQL.Simple as Sql
  import qualified PgNamed as Sql
  
  
  -- | Constraint for monadic actions that wants access to database.
  type WithDb env m = (MonadReader env m, Has DbPool env, MonadIO m)
  
  -- | Create 'Pool.Pool' by given credentials.
  initialisePool :: ByteString -> IO DbPool
  initialisePool credentials = Pool.createPool (Sql.connectPostgreSQL credentials) Sql.close 10 5 10
  
  -- | Performs a query without arguments and returns the resulting rows.
  queryRaw
      :: forall res env m .
         (WithDb env m, FromRow res)
      => Sql.Query
      -> m [res]
  queryRaw q = withPool $ \conn -> Sql.query_ conn q
  {-# INLINE queryRaw #-}
  
  -- | Performs a query with arguments and returns the resulting rows with the
  -- given parameters.
  query
      :: forall res args env m .
         (WithDb env m, ToRow args, FromRow res)
      => Sql.Query
      -> args
      -> m [res]
  query q args = withPool $ \conn -> Sql.query conn q args
  {-# INLINE query #-}
  
  -- | Performs a query with named parameters and returns a list of rows.
  queryNamed
      :: (WithError m, WithDb env m, FromRow res)
      => Sql.Query
      -> [NamedParam]
      -> m [res]
  queryNamed q params = withPool (\conn -> runExceptT $ Sql.queryNamed conn q params)
      >>= liftDbError
  {-# INLINE queryNamed #-}
  
  -- | Executes a query without arguments that is not expected to return results.
  executeRaw
      :: WithDb env m
      => Sql.Query
      -> m ()
  executeRaw q = withPool $ \conn -> void $ Sql.execute_ conn q
  {-# INLINE executeRaw #-}
  
  -- | Executes a query with parameters that is not expected to return results.
  execute
      :: forall args env m .
         (WithDb env m, ToRow args)
      => Sql.Query
      -> args
      -> m ()
  execute q args = withPool $ \conn -> void $ Sql.execute conn q args
  {-# INLINE execute #-}
  
  -- | Executes a multi-row query that is not expected to return results.
  executeMany
      :: (WithDb env m, ToRow args)
      => Sql.Query
      -> [args]
      -> m ()
  executeMany q args = withPool $ \conn -> void $ Sql.executeMany conn q args
  {-# INLINE executeMany #-}
  
  -- | Executes a query with named parameters, returning the number of rows affected.
  executeNamed
      :: (WithError m, WithDb env m)
      => Sql.Query
      -> [NamedParam]
      -> m Int64
  executeNamed q params = withPool (\conn -> runExceptT $ Sql.executeNamed conn q params)
      >>= liftDbError
  {-# INLINE executeNamed #-}
  
  -- | Executes a multi-row query that is expected to return results.
  -- A @RETURNING@ statement needs to be in the SQL query.
  returning
      :: (WithDb env m, ToRow args, FromRow res)
      => Sql.Query
      -> [args]
      -> m [res]
  returning q args = withPool $ \conn -> Sql.returning conn q args
  {-# INLINE returning #-}
  
  -- | Perform action that needs database connection.
  withPool :: WithDb env m => (Sql.Connection -> IO b) -> m b
  withPool f = do
      pool <- grab @DbPool
      liftIO $ Pool.withResource pool f
  {-# INLINE withPool #-}
  
  ----------------------------------------------------------------------------
  -- Error helpers
  ----------------------------------------------------------------------------
  
  -- | Helper function working with results from a database when you expect
  -- only one row to be returned.
  asSingleRow :: WithError m => m [a] -> m a
  asSingleRow res = withFrozenCallStack $ throwOnNothingM
      singleRowError
      (viaNonEmpty head <$> res)
  
  -- | Lift database named parameters errors.
  liftDbError :: WithError m => Either PgNamedError a -> m a
  liftDbError = either (throwError . DbNamedError) pure
  {-# INLINE liftDbError #-}
  
  singleRowError :: AppErrorType
  singleRowError = DbError "Expected a single row, but got none"
  