{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.Internal.RowCountExpectation
  ( expectExactlyOneRow
  , expectAtMostOneRow
  )
where

import Control.Exception (Exception, throwIO)
import Control.Monad.IO.Class (MonadIO (liftIO))

{- |
  INTERNAL: This should really never get thrown in the real world. It would be
  thrown if the returning clause from an insert statement for a single record
  returned 0 records or more than 1 record.

@since 1.0.0.0
-}
newtype RowCountExpectationError
  = RowCountExpectationError String
  deriving (Int -> RowCountExpectationError -> ShowS
[RowCountExpectationError] -> ShowS
RowCountExpectationError -> String
(Int -> RowCountExpectationError -> ShowS)
-> (RowCountExpectationError -> String)
-> ([RowCountExpectationError] -> ShowS)
-> Show RowCountExpectationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RowCountExpectationError -> ShowS
showsPrec :: Int -> RowCountExpectationError -> ShowS
$cshow :: RowCountExpectationError -> String
show :: RowCountExpectationError -> String
$cshowList :: [RowCountExpectationError] -> ShowS
showList :: [RowCountExpectationError] -> ShowS
Show)

instance Exception RowCountExpectationError

expectExactlyOneRow :: MonadIO m => String -> [a] -> m a
expectExactlyOneRow :: forall (m :: * -> *) a. MonadIO m => String -> [a] -> m a
expectExactlyOneRow String
caller [a]
rows =
  case [a]
rows of
    [a
row] ->
      a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
row
    [a]
_ ->
      IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (String -> IO a) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowCountExpectationError -> IO a
forall e a. Exception e => e -> IO a
throwIO (RowCountExpectationError -> IO a)
-> (String -> RowCountExpectationError) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RowCountExpectationError
RowCountExpectationError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
        String
caller
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": Expected exactly one row to be returned, but got "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
rows)

expectAtMostOneRow :: MonadIO m => String -> [a] -> m (Maybe a)
expectAtMostOneRow :: forall (m :: * -> *) a. MonadIO m => String -> [a] -> m (Maybe a)
expectAtMostOneRow String
caller [a]
rows =
  case [a]
rows of
    [] ->
      Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    [a
row] ->
      Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
row)
    [a]
_ ->
      IO (Maybe a) -> m (Maybe a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a))
-> (String -> IO (Maybe a)) -> String -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowCountExpectationError -> IO (Maybe a)
forall e a. Exception e => e -> IO a
throwIO (RowCountExpectationError -> IO (Maybe a))
-> (String -> RowCountExpectationError) -> String -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RowCountExpectationError
RowCountExpectationError (String -> m (Maybe a)) -> String -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$
        String
caller
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": Expected exactly one row to be returned, but got "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
rows)