module Database.PostgreSQL.PQTypes.Fold (
    queryResult
  , foldrDB
  , foldlDB
  , mapDB_
  , fetchMany
  , fetchMaybe
  , fetchOne
  ) where

import Control.Monad.Catch
import qualified Data.Foldable as F

import Database.PostgreSQL.PQTypes.Class
import Database.PostgreSQL.PQTypes.FromRow
import Database.PostgreSQL.PQTypes.Internal.Error
import Database.PostgreSQL.PQTypes.Internal.QueryResult
import Database.PostgreSQL.PQTypes.Utils

-- | Get current 'QueryResult' or throw an exception if there isn't one.
queryResult :: (MonadDB m, MonadThrow m, FromRow row) => m (QueryResult row)
queryResult :: forall (m :: * -> *) row.
(MonadDB m, MonadThrow m, FromRow row) =>
m (QueryResult row)
queryResult = forall (m :: * -> *) row.
(MonadDB m, FromRow row) =>
m (Maybe (QueryResult row))
getQueryResult
  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HPQTypesError
HPQTypesError forall a b. (a -> b) -> a -> b
$ String
"queryResult: no query result") forall (m :: * -> *) a. Monad m => a -> m a
return

----------------------------------------

-- | Specialization of 'F.foldrM' for convenient query results fetching.
foldrDB :: (MonadDB m, FromRow row) => (row -> acc -> m acc) -> acc -> m acc
foldrDB :: forall (m :: * -> *) row acc.
(MonadDB m, FromRow row) =>
(row -> acc -> m acc) -> acc -> m acc
foldrDB row -> acc -> m acc
f acc
acc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return acc
acc) (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
F.foldrM row -> acc -> m acc
f acc
acc) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) row.
(MonadDB m, FromRow row) =>
m (Maybe (QueryResult row))
getQueryResult

-- | Specialization of 'F.foldlM' for convenient query results fetching.
foldlDB :: (MonadDB m, FromRow row) => (acc -> row -> m acc) -> acc -> m acc
foldlDB :: forall (m :: * -> *) row acc.
(MonadDB m, FromRow row) =>
(acc -> row -> m acc) -> acc -> m acc
foldlDB acc -> row -> m acc
f acc
acc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return acc
acc) (forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
F.foldlM acc -> row -> m acc
f acc
acc) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) row.
(MonadDB m, FromRow row) =>
m (Maybe (QueryResult row))
getQueryResult

-- | Specialization of 'F.mapM_' for convenient mapping over query results.
mapDB_ :: (MonadDB m, FromRow row) => (row -> m t) -> m ()
mapDB_ :: forall (m :: * -> *) row t.
(MonadDB m, FromRow row) =>
(row -> m t) -> m ()
mapDB_ row -> m t
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ row -> m t
f) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) row.
(MonadDB m, FromRow row) =>
m (Maybe (QueryResult row))
getQueryResult

----------------------------------------

-- | Specialization of 'foldrDB' that fetches a list of rows.
fetchMany :: (MonadDB m, FromRow row) => (row -> t) -> m [t]
fetchMany :: forall (m :: * -> *) row t.
(MonadDB m, FromRow row) =>
(row -> t) -> m [t]
fetchMany row -> t
f = forall (m :: * -> *) row acc.
(MonadDB m, FromRow row) =>
(row -> acc -> m acc) -> acc -> m acc
foldrDB (\row
row [t]
acc -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ row -> t
f row
row forall a. a -> [a] -> [a]
: [t]
acc) []

-- | Specialization of 'foldlDB' that fetches one or zero rows. If
-- more rows are delivered, 'AffectedRowsMismatch' exception is thrown.
fetchMaybe :: (MonadDB m, MonadThrow m, FromRow row) => (row -> t) -> m (Maybe t)
fetchMaybe :: forall (m :: * -> *) row t.
(MonadDB m, MonadThrow m, FromRow row) =>
(row -> t) -> m (Maybe t)
fetchMaybe row -> t
f = forall (m :: * -> *) row.
(MonadDB m, FromRow row) =>
m (Maybe (QueryResult row))
getQueryResult forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe (QueryResult row)
mqr -> case Maybe (QueryResult row)
mqr of
  Maybe (QueryResult row)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  Just QueryResult row
qr -> forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) row acc.
(MonadDB m, FromRow row) =>
(acc -> row -> m acc) -> acc -> m acc
foldlDB (Maybe t, QueryResult t) -> row -> m (Maybe t, QueryResult t)
go (forall a. Maybe a
Nothing, row -> t
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryResult row
qr)
  where
    go :: (Maybe t, QueryResult t) -> row -> m (Maybe t, QueryResult t)
go (Maybe t
Nothing, QueryResult t
qr) row
row = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ row -> t
f row
row, QueryResult t
qr)
    go (Just t
_, QueryResult t
qr) row
_ = forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB AffectedRowsMismatch {
        rowsExpected :: [(Int, Int)]
rowsExpected  = [(Int
0, Int
1)]
      , rowsDelivered :: Int
rowsDelivered = forall t. QueryResult t -> Int
ntuples QueryResult t
qr
      }

-- | Specialization of 'fetchMaybe' that fetches exactly one row. If
-- no row is delivered, 'AffectedRowsMismatch' exception is thrown.
fetchOne :: (MonadDB m, MonadThrow m, FromRow row) => (row -> t) -> m t
fetchOne :: forall (m :: * -> *) row t.
(MonadDB m, MonadThrow m, FromRow row) =>
(row -> t) -> m t
fetchOne row -> t
f = do
  Maybe t
mt <- forall (m :: * -> *) row t.
(MonadDB m, MonadThrow m, FromRow row) =>
(row -> t) -> m (Maybe t)
fetchMaybe row -> t
f
  case Maybe t
mt of
    Just t
t  -> forall (m :: * -> *) a. Monad m => a -> m a
return t
t
    Maybe t
Nothing -> forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB AffectedRowsMismatch {
      rowsExpected :: [(Int, Int)]
rowsExpected = [(Int
1, Int
1)]
    , rowsDelivered :: Int
rowsDelivered = Int
0
    }