1. Running R in a Yesod application

    2016-09-01
    Source

    Basic demo

    This small app takes two numbers and returns their sum after performing the addition in R.

    This is an Haskell app created with Yesod, and R is called from Haskell with the help of the inline-R package. You may take a look at my inline-R demo and at my article Hello Yesod+Ajax before.

    {-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
{-# LANGUAGE TypeFamilies      #-}

import Yesod
import GHC.Generics
import qualified Language.R.Instance as R
import H.Prelude.Interactive

data HelloInlineR = HelloInlineR

mkYesod "HelloInlineR" [parseRoutes|
/ HomeR GET
/data DataR PUT
|]

instance Yesod HelloInlineR

data Args = Args {
    _x :: Double,
    _y :: Double
} deriving (Show,Generic)

instance FromJSON Args

getHomeR :: Handler ()
getHomeR = sendFile typeHtml "static/raddition.html"

runR :: Double -> Double -> IO(Double)
runR x y = 
  do
    r <-  [r|x_hs + y_hs|]
    return $ (fromSomeSEXP r :: Double) 

putDataR :: Handler String
putDataR = do
    arguments <- requireJsonBody :: Handler Args
    r <- liftIO $ runR (_x arguments) (_y arguments)
    return $ show r

main :: IO ()
main = do 
    R.initialize R.defaultConfig
    warp 3000 HelloInlineR

    File raddition.html:

    <html>
    <head>
         <script src="//ajax.googleapis.com/ajax/libs/jquery/2.1.0/jquery.min.js"></script>

        <script type="text/javascript">
            function save() {
                $.ajax({
                url: "/data",
                type: "PUT",
                processData: false,
                data: JSON.stringify({
                                        _x: Number($("#x").val()), 
                                        _y: Number($("#y").val())
                                    }),
                success: function (result) {
                    alert (result);
                },
                error: function(xhr, status, error) {
                  alert("Error: " + xhr.responseText);
                },
                dataType: "text",
                contentType: "application/json"
                }); 
            }
        </script>
    </head>
    <body>

        <h3>Enter two numbers:</h3>
        <input id="x" type="number" />
        <input id="y" type="number" />

        <br><br>
        
        <input id="submit" type="button" value="Addition" onclick="save()">

    </body>
</html>

    Instead of requesting a html file, we can create its contents in the Haskell code:

    ...

import Yesod.Form.Jquery (YesodJquery (urlJqueryJs))

...

instance Yesod HelloInlineR
instance YesodJquery HelloInlineR

...

getHomeR :: Handler Html
getHomeR = defaultLayout $ do
    setTitle "Yesod + Ajax"
    getYesod >>= addScriptEither . urlJqueryJs
    [whamlet|
        <input #x type=number>
        <input #y type=number>
        <button #add>Addition
    |]
    toWidget script

script = [julius|
$(function(){
    $("#add").click(function(){
        $.ajax({
            contentType: "application/json",
            processData: false,
            url: "@{DataR}",
            type: "PUT",
            data: JSON.stringify({
                                    _x: Number($("#x").val()), 
                                    _y: Number($("#y").val())
                                }),
            success: function(result) {
                alert(result);
            },
            dataType: "text"
        });
    });
});
|]

...


    Passing a dataframe

    Get the dataframe as a stringified JSON object, and use the jsonlite package.

    getHomeR :: Handler Html
getHomeR = defaultLayout $ do
    setTitle "Yesod + Ajax"
    getYesod >>= addScriptEither . urlJqueryJs
    [whamlet|
        <button #submit>Submit
    |]
    toWidget script

script = [julius|
$(function(){
    $("#submit").click(function(){
        $.ajax({
            contentType: "text",
            processData: false,
            url: "@{DataR}",
            type: "PUT",
            data: JSON.stringify(JSON.stringify([{name: "Alice", age: 25}, {name: "Bob", age: 30}])),
            success: function(result) {
                alert(result);
            },
            dataType: "text"
        });
    });
});
|]

runR :: String -> IO(Int32) -- requires Data.Int
runR dat = do
    r <- [r|ncol(jsonlite::fromJSON(dat_hs))|]
    return $ (fromSomeSEXP r :: Int32) 

putDataR :: Handler String
putDataR = do
    dat <- requireJsonBody :: Handler String
    r <- liftIO $ runR dat
    return $ show r