From d214d46cdfa149fb55be95651e1b3e2820bbbb92 Mon Sep 17 00:00:00 2001
From: sigma-andex <77549848+sigma-andex@users.noreply.github.com>
Date: Mon, 6 Jun 2022 10:40:23 +0100
Subject: [PATCH] Add json parsing test

---
 docs/Examples/JsonParsing/Main.js        | 16 ++++++
 docs/Examples/JsonParsing/Main.purs      | 62 ++++++++++++++++++++++++
 docs/Examples/JsonParsing/Readme.md      | 15 ++++++
 test/Test/HTTPurple/IntegrationSpec.purs | 21 ++++----
 4 files changed, 104 insertions(+), 10 deletions(-)
 create mode 100644 docs/Examples/JsonParsing/Main.js
 create mode 100644 docs/Examples/JsonParsing/Main.purs
 create mode 100644 docs/Examples/JsonParsing/Readme.md

diff --git a/docs/Examples/JsonParsing/Main.js b/docs/Examples/JsonParsing/Main.js
new file mode 100644
index 0000000..8f201af
--- /dev/null
+++ b/docs/Examples/JsonParsing/Main.js
@@ -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()
+    }
+}
diff --git a/docs/Examples/JsonParsing/Main.purs b/docs/Examples/JsonParsing/Main.purs
new file mode 100644
index 0000000..11c3d6e
--- /dev/null
+++ b/docs/Examples/JsonParsing/Main.purs
@@ -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 " └────────────────────────────────────────────┘"
diff --git a/docs/Examples/JsonParsing/Readme.md b/docs/Examples/JsonParsing/Readme.md
new file mode 100644
index 0000000..d2afb83
--- /dev/null
+++ b/docs/Examples/JsonParsing/Readme.md
@@ -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
+```
diff --git a/test/Test/HTTPurple/IntegrationSpec.purs b/test/Test/HTTPurple/IntegrationSpec.purs
index 1c4d168..4876b7c 100644
--- a/test/Test/HTTPurple/IntegrationSpec.purs
+++ b/test/Test/HTTPurple/IntegrationSpec.purs
@@ -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