master..e4cfd92 · purestack-dev/purescript-purestack-server

git.iko.soy/purestack-dev/purescript-purestack-server

on e4cfd92 help sign in

src/Main.purs+3−4

since splitsnapshots

unifiedsplit

@@ -7,7 +7,7 @@ import Data.Maybe (Maybe)

7import Effect (Effect)

8import Effect.Aff (Aff)

9import Effect.Console (log)

10−import PureStack.Route (type (/), GET, Headers(..), Middleware, POST)

10+import PureStack.Route (type (/), GET, Headers(..), POST)

11import PureStack.Route as Router

12import PureStack.Server as Server

13import Run (AFF, Run(..), runBaseAff)

@@ -17,7 +17,7 @@ type Foo = { a :: String, b :: Maybe Int, c :: Array Number }

18type API =

19 ( 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 }

21 , deep ::

22 "deep" /

23 ( something :: "something" / GET Unit { a :: String }

@@ -30,8 +30,7 @@ main = do

30 Bun.serve $ Server.run @API identity

31 { handlers:

32 { 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 }

34 , deep: { something: pure { a: "something" } }

35 }

36− , middlewares: { auth: \req -> pure 1 }

37 }

36 }

src/PureStack/Route.purs−3

@@ -10,7 +10,6 @@ module PureStack.Route

10 , DELETE

11 , PATCH

12 , Headers(..)

13− , Middleware

14 ) where

13 ) where

16data HttpMethod

15data HttpMethod

@@ -51,5 +50,3 @@ data Slash x y

51infixr 1 type Slash as /

50infixr 1 type Slash as /

53data Headers headers r = Headers headers r

52data Headers headers r = Headers headers r

54−

55−data Middleware tag

src/PureStack/Server.purs+37−57

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

30import PureStack.Route

32import Bun.Request (Request)

33−import Bun.Request as Bun

34import Bun.Request as Request

33import Bun.Request as Request

35import Bun.Response as Bun.Response

34import Bun.Response as Bun.Response

36import Control.Alternative (class Plus, empty)

35import Control.Alternative (class Plus, empty)

@@ -61,12 +60,7 @@ import Record.Builder (Builder)

61import Record.Builder as Builder

60import Record.Builder as Builder

62import Type.Proxy (Proxy(..))

61import Type.Proxy (Proxy(..))

64−type Route =

65− { path :: Array String

66− , verb :: String

67− , query :: Map String (Array String)

63+type Route = { path :: Array String, verb :: String, query :: Map String (Array String) }

68− , originalRequest :: Bun.Request

69− }

71routeFromRequest :: Request -> Route

65routeFromRequest :: Request -> Route

72routeFromRequest req =

66routeFromRequest req =

@@ -83,81 +77,67 @@ routeFromRequest req =

83 , query: case url of

77 , query: case url of

84 Nothing -> Map.empty

78 Nothing -> Map.empty

85 Just u -> URL.query u

79 Just u -> URL.query u

86− , originalRequest: req

87 }

80 }

89type Server a = ExceptT Response Aff a

82type Server a = ExceptT Response Aff a

91newtype Nt m = Nt (forall x. m x -> Server x)

84newtype Nt m = Nt (forall x. m x -> Server x)

93−class ServeRoute :: forall k. k -> Type -> Row Type -> (Type -> Type) -> Constraint

86+class ServeRoute :: forall k. k -> Type -> (Type -> Type) -> Constraint

94−class ServeRoute route handler middlewares m | route middlewares -> handler, handler -> m where

87+class ServeRoute route handler m | route -> handler, handler -> m where

95− serveRoute :: Route -> Maybe (Nt m -> handler -> Record middlewares -> Request -> Server Response)

88+ serveRoute :: Route -> Maybe (Nt m -> handler -> Request -> Server Response)

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

98 serveRoute route@{ path } = do

91 serveRoute route@{ path } = do

99 { head: h, tail } <- Array.uncons path

92 { head: h, tail } <- Array.uncons path

100 assert $ h == (reflectSymbol @path Proxy)

93 assert $ h == (reflectSymbol @path Proxy)

101 serveRoute @rest route { path = tail }

94 serveRoute @rest route { path = tail }

102

103else instance

96else instance

104− ( ServeRoute rest handler middlewares m

97+ ( ServeRoute rest handler m

105 , ServeQuery row list

98 , ServeQuery row list

106 , RowToList row list

99 , RowToList row list

107 ) =>

100 ) =>

108− ServeRoute (Record row / rest) (Record row -> handler) middlewares m where

101+ ServeRoute (Record row / rest) (Record row -> handler) m where

109 serveRoute route@{ query } = do

102 serveRoute route@{ query } = do

110 builder <- serveQuery @row @list query

103 builder <- serveQuery @row @list query

111 serveRoute @rest route <#> (\f nt handler req -> f nt (handler $ Builder.buildFromScratch builder) req)

104 serveRoute @rest route <#> (\f nt handler req -> f nt (handler $ Builder.buildFromScratch builder) req)

112

105

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

127 serveRoute route@{ path } = do

107 serveRoute route@{ path } = do

128 { head: h, tail } <- Array.uncons path

108 { head: h, tail } <- Array.uncons path

129 t <- parsePathPiece @t h

109 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)

131

111

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

133 serveRoute { path, verb } = do

113 serveRoute { path, verb } = do

134 assert $ verb == methodName @(meth Unit Unit)

114 assert $ verb == methodName @(meth Unit Unit)

135 assert $ path == []

115 assert $ path == []

136− pure $ \(Nt nt) handler _middlewares _req -> do

116+ pure $ \(Nt nt) handler _req -> do

137 nt handler

117 nt handler

138 pure $ ok

118 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

140 serveRoute { path, verb } = do

120 serveRoute { path, verb } = do

141 assert $ verb == methodName @(meth Unit resp)

121 assert $ verb == methodName @(meth Unit resp)

142 assert $ path == []

122 assert $ path == []

143− pure $ \(Nt nt) handler _middlewares _req -> do

123+ pure $ \(Nt nt) handler _req -> do

144 resp <- nt handler

124 resp <- nt handler

145 pure $ toResponse resp

125 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

147 serveRoute { path, verb } = do

127 serveRoute { path, verb } = do

148 assert $ verb == methodName @(meth resp Unit)

128 assert $ verb == methodName @(meth resp Unit)

149 assert $ path == []

129 assert $ path == []

150− pure $ \(Nt nt) handler _middlewares req -> do

130+ pure $ \(Nt nt) handler req -> do

151 liftAff (fromRequest req) >>= case _ of

131 liftAff (fromRequest req) >>= case _ of

152 Nothing -> pure $ badRequest

132 Nothing -> pure $ badRequest

153 Just r -> do

133 Just r -> do

154 nt $ handler r

134 nt $ handler r

155 pure $ ok

135 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

157 serveRoute { path, verb } = do

137 serveRoute { path, verb } = do

158 assert $ verb == methodName @(meth req resp)

138 assert $ verb == methodName @(meth req resp)

159 assert $ path == []

139 assert $ path == []

160− pure $ \(Nt nt) handler _middlewares req -> do

140+ pure $ \(Nt nt) handler req -> do

161 liftAff (fromRequest req) >>= case _ of

141 liftAff (fromRequest req) >>= case _ of

162 Nothing -> pure $ badRequest

142 Nothing -> pure $ badRequest

163 Just r -> do

143 Just r -> do

@@ -165,12 +145,12 @@ else instance (FromRequest req, ToResponse resp, MethodName (meth req resp)) =>

165 pure $ toResponse resp

145 pure $ toResponse resp

166

146

167else instance

147else instance

168− ( ServeAPI routes list handlers middlewares m

148+ ( ServeAPI routes list handlers m

169 , RowToList routes list

149 , RowToList routes list

170 ) =>

150 ) =>

171− ServeRoute routes (Record handlers) middlewares m where

151+ ServeRoute routes (Record handlers) m where

172− serveRoute route = pure $ \nt handlers middlewares req ->

152+ serveRoute route = pure $ \nt handlers req ->

173− serveAPI @routes @list nt handlers middlewares route req

153+ serveAPI @routes @list nt handlers route req

174

154

175class ServeQuery :: Row Type -> RowList Type -> Constraint

155class ServeQuery :: Row Type -> RowList Type -> Constraint

176class ServeQuery row list | list -> row where

156class ServeQuery row list | list -> row where

@@ -357,26 +337,26 @@ assert :: forall m. Applicative m => Plus m => Boolean -> m Unit

357assert true = pure unit

337assert true = pure unit

358assert false = empty

338assert false = empty

359

339

360−class ServeAPI :: Row Type -> RowList Type -> Row Type -> Row Type -> (Type -> Type) -> Constraint

340+class ServeAPI :: Row Type -> RowList Type -> Row Type -> (Type -> Type) -> Constraint

361−class ServeAPI row list handlers middlewares m | row -> handlers, handlers -> m where

341+class ServeAPI row list handlers m | row -> handlers, handlers -> m where

362− serveAPI :: Nt m -> Record handlers -> Record middlewares -> Route -> Request -> Server Response

342+ serveAPI :: Nt m -> Record handlers -> Route -> Request -> Server Response

363

343

364−instance ServeAPI row RowList.Nil () middlewares m where

344+instance ServeAPI row RowList.Nil () m where

365− serveAPI _ _ _ _ _ = pure notFound

345+ serveAPI _ _ _ _ = pure notFound

366

346

367instance

347instance

368− ( ServeRoute t handler middlewares m

348+ ( ServeRoute t handler m

369 , Row.Cons field t tail row

349 , Row.Cons field t tail row

370− , ServeAPI row rest restHandlers middlewares m

350+ , ServeAPI row rest restHandlers m

371 , IsSymbol field

351 , IsSymbol field

372 , Row.Cons field handler restHandlers handlers

352 , Row.Cons field handler restHandlers handlers

373 , Row.Lacks field restHandlers

353 , Row.Lacks field restHandlers

374 ) =>

354 ) =>

375− ServeAPI row (RowList.Cons field t rest) handlers middlewares m where

355+ ServeAPI row (RowList.Cons field t rest) handlers m where

376− serveAPI nt handlers middlewares route req =

356+ serveAPI nt handlers route req =

377 case serveRoute @t route of

357 case serveRoute @t route of

378− Nothing -> serveAPI @row @rest @restHandlers @middlewares nt (Record.delete (Proxy @field) handlers) middlewares route req

358+ Nothing -> serveAPI @row @rest @restHandlers nt (Record.delete (Proxy @field) handlers) route req

379− Just f -> f nt (Record.get (Proxy @field) handlers) middlewares req

359+ Just f -> f nt (Record.get (Proxy @field) handlers) req

380

360

381notFound :: Response

361notFound :: Response

382notFound = Response { body: EmptyResponseBody, status: 404, statusText: "Not Found", headers: Object.empty }

362notFound = Response { body: EmptyResponseBody, status: 404, statusText: "Not Found", headers: Object.empty }

@@ -393,16 +373,16 @@ ok = Response { body: EmptyResponseBody, status: 200, statusText: "OK", headers:

393-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad

373-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad

394-- | instead you can just pass `identity` as the first argument.

374-- | instead you can just pass `identity` as the first argument.

395run

375run

396− :: forall @row list handlers m middlewares

376+ :: forall @row list handlers m

397 . RowToList row list

377 . RowToList row list

398− => ServeAPI row list handlers middlewares m

378+ => ServeAPI row list handlers m

399 => (forall x. m x -> Server x)

379 => (forall x. m x -> Server x)

400− -> { handlers :: Record handlers, middlewares :: Record middlewares }

380+ -> { handlers :: Record handlers }

401 -> Request

381 -> Request

402 -> Aff Bun.Response.Response

382 -> Aff Bun.Response.Response

403−run nt { handlers, middlewares } req = do

383+run nt { handlers } req = do

404 Response { body, headers, status, statusText } <-

384 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

406 let opts = { headers, status, statusText }

386 let opts = { headers, status, statusText }

407 pure $ case body of

387 pure $ case body of

408 EmptyResponseBody -> Bun.Response.string "" opts

388 EmptyResponseBody -> Bun.Response.string "" opts