Make the container type for fetch customizable
This commit is contained in:
@@ -26,9 +26,10 @@ module Database.PostgreSQL.Opium
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Control.Monad (unless, void)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT)
|
||||
import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE)
|
||||
import Data.Functor.Identity (Identity (..))
|
||||
import Data.Proxy (Proxy (..))
|
||||
import Data.Text (Text)
|
||||
import Database.PostgreSQL.LibPQ
|
||||
@@ -41,24 +42,37 @@ import qualified Database.PostgreSQL.LibPQ as LibPQ
|
||||
|
||||
import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
|
||||
import Database.PostgreSQL.Opium.FromField (FromField (..), RawField (..))
|
||||
import Database.PostgreSQL.Opium.FromRow (FromRow (..))
|
||||
import Database.PostgreSQL.Opium.FromRow (FromRow (..), ColumnTable)
|
||||
import Database.PostgreSQL.Opium.ToField (ToField (..))
|
||||
import Database.PostgreSQL.Opium.ToParamList (ToParamList (..))
|
||||
|
||||
-- The order of the type parameters is important, because it is more common to use type applications for providing the row type.
|
||||
class RowContainer c where
|
||||
extract :: FromRow a => Result -> ColumnTable -> ExceptT Error IO (c a)
|
||||
|
||||
instance RowContainer [] where
|
||||
extract result columnTable = do
|
||||
nRows <- liftIO $ LibPQ.ntuples result
|
||||
mapM (ExceptT . fromRow result columnTable) [0..nRows - 1]
|
||||
|
||||
instance RowContainer Identity where
|
||||
extract result columnTable = do
|
||||
nRows <- liftIO $ LibPQ.ntuples result
|
||||
unless (nRows == 1) $ throwE ErrorNotExactlyOneRow
|
||||
Identity <$> ExceptT (fromRow result columnTable 0)
|
||||
|
||||
-- The order of the type parameters is important, because it is more common to use type applications for providing the row type and row container type.
|
||||
fetch
|
||||
:: forall a b. (ToParamList b, FromRow a)
|
||||
:: forall a b c. (ToParamList c, FromRow a, RowContainer b)
|
||||
=> Text
|
||||
-> b
|
||||
-> c
|
||||
-> Connection
|
||||
-> IO (Either Error [a])
|
||||
-> IO (Either Error (b a))
|
||||
fetch query params conn = runExceptT $ do
|
||||
result <- execParams conn query params
|
||||
columnTable <- ExceptT $ getColumnTable @a Proxy result
|
||||
nRows <- liftIO $ LibPQ.ntuples result
|
||||
mapM (ExceptT . fromRow result columnTable) [0..nRows - 1]
|
||||
extract result columnTable
|
||||
|
||||
fetch_ :: forall a. FromRow a => Text -> Connection -> IO (Either Error [a])
|
||||
fetch_ :: forall a c. (FromRow a, RowContainer c) => Text -> Connection -> IO (Either Error (c a))
|
||||
fetch_ query = fetch query ()
|
||||
|
||||
execute
|
||||
|
||||
@@ -17,6 +17,7 @@ data Error
|
||||
| ErrorInvalidOid Text Oid
|
||||
| ErrorUnexpectedNull ErrorPosition
|
||||
| ErrorInvalidField ErrorPosition Oid ByteString String
|
||||
| ErrorNotExactlyOneRow
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Exception Error where
|
||||
|
||||
@@ -14,6 +14,7 @@ module Database.PostgreSQL.Opium.FromRow
|
||||
-- * FromRow
|
||||
( FromRow (..)
|
||||
-- * Internal
|
||||
, ColumnTable
|
||||
, toListColumnTable
|
||||
) where
|
||||
|
||||
|
||||
Reference in New Issue
Block a user