feat: record builder

package.json

@@ -14,5 +14,5 @@
   "peerDependencies": {
     "typescript": "^5.0.0"
   },
-  "dependencies": {}
+  "dependencies": { "decimal.js": "^10.4.3" }
 }

spago.yaml

@@ -19,6 +19,10 @@ package:
     - typelevel-prelude
     - unlift
   name: postgres
+  test:
+    dependencies:
+      - spec
+    main: Test.Main
 workspace:
   extra_packages:
     postgresql-client:

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

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

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

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 ] }

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