git.iko.soy/purestack-dev/purescript-purestack-server
on e4cfd92 help sign in
3 files changed+40−64
since splitsnapshots
unifiedsplit
src/Main.purs+3−4 src/PureStack/Route.purs−3 src/PureStack/Server.purs+37−57
src/Main.purs+3−4
@@ -7,7 +7,7 @@ import Data.Maybe (Maybe)
77import Effect (Effect)
88import Effect.Aff (Aff)
99import Effect.Console (log)
10−import PureStack.Route (type (/), GET, Headers(..), Middleware, POST)
10+import PureStack.Route (type (/), GET, Headers(..), POST)
1111import PureStack.Route as Router
1212import PureStack.Server as Server
1313import Run (AFF, Run(..), runBaseAff)
@@ -17,7 +17,7 @@ type Foo = { a :: String, b :: Maybe Int, c :: Array Number }
1717
1818type API =
1919 ( foo :: "foo" / "bar" / Foo / GET Unit { a :: Int, b :: Number, c :: Foo }
20− , bar :: "foo" / Middleware "auth" / "qux" / POST (Headers { foo :: String } Unit) { a :: Int, s :: String }
20+ , bar :: "foo" / "qux" / POST (Headers { foo :: String } Unit) { a :: Int, s :: String }
2121 , deep ::
2222 "deep" /
2323 ( something :: "something" / GET Unit { a :: String }
@@ -30,8 +30,7 @@ main = do
3030 Bun.serve $ Server.run @API identity
3131 { handlers:
3232 { foo: \x -> pure { a: 1, b: 1.0, c: x }
33− , bar: \i (Headers x _) -> pure { a: 8, s: x.foo }
33+ , bar: \(Headers x _) -> pure { a: 8, s: x.foo }
3434 , deep: { something: pure { a: "something" } }
3535 }
36− , middlewares: { auth: \req -> pure 1 }
3736 }
src/PureStack/Route.purs−3
@@ -10,7 +10,6 @@ module PureStack.Route
1010 , DELETE
1111 , PATCH
1212 , Headers(..)
13− , Middleware
1413 ) where
1514
1615data HttpMethod
@@ -51,5 +50,3 @@ data Slash x y
5150infixr 1 type Slash as /
5251
5352data Headers headers r = Headers headers r
54−
55−data Middleware tag
src/PureStack/Server.purs+37−57
@@ -30,7 +30,6 @@ import Prelude
3030import PureStack.Route
3131
3232import Bun.Request (Request)
33−import Bun.Request as Bun
3433import Bun.Request as Request
3534import Bun.Response as Bun.Response
3635import Control.Alternative (class Plus, empty)
@@ -61,12 +60,7 @@ import Record.Builder (Builder)
6160import Record.Builder as Builder
6261import Type.Proxy (Proxy(..))
6362
64−type Route =
65− { path :: Array String
66− , verb :: String
67− , query :: Map String (Array String)
68− , originalRequest :: Bun.Request
69− }
63+type Route = { path :: Array String, verb :: String, query :: Map String (Array String) }
7064
7165routeFromRequest :: Request -> Route
7266routeFromRequest req =
@@ -83,81 +77,67 @@ routeFromRequest req =
8377 , query: case url of
8478 Nothing -> Map.empty
8579 Just u -> URL.query u
86− , originalRequest: req
8780 }
8881
8982type Server a = ExceptT Response Aff a
9083
9184newtype Nt m = Nt (forall x. m x -> Server x)
9285
93−class ServeRoute :: forall k. k -> Type -> Row Type -> (Type -> Type) -> Constraint
94−class ServeRoute route handler middlewares m | route middlewares -> handler, handler -> m where
95− serveRoute :: Route -> Maybe (Nt m -> handler -> Record middlewares -> Request -> Server Response)
86+class ServeRoute :: forall k. k -> Type -> (Type -> Type) -> Constraint
87+class ServeRoute route handler m | route -> handler, handler -> m where
88+ serveRoute :: Route -> Maybe (Nt m -> handler -> Request -> Server Response)
9689
97−instance (ServeRoute rest handler middlewares m, IsSymbol path) => ServeRoute (path / rest) handler middlewares m where
90+instance (ServeRoute rest handler m, IsSymbol path) => ServeRoute (path / rest) handler m where
9891 serveRoute route@{ path } = do
9992 { head: h, tail } <- Array.uncons path
10093 assert $ h == (reflectSymbol @path Proxy)
10194 serveRoute @rest route { path = tail }
10295
10396else instance
104− ( ServeRoute rest handler middlewares m
97+ ( ServeRoute rest handler m
10598 , ServeQuery row list
10699 , RowToList row list
107100 ) =>
108− ServeRoute (Record row / rest) (Record row -> handler) middlewares m where
101+ ServeRoute (Record row / rest) (Record row -> handler) m where
109102 serveRoute route@{ query } = do
110103 builder <- serveQuery @row @list query
111104 serveRoute @rest route <#> (\f nt handler req -> f nt (handler $ Builder.buildFromScratch builder) req)
112105
113−else instance
114− ( ServeRoute rest handler middlewares m
115− , IsSymbol field
116− , Row.Cons field (Bun.Request -> m x) tail middlewares
117− ) =>
118− ServeRoute (Middleware field / rest) (x -> handler) middlewares m where
119− serveRoute route@{ originalRequest } = do
120− serveRoute @rest route <#>
121− ( \f nt@(Nt ntf) handler middlewares req -> do
122− x <- ntf $ Record.get (Proxy @field) middlewares originalRequest
123− f nt (handler x) middlewares req
124− )
125−
126−else instance (ServeRoute rest handler middlewares m, ParsePathPiece t) => ServeRoute (t / rest) (t -> handler) middlewares m where
106+else instance (ServeRoute rest handler m, ParsePathPiece t) => ServeRoute (t / rest) (t -> handler) m where
127107 serveRoute route@{ path } = do
128108 { head: h, tail } <- Array.uncons path
129109 t <- parsePathPiece @t h
130− serveRoute @rest route { path = tail } <#> (\f nt handler mws req -> f nt (handler t) mws req)
110+ serveRoute @rest route { path = tail } <#> (\f nt handler req -> f nt (handler t) req)
131111
132−else instance MethodName (meth Unit Unit) => ServeRoute (meth Unit Unit) (m Unit) middlewares m where
112+else instance MethodName (meth Unit Unit) => ServeRoute (meth Unit Unit) (m Unit) m where
133113 serveRoute { path, verb } = do
134114 assert $ verb == methodName @(meth Unit Unit)
135115 assert $ path == []
136− pure $ \(Nt nt) handler _middlewares _req -> do
116+ pure $ \(Nt nt) handler _req -> do
137117 nt handler
138118 pure $ ok
139−else instance (ToResponse resp, MethodName (meth Unit resp)) => ServeRoute (meth Unit resp) (m resp) middlewares m where
119+else instance (ToResponse resp, MethodName (meth Unit resp)) => ServeRoute (meth Unit resp) (m resp) m where
140120 serveRoute { path, verb } = do
141121 assert $ verb == methodName @(meth Unit resp)
142122 assert $ path == []
143− pure $ \(Nt nt) handler _middlewares _req -> do
123+ pure $ \(Nt nt) handler _req -> do
144124 resp <- nt handler
145125 pure $ toResponse resp
146−else instance (FromRequest req, MethodName (meth resp Unit)) => ServeRoute (meth resp Unit) (req -> m Unit) middlewares m where
126+else instance (FromRequest req, MethodName (meth resp Unit)) => ServeRoute (meth resp Unit) (req -> m Unit) m where
147127 serveRoute { path, verb } = do
148128 assert $ verb == methodName @(meth resp Unit)
149129 assert $ path == []
150− pure $ \(Nt nt) handler _middlewares req -> do
130+ pure $ \(Nt nt) handler req -> do
151131 liftAff (fromRequest req) >>= case _ of
152132 Nothing -> pure $ badRequest
153133 Just r -> do
154134 nt $ handler r
155135 pure $ ok
156−else instance (FromRequest req, ToResponse resp, MethodName (meth req resp)) => ServeRoute (meth req resp) (req -> m resp) middlewares m where
136+else instance (FromRequest req, ToResponse resp, MethodName (meth req resp)) => ServeRoute (meth req resp) (req -> m resp) m where
157137 serveRoute { path, verb } = do
158138 assert $ verb == methodName @(meth req resp)
159139 assert $ path == []
160− pure $ \(Nt nt) handler _middlewares req -> do
140+ pure $ \(Nt nt) handler req -> do
161141 liftAff (fromRequest req) >>= case _ of
162142 Nothing -> pure $ badRequest
163143 Just r -> do
@@ -165,12 +145,12 @@ else instance (FromRequest req, ToResponse resp, MethodName (meth req resp)) =>
165145 pure $ toResponse resp
166146
167147else instance
168− ( ServeAPI routes list handlers middlewares m
148+ ( ServeAPI routes list handlers m
169149 , RowToList routes list
170150 ) =>
171− ServeRoute routes (Record handlers) middlewares m where
172− serveRoute route = pure $ \nt handlers middlewares req ->
173− serveAPI @routes @list nt handlers middlewares route req
151+ ServeRoute routes (Record handlers) m where
152+ serveRoute route = pure $ \nt handlers req ->
153+ serveAPI @routes @list nt handlers route req
174154
175155class ServeQuery :: Row Type -> RowList Type -> Constraint
176156class ServeQuery row list | list -> row where
@@ -357,26 +337,26 @@ assert :: forall m. Applicative m => Plus m => Boolean -> m Unit
357337assert true = pure unit
358338assert false = empty
359339
360−class ServeAPI :: Row Type -> RowList Type -> Row Type -> Row Type -> (Type -> Type) -> Constraint
361−class ServeAPI row list handlers middlewares m | row -> handlers, handlers -> m where
362− serveAPI :: Nt m -> Record handlers -> Record middlewares -> Route -> Request -> Server Response
340+class ServeAPI :: Row Type -> RowList Type -> Row Type -> (Type -> Type) -> Constraint
341+class ServeAPI row list handlers m | row -> handlers, handlers -> m where
342+ serveAPI :: Nt m -> Record handlers -> Route -> Request -> Server Response
363343
364−instance ServeAPI row RowList.Nil () middlewares m where
365− serveAPI _ _ _ _ _ = pure notFound
344+instance ServeAPI row RowList.Nil () m where
345+ serveAPI _ _ _ _ = pure notFound
366346
367347instance
368− ( ServeRoute t handler middlewares m
348+ ( ServeRoute t handler m
369349 , Row.Cons field t tail row
370− , ServeAPI row rest restHandlers middlewares m
350+ , ServeAPI row rest restHandlers m
371351 , IsSymbol field
372352 , Row.Cons field handler restHandlers handlers
373353 , Row.Lacks field restHandlers
374354 ) =>
375− ServeAPI row (RowList.Cons field t rest) handlers middlewares m where
376− serveAPI nt handlers middlewares route req =
355+ ServeAPI row (RowList.Cons field t rest) handlers m where
356+ serveAPI nt handlers route req =
377357 case serveRoute @t route of
378− Nothing -> serveAPI @row @rest @restHandlers @middlewares nt (Record.delete (Proxy @field) handlers) middlewares route req
379− Just f -> f nt (Record.get (Proxy @field) handlers) middlewares req
358+ Nothing -> serveAPI @row @rest @restHandlers nt (Record.delete (Proxy @field) handlers) route req
359+ Just f -> f nt (Record.get (Proxy @field) handlers) req
380360
381361notFound :: Response
382362notFound = Response { body: EmptyResponseBody, status: 404, statusText: "Not Found", headers: Object.empty }
@@ -393,16 +373,16 @@ ok = Response { body: EmptyResponseBody, status: 200, statusText: "OK", headers:
393373-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad
394374-- | instead you can just pass `identity` as the first argument.
395375run
396− :: forall @row list handlers m middlewares
376+ :: forall @row list handlers m
397377 . RowToList row list
398− => ServeAPI row list handlers middlewares m
378+ => ServeAPI row list handlers m
399379 => (forall x. m x -> Server x)
400− -> { handlers :: Record handlers, middlewares :: Record middlewares }
380+ -> { handlers :: Record handlers }
401381 -> Request
402382 -> Aff Bun.Response.Response
403−run nt { handlers, middlewares } req = do
383+run nt { handlers } req = do
404384 Response { body, headers, status, statusText } <-
405− map (either identity identity) $ runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers middlewares (routeFromRequest req) req
385+ map (either identity identity) $ runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers (routeFromRequest req) req
406386 let opts = { headers, status, statusText }
407387 pure $ case body of
408388 EmptyResponseBody -> Bun.Response.string "" opts