generated from tpl/purs
feat: FromResult, tests
This commit is contained in:
parent
d1f84bcc72
commit
08dd5fe964
@ -12,7 +12,8 @@
|
||||
"typescript": "^5.0.0"
|
||||
},
|
||||
"dependencies": {
|
||||
"postgres-range": "^1.1.4",
|
||||
"pg": "^8.11.3"
|
||||
"decimal.js": "^10.4.3",
|
||||
"pg": "^8.11.3",
|
||||
"postgres-range": "^1.1.4"
|
||||
}
|
||||
}
|
||||
|
@ -5,6 +5,7 @@ workspace:
|
||||
dependencies:
|
||||
- aff
|
||||
- aff-promise
|
||||
- arrays
|
||||
- bifunctors
|
||||
- control
|
||||
- datetime
|
||||
|
@ -6,6 +6,7 @@ package:
|
||||
dependencies:
|
||||
- aff
|
||||
- aff-promise
|
||||
- arrays
|
||||
- bifunctors
|
||||
- control
|
||||
- datetime
|
||||
|
52
src/Data.Postgres.Result.purs
Normal file
52
src/Data.Postgres.Result.purs
Normal file
@ -0,0 +1,52 @@
|
||||
module Data.Postgres.Result where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Error.Class (liftMaybe, throwError)
|
||||
import Data.Array as Array
|
||||
import Data.Int as Int
|
||||
import Data.Maybe (Maybe)
|
||||
import Data.Nullable (Nullable)
|
||||
import Data.Nullable as Nullable
|
||||
import Data.Postgres (class Rep, RepT, deserialize)
|
||||
import Data.Postgres.Raw (Raw)
|
||||
import Data.Tuple (Tuple)
|
||||
import Data.Tuple.Nested (type (/\), (/\))
|
||||
import Foreign (ForeignError(..))
|
||||
import Type.Prelude (Proxy(..))
|
||||
|
||||
foreign import data Result :: Type
|
||||
|
||||
foreign import rowsAffectedImpl :: Result -> Nullable Number
|
||||
foreign import rows :: Result -> Array (Array Raw)
|
||||
|
||||
rowsAffected :: Result -> Maybe Int
|
||||
rowsAffected = Int.fromNumber <=< Nullable.toMaybe <<< rowsAffectedImpl
|
||||
|
||||
class FromResult (a :: Type) where
|
||||
expectedRowLength :: forall g. g a -> Int
|
||||
fromRow :: Array Raw -> RepT a
|
||||
|
||||
instance (Rep a, FromResult b) => FromResult (a /\ b) where
|
||||
expectedRowLength _ = expectedRowLength (Proxy @b) + 1
|
||||
fromRow r =
|
||||
let
|
||||
expLen = expectedRowLength (Proxy @(Tuple a b))
|
||||
lengthMismatch = pure $ TypeMismatch ("Expected row of length " <> show expLen) ("Found row of length " <> show (Array.length r))
|
||||
in
|
||||
do
|
||||
when (Array.length r /= expLen) (throwError lengthMismatch)
|
||||
a <- deserialize =<< liftMaybe lengthMismatch (Array.head r)
|
||||
b <- fromRow =<< liftMaybe lengthMismatch (Array.tail r)
|
||||
pure $ a /\ b
|
||||
else instance FromResult Unit where
|
||||
expectedRowLength _ = 0
|
||||
fromRow _ = pure unit
|
||||
else instance Rep a => FromResult a where
|
||||
expectedRowLength _ = 1
|
||||
fromRow =
|
||||
let
|
||||
get [ a ] = pure a
|
||||
get o = throwError $ pure $ TypeMismatch "Expected row of length 1" $ show o
|
||||
in
|
||||
deserialize <=< get
|
@ -27,6 +27,9 @@ import Simple.JSON (class ReadForeign, class WriteForeign, readJSON', writeJSON)
|
||||
newtype JSON a = JSON a
|
||||
|
||||
derive instance Newtype (JSON a) _
|
||||
derive newtype instance Show a => Show (JSON a)
|
||||
derive newtype instance Eq a => Eq (JSON a)
|
||||
derive newtype instance Ord a => Ord (JSON a)
|
||||
derive newtype instance WriteForeign a => WriteForeign (JSON a)
|
||||
derive newtype instance ReadForeign a => ReadForeign (JSON a)
|
||||
|
||||
|
@ -4,14 +4,18 @@ import Prelude
|
||||
|
||||
import Control.Promise (Promise)
|
||||
import Control.Promise as Promise
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Maybe (Maybe(..), fromMaybe)
|
||||
import Data.Nullable (Nullable, toNullable)
|
||||
import Data.Postgres (smash)
|
||||
import Data.Postgres.Raw (Raw)
|
||||
import Data.Postgres.Result (class FromResult, Result, fromRow, rows, rowsAffected)
|
||||
import Data.Traversable (traverse)
|
||||
import Data.Tuple.Nested (type (/\), (/\))
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Postgres.Client (Client)
|
||||
import Effect.Postgres.Result (Result)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Postgres.Client (Client, Config, make)
|
||||
import Prim.Row (class Union)
|
||||
import Record (insert, modify)
|
||||
import Type.Prelude (Proxy(..))
|
||||
|
||||
@ -45,11 +49,23 @@ instance AsQuery String where
|
||||
instance AsQuery (String /\ Array Raw) where
|
||||
asQuery (text /\ values) = Query { text, values, name: Nothing }
|
||||
|
||||
connected :: forall r trash. Union r trash (Config ()) => Record r -> Aff Client
|
||||
connected c = do
|
||||
client <- liftEffect $ make c
|
||||
connect client
|
||||
pure client
|
||||
|
||||
connect :: Client -> Aff Unit
|
||||
connect = Promise.toAffE <<< connectImpl
|
||||
|
||||
end :: Client -> Aff Unit
|
||||
end = Promise.toAffE <<< endImpl
|
||||
|
||||
query :: forall q. AsQuery q => q -> Client -> Aff Result
|
||||
query q = Promise.toAffE <<< queryImpl (queryToRaw $ asQuery q)
|
||||
queryRaw :: forall q. AsQuery q => q -> Client -> Aff Result
|
||||
queryRaw q = Promise.toAffE <<< queryImpl (queryToRaw $ asQuery q)
|
||||
|
||||
exec :: forall q. AsQuery q => q -> Client -> Aff Int
|
||||
exec q = map (fromMaybe 0 <<< rowsAffected) <<< queryRaw q
|
||||
|
||||
query :: forall q r. AsQuery q => FromResult r => q -> Client -> Aff (Array r)
|
||||
query q = traverse (liftEffect <<< smash <<< fromRow) <=< map rows <<< queryRaw q
|
||||
|
@ -1,17 +0,0 @@
|
||||
module Effect.Postgres.Result where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Int as Int
|
||||
import Data.Maybe (Maybe)
|
||||
import Data.Nullable (Nullable)
|
||||
import Data.Nullable as Nullable
|
||||
import Data.Postgres.Raw (Raw)
|
||||
|
||||
foreign import data Result :: Type
|
||||
|
||||
foreign import rowsAffectedImpl :: Result -> Nullable Number
|
||||
foreign import rows :: Result -> Array (Array Raw)
|
||||
|
||||
rowsAffected :: Result -> Maybe Int
|
||||
rowsAffected = Int.fromNumber <=< Nullable.toMaybe <<< rowsAffectedImpl
|
@ -3,50 +3,62 @@ module Test.Effect.Postgres.Client where
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Error.Class (try)
|
||||
import Data.Array as Array
|
||||
import Data.Either (isLeft)
|
||||
import Data.Postgres (deserialize, smash)
|
||||
import Data.Traversable (traverse)
|
||||
import Effect.Aff (Aff)
|
||||
import Data.Either (Either, isLeft)
|
||||
import Data.Newtype (wrap)
|
||||
import Data.Postgres (JSON(..))
|
||||
import Data.PreciseDateTime (fromRFC3339String, toDateTimeLossy)
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff, bracket)
|
||||
import Effect.Aff.Postgres.Client (query)
|
||||
import Effect.Aff.Postgres.Client as PG.Aff.Client
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Console (log)
|
||||
import Effect.Postgres.Client as PG
|
||||
import Effect.Postgres.Client as PG.Client
|
||||
import Effect.Postgres.Result as Result
|
||||
import Node.Path as Path
|
||||
import Node.Process (cwd)
|
||||
import Test.Spec (Spec, describe, it)
|
||||
import Test.Spec (Spec, around, describe, it)
|
||||
import Test.Spec.Assertions (shouldEqual)
|
||||
|
||||
client :: Aff PG.Client
|
||||
client = do
|
||||
config
|
||||
:: Effect
|
||||
{ database :: String
|
||||
, host :: String
|
||||
, password :: String
|
||||
, user :: String
|
||||
}
|
||||
config = do
|
||||
cwd' <- liftEffect cwd
|
||||
host <- liftEffect $ Path.resolve [ cwd' ] "./pg"
|
||||
liftEffect $ PG.Client.make { host, user: "postgres", password: "password", database: "postgres" }
|
||||
pure { host, user: "postgres", password: "password", database: "postgres" }
|
||||
|
||||
withClient :: (PG.Client -> Aff Unit) -> Aff Unit
|
||||
withClient = bracket (PG.Aff.Client.connected =<< liftEffect config) PG.Aff.Client.end
|
||||
|
||||
spec :: Spec Unit
|
||||
spec = do
|
||||
describe "Client" do
|
||||
describe "make" do
|
||||
it "does not throw" $ void $ client
|
||||
describe "connect" do
|
||||
it "does not throw" $ PG.Aff.Client.connect =<< client
|
||||
describe "end" do
|
||||
it "does not throw" $ do
|
||||
c <- client
|
||||
PG.Aff.Client.connect c
|
||||
PG.Aff.Client.end c
|
||||
describe "query" do
|
||||
it "ok if connected" $ do
|
||||
c <- client
|
||||
PG.Aff.Client.connect c
|
||||
res <- Result.rows <$> PG.Aff.Client.query "select unnest(array[1, 2, 3])" c
|
||||
ints :: Array Int <- liftEffect $ smash $ traverse deserialize $ Array.catMaybes $ map Array.head res
|
||||
ints `shouldEqual` [ 1, 2, 3 ]
|
||||
it "throws if ended" $ do
|
||||
c <- client
|
||||
PG.Aff.Client.connect c
|
||||
PG.Aff.Client.end c
|
||||
res <- try $ PG.Aff.Client.query "select 1" c
|
||||
isLeft res `shouldEqual` true
|
||||
spec =
|
||||
around withClient do
|
||||
describe "Client" do
|
||||
it "connect & end do not throw" $ const $ pure unit
|
||||
describe "query" do
|
||||
it "ok if connected" \c -> shouldEqual [ 1, 2, 3 ] =<< query "select unnest(array[1, 2, 3])" c
|
||||
it "throws if ended" \c -> do
|
||||
PG.Aff.Client.end c
|
||||
res :: Either _ (Array Int) <- try $ query "select 1" c
|
||||
isLeft res `shouldEqual` true
|
||||
it "rowsAffected is correct" \c -> do
|
||||
void $ PG.Aff.Client.exec "create temp table foo (bar int);" c
|
||||
cta <- PG.Aff.Client.exec "insert into foo values (1);" c
|
||||
cta `shouldEqual` 1
|
||||
ctb <- PG.Aff.Client.exec "insert into foo values (1), (2), (3);" c
|
||||
ctb `shouldEqual` 3
|
||||
ctc <- PG.Aff.Client.exec "update foo set bar = 10;" c
|
||||
ctc `shouldEqual` 4
|
||||
describe "timestamp" do
|
||||
it "unmarshals" \c -> do
|
||||
let exp = toDateTimeLossy <$> fromRFC3339String (wrap "2020-01-01T00:00:00Z")
|
||||
shouldEqual [ exp ] =<< query "select '2020-01-01T00:00:00Z' :: timestamptz" c
|
||||
it "is string" \c -> shouldEqual [ "2020-01-01 00:00:00+00" ] =<< query "select '2020-01-01T00:00:00Z' :: timestamptz" c
|
||||
it "array is string" \c -> shouldEqual [ [ "2020-01-01 00:00:00+00" ] ] =<< query "select array['2020-01-01T00:00:00Z' :: timestamptz]" c
|
||||
describe "json" do
|
||||
it "unmarshals" \c -> shouldEqual [ JSON { foo: "bar" } ] =<< query "select '{\"foo\": \"bar\"}' :: json" c
|
||||
it "is string" \c -> shouldEqual [ "{\"foo\": \"bar\"}" ] =<< query "select '{\"foo\": \"bar\"}' :: json" c
|
||||
it "array is string" \c -> shouldEqual [ [ "{\"foo\": \"bar\"}" ] ] =<< query "select array['{\"foo\": \"bar\"}' :: json]" c
|
||||
|
Loading…
Reference in New Issue
Block a user