git.iko.soy/purestack-dev/purescript-purestack-server
on master help sign in
Response
a6a87a1iko
src/Bun/Response.js+23
@@ -10,3 +10,26 @@ export function string(s) {
10 return new Response(s, options)
10 return new Response(s, options)
11 }
11 }
12}
12}
13+
14+
15+export function stream(s) {
16+ return function(options) {
17+ return new Response(s, options)
18+ }
19+}
20+
21+export function body(resp) {
22+ return resp.body
23+}
24+
25+export function status(resp) {
26+ return resp.status
27+}
28+
29+export function statusText(resp) {
30+ return resp.statusText
31+}
32+
33+export function headers(resp) {
34+ return Object.fromEntries(resp.headers.entries());
35+}
src/Bun/Response.purs+9−3
@@ -1,12 +1,18 @@
1module Bun.Response where
1module Bun.Response where
2
2
3import Data.Argonaut (Json)
3import Data.Argonaut (Json)
4−import Data.Tuple.Nested (type (/\))
4+import Foreign.Object (Object)
5−import Effect (Effect)
6
5
7foreign import data Response :: Type
6foreign import data Response :: Type
7+foreign import data ReadableStream :: Type
8
8
9−type Options = { status :: Int, statusText :: String, headers :: Array (String /\ String) }
9+type Options = { status :: Int, statusText :: String, headers :: Object String }
10
10
11foreign import json :: Json -> Options -> Response
11foreign import json :: Json -> Options -> Response
12foreign import string :: String -> Options -> Response
12foreign import string :: String -> Options -> Response
13+foreign import stream :: ReadableStream -> Options -> Response
14+foreign import body :: Response -> ReadableStream
15+foreign import headers :: Response -> Object String
16+foreign import status :: Response -> Int
17+foreign import statusText :: Response -> String
18+
src/PureStack/Route.purs+1
@@ -32,3 +32,4 @@ data Slash x y
32-- | Other types are captured path pieces.
32-- | Other types are captured path pieces.
33infixr 1 type Slash as /
33infixr 1 type Slash as /
34
34
35+data Headers headers r = Headers (Record headers) r
src/PureStack/Server.purs+27−14
@@ -1,5 +1,7 @@
1module PureStack.Server
1module PureStack.Server
2 ( Server
2 ( Server
3+ , Response(..)
4+ , ResponseBody(..)
3 , class ToResponse
5 , class ToResponse
4 , toResponse
6 , toResponse
5 , class FromRequest
7 , class FromRequest
@@ -25,13 +27,12 @@ import PureStack.Route
25
27
26import Bun.Request (Request)
28import Bun.Request (Request)
27import Bun.Request as Request
29import Bun.Request as Request
28−import Bun.Response (Response)
30+import Bun.Response as Bun.Response
29−import Bun.Response as Response
30import Control.Alternative (class Plus, empty)
31import Control.Alternative (class Plus, empty)
31import Control.Monad.Except (ExceptT, runExceptT)
32import Control.Monad.Except (ExceptT, runExceptT)
32−import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
33+import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson)
33import Data.Array as Array
34import Data.Array as Array
34−import Data.Either (Either(..))
35+import Data.Either (Either(..), either)
35import Data.Int as Int
36import Data.Int as Int
36import Data.Map (Map)
37import Data.Map (Map)
37import Data.Map as Map
38import Data.Map as Map
@@ -43,6 +44,8 @@ import Data.Traversable (traverse)
43import Data.URL as URL
44import Data.URL as URL
44import Effect.Aff (Aff)
45import Effect.Aff (Aff)
45import Effect.Aff.Class (liftAff)
46import Effect.Aff.Class (liftAff)
47+import Foreign.Object (Object)
48+import Foreign.Object as Object
46import Prim.Row as Row
49import Prim.Row as Row
47import Prim.RowList (class RowToList, RowList)
50import Prim.RowList (class RowToList, RowList)
48import Prim.RowList as RowList
51import Prim.RowList as RowList
@@ -312,11 +315,18 @@ else instance
312 r <- serveQuery @tail @rest m
315 r <- serveQuery @tail @rest m
313 pure $ Builder.insert (Proxy @field) v <<< r
316 pure $ Builder.insert (Proxy @field) v <<< r
314
317
318+data ResponseBody
319+ = JsonResponseBody Json
320+ | EmptyResponseBody
321+ | StringResponseBody String
322+
323+newtype Response = Response { body :: ResponseBody, status :: Int, statusText :: String, headers :: Object String }
324+
315class ToResponse r where
325class ToResponse r where
316 toResponse :: r -> Response
326 toResponse :: r -> Response
317
327
318instance EncodeJson (Record row) => ToResponse (Record row) where
328instance EncodeJson (Record row) => ToResponse (Record row) where
319− toResponse rec = Response.json (encodeJson rec) { status: 200, statusText: "OK", headers: [] }
329+ toResponse rec = Response { body: JsonResponseBody $ encodeJson rec, status: 200, statusText: "OK", headers: Object.empty }
320
330
321instance ToResponse Response where
331instance ToResponse Response where
322 toResponse resp = resp
332 toResponse resp = resp
@@ -378,16 +388,16 @@ instance
378 Just f -> f nt (Record.get (Proxy @field) handlers) req
388 Just f -> f nt (Record.get (Proxy @field) handlers) req
379
389
380notFound :: Response
390notFound :: Response
381−notFound = Response.string "" { status: 404, statusText: "Not Found", headers: [] }
391+notFound = Response { body: EmptyResponseBody, status: 404, statusText: "Not Found", headers: Object.empty }
382
392
383internalServerError :: Response
393internalServerError :: Response
384−internalServerError = Response.string "" { status: 500, statusText: "Internal Server Error", headers: [] }
394+internalServerError = Response { body: EmptyResponseBody, status: 500, statusText: "Internal Server Error", headers: Object.empty }
385
395
386badRequest :: Response
396badRequest :: Response
387−badRequest = Response.string "" { status: 400, statusText: "Bad Request", headers: [] }
397+badRequest = Response { body: EmptyResponseBody, status: 400, statusText: "Bad Request", headers: Object.empty }
388
398
389ok :: Response
399ok :: Response
390−ok = Response.string "" { status: 200, statusText: "OK", headers: [] }
400+ok = Response { body: EmptyResponseBody, status: 200, statusText: "OK", headers: Object.empty }
391
401
392-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad
402-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad
393-- | instead you can just pass `identity` as the first argument.
403-- | instead you can just pass `identity` as the first argument.
@@ -398,9 +408,12 @@ run
398 => (forall x. m x -> Server x)
408 => (forall x. m x -> Server x)
399 -> Record handlers
409 -> Record handlers
400 -> Request
410 -> Request
401− -> Aff Response
411+ -> Aff Bun.Response.Response
402run nt handlers req = do
412run nt handlers req = do
413+ Response { body, headers, status, statusText } <-
403− res <- runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers (routeFromRequest req) req
414+ map (either identity identity) $ runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers (routeFromRequest req) req
415+ let opts = { headers, status, statusText }
404− pure case res of
416+ pure $ case body of
405− Left resp -> resp
417+ EmptyResponseBody -> Bun.Response.string "" opts
406− Right resp -> resp
418+ JsonResponseBody json -> Bun.Response.json json opts
419+ StringResponseBody string -> Bun.Response.string string opts