{-# OPTIONS_GHC -fno-warn-missing-fields #-} {- | A quasiquoter to help with calling from ghc. -} module RlangQQ ( -- * the quasiquoter r, rChan, -- ** conversion of values -- $note -- values passed to R and returned by it should have types in these classes ToRDS, FromRDS, -- ** records -- $records listToRecN, n, -- ** connecting to a single R session -- $chans newRChan, newRChan', sendRcv, module Data.HList.CommonMain, -- for ghc bug regarding lookupVers2 module GHC.TypeLits, -- ** TODO -- $TODO ) where import RlangQQ.Binary (ToRDS, FromRDS) import RlangQQ.Internal import RlangQQ.MakeRecord import RlangQQ.NatQQ import Language.Haskell.TH.Quote import Data.HList.CommonMain import GHC.TypeLits import Control.Concurrent {- | 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 at least one class 'FromRDS' or 'ToRDS'. Currently the relation between where variables are used and assigned to (using @<-@) determines the 'Intent'. Expressions are also supported. These must be text between $( ), just like template haskell. One condition is that the contents between the parentheses must be parseable by haskell-src-meta/haskell-src-exts. So if you find the hs_ notation unpleasant you can still interpolate using $(x). An example of both styles is > {-# LANGUAGE QuasiQuotes #-} > import RlangQQ > > x = [0 .. 10 :: Double] > > main = do > [r| > library(ggplot2) > png(file='test.png') > plot(qplot( hs_x, $(map (sin . (*pi) . (/10)) x) )) > dev.off() > |] You get a plot: <> While it is only somewhat usable, you can have Rnw/Rmd documents (knitr) that include haskell code. One example is given -} r = QuasiQuoter { quoteExp = \s -> do n <- getRlangQQ_n quoteRExpression2 n False ("print('');"++ s) -- the first expression gets dropped somewhere else -- this hack is easiest } -- | same as @[rChan| |]@ does the same as [r| |], except the -- return value will be a @Chan (Record a)@. rChan = QuasiQuoter { quoteExp = \s -> do n <- getRlangQQ_n quoteRExpression2 n True ("print('');"++ s) -- the first expression gets dropped somewhere else -- this hack is easiest } {- $records If the quasiquote assigns to variables @hs_x@ and @hs_y@, the result type will be @IO (Record '[LVPair "x" x, LVPair "y" y])@. The types @x@ and @y@ have to be determined on the haskell side. Here is a complete example: >>> :set -XQuasiQuotes -XDataKinds -XNoMonomorphismRestriction >>> let x = [2 :: Double] >>> let q = [r| hs_y <- 1 + hs_x; hs_z <- 2 |] These labels could be generated by template haskell with @$(makeLabels6 (words \"y z\"))@ >>> let y = Label :: Label "y" >>> let z = Label :: Label "z" >>> do o <- q; print (o .!. y ++ o .!. z :: [Double]) [3.0,2.0] -} {- $chans Variables like @ch_x@ @ch_longVariableName@ inside the quasiquote generate references to @x@ and @longVariableName@. These variables should have type @'Chan' (a, b -> 'IO' '()')@. 'newChan' can produce values of that type, but some versions with restricted types are provided: > do > x <- newRChan > longVariableName <- newRChan' (undefined :: Double) The whole input to R is re-sent each time whenever a whole set of ch_ variables is available. has an a working example shows that keeping the same R-session open is much faster, but that results may be confusing since nothing explicitly says (besides this documentation here) that the same code is re-sent. -} -- | 'newChan' with a more restricted type newRChan = newRChan' undefined -- | @newRChan (undefined :: Double)@ produces an even more restricted type than -- 'newRChan'', which can help make type errors more sensible and/or avoid -- @ambiguous type variable@ newRChan' proxy = newChan `asTypeOf` r proxy where r :: a -> IO (Chan (a, b -> IO ())) r _ = undefined -- | @y <- sendRcv c x@ sends the value @x@ using the chan @c@. -- Provided that an @[r| |]@ quasiquote above refers to a @ch_c@, -- the call to 'sendRcv' will eventually produce a 'Record' @y@ sendRcv :: Chan (t, b -> IO ()) -> t -> IO b sendRcv ch e = do v <- newEmptyMVar writeChan ch (e, putMVar v) takeMVar v {- $TODO [@debugging@] Write file that can be run to loading a quote into R interpreter (ie the same thing as readProcess "R" "--no-save" ...). For now it's pretty simple to just cd Rtmp and load/source things. also, return R's stdout / stderr / exitcode in the HList. This won't be practical for the Chan option since the stdout is getting consumed? [@more examples@] conversion both ways etc. [@read NULL as Maybe?@] [@more datatypes@] support things like ??, ... [@call R functions as if they were defined in haskell@] This can be achievede already by doing something like > x <- newRChan > [r| hs_f <- ch_x + 1 |] > let f :: Double -> IO Double > f xVal = (.!. (Label :: Label "f")) `fmap` sendRcv x xVal But perhaps something can be done to generate the above code from something much shorter like: > [r| hs_f <- function(x) x + 1 |] Can this be made to work without looking at whether there is a function() after the <-? [@call hs functions as if they were defined in R@] we might like to be able to have values like @f x = x + 1@ be callable by. [@use libR.so@] there is a which might allow usage similar to hslua (ie. calling individual R functions) one drawback is that it uses lists for vectors... [@static analysis@] (optionally?) call something like codetools on the generated R code to infer result/argument types. Or perhaps translate R code into some constraints: > class RApp (x :: [*]) r > instance (UpcastNumR a b ~ r, UpcastNumR b a ~ r) => RApp [Proxy "+", a, b] r > type family UpcastNumR a b > type instance UpcastNumR Double Int = Double > type instance UpcastNumR Int Int = Int the benefit here is that users could add their own RApp instances. On the other hand, perhaps using a separate constraint solver will be less confusing in terms of type errors (ie. failure to infer a type from R which will happen (features like @do.call@) should not complicate the types seen on the haskell side). -}