Menu
I'm trying to create simple page which use AJAX to communicate with server (Yesod). So far, I managed to pass data from server, but I don't know how to get client data with server handler (putJsonpR).
This is what I have so far:
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
import Yesod
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.ToRow
import Database.PostgreSQL.Simple.ToField
import Data.Aeson
import Data.Text (Text)
import Control.Applicative
import Control.Monad
import GHC.Generics
data HelloWorld = HelloWorld
mkYesod "HelloWorld" [parseRoutes|
/ HomeR GET
/json/#Int JsonR GET
/json JsonpR PUT
|]
instance Yesod HelloWorld
data Person = Person {
personId :: Int,
name :: String,
age :: Int
} deriving (Show,Generic)
instance FromJSON Person
instance ToJSON Person
instance FromRow Person where
fromRow = Person <$> field <*> field <*> field
instance ToRow Person where
toRow d = [ toField (personId d), toField (name d), toField (age d)]
getConnectionString = do
cnn <- connect defaultConnectInfo {
connectHost = "127.0.0.1"
, connectPort = 5432
, connectUser = "postgres"
, connectPassword = "123456"
, connectDatabase = "tst"
}
return (cnn)
getPerson id = do
cnn <- getConnectionString
xs <- query cnn "select \"PersonId\", \"Name\", \"Age\" from \"Person\" where \"PersonId\" = ?" (Only (id :: Int)) :: IO [Person]
return (head xs)
getHomeR :: Handler ()
getHomeR = sendFile typeHtml "staticpage.html"
getJsonR :: Int -> Handler Value
getJsonR personId = do
person <- liftIO $ getPerson personId
returnJson $ person
putJsonpR :: Handler Value
putJsonpR = do
person <- parseJsonBody_ :: Handler Person
returnJson $ person
main :: IO ()
main = warp 3000 HelloWorld
And this is HTML page:
<html>
<head>
<script src="//ajax.googleapis.com/ajax/libs/jquery/2.1.0/jquery.min.js"></script>
<script type="text/javascript">
function getPerson () {
$.ajax({
url: "/json/" + 1,
success: function (data) {
alert (data.personId + " - " + data.name + " - " + data.age);
},
dataType: "json"
});
}
function save() {
$.ajax({
url: "/json",
type: "PUT",
data: { "personId": 123, "name": "from gui", "age": 123 },
success: function (data) {
alert (data.personId + " - " + data.name + " - " + data.age);
},
error: function(xhr, status, error) {
alert(xhr.responseText);
},
dataType: "json"
});
}
</script>
</head>
<body>
<input type="button" onclick="getPerson()" value="get" />
<br />
<br />
<br />
<input type="button" onclick="save()" value="put" />
</body>
</html>
I got AJAX error whith message: "Failed reading: not a valid json value"
Also, is there a way to output whatever I got from AJAX request?
Something like:
putSomethingR = do
liftIO $ print $ whateverCameFromAjax
-- rest of handler
694
I've put together a sample of doing this on FP Haskell Center. The code is included below as well.
The issue with what you initially wrote is in the Javascript code. Your parameters to jQuery tell it to create a URL-encoded request body. You need to manually render your JSON to text, and turn off processing with processData: false.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
import Yesod
import Yesod.Form.Jquery (YesodJquery (urlJqueryJs))
import Data.Conduit
import qualified Data.Conduit.Text as CT
import qualified Data.Conduit.List as CL
import qualified Data.Text as T
data App = App
mkYesod "App" [parseRoutes|
/ HomeR GET
/echo-body EchoBodyR PUT
|]
instance Yesod App
instance YesodJquery App
getHomeR :: Handler Html
getHomeR = defaultLayout $ do
setTitle "Yesod + Ajax"
getYesod >>= addScriptEither . urlJqueryJs
[whamlet|
<button #echo>Echo body
|]
toWidget script
script = [julius|
$(function(){
$("#echo").click(function(){
$.ajax({
// sending a JSON encoded body
contentType: "application/json",
// don't process the body, we'll render data into a valid string
processData: false,
url: "@{EchoBodyR}",
type: "PUT",
// notice the usage of stringify here
data: JSON.stringify([{name:"Alice",age:25}, {name:"Bob",age:30}]),
success: function(data) {
alert(data.body);
},
// this only refers to the data type of the *returned* data
dataType: "json"
});
});
});
|]
putEchoBodyR :: Handler Value
putEchoBodyR = do
texts <- rawRequestBody $$ CT.decode CT.utf8 =$ CL.consume
return $ object ["body" .= T.concat texts]
main :: IO ()
main = warpEnv App
On the "GET" side, since you don't use persistent templates but db level sql from Database.PostgreSQL.Simple.query, using the real database identifiers, solves the error.
getPerson id = do
cnn <- getConnectionString
xs <- query cnn "select \"id\", \"name\", \"age\" from \"person\" where \"id\" = ?" (Only (id :: Int)) :: IO [Person]
return (head xs)
On the "PUT" side, there is an ajax parse error on your staticpage.html jquery script, corrected when you enclose the "data" field in single quotes:
function save() {
$.ajax({
url: "/json",
type: "PUT",
data: '{ "personId": 123, "name": "from gui", "age": 123 }',
...
dataType: "json"
...
3rd. You can log your ajax output with
$(logDebug) (show whatEverCameFromAjax)
from a MonadLogger instance monad, if you use the yesod scaffold.
23
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
