inline-r-1.0.1: Seamlessly call R from Haskell and vice versa. No FFI required.
Safe HaskellSafe-Inferred
LanguageHaskell2010

H.Prelude

Description

| Copyright: (C) 2013 Amgen, Inc.

DEPRECATED: use Language.R instead.

Synopsis

Documentation

class (Applicative m, MonadIO m, MonadCatch m, MonadMask m, PrimMonad m) => MonadR m where Source #

The class of R interaction monads. For safety, in compiled code we normally use the R monad. For convenience, in a GHCi session, we normally use the IO monad directly (by means of a MonadR instance for IO, imported only in GHCi).

Minimal complete definition

getExecContext, unsafeRunWithExecContext

Associated Types

data ExecContext m :: * Source #

A reification of an R execution context, i.e. a "session".

Methods

io :: IO a -> m a Source #

Lift an IO action.

acquire :: s ~ V => SEXP s a -> m (SEXP (Region m) a) Source #

Acquire ownership in the current region of the given object. This means that the liveness of the object is guaranteed so long as the current region remains active (the R garbage collector will not attempt to free it).

default acquire :: (MonadIO m, Region m ~ G) => SEXP s a -> m (SEXP (Region m) a) Source #

getExecContext :: m (ExecContext m) Source #

Get the current execution context.

unsafeRunWithExecContext :: m a -> ExecContext m -> IO a Source #

Provides no static guarantees that resources do not extrude the scope of their region. Acquired resources are not freed automatically upon exit. For internal use only.

Instances

Instances details
MonadR IO Source # 
Instance details

Defined in H.Prelude.Interactive

Associated Types

data ExecContext IO Source #

Methods

io :: IO a -> IO a Source #

acquire :: forall s (a :: SEXPTYPE). s ~ V => SEXP s a -> IO (SEXP (Region IO) a) Source #

getExecContext :: IO (ExecContext IO) Source #

unsafeRunWithExecContext :: IO a -> ExecContext IO -> IO a Source #

MonadR (R s) Source # 
Instance details

Defined in Language.R.Instance

Associated Types

data ExecContext (R s) Source #

Methods

io :: IO a -> R s a Source #

acquire :: forall s0 (a :: SEXPTYPE). s0 ~ V => SEXP s0 a -> R s (SEXP (Region (R s)) a) Source #

getExecContext :: R s (ExecContext (R s)) Source #

unsafeRunWithExecContext :: R s a -> ExecContext (R s) -> IO a Source #

Language.R functions

type family Sing :: k -> Type #

The singleton kind-indexed type family.

Instances

Instances details
type Sing Source # 
Instance details

Defined in Foreign.R.Type

type Sing 
Instance details

Defined in Data.Singletons

type Sing 
Instance details

Defined in Data.Singletons

type Sing = SLambda :: (k1 ~> k2) -> Type

data Logical Source #

R uses three-valued logic.

Constructors

FALSE 
TRUE 
NA 

Instances

Instances details
Storable Logical Source # 
Instance details

Defined in Foreign.R.Context

Show Logical Source # 
Instance details

Defined in Foreign.R.Context

Eq Logical Source # 
Instance details

Defined in Foreign.R.Context

Methods

(==) :: Logical -> Logical -> Bool #

(/=) :: Logical -> Logical -> Bool #

Ord Logical Source # 
Instance details

Defined in Foreign.R.Context

Literal Logical 'Logical Source # 
Instance details

Defined in Language.R.Literal

Literal [Logical] 'Logical Source # 
Instance details

Defined in Language.R.Literal

type IsExpression (a :: SEXPTYPE) = (SingI a, a :∈ [Lang, Expr, Symbol]) Source #

Constraint synonym grouping all expression forms into one class. According to R internals, an expression is usually a Lang, but can sometimes also be an Expr or a Symbol.

type IsPairList (a :: SEXPTYPE) = (SingI a, a :∈ [List, Nil]) Source #

IsPairList a holds iff R's is.pairlist() returns TRUE.

type IsList (a :: SEXPTYPE) = (SingI a, a :∈ ('Char ': ('Logical ': ('Int ': ('Real ': ('Complex ': ('String ': ('Vector ': ('Expr ': ('WeakRef ': ('Raw ': (List ': '[])))))))))))) Source #

IsList a holds iff R's is.list() returns TRUE.

type IsGenericVector (a :: SEXPTYPE) = (SingI a, a :∈ [Vector, Expr, WeakRef]) Source #

Non-atomic vector forms. See src/main/memory.c:SET_VECTOR_ELT in the R source distribution.

type IsVector (a :: SEXPTYPE) = (SingI a, a :∈ ('Char ': ('Logical ': ('Int ': ('Real ': ('Complex ': ('String ': ('Vector ': ('Expr ': ('WeakRef ': ('Raw ': '[]))))))))))) Source #

Constraint synonym grouping all vector forms into one class. IsVector a holds iff R's is.vector() returns TRUE.

type PairList = List Source #

Used where the R documentation speaks of "pairlists", which are really just regular lists.

data SomeSEXP s Source #

A SEXP of unknown form.

Constructors

forall a. SomeSEXP !(SEXP s a) 

Instances

Instances details
ToJSON (SomeSEXP s) Source # 
Instance details

Defined in Language.R.Debug

Storable (SomeSEXP s) Source # 
Instance details

Defined in Foreign.R.Internal

Methods

sizeOf :: SomeSEXP s -> Int #

alignment :: SomeSEXP s -> Int #

peekElemOff :: Ptr (SomeSEXP s) -> Int -> IO (SomeSEXP s) #

pokeElemOff :: Ptr (SomeSEXP s) -> Int -> SomeSEXP s -> IO () #

peekByteOff :: Ptr b -> Int -> IO (SomeSEXP s) #

pokeByteOff :: Ptr b -> Int -> SomeSEXP s -> IO () #

peek :: Ptr (SomeSEXP s) -> IO (SomeSEXP s) #

poke :: Ptr (SomeSEXP s) -> SomeSEXP s -> IO () #

Show (SomeSEXP s) Source # 
Instance details

Defined in Foreign.R.Internal

Methods

showsPrec :: Int -> SomeSEXP s -> ShowS #

show :: SomeSEXP s -> String #

showList :: [SomeSEXP s] -> ShowS #

NFData (SomeSEXP s) Source # 
Instance details

Defined in Foreign.R.Internal

Methods

rnf :: SomeSEXP s -> () #

PrintR (SomeSEXP s) Source # 
Instance details

Defined in H.Prelude.Interactive

Methods

printR :: MonadR m => SomeSEXP s -> m () Source #

Literal (SomeSEXP s) 'Any Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: SomeSEXP s -> IO (SEXP V 'Any) Source #

fromSEXP :: SEXP s0 'Any -> SomeSEXP s Source #

data SEXP s (a :: SEXPTYPE) Source #

The basic type of all R expressions, classified by the form of the expression, and the memory region in which it has been allocated.

Instances

Instances details
ToJSON (SEXP s a) Source # 
Instance details

Defined in Language.R.Debug

Methods

toJSON :: SEXP s a -> Value #

toEncoding :: SEXP s a -> Encoding #

toJSONList :: [SEXP s a] -> Value #

toEncodingList :: [SEXP s a] -> Encoding #

Storable (SEXP s a) Source # 
Instance details

Defined in Foreign.R.Internal

Methods

sizeOf :: SEXP s a -> Int #

alignment :: SEXP s a -> Int #

peekElemOff :: Ptr (SEXP s a) -> Int -> IO (SEXP s a) #

pokeElemOff :: Ptr (SEXP s a) -> Int -> SEXP s a -> IO () #

peekByteOff :: Ptr b -> Int -> IO (SEXP s a) #

pokeByteOff :: Ptr b -> Int -> SEXP s a -> IO () #

peek :: Ptr (SEXP s a) -> IO (SEXP s a) #

poke :: Ptr (SEXP s a) -> SEXP s a -> IO () #

Show (SEXP s a) Source # 
Instance details

Defined in Foreign.R.Internal

Methods

showsPrec :: Int -> SEXP s a -> ShowS #

show :: SEXP s a -> String #

showList :: [SEXP s a] -> ShowS #

NFData (SEXP s a) Source # 
Instance details

Defined in Foreign.R.Internal

Methods

rnf :: SEXP s a -> () #

Eq (SEXP s a) Source # 
Instance details

Defined in Foreign.R.Internal

Methods

(==) :: SEXP s a -> SEXP s a -> Bool #

(/=) :: SEXP s a -> SEXP s a -> Bool #

Ord (SEXP s a) Source # 
Instance details

Defined in Foreign.R.Internal

Methods

compare :: SEXP s a -> SEXP s a -> Ordering #

(<) :: SEXP s a -> SEXP s a -> Bool #

(<=) :: SEXP s a -> SEXP s a -> Bool #

(>) :: SEXP s a -> SEXP s a -> Bool #

(>=) :: SEXP s a -> SEXP s a -> Bool #

max :: SEXP s a -> SEXP s a -> SEXP s a #

min :: SEXP s a -> SEXP s a -> SEXP s a #

PrintR (SEXP s a) Source # 
Instance details

Defined in H.Prelude.Interactive

Methods

printR :: MonadR m => SEXP s a -> m () Source #

SingI a => Literal (SEXP s a) a Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: SEXP s a -> IO (SEXP V a) Source #

fromSEXP :: SEXP s0 a -> SEXP s a Source #

unSomeSEXP :: SomeSEXP s -> (forall a. SEXP s a -> r) -> r Source #

Deconstruct a SomeSEXP. Takes a continuation since otherwise the existentially quantified variable hidden inside SomeSEXP would escape.

typeOf :: SEXP s a -> SEXPTYPE Source #

Return the "type" tag (aka the form tag) of the given SEXP. This function is pure because the type of an object does not normally change over the lifetime of the object.

cast :: SSEXPTYPE a -> SomeSEXP s -> SEXP s a Source #

Cast the type of a SEXP into another type. This function is partial: at runtime, an error is raised if the source form tag does not match the target form tag.

asTypeOf :: SomeSEXP s -> SEXP s a -> SEXP s a Source #

Cast form of first argument to that of the second argument.

unsafeCoerce :: SEXP s a -> SEXP s b Source #

Unsafe coercion from one form to another. This is unsafe, in the sense that using this function improperly could cause code to crash in unpredictable ways. Contrary to cast, it has no runtime cost since it does not introduce any dynamic check at runtime.

automatic :: MonadR m => SEXP s a -> m (SEXP G a) Source #

Declare memory management for this value to be automatic. That is, the memory associated with it may be freed as soon as the garbage collector notices that it is safe to do so.

Values with automatic memory management are tagged with the global region. The reason is that just like for other global values, deallocation of the value can never be observed. Indeed, it is a mere "optimization" to deallocate the value sooner - it would still be semantically correct to never deallocate it at all.

pokeRVariables :: RVariables -> IO () Source #

unboundValue :: SEXP G 'Symbol Source #

Special value to which all symbols unbound in the current environment resolve to.

nilValue :: SEXP G 'Nil Source #

R's NULL value.

missingArg :: SEXP G 'Symbol Source #

Value substituted for all missing actual arguments of a function call.

baseEnv :: SEXP G 'Env Source #

The base environment.

emptyEnv :: SEXP G 'Env Source #

The empty environment.

globalEnv :: SEXP G 'Env Source #

The global environment.

data Config Source #

Configuration options for the R runtime. Configurations form monoids, so arguments can be accumulated left-to-right through monoidal composition.

Constructors

Config 

Fields

  • configProgName :: Last String

    Program name. If Nothing then the value of getProgName will be used.

  • configArgs :: [String]

    Command-line arguments.

  • configSignalHandlers :: Last Bool

    Set to True if you're happy to let R install its own signal handlers during initialization. By default R sets following signal handlers:

    • SIGPIPE - ignore signal;
    • SIGUSR1 - save workspace and terminate program;
    • SIGUSR2 - terminate program without saving workspace;
    • SIGINT - cancel execution of the current function.
    • N.B.* When program is terminated, haskell runtime will not have any chances to run any exception handlers or finalizers.

Instances

Instances details
Monoid Config Source # 
Instance details

Defined in Language.R.Instance

Semigroup Config Source # 
Instance details

Defined in Language.R.Instance

Default Config Source # 
Instance details

Defined in Language.R.Instance

Methods

def :: Config #

data R s a Source #

The R monad, for sequencing actions interacting with a single instance of the R interpreter, much as the IO monad sequences actions interacting with the real world. The R monad embeds the IO monad, so all IO actions can be lifted to R actions.

Instances

Instances details
MonadFail (R s) Source # 
Instance details

Defined in Language.R.Instance

Methods

fail :: String -> R s a #

MonadIO (R s) Source # 
Instance details

Defined in Language.R.Instance

Methods

liftIO :: IO a -> R s a #

Applicative (R s) Source # 
Instance details

Defined in Language.R.Instance

Methods

pure :: a -> R s a #

(<*>) :: R s (a -> b) -> R s a -> R s b #

liftA2 :: (a -> b -> c) -> R s a -> R s b -> R s c #

(*>) :: R s a -> R s b -> R s b #

(<*) :: R s a -> R s b -> R s a #

Functor (R s) Source # 
Instance details

Defined in Language.R.Instance

Methods

fmap :: (a -> b) -> R s a -> R s b #

(<$) :: a -> R s b -> R s a #

Monad (R s) Source # 
Instance details

Defined in Language.R.Instance

Methods

(>>=) :: R s a -> (a -> R s b) -> R s b #

(>>) :: R s a -> R s b -> R s b #

return :: a -> R s a #

MonadCatch (R s) Source # 
Instance details

Defined in Language.R.Instance

Methods

catch :: Exception e => R s a -> (e -> R s a) -> R s a #

MonadMask (R s) Source # 
Instance details

Defined in Language.R.Instance

Methods

mask :: ((forall a. R s a -> R s a) -> R s b) -> R s b #

uninterruptibleMask :: ((forall a. R s a -> R s a) -> R s b) -> R s b #

generalBracket :: R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c) #

MonadThrow (R s) Source # 
Instance details

Defined in Language.R.Instance

Methods

throwM :: Exception e => e -> R s a #

MonadR (R s) Source # 
Instance details

Defined in Language.R.Instance

Associated Types

data ExecContext (R s) Source #

Methods

io :: IO a -> R s a Source #

acquire :: forall s0 (a :: SEXPTYPE). s0 ~ V => SEXP s0 a -> R s (SEXP (Region (R s)) a) Source #

getExecContext :: R s (ExecContext (R s)) Source #

unsafeRunWithExecContext :: R s a -> ExecContext (R s) -> IO a Source #

PrimMonad (R s) Source # 
Instance details

Defined in Language.R.Instance

Associated Types

type PrimState (R s) #

Methods

primitive :: (State# (PrimState (R s)) -> (# State# (PrimState (R s)), a #)) -> R s a #

(NFData a, Literal a b) => Literal (R s a) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: R s a -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> R s a Source #

(NFData b, Literal a a0, Literal b b0) => Literal (a -> R s b) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a -> R s b) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a -> R s b Source #

(NFData c, Literal a a0, Literal b b0, Literal c c0) => Literal (a -> b -> R s c) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a -> b -> R s c) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a -> b -> R s c Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a1 i4) => Literal (a2 -> a3 -> a4 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a1 i5) => Literal (a2 -> a3 -> a4 -> a5 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a1 i6) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a1 i7) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a1 i8) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a1 i9) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a10 i9, Literal a1 i10) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a10 i9, Literal a11 i10, Literal a1 i11) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a10 i9, Literal a11 i10, Literal a12 i11, Literal a1 i12) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a10 i9, Literal a11 i10, Literal a12 i11, Literal a13 i12, Literal a1 i13) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> a13 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> a13 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> a13 -> R s a1 Source #

newtype ExecContext (R s) Source # 
Instance details

Defined in Language.R.Instance

type PrimState (R s) Source # 
Instance details

Defined in Language.R.Instance

type PrimState (R s) = s

withEmbeddedR :: Config -> IO a -> IO a Source #

Initialize a new instance of R, execute actions that interact with the R instance and then finalize the instance. This is typically called at the very beginning of the main function of the program.

main = withEmbeddedR $ do {...}

Note that R does not currently support reinitialization after finalization, so this function should be called only once during the lifetime of the program (see srcunixsystem.c:Rf_initialize() in the R source code).

runRegion :: NFData a => (forall s. R s a) -> IO a Source #

Run an R action in the global R instance from the IO monad. This action provides no static guarantees that the R instance was indeed initialized and has not yet been finalized. Make sure to call it within the scope of withEmbeddedR.

runRegion m fully evaluates the result of action m, to ensure that no thunks hold onto resources in a way that would extrude the scope of the region. This means that the result must be first-order data (i.e. not a function).

throws Error. Generaly any R function may throw RError that is safe to be cached and computation can proceed. However RError will cancel entire R block. So in order to catch exception in more fine grained way one has to use function tryCatch inside R block.

unsafeRunRegion :: NFData a => R s a -> IO a Source #

defaultConfig :: Config Source #

Default argument to pass to initialize.

initialize :: Config -> IO () Source #

Create a new embedded instance of the R interpreter. Only works from the main thread of the program. That is, from the same thread of execution that the program's main function is running on. In GHCi, use -fno-ghci-sandbox to achieve this.

finalize :: IO () Source #

Finalize an R instance.

class SingI ty => Literal a ty | a -> ty where Source #

Values that can be converted to SEXP.

Minimal complete definition

Nothing

Methods

mkSEXPIO :: a -> IO (SEXP V ty) Source #

Internal function for converting a literal to a SEXP value. You probably want to be using mkSEXP instead.

default mkSEXPIO :: (IsVector ty, Literal [a] ty) => a -> IO (SEXP V ty) Source #

fromSEXP :: SEXP s ty -> a Source #

default fromSEXP :: (IsVector ty, Literal [a] ty) => SEXP s ty -> a Source #

Instances

Instances details
Literal Int32 'Int Source # 
Instance details

Defined in Language.R.Literal

Literal Logical 'Logical Source # 
Instance details

Defined in Language.R.Literal

Literal Text 'String Source # 
Instance details

Defined in Language.R.Literal

Literal String 'String Source # 
Instance details

Defined in Language.R.Literal

Literal Double 'Real Source # 
Instance details

Defined in Language.R.Literal

Literal (Complex Double) 'Complex Source # 
Instance details

Defined in Language.R.Literal

Literal (SomeSEXP s) 'Any Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: SomeSEXP s -> IO (SEXP V 'Any) Source #

fromSEXP :: SEXP s0 'Any -> SomeSEXP s Source #

Literal [Complex Double] 'Complex Source # 
Instance details

Defined in Language.R.Literal

Literal [Int32] 'Int Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: [Int32] -> IO (SEXP V 'Int) Source #

fromSEXP :: SEXP s 'Int -> [Int32] Source #

Literal [Logical] 'Logical Source # 
Instance details

Defined in Language.R.Literal

Literal [String] 'String Source # 
Instance details

Defined in Language.R.Literal

Literal [Double] 'Real Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: [Double] -> IO (SEXP V 'Real) Source #

fromSEXP :: SEXP s 'Real -> [Double] Source #

SVECTOR ty a => Literal (Vector ty a) ty Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: Vector ty a -> IO (SEXP V ty) Source #

fromSEXP :: SEXP s ty -> Vector ty a Source #

SingI a => Literal (SEXP s a) a Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: SEXP s a -> IO (SEXP V a) Source #

fromSEXP :: SEXP s0 a -> SEXP s a Source #

(NFData a, Literal a b) => Literal (R s a) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: R s a -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> R s a Source #

(NFData b, Literal a a0, Literal b b0) => Literal (a -> R s b) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a -> R s b) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a -> R s b Source #

(NFData c, Literal a a0, Literal b b0, Literal c c0) => Literal (a -> b -> R s c) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a -> b -> R s c) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a -> b -> R s c Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a1 i4) => Literal (a2 -> a3 -> a4 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a1 i5) => Literal (a2 -> a3 -> a4 -> a5 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a1 i6) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a1 i7) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a1 i8) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a1 i9) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a10 i9, Literal a1 i10) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a10 i9, Literal a11 i10, Literal a1 i11) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a10 i9, Literal a11 i10, Literal a12 i11, Literal a1 i12) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> R s a1 Source #

(NFData a1, Literal a2 i1, Literal a3 i2, Literal a4 i3, Literal a5 i4, Literal a6 i5, Literal a7 i6, Literal a8 i7, Literal a9 i8, Literal a10 i9, Literal a11 i10, Literal a12 i11, Literal a13 i12, Literal a1 i13) => Literal (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> a13 -> R s a1) 'ExtPtr Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> a13 -> R s a1) -> IO (SEXP V 'ExtPtr) Source #

fromSEXP :: SEXP s0 'ExtPtr -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> a13 -> R s a1 Source #

VECTOR V ty a => Literal (MVector V ty a) ty Source # 
Instance details

Defined in Language.R.Literal

Methods

mkSEXPIO :: MVector V ty a -> IO (SEXP V ty) Source #

fromSEXP :: SEXP s ty -> MVector V ty a Source #

mkSEXP :: (Literal a b, MonadR m) => a -> m (SEXP (Region m) b) Source #

Create a SEXP value and protect it in current region

fromSomeSEXP :: forall s a form. Literal a form => SomeSEXP s -> a Source #

Like fromSEXP, but with no static type satefy. Performs a dynamic (i.e. at runtime) check instead.

dynSEXP :: forall a s ty. Literal a ty => SomeSEXP s -> a Source #

Like fromSomeSEXP, but behaves like the as.* family of functions in R, by performing a best effort conversion to the target form (e.g. rounds reals to integers, etc) for atomic types.

mkSEXPVector :: (Storable (ElemRep s a), IsVector a) => SSEXPTYPE a -> [IO (ElemRep s a)] -> SEXP s a Source #

mkSEXPVectorIO :: (Storable (ElemRep s a), IsVector a) => SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a) Source #

toPairList :: MonadR m => [(String, SomeSEXP (Region m))] -> m (SomeSEXP (Region m)) Source #

Create a pairlist from an association list. Result is either a pairlist or nilValue if the input is the null list. These are two distinct forms. Hence why the type of this function is not more precise.

fromPairList :: SomeSEXP s -> [(String, SomeSEXP s)] Source #

Create an association list from a pairlist. R Pairlists are nil-terminated chains of nested cons cells, as in LISP.

funToSEXP :: HFunWrap a b => (b -> IO (FunPtr b)) -> a -> IO (SEXP s 'ExtPtr) Source #

parseFile :: FilePath -> (SEXP s 'Expr -> IO a) -> IO a Source #

Deprecated: Use [r| parse(file="pathtofile") |] instead.

Parse file and perform some actions on parsed file.

This function uses continuation because this is an easy way to make operations GC-safe.

parseText Source #

Arguments

:: String

Text to parse

-> Bool

Whether to annotate the AST with source locations.

-> IO (SEXP V 'Expr) 

Deprecated: Use [r| parse(text=...) |] instead.

install :: MonadR m => String -> m (SEXP V 'Symbol) Source #

Internalize a symbol name.

string :: String -> IO (SEXP V 'Char) Source #

Deprecated: Use mkSEXP instead

Create an R character string from a Haskell string.

strings :: String -> IO (SEXP V 'String) Source #

Deprecated: Use mkSEXP instead

Create an R string vector from a Haskell string.

evalEnv :: MonadR m => SEXP s a -> SEXP s 'Env -> m (SomeSEXP (Region m)) Source #

Evaluate a (sequence of) expression(s) in the given environment, returning the value of the last.

eval :: MonadR m => SEXP s a -> m (SomeSEXP (Region m)) Source #

Evaluate a (sequence of) expression(s) in the global environment.

eval_ :: MonadR m => SEXP s a -> m () Source #

Silent version of eval function that discards it's result.

throwR Source #

Arguments

:: MonadR m 
=> SEXP s 'Env

Environment in which to find error.

-> m a 

Throw an R error as an exception.

cancel :: IO () Source #

Cancel any ongoing R computation in the current process. After interruption an RError exception will be raised.

This call is safe to run in any thread. If there is no R computation running, the next computaion will be immediately cancelled. Note that R will only interrupt computations at so-called "safe points" (in particular, not in the middle of a C call).

throwRMessage :: MonadR m => String -> m a Source #

Throw an R exception with specified message.

refresh :: MonadR m => m () Source #

Manually trigger processing all pending events. Useful when at an interactive prompt and no event loop is running.

Globals