Skip to content
Permalink
Browse files

Cookbook entry for Raw json parsing example in Yesod Handler

Fixes #22
  • Loading branch information...
psibi committed Dec 7, 2016
1 parent 7ed4b8e commit 68abf4950d4aa29fcc00f2a079cff0ffeddbeadc
Showing with 99 additions and 0 deletions.
  1. +1 −0 Cookbook.md
  2. +98 −0 cookbook/raw-json-parsing.md
@@ -11,6 +11,7 @@ For non-Yesod code, see also [Snippets](https://github.com/yesodweb/yesod-cookbo
* [JSON Object Create and Append](https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/JSON-data-helpful-manipulations.md)
* [Doing AJAX calls with CSRF Protection](https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/ajax-csrf.md)
* [Develop JS without recompiling the yesod project](https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/Develop-JS-without-recompiling-the-yesod-project.md)
* [RAW JSON Parsing example](./cookbook/raw-json-parsing.md)

## Forms

@@ -0,0 +1,98 @@
# Raw JSON Parsing Example

The following code shows how to parse raw json in Yesod Handlers.

``` haskell
#!/usr/bin/env stack
{- stack
--resolver lts-6.24
--install-ghc
runghc
--package yesod
--package yesod-core
--package blaze-html
--package text
--package shakespeare
--package aeson
-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances#-}
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad (join)
import Data.Maybe (isJust)
import Data.Text (Text, unpack)
import qualified Data.Text.Lazy.Encoding
import Data.Typeable (Typeable)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Hamlet (shamlet)
import Text.Shakespeare.Text (stext)
import Yesod
import Network.HTTP.Types.Status (status400, status200)
import Data.Aeson.Types (Result(..))
import Data.Aeson.Types
data App = App
mkYesod
"App"
[parseRoutes|
/ HomeR GET POST
|]
instance Yesod App where
approot = ApprootStatic "http://localhost:3006"
instance RenderMessage App FormMessage where
renderMessage _ _ = defaultFormMessage
data Response = Response {
msg :: Text
} deriving (Show, Eq)
instance ToJSON Response where
toJSON (Response x) = object [ "msg" .= x ]
getHomeR :: Handler Html
getHomeR = defaultLayout $ do
toWidget [hamlet|
<p>Hello world
|]
parseUser :: Value -> Parser (Text, Text)
parseUser = withObject "expected object" (\obj -> do
uname <- obj .: "username"
pword <- obj .: "password"
return (uname, pword))
postHomeR :: Handler RepJson
postHomeR = do
(jsobj :: Result Value) <- parseJsonBody
case jsobj of
Error err -> sendStatusJSON status400 (Response { msg = "invalid body"})
Success v -> sendStatusJSON status200 (parseMaybe parseUser v)
main :: IO ()
main = warp 3000 App
```

Run the server and pass them curl request to see how they behave. Demo:

``` shellsession
sibi::casey { ~ }-> curl -H "Content-Type: application/json" -H "Accept: application/json" -X POST -d '{"username":"xyz","password":"xyz"}' http://127.0.0.1:3000
["xyz","xyz"]

sibi::casey { ~ }-> curl -H "Content-Type: application/json" -H "Accept: application/json" -X POST http://127.0.0.1:3006
{"msg":"invalid body"}
```

0 comments on commit 68abf49

Please sign in to comment.
You can’t perform that action at this time.