packages feed

Rlang-QQ (empty) → 0.0.0.0

raw patch · 8 files changed

+307/−0 lines, 8 filesdep +Cabaldep +basedep +bytestringsetup-changed

Dependencies added: Cabal, base, bytestring, containers, directory, process, template-haskell, trifecta, utf8-string

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Adam Vogt <vogt.adam@gmail.com>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Adam Vogt <vogt.adam@gmail.com> nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Rlang-QQ.cabal view
@@ -0,0 +1,39 @@+name: Rlang-QQ+version: 0.0.0.0+cabal-version: >=1.8+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: Adam Vogt <vogt.adam@gmail.com>+homepage: http://code.haskell.org/~aavogt/Rlang-QQ+synopsis: quasiquoter for inline-R code+description: This quasiquoter calls R (www.r-project.org/) from ghc.+             Variables from the haskell-side are passed in. In the future,+             variables created (or modified) could be returned as the value+             of the quasiquote.+category: Development+author: Adam Vogt <vogt.adam@gmail.com>+data-dir: rsrc+data-files: Tree.R parseTreeExample.R+extra-source-files: examples/test.hs++source-repository head+    type: darcs+    location: http://code.haskell.org/~aavogt/Rlang-QQ++library+    hs-source-dirs: src++    build-depends: base ==4.*, containers,+                   template-haskell ==2.8.*, directory, process,+                   trifecta ==1.1.*, utf8-string ==0.3.*, bytestring,+                   Cabal++    exposed-modules: RlangQQ.Internal+                     RlangQQ++    other-modules:  Paths_Rlang_QQ++    exposed: True+    buildable: True+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/test.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE QuasiQuotes #-}+import RlangQQ++x = [0 .. 10  :: Double]+y = map (sin . (*pi) . (/10)) x++main = do+  [r|+    library(ggplot2)+    png(file='test.png')+    plot(qplot( hs_x, hs_y ))+    dev.off()+    |]+
+ rsrc/Tree.R view
@@ -0,0 +1,10 @@++rlangQQ_toTree <- function(e)+    if (is.symbol(e)) paste('Node', show2(e), '[]') else {+++        paste('Node',+              show2(e[[1]]),+              if (length(e) < 2) '[]' else+                paste('[', paste(sapply(2:length(e), function(i) rlangQQ_toTree(e[[i]])), collapse=', '), ']') )+    }
+ rsrc/parseTreeExample.R view
@@ -0,0 +1,6 @@+library(ggplot2)++d <- data.frame(x=c(1,2,3), y=c(3,2,3), z = hs_z)++d$x+d$y+
+ src/RlangQQ.hs view
@@ -0,0 +1,53 @@+{- | A quasiquoter to help with calling R (<www.r-project.org/>) from ghc.++-}+module RlangQQ (+    -- * the quasiquoter+    r,++    ToRVal,++    -- ** TODO+    -- $TODO+    ) where++import RlangQQ.Internal+import Language.Haskell.TH.Quote+++{- $TODO++[R -> haskell]++Currently nothing is done to the output. It should be possible to return the+original hs_foo variables in an extensible record, (possibly limited to the+case where they have been modified?).++ie.if there is a @[r| hs_foo <- \"abc\" |]@, then at the very bottom of the+generated R file we should have be calling an R function like+@serialize(hs_foo)@.  then on the haskell side we have:++>  return (label foo $ deserialize "hs_foo" `asTypeOf` hs_foo,+>          label abc $ deserialize "hs_abc" `asTypeOf` hs_abc,+>          ... )++Where the tuple is an extensible record, and the IO needed to+get the result is also sequenced.++Variables whose first occurence is an assignment do not need a corresponding+variable to be sent into R:++> [r| hs_x <- rnorm(5); hs_x <- sum(hs_x) |]+++[better IPC]++perhaps communicating through files is not the best idea. When there are+multiple quasi quotes, maybe they should be connecting to the same session.++Marshalling other types (Vector, Array, Map etc.).++Use 'FromRVal'++-}+
+ src/RlangQQ/Internal.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+module RlangQQ.Internal where++import Data.Char+import Data.List+import Data.Maybe+import Data.Monoid+import Data.Tree+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import qualified Data.Foldable as F+import System.Directory+import System.Process+import Text.Printf+import Text.Trifecta++import Data.ByteString.Lazy.UTF8 as B+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Char8 as B8+++import Paths_Rlang_QQ++{- | Calls R with the supplied string. Variables in R prefixed hs_ cause+the corresponding (un-prefixed) variable to be converted. The variable(s) must+be in the class 'ToRVal'.++For example, when this file <http://code.haskell.org/~aavogt/examples/test.hs> is run++> {-# LANGUAGE QuasiQuotes #-}+> import RlangQQ+>+> x = [0 .. 10  :: Double]+> y = map (sin . (*pi) . (/10)) x+>+> main = do+>   [r|+>     library(ggplot2)+>     png(file='test.png')+>     plot(qplot( hs_x, hs_y ))+>     dev.off()+>     |]++The file is produced <<http://code.haskell.org/~aavogt/Rlang-QQ/examples/test.png>>++-}+r = QuasiQuoter { quoteExp = quoteRExpression 1 }++quoteRExpression i str = do+    let rawFile = printf "Rtmp/raw%d.R" (i::Int) :: String+    let hdrFile = printf "Rtmp/new%d.R" (i::Int) :: String++    variablesToInput <- runIO $ do+        t <- getDataFileName "Tree.R"+        createDirectoryIfMissing False "Rtmp"+        writeFile rawFile str+        rt <- readProcess "R" ["--no-save","--quiet"]+            $ printf "source('%s'); rlangQQ_toTree(parse('%s'))" t rawFile+        case parseString parseTree mempty rt of+            Success a -> return $ hsVars a+            Failure a -> do+                print a+                error "parse failure"+    let varFiles = map (stringE . printf "Rtmp/%d_hs_%s" i) variablesToInput++        writeVarFiles = [|+            mapM_ (\(file,varName, value) -> B.writeFile file (toRVal varName value))  $+                $(listE $ zipWith3 (\x y z -> [| ($x, $y, $z) |])+                            varFiles+                            (map (stringE . ("hs_"++)) variablesToInput)+                            (map (varE . mkName) variablesToInput))++                |]++        runR = [| readProcess "R" ["--no-save", "--quiet"]+                    $ concat+                    $ map (printf "source('%s');") $(listE varFiles)+                     ++ [ printf "source('%s')" rawFile] |]+    [| do+        writeFile hdrFile $ concatMap (printf "source('%s');") variablesToInput+        $writeVarFiles+        $runR+        |]+++++-- * converting R\'s AST++parseTree' =  do+    symbol "Node"+    nl <- stringLiteral'+    children <- brackets $ commaSep parseTree'+    return (Node nl children)++parseTree = do+    manyTill anyChar (try (string "[1]"))+    manyTill (noneOf "\n") space+    between (oneOf "\"") (oneOf "\"") parseTree'+++parseTreeTest = do+    t <- getDataFileName "Tree.R"+    inputFile <- getDataFileName "parseTreeExample.R"+    rt <- readProcess "R" ["--no-save","--quiet"] $ "source('"++ t ++ "'); rlangQQ_toTree(parse('"++ inputFile ++ "'))"+    print rt+    let r = parseString parseTree mempty rt :: Result (Tree String)++    print (fmap hsVars r)++-- | gets variables like @abc@ provided the R file contained @hs_abc@+hsVars :: Tree String -> [String]+hsVars =  mapMaybe (stripPrefix "hs_") . F.toList++++-- * classes for marshalling data+++-- ** haskell -> R+class ToRVal a where+    toRVal :: String -- ^ variable name+            -> a+            -> B.ByteString++instance ToRVal Int where toRVal x n = B.fromString $ x ++ "<-" ++ show n+instance ToRVal Integer where toRVal x n = B.fromString $ x ++ "<-" ++ show n+instance ToRVal Double where toRVal x n = B.fromString $ x ++ "<-" ++ show n+instance ToRVal String where toRVal x n = B.fromString $ x ++ "<-" ++ show n+instance ToRVal [Int] where toRVal = listToVec+instance ToRVal [Integer] where toRVal = listToVec+instance ToRVal [Double] where toRVal = listToVec+instance ToRVal [String] where toRVal = listToVec++listToVec x n = B8.unwords $+    [B.fromString x,+     B.fromString "<- c(",+        B8.intercalate (B.fromString ",") (map (B.fromString . show) n),+            B.fromString ")"]++-- ** R -> haskell++-- | not used yet+class FromRVal a where fromRVal :: B.ByteString -> a+instance FromRVal Double where fromRVal = fromRValp double+++fromRValp p s =+    case parseByteString p mempty (B.toStrict s) of+                Success a -> a+                Failure a -> error (show a)