Add json parsing test
This commit is contained in:
parent
de41a12f96
commit
d214d46cdf
16
docs/Examples/JsonParsing/Main.js
Normal file
16
docs/Examples/JsonParsing/Main.js
Normal file
@ -0,0 +1,16 @@
|
||||
import * as Maybe from '../Data.Maybe/index.js'
|
||||
export const parseJson = (str) => {
|
||||
try {
|
||||
return new Maybe.Just(JSON.parse(str))
|
||||
} catch (error) {
|
||||
return new Maybe.Nothing()
|
||||
}
|
||||
}
|
||||
|
||||
export const getName = (obj) => {
|
||||
if (typeof obj.name == 'string') {
|
||||
return new Maybe.Just(obj.name)
|
||||
} else {
|
||||
return new Maybe.Nothing()
|
||||
}
|
||||
}
|
62
docs/Examples/JsonParsing/Main.purs
Normal file
62
docs/Examples/JsonParsing/Main.purs
Normal file
@ -0,0 +1,62 @@
|
||||
module Examples.JsonParsing.Main where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Either (Either)
|
||||
import Data.Either as Either
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Data.Maybe (Maybe)
|
||||
import Effect.Console (log)
|
||||
import HTTPurple (JsonDecoder(..), JsonEncoder(..), ServerM, fromJson, notFound, serve, toJson, usingCont)
|
||||
import HTTPurple as Json
|
||||
import HTTPurple.Method (Method(..))
|
||||
import HTTPurple.Response (ok')
|
||||
import Routing.Duplex as RD
|
||||
import Routing.Duplex.Generic as RG
|
||||
|
||||
data Route = SayHello
|
||||
|
||||
derive instance Generic Route _
|
||||
|
||||
route :: RD.RouteDuplex' Route
|
||||
route = RD.root $ RG.sum
|
||||
{ "SayHello": RG.noArgs
|
||||
}
|
||||
|
||||
type HelloWorldRequest = { name :: String }
|
||||
type HelloWorldResponse = { hello :: String }
|
||||
|
||||
foreign import data Json :: Type
|
||||
|
||||
foreign import parseJson :: String -> Maybe Json
|
||||
|
||||
foreign import getName :: Json -> Maybe String
|
||||
|
||||
testDecoder :: JsonDecoder String HelloWorldRequest
|
||||
testDecoder = JsonDecoder fromJsonString
|
||||
where
|
||||
fromJsonString :: String -> Either String HelloWorldRequest
|
||||
fromJsonString = (parseJson >=> getName) >>> map { name: _ } >>> Either.note "Invalid json"
|
||||
|
||||
testEncoder :: JsonEncoder HelloWorldResponse
|
||||
testEncoder = JsonEncoder $ \{ hello } -> "{\"hello\": \"" <> hello <> "\" }"
|
||||
|
||||
-- | Boot up the server
|
||||
main :: ServerM
|
||||
main =
|
||||
serve { port: 8080, onStarted } { route, router }
|
||||
where
|
||||
router { route: SayHello, method: Post, body } = usingCont do
|
||||
-- in your project you will want to use the httpurple-argonaut or httpurple-yoga-json decoder and encoder
|
||||
{ name } :: HelloWorldRequest <- fromJson testDecoder body
|
||||
ok' Json.jsonHeaders $ toJson testEncoder $ { hello: name }
|
||||
router { route: SayHello } = notFound
|
||||
|
||||
onStarted = do
|
||||
log " ┌────────────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > http -v POST localhost:8080 hello=world │"
|
||||
log " | # => { \"hello\": \"world\" } │"
|
||||
log " └────────────────────────────────────────────┘"
|
15
docs/Examples/JsonParsing/Readme.md
Normal file
15
docs/Examples/JsonParsing/Readme.md
Normal file
@ -0,0 +1,15 @@
|
||||
# Json Parsing Example
|
||||
|
||||
This is an example using the json parser.
|
||||
|
||||
To run the example server, run:
|
||||
|
||||
```bash
|
||||
nix-shell --run 'example JsonParsing'
|
||||
```
|
||||
|
||||
Or, without nix:
|
||||
|
||||
```bash
|
||||
spago -x test.dhall run --main Examples.JsonParsing.Main
|
||||
```
|
@ -10,6 +10,7 @@ import Examples.Chunked.Main as Chunked
|
||||
import Examples.CustomStack.Main as CustomStack
|
||||
import Examples.Headers.Main as Headers
|
||||
import Examples.HelloWorld.Main as HelloWorld
|
||||
import Examples.JsonParsing.Main as JsonParsing
|
||||
import Examples.Middleware.Main as Middleware
|
||||
import Examples.MultiRoute.Main as MultiRoute
|
||||
import Examples.PathSegments.Main as PathSegments
|
||||
@ -19,16 +20,7 @@ import Examples.SSL.Main as SSL
|
||||
import Foreign.Object (empty, singleton)
|
||||
import Node.Buffer (toArray)
|
||||
import Node.FS.Aff (readFile)
|
||||
import Test.HTTPurple.TestHelpers
|
||||
( Test
|
||||
, get
|
||||
, get'
|
||||
, getBinary
|
||||
, getHeader
|
||||
, post
|
||||
, postBinary
|
||||
, (?=)
|
||||
)
|
||||
import Test.HTTPurple.TestHelpers (Test, get, get', getBinary, getHeader, post, postBinary, (?=))
|
||||
import Test.Spec (describe, it)
|
||||
|
||||
asyncResponseSpec :: Test
|
||||
@ -95,6 +87,14 @@ helloWorldSpec =
|
||||
liftEffect $ close $ pure unit
|
||||
response ?= "hello world!"
|
||||
|
||||
jsonParsingSpec :: Test
|
||||
jsonParsingSpec =
|
||||
it "runs the hello world example" do
|
||||
close <- liftEffect JsonParsing.main
|
||||
response <- post 8080 empty "/" "{\"name\":\"world\"}"
|
||||
liftEffect $ close $ pure unit
|
||||
response ?= "{\"hello\": \"world\"}"
|
||||
|
||||
middlewareSpec :: Test
|
||||
middlewareSpec =
|
||||
it "runs the middleware example" do
|
||||
@ -175,3 +175,4 @@ integrationSpec =
|
||||
postSpec
|
||||
queryParametersSpec
|
||||
sslSpec
|
||||
jsonParsingSpec
|
||||
|
Loading…
Reference in New Issue
Block a user