git.iko.soy/purestack-dev/purescript-purestack-server
on master help sign in
Handle all methods
c0ddf54iko
spago.dhall+2
@@ -9,7 +9,9 @@
9 , "effect"
9 , "effect"
10 , "either"
10 , "either"
11 , "foldable-traversable"
11 , "foldable-traversable"
12+ , "integers"
12 , "maybe"
13 , "maybe"
14+ , "numbers"
13 , "ordered-collections"
15 , "ordered-collections"
14 , "prelude"
16 , "prelude"
15 , "record"
17 , "record"
src/PureStack/Server.purs+135−2
@@ -37,6 +37,7 @@ import Data.Map (Map)
37import Data.Map as Map
37import Data.Map as Map
38import Data.Maybe (Maybe(..))
38import Data.Maybe (Maybe(..))
39import Data.Number as Number
39import Data.Number as Number
40+import Data.String as String
40import Data.Symbol (class IsSymbol, reflectSymbol)
41import Data.Symbol (class IsSymbol, reflectSymbol)
41import Data.Traversable (traverse)
42import Data.Traversable (traverse)
42import Data.URL as URL
43import Data.URL as URL
@@ -107,18 +108,139 @@ else instance ToResponse resp => ServeRoute (GET resp) (m resp) m where
107 resp <- nt handler
108 resp <- nt handler
108 pure $ toResponse resp
109 pure $ toResponse resp
109
110
111+else instance ServeRoute (POST Unit Unit) (m Unit) m where
112+ serveRoute { path, verb } = do
113+ assert $ verb == "POST"
114+ assert $ path == []
115+ pure $ \(Nt nt) handler _req -> do
116+ nt handler
117+ pure $ ok
110else instance (ToResponse resp) => ServeRoute (POST Unit resp) (m resp) m where
118else instance (ToResponse resp) => ServeRoute (POST Unit resp) (m resp) m where
111 serveRoute { path, verb } = do
119 serveRoute { path, verb } = do
120+ assert $ verb == "POST"
121+ assert $ path == []
122+ pure $ \(Nt nt) handler _req -> do
123+ resp <- nt handler
124+ pure $ toResponse resp
125+else instance (FromRequest req) => ServeRoute (POST resp Unit) (req -> m Unit) m where
126+ serveRoute { path, verb } = do
127+ assert $ verb == "POST"
112 assert $ path == []
128 assert $ path == []
129+ pure $ \(Nt nt) handler req -> do
130+ liftAff (fromRequest req) >>= case _ of
131+ Nothing -> pure $ badRequest
132+ Just r -> do
133+ nt $ handler r
134+ pure $ ok
135+else instance (FromRequest req, ToResponse resp) => ServeRoute (POST req resp) (req -> m resp) m where
136+ serveRoute { path, verb } = do
113 assert $ verb == "POST"
137 assert $ verb == "POST"
138+ assert $ path == []
139+ pure $ \(Nt nt) handler req -> do
140+ liftAff (fromRequest req) >>= case _ of
141+ Nothing -> pure $ badRequest
142+ Just r -> do
143+ resp <- nt $ handler r
144+ pure $ toResponse resp
145+
146+else instance ServeRoute (DELETE Unit Unit) (m Unit) m where
147+ serveRoute { path, verb } = do
148+ assert $ verb == "DELETE"
149+ assert $ path == []
150+ pure $ \(Nt nt) handler _req -> do
151+ nt handler
152+ pure $ ok
153+else instance (ToResponse resp) => ServeRoute (DELETE Unit resp) (m resp) m where
154+ serveRoute { path, verb } = do
155+ assert $ verb == "DELETE"
156+ assert $ path == []
114 pure $ \(Nt nt) handler _req -> do
157 pure $ \(Nt nt) handler _req -> do
115 resp <- nt handler
158 resp <- nt handler
116 pure $ toResponse resp
159 pure $ toResponse resp
160+else instance (FromRequest req) => ServeRoute (DELETE resp Unit) (req -> m Unit) m where
161+ serveRoute { path, verb } = do
162+ assert $ verb == "DELETE"
163+ assert $ path == []
164+ pure $ \(Nt nt) handler req -> do
165+ liftAff (fromRequest req) >>= case _ of
166+ Nothing -> pure $ badRequest
167+ Just r -> do
168+ nt $ handler r
169+ pure $ ok
170+else instance (FromRequest req, ToResponse resp) => ServeRoute (DELETE req resp) (req -> m resp) m where
171+ serveRoute { path, verb } = do
172+ assert $ verb == "DELETE"
173+ assert $ path == []
174+ pure $ \(Nt nt) handler req -> do
175+ liftAff (fromRequest req) >>= case _ of
176+ Nothing -> pure $ badRequest
177+ Just r -> do
178+ resp <- nt $ handler r
179+ pure $ toResponse resp
117
180
118−else instance (FromRequest req, ToResponse resp) => ServeRoute (POST req resp) (req -> m resp) m where
181+else instance ServeRoute (PUT Unit Unit) (m Unit) m where
119 serveRoute { path, verb } = do
182 serveRoute { path, verb } = do
183+ assert $ verb == "PUT"
184+ assert $ path == []
185+ pure $ \(Nt nt) handler _req -> do
186+ nt handler
187+ pure $ ok
188+else instance (ToResponse resp) => ServeRoute (PUT Unit resp) (m resp) m where
189+ serveRoute { path, verb } = do
190+ assert $ verb == "PUT"
191+ assert $ path == []
192+ pure $ \(Nt nt) handler _req -> do
193+ resp <- nt handler
194+ pure $ toResponse resp
195+else instance (FromRequest req) => ServeRoute (PUT resp Unit) (req -> m Unit) m where
196+ serveRoute { path, verb } = do
197+ assert $ verb == "PUT"
198+ assert $ path == []
199+ pure $ \(Nt nt) handler req -> do
200+ liftAff (fromRequest req) >>= case _ of
201+ Nothing -> pure $ badRequest
202+ Just r -> do
203+ nt $ handler r
204+ pure $ ok
205+else instance (FromRequest req, ToResponse resp) => ServeRoute (PUT req resp) (req -> m resp) m where
206+ serveRoute { path, verb } = do
207+ assert $ verb == "PUT"
208+ assert $ path == []
209+ pure $ \(Nt nt) handler req -> do
210+ liftAff (fromRequest req) >>= case _ of
211+ Nothing -> pure $ badRequest
212+ Just r -> do
213+ resp <- nt $ handler r
214+ pure $ toResponse resp
215+
216+else instance ServeRoute (PATCH Unit Unit) (m Unit) m where
217+ serveRoute { path, verb } = do
218+ assert $ verb == "PATCH"
219+ assert $ path == []
220+ pure $ \(Nt nt) handler _req -> do
221+ nt handler
222+ pure $ ok
223+else instance (ToResponse resp) => ServeRoute (PATCH Unit resp) (m resp) m where
224+ serveRoute { path, verb } = do
225+ assert $ verb == "PATCH"
226+ assert $ path == []
227+ pure $ \(Nt nt) handler _req -> do
228+ resp <- nt handler
229+ pure $ toResponse resp
230+else instance (FromRequest req) => ServeRoute (PATCH resp Unit) (req -> m Unit) m where
231+ serveRoute { path, verb } = do
232+ assert $ verb == "PATCH"
233+ assert $ path == []
234+ pure $ \(Nt nt) handler req -> do
235+ liftAff (fromRequest req) >>= case _ of
236+ Nothing -> pure $ badRequest
237+ Just r -> do
238+ nt $ handler r
239+ pure $ ok
240+else instance (FromRequest req, ToResponse resp) => ServeRoute (PATCH req resp) (req -> m resp) m where
241+ serveRoute { path, verb } = do
242+ assert $ verb == "PATCH"
120 assert $ path == []
243 assert $ path == []
121− assert $ verb == "POST"
122 pure $ \(Nt nt) handler req -> do
244 pure $ \(Nt nt) handler req -> do
123 liftAff (fromRequest req) >>= case _ of
245 liftAff (fromRequest req) >>= case _ of
124 Nothing -> pure $ badRequest
246 Nothing -> pure $ badRequest
@@ -214,6 +336,14 @@ instance ParsePathPiece Int where
214instance ParsePathPiece Number where
336instance ParsePathPiece Number where
215 parsePathPiece = Number.fromString
337 parsePathPiece = Number.fromString
216
338
339+instance ParsePathPiece Boolean where
340+ parsePathPiece s = case String.toLower s of
341+ "true" -> Just true
342+ "1" -> Just true
343+ "false" -> Just false
344+ "0" -> Just false
345+ _ -> Nothing
346+
217assert :: forall m. Applicative m => Plus m => Boolean -> m Unit
347assert :: forall m. Applicative m => Plus m => Boolean -> m Unit
218assert true = pure unit
348assert true = pure unit
219assert false = empty
349assert false = empty
@@ -248,6 +378,9 @@ internalServerError = Response.string "" { status: 500, statusText: "Internal Se
248badRequest :: Response
378badRequest :: Response
249badRequest = Response.string "" { status: 400, statusText: "Bad Request", headers: [] }
379badRequest = Response.string "" { status: 400, statusText: "Bad Request", headers: [] }
250
380
381+ok :: Response
382+ok = Response.string "" { status: 200, statusText: "OK", headers: [] }
383+
251-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad
384-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad
252-- | instead you can just pass `identity` as the first argument.
385-- | instead you can just pass `identity` as the first argument.
253run
386run