feat: MOVE support for cursors, RowsAffected

This commit is contained in:
orion 2024-04-29 09:27:31 -05:00
parent 3e9f22397d
commit 24b2156524
Signed by: orion
GPG Key ID: 6D4165AE4C928719
4 changed files with 53 additions and 13 deletions

View File

@ -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`

View File

@ -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

View File

@ -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
-- |

View File

@ -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
-- |
-- | <https://node-postgres.com/apis/client#clientquery>
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)