diff --git a/README.md b/README.md index 7bf87e3..cf576fa 100644 --- a/README.md +++ b/README.md @@ -116,6 +116,8 @@ which is implemented for: - `Array a` where `a` is [`FromRow`] - `Maybe a` where `a` is [`FromRow`] (equivalent to `Array.head <<< fromRows`) - `a` where `a` is [`FromRow`] (throws if 0 rows yielded) + - `RowsAffected` + - Extracts the number of rows processed by the last command in the query (ex. `INSERT INTO foo (bar) VALUES ('a'), ('b')` -> `INSERT 2` -> `RowsAffected 2`) ### Data - Ranges Postgres ranges are represented with [`Range`]. @@ -223,9 +225,11 @@ Execute [`CursorT`] monads with [`cursor`]: dbMain :: PostgresT Aff Int dbMain = cursor @(Int /\ String) "people_cursor" "select id, name from persons" do - fetchOne -- Just (1 /\ "Henry") - fetchAll -- [2 /\ "Sarah"] - fetchOne -- Nothing + a <- fetchOne -- Just (1 /\ "Henry") + b <- fetchOne -- Just (2 /\ "Sarah") + void $ move (MoveRelative -2) + c <- fetchAll -- [1 /\ "Henry", 2 /\ "Sarah"] + d <- fetchOne -- Nothing ``` ### Monads - `SessionT` diff --git a/src/Control.Monad.Postgres.Cursor.purs b/src/Control.Monad.Postgres.Cursor.purs index 1e1bf54..c2e49ae 100644 --- a/src/Control.Monad.Postgres.Cursor.purs +++ b/src/Control.Monad.Postgres.Cursor.purs @@ -16,6 +16,7 @@ import Data.Maybe (Maybe) import Data.Newtype (class Newtype, unwrap, wrap) import Data.Postgres (RepT, smash) import Data.Postgres.Raw (Raw) +import Data.Postgres.Result (RowsAffected(..)) import Data.Traversable (traverse) import Data.Tuple.Nested (type (/\), (/\)) import Effect.Aff.Class (class MonadAff) @@ -23,6 +24,12 @@ import Effect.Aff.Unlift (class MonadUnliftAff) import Effect.Class (class MonadEffect, liftEffect) import Effect.Unlift (class MonadUnliftEffect) +data Move + -- | `MOVE RELATIVE` + = MoveRelative Int + -- | `MOVE ABSOLUTE` + | MoveTo Int + newtype CursorT :: forall k. Type -> (k -> Type) -> k -> Type newtype CursorT t m a = CursorT (ReaderT (String /\ (Array Raw -> RepT t)) m a) @@ -88,6 +95,9 @@ class (MonadSession m) <= MonadCursor m t where fetch :: Int -> m (Array t) -- | Fetch all remaining rows from the cursor fetchAll :: m (Array t) + -- | Change the cursor's position without fetching any data, + -- | returning the number of rows skipped. + move :: Move -> m Int instance (MonadSession m) => MonadCursor (CursorT t m) t where fetch n = do @@ -98,6 +108,14 @@ instance (MonadSession m) => MonadCursor (CursorT t m) t where cur /\ f <- ask raw :: Array (Array Raw) <- query $ "fetch all from " <> cur liftEffect $ smash $ traverse f raw + move (MoveTo n) = do + cur /\ _ <- ask + RowsAffected n' <- query $ ("move absolute $1 from " <> cur) /\ n + pure n' + move (MoveRelative n) = do + cur /\ _ <- ask + RowsAffected n' <- query $ ("move relative $1 from " <> cur) /\ n + pure n' instance (MonadSession m) => MonadSession (CursorT t m) where query = lift <<< query diff --git a/src/Data.Postgres.Result.purs b/src/Data.Postgres.Result.purs index 6637c23..16ec67c 100644 --- a/src/Data.Postgres.Result.purs +++ b/src/Data.Postgres.Result.purs @@ -4,11 +4,13 @@ import Prelude import Control.Monad.Error.Class (liftMaybe, throwError) import Data.Array as Array +import Data.Generic.Rep (class Generic) import Data.Int as Int import Data.Maybe (Maybe) +import Data.Newtype (class Newtype) import Data.Nullable (Nullable) import Data.Nullable as Nullable -import Data.Postgres (class Deserialize, class Rep, RepT, deserialize) +import Data.Postgres (class Deserialize, RepT, deserialize) import Data.Postgres.Raw (Raw) import Data.Traversable (traverse) import Data.Tuple (Tuple) @@ -27,19 +29,29 @@ foreign import data Result :: Type rowsAffected :: Result -> Maybe Int rowsAffected = Int.fromNumber <=< Nullable.toMaybe <<< __rowsAffected -class FromRows a where - fromRows :: Array (Array Raw) -> RepT a +newtype RowsAffected = RowsAffected Int -instance (FromRow a) => FromRows (Array a) where - fromRows = traverse fromRow +derive instance Newtype RowsAffected _ +derive instance Generic RowsAffected _ +derive newtype instance Eq RowsAffected +derive newtype instance Ord RowsAffected +derive newtype instance Show RowsAffected + +class FromRows a where + fromRows :: RowsAffected -> Array (Array Raw) -> RepT a + +instance FromRows RowsAffected where + fromRows a _ = pure a +else instance (FromRow a) => FromRows (Array a) where + fromRows _ = traverse fromRow else instance (FromRow a) => FromRows (Maybe a) where - fromRows = map Array.head <<< traverse fromRow + fromRows _ = map Array.head <<< traverse fromRow else instance (FromRow a) => FromRows a where - fromRows = + fromRows a = let e = pure $ ForeignError $ "Expected at least 1 row" in - liftMaybe e <=< fromRows @(Maybe a) + liftMaybe e <=< fromRows @(Maybe a) a -- | Can be unmarshalled from a queried row -- | diff --git a/src/Effect.Aff.Postgres.Client.purs b/src/Effect.Aff.Postgres.Client.purs index 80d8026..d5a283a 100644 --- a/src/Effect.Aff.Postgres.Client.purs +++ b/src/Effect.Aff.Postgres.Client.purs @@ -6,14 +6,15 @@ import Control.Promise (Promise) import Control.Promise as Promise import Data.Functor (voidRight) import Data.Maybe (fromMaybe) +import Data.Newtype (wrap) import Data.Postgres (smash) import Data.Postgres.Query (class AsQuery, QueryRaw, asQuery, __queryToRaw) import Data.Postgres.Result (class FromRows, Result, fromRows, rows, rowsAffected) import Effect (Effect) import Effect.Aff (Aff) import Effect.Class (liftEffect) -import Effect.Postgres.Client (Client, Config, make) import Effect.Postgres.Client (Client, ClientConfigRaw, Config, Notification, NotificationRaw, __make, __uncfg, endE, errorE, make, noticeE, notificationE) as X +import Effect.Postgres.Client (Client, Config, make) import Prim.Row (class Union) -- | Create a client and immediately connect it to the database @@ -56,7 +57,12 @@ exec q = map (fromMaybe 0 <<< rowsAffected) <<< queryRaw q -- | -- | query :: forall q r. AsQuery q => FromRows r => q -> Client -> Aff r -query q = (liftEffect <<< smash <<< fromRows) <=< map rows <<< queryRaw q +query q c = do + raw <- queryRaw q c + let + affected = rowsAffected raw + rows' = rows raw + liftEffect $ smash $ fromRows (wrap $ fromMaybe 0 affected) rows' -- | FFI binding to `Client#connect` foreign import __connect :: Client -> Effect (Promise Unit)