Question

我试图创建使用AJAX与服务器通信的简单页面（Yesod）。到目前为止，我设法从服务器传递数据，但我不知道如何使用服务器处理程序（putJsonpR）获取客户端数据。

这是我到目前为止所做的：

    {-# 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

这是HTML页面：

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

我收到了AJAX错误消息：＆＃34;读取失败：不是有效的json值＆＃34;

另外，有没有办法输出我从AJAX请求得到的任何东西？
类似的东西：

    putSomethingR = do
        liftIO $ print $ whateverCameFromAjax
        -- rest of handler

Answer 1

我把a sample of doing this on FP Haskell Center放在一起。代码也包含在下面。

您最初编写的内容存在于Javascript代码中。你的jQuery参数告诉它创建一个URL编码的请求体。您需要手动将JSON呈现为文本，并使用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

Answer 2

在“GET”方面，因为您不使用持久性模板，而是使用Database.PostgreSQL.Simple.query中的db level sql，使用真实数据库标识符，解决了错误。

getPerson id = do
    cnn <- getConnectionString
    xs <- query cnn "select \"id\", \"name\", \"age\" from \"person\" where \"id\" = ?" (Only (id :: Int))  :: IO [Person]
    return (head xs)

在“PUT”端，staticpage.html jquery脚本上存在ajax解析错误，当您将“data”字段括在单引号中时更正：

   function save() {
       $.ajax({
       url: "/json",
       type: "PUT",
       data: '{ "personId": 123, "name": "from gui", "age": 123 }',
       ...
       dataType: "json"
       ...

第三。您可以使用

log ajax输出

$(logDebug) (show whatEverCameFromAjax)

来自MonadLogger实例monad，如果你使用yesod脚手架。

很高兴从yesj的ajax请求中获取数据

2 个答案: