1. Hello Yesod + Ajax

    2016-09-02
    Source

    Nous donnons un exemple des requêtes POST, PUT et GET dans une application Yesod.

    POST

    La requête POST permet d’obtenir un objet défini dans le code Haskell (ici le tableau [1,2,3] retourné par la fonction postJsonR).

    {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE ViewPatterns      #-}
 
import Yesod
import Yesod.Form.Jquery (YesodJquery (urlJqueryJs))
 
data HelloWorld = HelloWorld
 
mkYesod "HelloWorld" [parseRoutes|
/ HomeR GET
/json JsonR POST
|]
 
instance Yesod HelloWorld
instance YesodJquery HelloWorld
 
getHomeR :: Handler Html
getHomeR = defaultLayout $ do
    setTitle "Hello POST"
    getYesod >>= addScriptEither . urlJqueryJs
    [whamlet|
        <button #post>Post
    |]
    toWidget script
 
script = [julius|
$(function(){
    $("#post").click(function(){
        $.ajax({
            url: "@{JsonR}",
            type: "POST",
            success: function(result) {
                alert(result);
            },
            dataType: "json"
        });
    });
});
|]
 
postJsonR :: Handler Value
postJsonR = do
    returnJson $ ([1,2,3] :: [Int])
 
main :: IO ()
main = warp 3000 HelloWorld


    PUT

    La requête PUT envoie des données qu’on peut traiter dans le code Haskell, et obtient le résultat.

    {-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE ViewPatterns      #-}
 
import Yesod
import Yesod.Form.Jquery (YesodJquery (urlJqueryJs))
import GHC.Generics
 
data HelloWorld = HelloWorld
 
mkYesod "HelloWorld" [parseRoutes|
/ HomeR GET
/json JsonR PUT
|]
 
instance Yesod HelloWorld
instance YesodJquery HelloWorld
 
data Person = Person {
    name :: String,
    age :: Int
} deriving (Show,Generic)
 
instance FromJSON Person
 
getHomeR :: Handler Html
getHomeR = defaultLayout $ do
    setTitle "Hello PUT"
    getYesod >>= addScriptEither . urlJqueryJs
    [whamlet|
        <p>Enter your name and your age
        <input #name type=text value="Joe">
        <input #age type=numeric value=40>
        <br>
        <button #submit>Put
    |]
    toWidget script
 
script = [julius|
$(function(){
    $("#submit").click(function(){
        $.ajax({
            contentType: "application/json",
            processData: false,
            url: "@{JsonR}",
            type: "PUT",
            data: JSON.stringify({
                                    name: $("#name").val(), 
                                    age: Number($("#age").val())
                                }),
            success: function(result) {
                alert(result);
            },
            dataType: "text"
        });
    });
});
|]
 
putJsonR :: Handler String
putJsonR = do
    person <- requireJsonBody :: Handler Person
    return $ processPerson person 
 
processPerson :: Person -> String
processPerson person = "Your name is " ++ (name person) ++ " and you are " ++ (show $ age person) ++ " years old."
 
main :: IO ()
main = warp 3000 HelloWorld


    GET

    Avec cette application, dès qu’on visite la page json/i, où i est un entier, on obtient dans cette page l’objet retourné par getJsonR i. La requête GET permet d’obtenir cet objet quand on lui donne l’url json/i.

    {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE ViewPatterns      #-}
 
import Yesod
import Yesod.Form.Jquery (YesodJquery (urlJqueryJs))
 
data HelloWorld = HelloWorld
 
mkYesod "HelloWorld" [parseRoutes|
/ HomeR GET
/json/#Int JsonR GET
|]
 
instance Yesod HelloWorld
instance YesodJquery HelloWorld
 
getHomeR :: Handler Html
getHomeR = defaultLayout $ do
    setTitle "Hello GET"
    getYesod >>= addScriptEither . urlJqueryJs
    [whamlet|
        <input #x type=number value=0>
        <button #get>Get
    |]
    toWidget script
 
script = [julius|
$(function(){
    $("#get").click(function(){
        $.ajax({
            url: "/json/" + $("#x").val(),
            type: "GET",
            success: function(result) {
                alert(JSON.stringify(result));
            },
            dataType: "json"
        });
    });
});
|]
 
getJsonR :: Int -> Handler Value
getJsonR i = do
    out <- liftIO $ processInt i
    return $ object ["input" .= fst out, "output" .= snd out]
 
processInt :: Int -> IO((Int, Int))
processInt i = do
    return (i, i^2)
 
main :: IO ()
main = warp 3000 HelloWorld