generated from tpl/purs
feat: MOVE support for cursors, RowsAffected
This commit is contained in:
parent
3e9f22397d
commit
24b2156524
10
README.md
10
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`
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
-- |
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user