diff --git a/bun.lockb b/bun.lockb new file mode 100755 index 0000000..ba2175d Binary files /dev/null and b/bun.lockb differ diff --git a/package.json b/package.json index cae51fa..305ab9f 100644 --- a/package.json +++ b/package.json @@ -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" } } diff --git a/spago.lock b/spago.lock index c50cfbf..0f7e969 100644 --- a/spago.lock +++ b/spago.lock @@ -5,6 +5,7 @@ workspace: dependencies: - aff - aff-promise + - arrays - bifunctors - control - datetime diff --git a/spago.yaml b/spago.yaml index f0da68f..ba7aaef 100644 --- a/spago.yaml +++ b/spago.yaml @@ -6,6 +6,7 @@ package: dependencies: - aff - aff-promise + - arrays - bifunctors - control - datetime diff --git a/src/Effect.Postgres.Result.js b/src/Data.Postgres.Result.js similarity index 100% rename from src/Effect.Postgres.Result.js rename to src/Data.Postgres.Result.js diff --git a/src/Data.Postgres.Result.purs b/src/Data.Postgres.Result.purs new file mode 100644 index 0000000..7212ae3 --- /dev/null +++ b/src/Data.Postgres.Result.purs @@ -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 diff --git a/src/Data.Postgres.purs b/src/Data.Postgres.purs index f3749ec..f6ed84b 100644 --- a/src/Data.Postgres.purs +++ b/src/Data.Postgres.purs @@ -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) diff --git a/src/Effect.Aff.Postgres.Client.purs b/src/Effect.Aff.Postgres.Client.purs index 1f7499d..accfefd 100644 --- a/src/Effect.Aff.Postgres.Client.purs +++ b/src/Effect.Aff.Postgres.Client.purs @@ -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 diff --git a/src/Effect.Postgres.Result.purs b/src/Effect.Postgres.Result.purs deleted file mode 100644 index 5666907..0000000 --- a/src/Effect.Postgres.Result.purs +++ /dev/null @@ -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 diff --git a/test/Test.Effect.Postgres.Client.purs b/test/Test.Effect.Postgres.Client.purs index ab068fb..5a32673 100644 --- a/test/Test.Effect.Postgres.Client.purs +++ b/test/Test.Effect.Postgres.Client.purs @@ -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