{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# Language GADTs #-}
{-# Language ViewPatterns #-}
module Language.R
( module Foreign.R
, module Foreign.R.Type
, module Language.R.Instance
, module Language.R.Globals
, module Language.R.GC
, module Language.R.Literal
, eval
, eval_
, evalEnv
, install
, cancel
, throwR
, throwRMessage
, parseFile
, parseText
, string
, strings
) where
import Control.Memory.Region
import qualified Data.Vector.SEXP as Vector
import Control.Monad.R.Class
import Foreign.R
( SEXP
, SomeSEXP(..)
, typeOf
, asTypeOf
, cast
, unSomeSEXP
, unsafeCoerce
)
import qualified Foreign.R as R
import qualified Foreign.R.Parse as R
import qualified Foreign.R.Error as R
import Foreign.R.Type
import Language.R.GC
import Language.R.Globals
import Language.R.HExp
import Language.R.Instance
import {-# SOURCE #-} Language.R.Internal
import Language.R.Literal
import Control.Applicative
import Control.Exception ( throwIO )
import Control.Monad ( (>=>), when, unless, forM, void )
import Data.ByteString as B
import Data.ByteString.Char8 as C8 ( pack, unpack )
import Data.Singletons (sing)
import Foreign
( alloca
, castPtr
, peek
, poke
)
import Foreign.C.String ( withCString, peekCString )
import Prelude
parseEval :: ByteString -> IO (SomeSEXP V)
parseEval :: ByteString -> IO (SomeSEXP V)
parseEval ByteString
txt = forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
txt forall a b. (a -> b) -> a -> b
$ \CString
ctxt ->
forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (CString -> IO (SEXP V 'String)
R.mkString CString
ctxt) forall a b. (a -> b) -> a -> b
$ \SEXP V 'String
rtxt ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
status -> do
forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (forall (a :: SEXPTYPE) s.
In a '[ 'Nil, 'String] =>
SEXP s 'String -> Int -> Ptr CInt -> SEXP s a -> IO (SEXP s 'Expr)
R.parseVector SEXP V 'String
rtxt Int
1 Ptr CInt
status (forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release SEXP G 'Nil
nilValue)) forall a b. (a -> b) -> a -> b
$ \SEXP Any 'Expr
exprs -> do
Int
rc <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
status
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ParseStatus
R.PARSE_OK forall a. Eq a => a -> a -> Bool
== forall a. Enum a => Int -> a
toEnum Int
rc) forall a b. (a -> b) -> a -> b
$
forall a. NFData a => (forall s. R s a) -> IO a
runRegion forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadR m => String -> m a
throwRMessage forall a b. (a -> b) -> a -> b
$ String
"Parse error in: " forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack ByteString
txt
SomeSEXP SEXP Any a
expr <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE). SEXP s a -> Ptr ()
R.unsafeSEXPToVectorPtr SEXP Any 'Expr
exprs
forall a. NFData a => (forall s. R s a) -> IO a
runRegion forall a b. (a -> b) -> a -> b
$ do
SomeSEXP SEXP s a
val <- forall (m :: * -> *) s (a :: SEXPTYPE).
MonadR m =>
SEXP s a -> m (SomeSEXP (Region m))
eval SEXP Any a
expr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release SEXP s a
val)
parseFile :: FilePath -> (SEXP s 'R.Expr -> IO a) -> IO a
{-# DEPRECATED parseFile "Use [r| parse(file=\"path/to/file\") |] instead." #-}
parseFile :: forall s a. String -> (SEXP s 'Expr -> IO a) -> IO a
parseFile String
fl SEXP s 'Expr -> IO a
f = do
forall a. String -> (CString -> IO a) -> IO a
withCString String
fl forall a b. (a -> b) -> a -> b
$ \CString
cfl ->
forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (CString -> IO (SEXP V 'String)
R.mkString CString
cfl) forall a b. (a -> b) -> a -> b
$ \SEXP Any 'String
rfl ->
forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 (String -> ByteString
C8.pack String
"parse") SEXP Any 'String
rfl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(R.SomeSEXP SEXP V a
s) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
R.unsafeCoerce SEXP V a
s) forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
`R.withProtected` SEXP s 'Expr -> IO a
f
parseText
:: String
-> Bool
-> IO (R.SEXP V 'R.Expr)
{-# DEPRECATED parseText "Use [r| parse(text=...) |] instead." #-}
parseText :: String -> Bool -> IO (SEXP V 'Expr)
parseText String
txt Bool
b = do
SomeSEXP V
s <- ByteString -> IO (SomeSEXP V)
parseEval forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack forall a b. (a -> b) -> a -> b
$
String
"parse(text=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
txt forall a. [a] -> [a] -> [a]
++ String
", keep.source=" forall a. [a] -> [a] -> [a]
++ String
keep forall a. [a] -> [a] -> [a]
++ String
")"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall {k} (a :: k). SingI a => Sing a
sing :: R.SSEXPTYPE 'R.Expr) forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
`R.cast` SomeSEXP V
s
where
keep :: String
keep | Bool
b = String
"TRUE"
| Bool
otherwise = String
"FALSE"
install :: MonadR m => String -> m (SEXP V 'R.Symbol)
install :: forall (m :: * -> *). MonadR m => String -> m (SEXP V 'Symbol)
install = forall (m :: * -> *) a. MonadR m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (SEXP V 'Symbol)
installIO
{-# DEPRECATED string, strings "Use mkSEXP instead" #-}
string :: String -> IO (SEXP V 'R.Char)
string :: String -> IO (SEXP V 'Char)
string String
str = forall a. String -> (CString -> IO a) -> IO a
withCString String
str CString -> IO (SEXP V 'Char)
R.mkChar
strings :: String -> IO (SEXP V 'R.String)
strings :: String -> IO (SEXP V 'String)
strings String
str = forall a. String -> (CString -> IO a) -> IO a
withCString String
str CString -> IO (SEXP V 'String)
R.mkString
evalEnv :: MonadR m => SEXP s a -> SEXP s 'R.Env -> m (SomeSEXP (Region m))
evalEnv :: forall (m :: * -> *) s (a :: SEXPTYPE).
MonadR m =>
SEXP s a -> SEXP s 'Env -> m (SomeSEXP (Region m))
evalEnv (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Language.R.HExp.Expr Int32
_ Vector 'Expr (SomeSEXP V)
v) SEXP s 'Env
rho = forall (m :: * -> *).
MonadR m =>
SomeSEXP V -> m (SomeSEXP (Region m))
acquireSome forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
forall (m :: * -> *) a. MonadR m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(SomeSEXP SEXP V a
s) -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE). SEXP s a -> IO (SEXP G a)
R.protect SEXP V a
s) (forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
Vector.toList Vector 'Expr (SomeSEXP V)
v)
SomeSEXP V
x <- forall a. [a] -> a
Prelude.last forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
Vector.toList Vector 'Expr (SomeSEXP V)
v) (\(SomeSEXP SEXP V a
s) -> do
SomeSEXP V
z <- forall s (a :: SEXPTYPE).
SEXP s a -> SEXP s 'Env -> Ptr CInt -> IO (SomeSEXP V)
R.tryEvalSilent SEXP V a
s (forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release SEXP s 'Env
rho) Ptr CInt
p
CInt
e <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
e forall a. Eq a => a -> a -> Bool
/= CInt
0) forall a b. (a -> b) -> a -> b
$ forall a. NFData a => (forall s. R s a) -> IO a
runRegion forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. MonadR m => SEXP s 'Env -> m a
throwR SEXP s 'Env
rho
forall (m :: * -> *) a. Monad m => a -> m a
return SomeSEXP V
z)
Int -> IO ()
R.unprotect (forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> Int
Vector.length Vector 'Expr (SomeSEXP V)
v)
forall (m :: * -> *) a. Monad m => a -> m a
return SomeSEXP V
x
evalEnv SEXP s a
x SEXP s 'Env
rho = forall (m :: * -> *).
MonadR m =>
SomeSEXP V -> m (SomeSEXP (Region m))
acquireSome forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
forall (m :: * -> *) a. MonadR m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p -> forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (forall (m :: * -> *) a. Monad m => a -> m a
return (forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release SEXP s a
x)) forall a b. (a -> b) -> a -> b
$ \SEXP Any a
_ -> do
SomeSEXP V
v <- forall s (a :: SEXPTYPE).
SEXP s a -> SEXP s 'Env -> Ptr CInt -> IO (SomeSEXP V)
R.tryEvalSilent SEXP s a
x SEXP s 'Env
rho Ptr CInt
p
CInt
e <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
e forall a. Eq a => a -> a -> Bool
/= CInt
0) forall a b. (a -> b) -> a -> b
$ forall a. NFData a => (forall s. R s a) -> IO a
runRegion forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. MonadR m => SEXP s 'Env -> m a
throwR SEXP s 'Env
rho
forall (m :: * -> *) a. Monad m => a -> m a
return SomeSEXP V
v
eval :: MonadR m => SEXP s a -> m (SomeSEXP (Region m))
eval :: forall (m :: * -> *) s (a :: SEXPTYPE).
MonadR m =>
SEXP s a -> m (SomeSEXP (Region m))
eval SEXP s a
x = forall (m :: * -> *) s (a :: SEXPTYPE).
MonadR m =>
SEXP s a -> SEXP s 'Env -> m (SomeSEXP (Region m))
evalEnv SEXP s a
x (forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release SEXP G 'Env
globalEnv)
eval_ :: MonadR m => SEXP s a -> m ()
eval_ :: forall (m :: * -> *) s (a :: SEXPTYPE).
MonadR m =>
SEXP s a -> m ()
eval_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s (a :: SEXPTYPE).
MonadR m =>
SEXP s a -> m (SomeSEXP (Region m))
eval
throwR :: MonadR m => R.SEXP s 'R.Env
-> m a
throwR :: forall (m :: * -> *) s a. MonadR m => SEXP s 'Env -> m a
throwR SEXP s 'Env
env = forall (m :: * -> *) s. MonadR m => SEXP s 'Env -> m String
getErrorMessage SEXP s 'Env
env forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadR m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RError
R.RError
cancel :: IO ()
cancel :: IO ()
cancel = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
R.interruptsPending CInt
1
throwRMessage :: MonadR m => String -> m a
throwRMessage :: forall (m :: * -> *) a. MonadR m => String -> m a
throwRMessage = forall (m :: * -> *) a. MonadR m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RError
R.RError
getErrorMessage :: MonadR m => R.SEXP s 'R.Env -> m String
getErrorMessage :: forall (m :: * -> *) s. MonadR m => SEXP s 'Env -> m String
getErrorMessage SEXP s 'Env
e = forall (m :: * -> *) a. MonadR m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (forall a. String -> (CString -> IO a) -> IO a
withCString String
"geterrmessage" ((CString -> IO (SEXP V 'Symbol)
R.install forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall s (a :: SEXPTYPE). SEXP s a -> IO (SEXP V 'Lang)
R.lang1))) forall a b. (a -> b) -> a -> b
$ \SEXP Any 'Lang
f -> do
forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (forall (m :: * -> *) a. Monad m => a -> m a
return (forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release SEXP s 'Env
e)) forall a b. (a -> b) -> a -> b
$ \SEXP Any 'Env
env -> do
CString -> IO String
peekCString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. SEXP s 'Char -> IO CString
R.char
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. SEXP s 'String -> IO (Ptr (SEXP s 'Char))
R.string forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
R.cast (forall {k} (a :: k). SingI a => Sing a
sing :: R.SSEXPTYPE 'R.String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (a :: SEXPTYPE).
SEXP s a -> SEXP s 'Env -> IO (SomeSEXP V)
R.eval SEXP Any 'Lang
f SEXP Any 'Env
env