57eec00 · rowtype-yoga/purescript-yoga-fetch-om

git.iko.soy/rowtype-yoga/purescript-yoga-fetch-om

Polymorphic client types, remove unsafeCoerce from ClientFunction

- client now returns polymorphic types directly (no 'polymorphic' wrapper needed) - Use fundeps to eliminate unsafeCoerce for empty records in BuildClientFn - Only unsafeCoerce left is the single polymorphic coerce in client - Rename ClientFn to ClientFunction - Fix referrer 'none' to empty string for Node.js compat - Add integration tests with real HTTP server proving polymorphism works

commit57eec00c846777656cde721407e4bbf3f6950735 authorMark <mark.eibes@gmail.com> dateMon 9 Feb 2026, 17:48 (8 months ago) parent9df43d1

9 files changed+129−29

compare with main

unifiedsplit

src/Yoga/Fetch/Om.purs+5−5 src/Yoga/Fetch/Om/ClientFn.purs → src/Yoga/Fetch/Om/ClientFunction.purs+20−19 src/Yoga/Fetch/Om/MakeRequest.purs+1−1 test/Complete.Example.purs+2−2 test/Polymorphic.Spec.purs+60 test/Test.Main.purs+3−1 test/setup.js+9 test/test-server.js+27 vitest.config.js+2−1

src/Yoga/Fetch/Om.purs+5−5

@@ -31,7 +31,7 @@ import JS.Fetch.Headers as Headers

3131import Type.Row.Homogeneous (class Homogeneous)

3232import Yoga.Fetch.Om.BuildUrl (class BuildUrl, buildUrl)

3333import Yoga.Fetch.Om.Simple (class DecodeResponse, decodeResponse, FetchError, FetchResponse, get, getWithHeaders, delete, deleteWithHeaders, delete_, post, postWithHeaders, post_, put, putWithHeaders, put_, patch, patchWithHeaders, patch_)

34−import Yoga.Fetch.Om.ClientFn (class BuildClientFn, class CheckBodyIsUnit, buildClientFn)

34+import Yoga.Fetch.Om.ClientFunction (class BuildClientFn, class CheckBodyIsUnit, buildClientFn)

3535import Yoga.Fetch.Om.ExtractParams (class ExtractRequestBody, class ExtractRequestHeaders)

3636import Yoga.Fetch.Om.MakeRequest (class MakeRequest, class SerializeBody, makeRequest, serializeBody)

3737import Yoga.Fetch.Om.ParseResponse (class ParseResponse, parseResponse)

@@ -110,16 +110,16 @@ class DeriveClient routesRow clientsRow | routesRow -> clientsRow where

110110-- | type UserAPI = { getUser :: Route ... }

111111-- | api = client @UserAPI "https://api.example.com"

112112-- | ```

113−client :: forall @routes routesRow clientsRow. RecordRow routes routesRow => DeriveClient routesRow clientsRow => String -> Record clientsRow

114−client baseUrl = deriveClientImpl baseUrl (Proxy :: _ { | routesRow })

113+client :: forall @routes routesRow clientsRow polyClientsRow. RecordRow routes routesRow => DeriveClient routesRow clientsRow => String -> Record polyClientsRow

114+client baseUrl = polymorphic (deriveClientImpl baseUrl (Proxy :: _ { | routesRow }) :: Record clientsRow)

115115

116116-- | Deprecated: Use `client` with VTA instead

117117-- |

118118-- | ```purescript

119119-- | api = deriveClient @UserAPI "https://api.example.com"

120120-- | ```

121−deriveClient :: forall @routesRow clientsRow. DeriveClient routesRow clientsRow => String -> Record clientsRow

122−deriveClient baseUrl = deriveClientImpl baseUrl (Proxy :: _ { | routesRow })

121+deriveClient :: forall @routesRow clientsRow polyClientsRow. DeriveClient routesRow clientsRow => String -> Record polyClientsRow

122+deriveClient baseUrl = polymorphic (deriveClientImpl baseUrl (Proxy :: _ { | routesRow }) :: Record clientsRow)

123123

124124-- | Cast a generated client to a polymorphic type signature

125125-- | This allows you to add explicit forall quantification for better documentation

src/Yoga/Fetch/Om/ClientFn.purs → src/Yoga/Fetch/Om/ClientFunction.pursrenamed+20−19

@@ -1,4 +1,4 @@

1−module Yoga.Fetch.Om.ClientFn

1+module Yoga.Fetch.Om.ClientFunction

22 ( class BuildClientFn

33 , buildClientFn

44 , class CheckBodyIsUnit

@@ -10,7 +10,6 @@ import Data.Unit (Unit, unit)

1010import Prim.RowList (RowList)

1111import Prim.RowList as RL

1212import Type.Proxy (Proxy)

13−import Unsafe.Coerce (unsafeCoerce)

1413import Yoga.Om (Om)

1514

1615data IsUnit

@@ -26,7 +25,9 @@ class BuildClientFn

2625 :: RowList Type -> RowList Type -> Type -> Type -> Row Type -> Row Type -> Row Type -> Type -> Type -> Constraint

2726class

2827 BuildClientFn pathQueryRL headersRL bodyFlag body pathQuery headers errorRow result fn

29− | pathQueryRL headersRL bodyFlag body pathQuery headers errorRow result -> fn where

28+ | pathQueryRL -> pathQuery

29+ , headersRL -> headers

30+ , pathQueryRL headersRL bodyFlag body errorRow result -> fn where

3031 buildClientFn

3132 :: Proxy pathQueryRL

3233 -> Proxy headersRL

@@ -40,12 +41,12 @@ instance

4041 RL.Nil

4142 IsUnit

4243 Unit

43− pq

44− h

44+ ()

45+ ()

4546 errorRow

4647 result

4748 (Om (Record ()) errorRow result) where

48− buildClientFn _ _ _ f = unsafeCoerce (f (unsafeCoerce {}) (unsafeCoerce {}) unit)

49+ buildClientFn _ _ _ f = f {} {} unit

4950

5051-- No path/query, no headers, with body

5152instance

@@ -53,12 +54,12 @@ instance

5354 RL.Nil

5455 IsNotUnit

5556 body

56− pq

57− h

57+ ()

58+ ()

5859 errorRow

5960 result

6061 (body -> Om (Record ()) errorRow result) where

61− buildClientFn _ _ _ f = unsafeCoerce (\b -> f (unsafeCoerce {}) (unsafeCoerce {}) b)

62+ buildClientFn _ _ _ f b = f {} {} b

6263

6364-- No path/query, with headers, no body

6465instance

@@ -66,12 +67,12 @@ instance

6667 (RL.Cons n t tl)

6768 IsUnit

6869 Unit

69− pq

70+ ()

7071 h

7172 errorRow

7273 result

7374 (Record h -> Om (Record ()) errorRow result) where

74− buildClientFn _ _ _ f = unsafeCoerce (\hdrs -> f (unsafeCoerce {}) hdrs unit)

75+ buildClientFn _ _ _ f hdrs = f {} hdrs unit

7576

7677-- No path/query, with headers, with body

7778instance

@@ -79,12 +80,12 @@ instance

7980 (RL.Cons n t tl)

8081 IsNotUnit

8182 body

82− pq

83+ ()

8384 h

8485 errorRow

8586 result

8687 (Record h -> body -> Om (Record ()) errorRow result) where

87− buildClientFn _ _ _ f = unsafeCoerce (\hdrs b -> f (unsafeCoerce {}) hdrs b)

88+ buildClientFn _ _ _ f hdrs b = f {} hdrs b

8889

8990-- With path/query, no headers, no body

9091instance

@@ -93,11 +94,11 @@ instance

9394 IsUnit

9495 Unit

9596 pq

96− h

97+ ()

9798 errorRow

9899 result

99100 (Record pq -> Om (Record ()) errorRow result) where

100− buildClientFn _ _ _ f = unsafeCoerce (\pqr -> f pqr (unsafeCoerce {}) unit)

101+ buildClientFn _ _ _ f pqr = f pqr {} unit

101102

102103-- With path/query, no headers, with body

103104instance

@@ -106,11 +107,11 @@ instance

106107 IsNotUnit

107108 body

108109 pq

109− h

110+ ()

110111 errorRow

111112 result

112113 (Record pq -> body -> Om (Record ()) errorRow result) where

113− buildClientFn _ _ _ f = unsafeCoerce (\pqr b -> f pqr (unsafeCoerce {}) b)

114+ buildClientFn _ _ _ f pqr b = f pqr {} b

114115

115116-- With path/query, with headers, no body

116117instance

@@ -123,7 +124,7 @@ instance

123124 errorRow

124125 result

125126 (Record pq -> Record h -> Om (Record ()) errorRow result) where

126− buildClientFn _ _ _ f = unsafeCoerce (\pqr hdrs -> f pqr hdrs unit)

127+ buildClientFn _ _ _ f pqr hdrs = f pqr hdrs unit

127128

128129-- With path/query, with headers, with body

129130instance

@@ -136,4 +137,4 @@ instance

136137 errorRow

137138 result

138139 (Record pq -> Record h -> body -> Om (Record ()) errorRow result) where

139− buildClientFn _ _ _ f = unsafeCoerce f

140+ buildClientFn _ _ _ f = f

src/Yoga/Fetch/Om/MakeRequest.purs+1−1

@@ -81,7 +81,7 @@ makeRequest proxy url customHeaders maybeBody = do

8181 , body

8282 , credentials: Credentials.SameOrigin

8383 , mode: Mode.Cors

84− , referrer: Referrer.ReferrerNone

84+ , referrer: Referrer.ReferrerUrl ""

8585 , referrerPolicy: ReferrerPolicy.NoReferrer

8686 , integrity: Integrity ""

8787 , duplex: Duplex.Half

test/Complete.Example.purs+2−2

@@ -5,7 +5,7 @@ import Prelude

55import Data.Array (length)

66import Data.Maybe (Maybe(..))

77import Effect.Class.Console (log)

8−import Yoga.Fetch.Om (GET, POST, PUT, DELETE, Route, JSON, Path, type (/), type (:), type (:?), client, polymorphic)

8+import Yoga.Fetch.Om (GET, POST, PUT, DELETE, Route, JSON, Path, type (/), type (:), type (:?), client)

99import Yoga.Om (Om, handleErrors)

1010

1111type User =

@@ -83,7 +83,7 @@ api

8383 , listUsers :: { limit :: Maybe Int, offset :: Maybe Int } -> Om ctx err (Array User)

8484 , updateUser :: { id :: Int } -> UpdateUserRequest -> Om ctx (badRequest :: ErrorMessage, notFound :: ErrorMessage | err) User

8585 }

86−api = polymorphic $ client @UserAPI "https://api.example.com"

86+api = client @UserAPI "https://api.example.com"

8787

8888exampleGetUser :: Om {} (notFound :: ErrorMessage) Unit

8989exampleGetUser = do

test/Polymorphic.Spec.pursnew file+60

@@ -0,0 +1,60 @@

1+module Polymorphic.Spec where

3+import Prelude

5+import Effect (Effect)

6+import Effect.Class (liftEffect)

7+import Effect.Ref as Ref

8+import Yoga.Fetch.Om (GET, Route, Path, type (/), type (:), client)

9+import Yoga.Om (Om, ask, runOm)

10+import ViTest (ViTest, describe, test)

11+import ViTest.Expect (expectToBe)

12+

13+type User = { id :: Int, name :: String }

14+

15+type TestAPI =

16+ { getUser :: Route GET (Path ("users" / "id" : Int)) {} (ok :: { body :: User })

17+ }

18+

19+api

20+ :: forall ctx err

21+ . { getUser :: { id :: Int } -> Om ctx err User

22+ }

23+api = client @TestAPI "http://localhost:44931"

24+

25+testPolymorphic :: Effect ViTest

26+testPolymorphic = describe "polymorphic client" do

27+ _ <- test "fetches user with { token :: String } context" do

28+ tokenRef <- liftEffect $ Ref.new ""

29+ runOm { token: "secret123" } { exception: \_ -> pure unit } do

30+ ctx <- ask

31+ liftEffect $ Ref.write ctx.token tokenRef

32+ user <- api.getUser { id: 42 }

33+ liftEffect $ Ref.write (ctx.token <> ":" <> user.name) tokenRef

34+ val <- liftEffect $ Ref.read tokenRef

35+ expectToBe val "secret123:User 42"

36+

37+ _ <- test "fetches user with { apiKey :: String, userId :: Int } context" do

38+ resultRef <- liftEffect $ Ref.new ""

39+ runOm { apiKey: "mykey", userId: 7 } { exception: \_ -> pure unit } do

40+ ctx <- ask

41+ user <- api.getUser { id: ctx.userId }

42+ liftEffect $ Ref.write (ctx.apiKey <> ":" <> user.name) resultRef

43+ val <- liftEffect $ Ref.read resultRef

44+ expectToBe val "mykey:User 7"

45+

46+ test "same api.getUser works in two different contexts" do

47+ ref1 <- liftEffect $ Ref.new ""

48+ ref2 <- liftEffect $ Ref.new ""

49+ runOm { token: "tok1" } { exception: \_ -> pure unit } do

50+ ctx <- ask

51+ user <- api.getUser { id: 1 }

52+ liftEffect $ Ref.write (ctx.token <> ":" <> user.name) ref1

53+ runOm { endpoint: "prod", region: "eu" } { exception: \_ -> pure unit } do

54+ ctx <- ask

55+ user <- api.getUser { id: 2 }

56+ liftEffect $ Ref.write (ctx.endpoint <> "-" <> ctx.region <> ":" <> user.name) ref2

57+ val1 <- liftEffect $ Ref.read ref1

58+ val2 <- liftEffect $ Ref.read ref2

59+ expectToBe val1 "tok1:User 1"

60+ expectToBe val2 "prod-eu:User 2"

test/Test.Main.purs+3−1

@@ -4,6 +4,7 @@ import Prelude

55import BuildUrl.Spec as BuildUrl

66import MakeRequest.Spec as MakeRequest

7+import Polymorphic.Spec as Polymorphic

78import SplitParams.Spec as SplitParams

89import Variant.Spec as Variant

910import Effect (Effect)

@@ -16,7 +17,8 @@ spec = do

1617 _ <- BuildUrl.testBuildUrl

1718 _ <- SplitParams.testSplitParams

1819 _ <- Variant.testOnly

19− MakeRequest.testToHeaders

20+ _ <- MakeRequest.testToHeaders

21+ Polymorphic.testPolymorphic

2022

2123main :: ViTest

2224main = viTest spec

test/setup.jsnew file+9

@@ -0,0 +1,9 @@

1+import { listen, close } from "./test-server.js";

3+export async function setup() {

4+ await listen();

5+}

7+export async function teardown() {

8+ await close();

9+}

test/test-server.jsnew file+27

@@ -0,0 +1,27 @@

1+import { createServer } from "node:http";

3+const server = createServer((req, res) => {

4+ const url = new URL(req.url, "http://localhost:44931");

5+ const match = url.pathname.match(/^\/users\/(\d+)$/);

6+ if (match && req.method === "GET") {

7+ res.writeHead(200, { "Content-Type": "application/json" });

8+ res.end(

9+ JSON.stringify({ id: parseInt(match[1]), name: "User " + match[1] }),

10+ );

11+ return;

12+ }

13+ res.writeHead(404);

14+ res.end("Not Found");

15+});

16+

17+export function listen() {

18+ return new Promise((resolve) => {

19+ server.listen(44931, () => resolve());

20+ });

21+}

22+

23+export function close() {

24+ return new Promise((resolve) => {

25+ server.close(() => resolve());

26+ });

27+}

vitest.config.js+2−1

@@ -3,7 +3,8 @@ import { defineConfig } from "vitest/config";

33export default defineConfig({

44 test: {

55 include: ["output/Test.Main/index.js"],

6− globals: true,

76 environment: "jsdom",

7+ globals: true,

8+ globalSetup: ["test/setup.js"],

89 },

910});