{-# Language ConstraintKinds #-}
{-# Language DefaultSignatures #-}
{-# Language DataKinds #-}
{-# Language FlexibleContexts #-}
{-# Language FlexibleInstances #-}
{-# Language FunctionalDependencies #-}
{-# Language GADTs #-}
{-# Language LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# Language TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# Language ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Language.R.Literal
(
Literal(..)
, toPairList
, fromPairList
, fromSomeSEXP
, mkSEXP
, dynSEXP
, mkSEXPVector
, mkSEXPVectorIO
, mkProtectedSEXPVector
, mkProtectedSEXPVectorIO
, funToSEXP
) where
import Control.Memory.Region
import Control.Monad.R.Class
import qualified Data.Vector.SEXP as SVector
import qualified Data.Vector.SEXP.Mutable as SMVector
import qualified Foreign.R as R
import qualified Foreign.R.Internal as R (somesexp)
import Foreign.R.Type ( IsVector, SSEXPTYPE )
import Foreign.R ( SEXP, SomeSEXP(..) )
import Internal.Error
import {-# SOURCE #-} Language.R.Internal (r1)
import Language.R.Globals (nilValue)
import Language.R.HExp
import Language.R.Instance
import Language.R.Internal.FunWrappers
import Language.R.Internal.FunWrappers.TH
import Data.Singletons ( Sing, SingI, fromSing, sing )
import Control.DeepSeq ( NFData )
import Control.Monad ( void, zipWithM_, (<=<) )
import Data.Int (Int32)
import qualified Data.ByteString.Unsafe as B
import Data.Complex (Complex)
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import Foreign ( FunPtr, castPtr )
import Foreign.C.String ( withCString )
import Foreign.Storable ( Storable, pokeElemOff )
import qualified GHC.Foreign as GHC
import GHC.IO.Encoding.UTF8
import System.IO.Unsafe ( unsafePerformIO )
class SingI ty => Literal a ty | a -> ty where
mkSEXPIO :: a -> IO (SEXP V ty)
fromSEXP :: SEXP s ty -> a
default mkSEXPIO :: (IsVector ty, Literal [a] ty) => a -> IO (SEXP V ty)
mkSEXPIO a
x = forall a (ty :: SEXPTYPE). Literal a ty => a -> IO (SEXP V ty)
mkSEXPIO [a
x]
default fromSEXP :: (IsVector ty, Literal [a] ty) => SEXP s ty -> a
fromSEXP (forall a (ty :: SEXPTYPE) s. Literal a ty => SEXP s ty -> a
fromSEXP -> [a
x]) = a
x
fromSEXP SEXP s ty
_ = forall a. String -> String -> a
failure String
"fromSEXP" String
"Not a singleton vector."
mkSEXP :: (Literal a b, MonadR m) => a -> m (SEXP (Region m) b)
mkSEXP :: forall a (b :: SEXPTYPE) (m :: * -> *).
(Literal a b, MonadR m) =>
a -> m (SEXP (Region m) b)
mkSEXP a
x = forall (m :: * -> *) s (a :: SEXPTYPE).
(MonadR m, s ~ V) =>
SEXP s a -> m (SEXP (Region m) a)
acquire forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadR m => IO a -> m a
io (forall a (ty :: SEXPTYPE). Literal a ty => a -> IO (SEXP V ty)
mkSEXPIO a
x)
fromSomeSEXP :: forall s a form. (Literal a form) => R.SomeSEXP s -> a
fromSomeSEXP :: forall s a (form :: SEXPTYPE). Literal a form => SomeSEXP s -> a
fromSomeSEXP = forall a (ty :: SEXPTYPE) s. Literal a ty => SEXP s ty -> a
fromSEXP 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 :: Sing form)
dynSEXP :: forall a s ty. (Literal a ty) => SomeSEXP s -> a
dynSEXP :: forall a s (ty :: SEXPTYPE). Literal a ty => SomeSEXP s -> a
dynSEXP (SomeSEXP SEXP s a
sx) =
forall s a (form :: SEXPTYPE). Literal a form => SomeSEXP s -> a
fromSomeSEXP forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ case forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing (forall {k} (a :: k). SingI a => Sing a
sing :: SSEXPTYPE ty) of
Demote SEXPTYPE
SEXPTYPE
R.Char -> forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 ByteString
"as.character" SEXP s a
sx
Demote SEXPTYPE
SEXPTYPE
R.Int -> forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 ByteString
"as.integer" SEXP s a
sx
Demote SEXPTYPE
SEXPTYPE
R.Real -> forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 ByteString
"as.double" SEXP s a
sx
Demote SEXPTYPE
SEXPTYPE
R.Complex -> forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 ByteString
"as.complex" SEXP s a
sx
Demote SEXPTYPE
SEXPTYPE
R.Logical -> forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 ByteString
"as.logical" SEXP s a
sx
Demote SEXPTYPE
SEXPTYPE
R.Raw -> forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 ByteString
"as.raw" SEXP s a
sx
Demote SEXPTYPE
_ -> 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 a b. (a -> b) -> a -> b
$ forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release SEXP s a
sx
{-# NOINLINE mkSEXPVector #-}
mkSEXPVector :: (Storable (SVector.ElemRep s a), IsVector a)
=> SSEXPTYPE a
-> [IO (SVector.ElemRep s a)]
-> SEXP s a
mkSEXPVector :: forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> SEXP s a
mkSEXPVector SSEXPTYPE a
ty [IO (ElemRep s a)]
allocators = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO SSEXPTYPE a
ty [IO (ElemRep s a)]
allocators
mkSEXPVectorIO :: (Storable (SVector.ElemRep s a), IsVector a)
=> SSEXPTYPE a
-> [IO (SVector.ElemRep s a)]
-> IO (SEXP s a)
mkSEXPVectorIO :: forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO SSEXPTYPE a
ty [IO (ElemRep s a)]
allocators =
forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (forall (a :: SEXPTYPE).
IsVector a =>
SSEXPTYPE a -> Int -> IO (SEXP V a)
R.allocVector SSEXPTYPE a
ty forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [IO (ElemRep s a)]
allocators) forall a b. (a -> b) -> a -> b
$ \SEXP s a
vec -> do
let ptr :: Ptr (ElemRep s a)
ptr = 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 s a
vec
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Int
i -> (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr (ElemRep s a)
ptr Int
i)) [Int
0..] [IO (ElemRep s a)]
allocators
forall (m :: * -> *) a. Monad m => a -> m a
return SEXP s a
vec
{-# NOINLINE mkProtectedSEXPVector #-}
mkProtectedSEXPVector :: IsVector b
=> SSEXPTYPE b
-> [SEXP s a]
-> SEXP s b
mkProtectedSEXPVector :: forall (b :: SEXPTYPE) s (a :: SEXPTYPE).
IsVector b =>
SSEXPTYPE b -> [SEXP s a] -> SEXP s b
mkProtectedSEXPVector SSEXPTYPE b
ty [SEXP s a]
xs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (b :: SEXPTYPE) s (a :: SEXPTYPE).
IsVector b =>
SSEXPTYPE b -> [SEXP s a] -> IO (SEXP s b)
mkProtectedSEXPVectorIO SSEXPTYPE b
ty [SEXP s a]
xs
mkProtectedSEXPVectorIO :: IsVector b
=> SSEXPTYPE b
-> [SEXP s a]
-> IO (SEXP s b)
mkProtectedSEXPVectorIO :: forall (b :: SEXPTYPE) s (a :: SEXPTYPE).
IsVector b =>
SSEXPTYPE b -> [SEXP s a] -> IO (SEXP s b)
mkProtectedSEXPVectorIO SSEXPTYPE b
ty [SEXP s a]
xs = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP s a -> IO (SEXP G a)
R.protect) [SEXP s a]
xs
SEXP s b
z <- forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (forall (a :: SEXPTYPE).
IsVector a =>
SSEXPTYPE a -> Int -> IO (SEXP V a)
R.allocVector SSEXPTYPE b
ty forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [SEXP s a]
xs) forall a b. (a -> b) -> a -> b
$ \SEXP s b
vec -> do
let ptr :: Ptr (SEXP s a)
ptr = 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 s b
vec
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr (SEXP s a)
ptr) [Int
0..] [SEXP s a]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return SEXP s b
vec
Int -> IO ()
R.unprotect (forall (t :: * -> *) a. Foldable t => t a -> Int
length [SEXP s a]
xs)
forall (m :: * -> *) a. Monad m => a -> m a
return SEXP s b
z
instance Literal [R.Logical] 'R.Logical where
mkSEXPIO :: [Logical] -> IO (SEXP V 'Logical)
mkSEXPIO = forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO forall {k} (a :: k). SingI a => Sing a
sing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return
fromSEXP :: forall s. SEXP s 'Logical -> [Logical]
fromSEXP (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Logical Vector 'Logical Logical
v) = forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'Logical Logical
v
instance Literal [Int32] 'R.Int where
mkSEXPIO :: [Int32] -> IO (SEXP V 'Int)
mkSEXPIO = forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO forall {k} (a :: k). SingI a => Sing a
sing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return
fromSEXP :: forall s. SEXP s 'Int -> [Int32]
fromSEXP (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Int Vector 'Int Int32
v) = forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'Int Int32
v
instance Literal [Double] 'R.Real where
mkSEXPIO :: [Double] -> IO (SEXP V 'Real)
mkSEXPIO = forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO forall {k} (a :: k). SingI a => Sing a
sing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return
fromSEXP :: forall s. SEXP s 'Real -> [Double]
fromSEXP (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Real Vector 'Real Double
v) = forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'Real Double
v
instance Literal [Complex Double] 'R.Complex where
mkSEXPIO :: [Complex Double] -> IO (SEXP V 'Complex)
mkSEXPIO = forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO forall {k} (a :: k). SingI a => Sing a
sing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return
fromSEXP :: forall s. SEXP s 'Complex -> [Complex Double]
fromSEXP (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Complex Vector 'Complex (Complex Double)
v) = forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'Complex (Complex Double)
v
instance Literal [String] 'R.String where
mkSEXPIO :: [String] -> IO (SEXP V 'String)
mkSEXPIO =
forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO forall {k} (a :: k). SingI a => Sing a
sing forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (\String
str -> forall a. TextEncoding -> String -> (CString -> IO a) -> IO a
GHC.withCString TextEncoding
utf8 String
str (CEType -> CString -> IO (SEXP V 'Char)
R.mkCharCE CEType
R.CE_UTF8))
fromSEXP :: forall s. SEXP s 'String -> [String]
fromSEXP (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> String Vector 'String (SEXP V 'Char)
v) =
forall a b. (a -> b) -> [a] -> [b]
map (\(forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Char Vector 'Char Word8
xs) -> Vector 'Char Word8 -> String
SVector.toString Vector 'Char Word8
xs) (forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'String (SEXP V 'Char)
v)
instance Literal Text 'R.String where
mkSEXPIO :: Text -> IO (SEXP V 'String)
mkSEXPIO Text
s =
forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO forall {k} (a :: k). SingI a => Sing a
sing
[ forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
s) forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (CEType -> CString -> Int -> IO (SEXP V 'Char)
R.mkCharLenCE CEType
R.CE_UTF8) ]
fromSEXP :: forall s. SEXP s 'String -> Text
fromSEXP (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> String Vector 'String (SEXP V 'Char)
v) =
case forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'String (SEXP V 'Char)
v of
[forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Char Vector 'Char Word8
x] -> forall a.
NFData a =>
Vector 'Char Word8 -> (ByteString -> IO a) -> a
SVector.unsafeWithByteString Vector 'Char Word8
x forall a b. (a -> b) -> a -> b
$ \ByteString
p -> do
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
p
[SEXP V 'Char]
_ -> forall a. String -> String -> a
failure String
"fromSEXP" String
"Not a singleton vector"
toPairList :: MonadR m => [(String, SomeSEXP (Region m))] -> m (SomeSEXP (Region m))
toPairList :: forall (m :: * -> *).
MonadR m =>
[(String, SomeSEXP (Region m))] -> m (SomeSEXP (Region m))
toPairList [] = 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 G 'Nil
nilValue)
toPairList ((String
k, SomeSEXP SEXP (PrimState m) a
v):[(String, SomeSEXP (PrimState m))]
kvs) = do
SEXP V 'Symbol
tag <- forall (m :: * -> *) a. MonadR m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
k CString -> IO (SEXP V 'Symbol)
R.install
forall (m :: * -> *).
MonadR m =>
[(String, SomeSEXP (Region m))] -> m (SomeSEXP (Region m))
toPairList [(String, SomeSEXP (PrimState m))]
kvs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
SomeSEXP SEXP (PrimState m) a
cdr -> forall (m :: * -> *).
MonadR m =>
SomeSEXP V -> m (SomeSEXP (Region m))
acquireSome forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a. MonadR m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
SEXP V 'List
l <- forall s (a :: SEXPTYPE) (b :: SEXPTYPE).
SEXP s a -> SEXP s b -> IO (SEXP V 'List)
R.cons SEXP (PrimState m) a
v SEXP (PrimState m) a
cdr
forall s (a :: SEXPTYPE) (b :: SEXPTYPE).
SEXP s a -> SEXP s b -> IO ()
R.setTag SEXP V 'List
l (forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease SEXP V 'Symbol
tag)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP V 'List
l)
fromPairList :: SomeSEXP s -> [(String, SomeSEXP s)]
fromPairList :: forall s. SomeSEXP s -> [(String, SomeSEXP s)]
fromPairList (SomeSEXP (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> HExp s a
Nil)) = []
fromPairList (SomeSEXP (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> List SEXP s a1
car SEXP s b1
cdr (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Symbol (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Char Vector 'Char Word8
name) SEXP s b1
_ SEXP s c
_))) =
(Vector 'Char Word8 -> String
SVector.toString Vector 'Char Word8
name, forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a1
car) forall a. a -> [a] -> [a]
: forall s. SomeSEXP s -> [(String, SomeSEXP s)]
fromPairList (forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s b1
cdr)
fromPairList (SomeSEXP (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> List SEXP s a1
_ SEXP s b1
_ SEXP s c
_)) =
forall a. String -> String -> a
failure String
"fromPairList" String
"Association listed expected but tag not set."
fromPairList SomeSEXP s
_ =
forall a. String -> String -> a
failure String
"fromPairList" String
"Pairlist expected where some other expression appeared."
instance Literal R.Logical 'R.Logical
instance Literal Int32 'R.Int
instance Literal Double 'R.Real
instance Literal (Complex Double) 'R.Complex
instance Literal String 'R.String where
mkSEXPIO :: String -> IO (SEXP V 'String)
mkSEXPIO String
x = forall a (ty :: SEXPTYPE). Literal a ty => a -> IO (SEXP V ty)
mkSEXPIO [String
x]
fromSEXP :: forall s. SEXP s 'String -> String
fromSEXP x :: SEXP s 'String
x@(forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> String {})
| [String
h] <- forall a (ty :: SEXPTYPE) s. Literal a ty => SEXP s ty -> a
fromSEXP SEXP s 'String
x = String
h
| Bool
otherwise = forall a. String -> String -> a
failure String
"fromSEXP" String
"Not a singleton vector."
instance SVector.SVECTOR ty a => Literal (SVector.Vector ty a) ty where
mkSEXPIO :: Vector ty a -> IO (SEXP V ty)
mkSEXPIO = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
Vector ty a -> SEXP s ty
SVector.toSEXP
fromSEXP :: forall s. SEXP s ty -> Vector ty a
fromSEXP = forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
SVector.fromSEXP 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 :: SSEXPTYPE ty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP
instance SVector.VECTOR V ty a => Literal (SMVector.MVector V ty a) ty where
mkSEXPIO :: MVector V ty a -> IO (SEXP V ty)
mkSEXPIO = forall a s. NFData a => R s a -> IO a
unsafeRunRegion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (ty :: SEXPTYPE) a.
(MonadR m, VECTOR (Region m) ty a) =>
MVector (Region m) ty a -> m (SEXP (Region m) ty)
SMVector.toSEXP
fromSEXP :: forall s. SEXP s ty -> MVector V ty a
fromSEXP = forall s (ty :: SEXPTYPE) a.
VECTOR s ty a =>
SEXP s ty -> MVector s ty a
SMVector.fromSEXP 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 :: SSEXPTYPE ty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release
instance SingI a => Literal (SEXP s a) a where
mkSEXPIO :: SEXP s a -> IO (SEXP V a)
mkSEXPIO = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
fromSEXP :: forall s. SEXP s a -> SEXP s a
fromSEXP = forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
R.cast (forall {k} (a :: k). SingI a => Sing a
sing :: SSEXPTYPE a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease
instance Literal (SomeSEXP s) 'R.Any where
mkSEXPIO :: SomeSEXP s -> IO (SEXP V 'Any)
mkSEXPIO (SomeSEXP SEXP s a
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
R.unsafeCoerce SEXP s a
s
fromSEXP :: forall s. SEXP s 'Any -> SomeSEXP s
fromSEXP = forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease
instance (NFData a, Literal a b) => Literal (R s a) 'R.ExtPtr where
mkSEXPIO :: R s a -> IO (SEXP V 'ExtPtr)
mkSEXPIO = forall a b s.
HFunWrap a b =>
(b -> IO (FunPtr b)) -> a -> IO (SEXP s 'ExtPtr)
funToSEXP IO SEXP0 -> IO (FunPtr (IO SEXP0))
wrap0
fromSEXP :: forall s. SEXP s 'ExtPtr -> R s a
fromSEXP = forall a. String -> a
unimplemented String
"Literal (R s a) fromSEXP"
instance (NFData b, Literal a a0, Literal b b0) => Literal (a -> R s b) 'R.ExtPtr where
mkSEXPIO :: (a -> R s b) -> IO (SEXP V 'ExtPtr)
mkSEXPIO = forall a b s.
HFunWrap a b =>
(b -> IO (FunPtr b)) -> a -> IO (SEXP s 'ExtPtr)
funToSEXP (SEXP0 -> IO SEXP0) -> IO (FunPtr (SEXP0 -> IO SEXP0))
wrap1
fromSEXP :: forall s. SEXP s 'ExtPtr -> a -> R s b
fromSEXP = forall a. String -> a
unimplemented String
"Literal (a -> R s b) fromSEXP"
instance (NFData c, Literal a a0, Literal b b0, Literal c c0)
=> Literal (a -> b -> R s c) 'R.ExtPtr where
mkSEXPIO :: (a -> b -> R s c) -> IO (SEXP V 'ExtPtr)
mkSEXPIO = forall a b s.
HFunWrap a b =>
(b -> IO (FunPtr b)) -> a -> IO (SEXP s 'ExtPtr)
funToSEXP (SEXP0 -> SEXP0 -> IO SEXP0)
-> IO (FunPtr (SEXP0 -> SEXP0 -> IO SEXP0))
wrap2
fromSEXP :: forall s. SEXP s 'ExtPtr -> a -> b -> R s c
fromSEXP = forall a. String -> a
unimplemented String
"Literal (a -> b -> IO c) fromSEXP"
class HFunWrap a b | a -> b where
hFunWrap :: a -> b
instance (NFData a, Literal a la) => HFunWrap (R s a) (IO R.SEXP0) where
hFunWrap :: R s a -> IO SEXP0
hFunWrap R s a
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp forall a b. (a -> b) -> a -> b
$ (forall a (ty :: SEXPTYPE). Literal a ty => a -> IO (SEXP V ty)
mkSEXPIO forall a b. (a -> b) -> a -> b
$!) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a s. NFData a => R s a -> IO a
unsafeRunRegion R s a
a
instance (Literal a la, HFunWrap b wb)
=> HFunWrap (a -> b) (R.SEXP0 -> wb) where
hFunWrap :: (a -> b) -> SEXP0 -> wb
hFunWrap a -> b
f SEXP0
a = forall a b. HFunWrap a b => a -> b
hFunWrap forall a b. (a -> b) -> a -> b
$ a -> b
f forall a b. (a -> b) -> a -> b
$! forall a (ty :: SEXPTYPE) s. Literal a ty => SEXP s ty -> a
fromSEXP (forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
R.cast forall {k} (a :: k). SingI a => Sing a
sing (forall s. SEXP0 -> SomeSEXP s
R.somesexp SEXP0
a) :: SEXP s la)
foreign import ccall "missing_r.h funPtrToSEXP" funPtrToSEXP
:: FunPtr a -> IO (SEXP s 'R.ExtPtr)
funToSEXP :: HFunWrap a b => (b -> IO (FunPtr b)) -> a -> IO (SEXP s 'R.ExtPtr)
funToSEXP :: forall a b s.
HFunWrap a b =>
(b -> IO (FunPtr b)) -> a -> IO (SEXP s 'ExtPtr)
funToSEXP b -> IO (FunPtr b)
w a
x = forall a s. FunPtr a -> IO (SEXP s 'ExtPtr)
funPtrToSEXP forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO (FunPtr b)
w (forall a b. HFunWrap a b => a -> b
hFunWrap a
x)
$(thWrapperLiterals 3 12)