Add json parsing test

This commit is contained in:
sigma-andex 2022-06-06 10:40:23 +01:00
parent de41a12f96
commit d214d46cdf
4 changed files with 104 additions and 10 deletions

View 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()
}
}

View 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 " └────────────────────────────────────────────┘"

View 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
```

View File

@ -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