@@ -1,5 +1,7 @@
1module PureStack.Server
1module PureStack.Server
3 , class ToResponse
5 , class ToResponse
4 , toResponse
6 , toResponse
5 , class FromRequest
7 , class FromRequest
@@ -25,13 +27,12 @@ import PureStack.Route
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
319+ = JsonResponseBody Json
321+ | StringResponseBody String
323+newtype Response = Response { body :: ResponseBody, status :: Int, statusText :: String, headers :: Object String }
315class ToResponse r where
325class ToResponse r where
316 toResponse :: r -> Response
326 toResponse :: r -> Response
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 }
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
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 }
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 }
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 }
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 }
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