diff --git a/bun.lockb b/bun.lockb index c42d05c..8c74b90 100755 Binary files a/bun.lockb and b/bun.lockb differ diff --git a/package.json b/package.json index e446309..88c909d 100644 --- a/package.json +++ b/package.json @@ -14,5 +14,5 @@ "peerDependencies": { "typescript": "^5.0.0" }, - "dependencies": {} + "dependencies": { "decimal.js": "^10.4.3" } } diff --git a/spago.yaml b/spago.yaml index d11743d..973d97a 100644 --- a/spago.yaml +++ b/spago.yaml @@ -19,6 +19,10 @@ package: - typelevel-prelude - unlift name: postgres + test: + dependencies: + - spec + main: Test.Main workspace: extra_packages: postgresql-client: diff --git a/src/Control.Monad.Postgres.purs b/src/Control.Monad.Postgres.purs index 785cf6c..859ddab 100644 --- a/src/Control.Monad.Postgres.purs +++ b/src/Control.Monad.Postgres.purs @@ -195,12 +195,3 @@ runPostgres conn t = (unwrap $ unwrap t) conn runHasPostgres :: forall m a. Pg.Connection -> HasPostgresT m a -> m a runHasPostgres conn t = (unwrap $ unwrap t) conn - -newtype RawRow = RawRow (Array Foreign) - -derive instance Newtype RawRow _ -instance Pg.FromSQLRow RawRow where - fromSQLRow = pure <<< wrap - -instance Pg.ToSQLRow RawRow where - toSQLRow = unwrap diff --git a/src/Data.Postgres.Extract.Record.purs b/src/Data.Postgres.Extract.Record.purs new file mode 100644 index 0000000..9812629 --- /dev/null +++ b/src/Data.Postgres.Extract.Record.purs @@ -0,0 +1,45 @@ +module Data.Postgres.Extract.Record where + +import Prelude + +import Control.Monad.Error.Class (liftMaybe) +import Data.Array as Array +import Data.Either (Either) +import Data.Maybe (fromMaybe) +import Data.Postgres.Types (RawRow(..)) +import Database.PostgreSQL (class FromSQLValue, fromSQLValue) +import Foreign (Foreign) +import Prim.Row (class Cons, class Lacks) +import Record as Record +import Type.Function (type ($)) +import Type.Prelude (class IsSymbol, Proxy(..)) + +data ExtractRecord a = ExtractRecord (Array Foreign) a + +extract :: forall a. (ExtractRecord {} -> Either String $ ExtractRecord a) -> RawRow -> Either String a +extract f = map finish <<< f <<< start + +finish :: forall a. ExtractRecord a -> a +finish (ExtractRecord _ a) = a + +start :: RawRow -> ExtractRecord {} +start (RawRow r) = ExtractRecord r {} + +skip :: forall a. ExtractRecord a -> ExtractRecord a +skip (ExtractRecord r a) = ExtractRecord (fromMaybe [] $ Array.tail r) a + +field + :: forall a b @k @v + . Show (Record a) + => Lacks k a + => Cons k v a b + => IsSymbol k + => FromSQLValue v + => ExtractRecord $ Record a + -> Either String $ ExtractRecord $ Record b +field (ExtractRecord row r) = do + let + eempty = "no more values to consume, built: " <> show r + col <- liftMaybe eempty $ Array.head row + val <- fromSQLValue col + pure $ skip $ ExtractRecord row $ Record.insert (Proxy @k) val r diff --git a/src/Data.Postgres.Types.purs b/src/Data.Postgres.Types.purs new file mode 100644 index 0000000..5330f64 --- /dev/null +++ b/src/Data.Postgres.Types.purs @@ -0,0 +1,16 @@ +module Data.Postgres.Types where + +import Prelude + +import Data.Newtype (class Newtype, unwrap, wrap) +import Database.PostgreSQL (class FromSQLRow, class ToSQLRow) +import Foreign (Foreign) + +newtype RawRow = RawRow (Array Foreign) + +derive instance Newtype RawRow _ +instance FromSQLRow RawRow where + fromSQLRow = pure <<< wrap + +instance ToSQLRow RawRow where + toSQLRow = unwrap diff --git a/test/Spec.Data.Postgres.Record.purs b/test/Spec.Data.Postgres.Record.purs new file mode 100644 index 0000000..f4911f6 --- /dev/null +++ b/test/Spec.Data.Postgres.Record.purs @@ -0,0 +1,45 @@ +module Spec.Data.Postgres.Record where + +import Prelude + +import Control.Monad.Error.Class (liftEither, throwError) +import Data.Bifunctor (lmap) +import Data.Either (isRight) +import Data.Postgres.Extract.Record as Rec +import Data.Postgres.Types (RawRow(..)) +import Effect.Exception (error) +import Foreign (unsafeToForeign) +import Test.Spec (Spec, describe, it) +import Test.Spec.Assertions (shouldEqual) + +spec :: Spec Unit +spec = + describe "Data.Postgres.Record" do + it "empty case" do + let raw = RawRow [ unsafeToForeign 1 ] + (Rec.finish $ Rec.start raw) `shouldEqual` {} + it "fails when type incorrect" do + let + raw = RawRow [ unsafeToForeign 12 ] + actual = map Rec.finish $ Rec.field @"foo" @String $ Rec.start raw + when (isRight actual) $ throwError $ error "should have failed" + it "succeeds" do + let + raw = + RawRow + [ unsafeToForeign 12 + , unsafeToForeign "hello" + , unsafeToForeign "SKIP" + , unsafeToForeign [ 1, 2, 3 ] + ] + actual <- + liftEither + $ lmap error + $ Rec.extract + ( Rec.field @"num" + >=> Rec.field @"str" + >=> (pure <<< Rec.skip) + >=> Rec.field @"arr" + ) + $ raw + actual `shouldEqual` { num: 12, str: "hello", arr: [ 1, 2, 3 ] } diff --git a/test/Test.Main.purs b/test/Test.Main.purs new file mode 100644 index 0000000..e5186b5 --- /dev/null +++ b/test/Test.Main.purs @@ -0,0 +1,13 @@ +module Test.Main where + +import Prelude + +import Effect (Effect) +import Effect.Aff (launchAff_) +import Spec.Data.Postgres.Record as Spec.Data.Postgres.Record +import Test.Spec.Reporter (consoleReporter) +import Test.Spec.Runner (runSpec) + +main :: Effect Unit +main = launchAff_ $ runSpec [ consoleReporter ] do + Spec.Data.Postgres.Record.spec