-- |
-- Copyright: 2013 (C) Amgen, Inc
--

{-# 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 #-}

-- required to not warn about IsVector usage.
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Language.R.Literal
  ( -- * Literals conversion
    Literal(..)
  , toPairList
  , fromPairList
    -- * Derived helpers
  , fromSomeSEXP
  , mkSEXP
  , dynSEXP
  , mkSEXPVector
  , mkSEXPVectorIO
  , mkProtectedSEXPVector
  , mkProtectedSEXPVectorIO
    -- * Internal
  , 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 )

-- | Values that can be converted to 'SEXP'.
class SingI ty => Literal a ty | a -> ty where
    -- | Internal function for converting a literal to a 'SEXP' value. You
    -- probably want to be using 'mkSEXP' instead.
    mkSEXPIO :: a -> IO (SEXP V ty)
    fromSEXP :: SEXP s ty -> a

    default mkSEXPIO :: (IsVector ty, Literal [a] ty) => a -> IO (SEXP V ty)
    mkSEXPIO x :: a
x = [a] -> IO (SEXP V ty)
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 (SEXP s ty -> [a]
forall a (ty :: SEXPTYPE) s. Literal a ty => SEXP s ty -> a
fromSEXP -> [x :: a
x]) = a
x
    fromSEXP _ = String -> String -> a
forall a. String -> String -> a
failure "fromSEXP" "Not a singleton vector."

-- |  Create a SEXP value and protect it in current region
mkSEXP :: (Literal a b, MonadR m) => a -> m (SEXP (Region m) b)
mkSEXP :: a -> m (SEXP (Region m) b)
mkSEXP x :: a
x = SEXP V b -> m (SEXP (Region m) b)
forall (m :: * -> *) s (a :: SEXPTYPE).
(MonadR m, s ~ V) =>
SEXP s a -> m (SEXP (Region m) a)
acquire (SEXP V b -> m (SEXP (Region m) b))
-> m (SEXP V b) -> m (SEXP (Region m) b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (SEXP V b) -> m (SEXP V b)
forall (m :: * -> *) a. MonadR m => IO a -> m a
io (a -> IO (SEXP V b)
forall a (ty :: SEXPTYPE). Literal a ty => a -> IO (SEXP V ty)
mkSEXPIO a
x)

-- | Like 'fromSEXP', but with no static type satefy. Performs a dynamic
-- (i.e. at runtime) check instead.
fromSomeSEXP :: forall s a form. (Literal a form) => R.SomeSEXP s -> a
fromSomeSEXP :: SomeSEXP s -> a
fromSomeSEXP = SEXP s form -> a
forall a (ty :: SEXPTYPE) s. Literal a ty => SEXP s ty -> a
fromSEXP (SEXP s form -> a)
-> (SomeSEXP s -> SEXP s form) -> SomeSEXP s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSEXPTYPE form -> SomeSEXP s -> SEXP s form
forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
R.cast (Sing form
forall k (a :: k). SingI a => Sing a
sing :: Sing form)

-- | 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.
dynSEXP :: forall a s ty. (Literal a ty) => SomeSEXP s -> a
dynSEXP :: SomeSEXP s -> a
dynSEXP (SomeSEXP sx :: SEXP s a
sx) =
    SomeSEXP V -> a
forall s a (form :: SEXPTYPE). Literal a form => SomeSEXP s -> a
fromSomeSEXP (SomeSEXP V -> a) -> SomeSEXP V -> a
forall a b. (a -> b) -> a -> b
$ IO (SomeSEXP V) -> SomeSEXP V
forall a. IO a -> a
unsafePerformIO (IO (SomeSEXP V) -> SomeSEXP V) -> IO (SomeSEXP V) -> SomeSEXP V
forall a b. (a -> b) -> a -> b
$ case Sing ty -> Demote SEXPTYPE
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing (SSEXPTYPE ty
forall k (a :: k). SingI a => Sing a
sing :: SSEXPTYPE ty) of
      R.Char -> ByteString -> SEXP s a -> IO (SomeSEXP V)
forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 "as.character" SEXP s a
sx
      R.Int -> ByteString -> SEXP s a -> IO (SomeSEXP V)
forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 "as.integer" SEXP s a
sx
      R.Real -> ByteString -> SEXP s a -> IO (SomeSEXP V)
forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 "as.double" SEXP s a
sx
      R.Complex -> ByteString -> SEXP s a -> IO (SomeSEXP V)
forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 "as.complex" SEXP s a
sx
      R.Logical -> ByteString -> SEXP s a -> IO (SomeSEXP V)
forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 "as.logical" SEXP s a
sx
      R.Raw -> ByteString -> SEXP s a -> IO (SomeSEXP V)
forall s (a :: SEXPTYPE). ByteString -> SEXP s a -> IO (SomeSEXP V)
r1 "as.raw" SEXP s a
sx
      _ -> SomeSEXP V -> IO (SomeSEXP V)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSEXP V -> IO (SomeSEXP V)) -> SomeSEXP V -> IO (SomeSEXP V)
forall a b. (a -> b) -> a -> b
$ SEXP V a -> SomeSEXP V
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (SEXP V a -> SomeSEXP V) -> SEXP V a -> SomeSEXP V
forall a b. (a -> b) -> a -> b
$ SEXP s a -> SEXP V a
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 :: SSEXPTYPE a -> [IO (ElemRep s a)] -> SEXP s a
mkSEXPVector ty :: SSEXPTYPE a
ty allocators :: [IO (ElemRep s a)]
allocators = IO (SEXP s a) -> SEXP s a
forall a. IO a -> a
unsafePerformIO (IO (SEXP s a) -> SEXP s a) -> IO (SEXP s a) -> SEXP s a
forall a b. (a -> b) -> a -> b
$ SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
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 :: SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO ty :: SSEXPTYPE a
ty allocators :: [IO (ElemRep s a)]
allocators =
    IO (SEXP V a) -> (SEXP s a -> IO (SEXP s a)) -> IO (SEXP s a)
forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (SSEXPTYPE a -> Int -> IO (SEXP V a)
forall (a :: SEXPTYPE).
IsVector a =>
SSEXPTYPE a -> Int -> IO (SEXP V a)
R.allocVector SSEXPTYPE a
ty (Int -> IO (SEXP V a)) -> Int -> IO (SEXP V a)
forall a b. (a -> b) -> a -> b
$ [IO (ElemRep s a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IO (ElemRep s a)]
allocators) ((SEXP s a -> IO (SEXP s a)) -> IO (SEXP s a))
-> (SEXP s a -> IO (SEXP s a)) -> IO (SEXP s a)
forall a b. (a -> b) -> a -> b
$ \vec :: SEXP s a
vec -> do
      let ptr :: Ptr (ElemRep s a)
ptr = Ptr () -> Ptr (ElemRep s a)
forall a b. Ptr a -> Ptr b
castPtr (Ptr () -> Ptr (ElemRep s a)) -> Ptr () -> Ptr (ElemRep s a)
forall a b. (a -> b) -> a -> b
$ SEXP s a -> Ptr ()
forall s (a :: SEXPTYPE). SEXP s a -> Ptr ()
R.unsafeSEXPToVectorPtr SEXP s a
vec
      (Int -> IO (ElemRep s a) -> IO ())
-> [Int] -> [IO (ElemRep s a)] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\i :: Int
i -> (IO (ElemRep s a) -> (ElemRep s a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (ElemRep s a) -> Int -> ElemRep s a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr (ElemRep s a)
ptr Int
i)) [0..] [IO (ElemRep s a)]
allocators
      SEXP s a -> IO (SEXP s a)
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 :: SSEXPTYPE b -> [SEXP s a] -> SEXP s b
mkProtectedSEXPVector ty :: SSEXPTYPE b
ty xs :: [SEXP s a]
xs = IO (SEXP s b) -> SEXP s b
forall a. IO a -> a
unsafePerformIO (IO (SEXP s b) -> SEXP s b) -> IO (SEXP s b) -> SEXP s b
forall a b. (a -> b) -> a -> b
$ SSEXPTYPE b -> [SEXP s a] -> IO (SEXP s 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 :: SSEXPTYPE b -> [SEXP s a] -> IO (SEXP s b)
mkProtectedSEXPVectorIO ty :: SSEXPTYPE b
ty xs :: [SEXP s a]
xs = do
    (SEXP s a -> IO ()) -> [SEXP s a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO (SEXP G a) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (SEXP G a) -> IO ())
-> (SEXP s a -> IO (SEXP G a)) -> SEXP s a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s a -> IO (SEXP G a)
forall s (a :: SEXPTYPE). SEXP s a -> IO (SEXP G a)
R.protect) [SEXP s a]
xs
    SEXP s b
z <- IO (SEXP V b) -> (SEXP s b -> IO (SEXP s b)) -> IO (SEXP s b)
forall (a :: SEXPTYPE) s b.
IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
R.withProtected (SSEXPTYPE b -> Int -> IO (SEXP V b)
forall (a :: SEXPTYPE).
IsVector a =>
SSEXPTYPE a -> Int -> IO (SEXP V a)
R.allocVector SSEXPTYPE b
ty (Int -> IO (SEXP V b)) -> Int -> IO (SEXP V b)
forall a b. (a -> b) -> a -> b
$ [SEXP s a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SEXP s a]
xs) ((SEXP s b -> IO (SEXP s b)) -> IO (SEXP s b))
-> (SEXP s b -> IO (SEXP s b)) -> IO (SEXP s b)
forall a b. (a -> b) -> a -> b
$ \vec :: SEXP s b
vec -> do
           let ptr :: Ptr (SEXP s a)
ptr = Ptr () -> Ptr (SEXP s a)
forall a b. Ptr a -> Ptr b
castPtr (Ptr () -> Ptr (SEXP s a)) -> Ptr () -> Ptr (SEXP s a)
forall a b. (a -> b) -> a -> b
$ SEXP s b -> Ptr ()
forall s (a :: SEXPTYPE). SEXP s a -> Ptr ()
R.unsafeSEXPToVectorPtr SEXP s b
vec
           (Int -> SEXP s a -> IO ()) -> [Int] -> [SEXP s a] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (Ptr (SEXP s a) -> Int -> SEXP s a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr (SEXP s a)
ptr) [0..] [SEXP s a]
xs
           SEXP s b -> IO (SEXP s b)
forall (m :: * -> *) a. Monad m => a -> m a
return SEXP s b
vec
    Int -> IO ()
R.unprotect ([SEXP s a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SEXP s a]
xs)
    SEXP s b -> IO (SEXP s b)
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 = SSEXPTYPE 'Logical
-> [IO (ElemRep V 'Logical)] -> IO (SEXP V 'Logical)
forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO SSEXPTYPE 'Logical
forall k (a :: k). SingI a => Sing a
sing ([IO Logical] -> IO (SEXP V 'Logical))
-> ([Logical] -> [IO Logical]) -> [Logical] -> IO (SEXP V 'Logical)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Logical -> IO Logical) -> [Logical] -> [IO Logical]
forall a b. (a -> b) -> [a] -> [b]
map Logical -> IO Logical
forall (m :: * -> *) a. Monad m => a -> m a
return
    fromSEXP :: SEXP s 'Logical -> [Logical]
fromSEXP (SEXP s 'Logical -> HExp s 'Logical
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Logical v :: Vector 'Logical Logical
v) = Vector 'Logical Logical -> [Logical]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'Logical Logical
v
    fromSEXP _ =
        String -> String -> [Logical]
forall a. String -> String -> a
failure "fromSEXP" "Logical expected where some other expression appeared."

instance Literal [Int32] 'R.Int where
    mkSEXPIO :: [Int32] -> IO (SEXP V 'Int)
mkSEXPIO = SSEXPTYPE 'Int -> [IO (ElemRep V 'Int)] -> IO (SEXP V 'Int)
forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO SSEXPTYPE 'Int
forall k (a :: k). SingI a => Sing a
sing ([IO Int32] -> IO (SEXP V 'Int))
-> ([Int32] -> [IO Int32]) -> [Int32] -> IO (SEXP V 'Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> IO Int32) -> [Int32] -> [IO Int32]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return
    fromSEXP :: SEXP s 'Int -> [Int32]
fromSEXP (SEXP s 'Int -> HExp s 'Int
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Int v :: Vector 'Int Int32
v) = Vector 'Int Int32 -> [Int32]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'Int Int32
v
    fromSEXP _ =
        String -> String -> [Int32]
forall a. String -> String -> a
failure "fromSEXP" "Int expected where some other expression appeared."

instance Literal [Double] 'R.Real where
    mkSEXPIO :: [Double] -> IO (SEXP V 'Real)
mkSEXPIO = SSEXPTYPE 'Real -> [IO (ElemRep V 'Real)] -> IO (SEXP V 'Real)
forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO SSEXPTYPE 'Real
forall k (a :: k). SingI a => Sing a
sing ([IO Double] -> IO (SEXP V 'Real))
-> ([Double] -> [IO Double]) -> [Double] -> IO (SEXP V 'Real)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> IO Double) -> [Double] -> [IO Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return
    fromSEXP :: SEXP s 'Real -> [Double]
fromSEXP (SEXP s 'Real -> HExp s 'Real
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Real v :: Vector 'Real Double
v) = Vector 'Real Double -> [Double]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'Real Double
v
    fromSEXP _ =
        String -> String -> [Double]
forall a. String -> String -> a
failure "fromSEXP" "Numeric expected where some other expression appeared."

instance Literal [Complex Double] 'R.Complex where
    mkSEXPIO :: [Complex Double] -> IO (SEXP V 'Complex)
mkSEXPIO = SSEXPTYPE 'Complex
-> [IO (ElemRep V 'Complex)] -> IO (SEXP V 'Complex)
forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO SSEXPTYPE 'Complex
forall k (a :: k). SingI a => Sing a
sing ([IO (Complex Double)] -> IO (SEXP V 'Complex))
-> ([Complex Double] -> [IO (Complex Double)])
-> [Complex Double]
-> IO (SEXP V 'Complex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Complex Double -> IO (Complex Double))
-> [Complex Double] -> [IO (Complex Double)]
forall a b. (a -> b) -> [a] -> [b]
map Complex Double -> IO (Complex Double)
forall (m :: * -> *) a. Monad m => a -> m a
return
    fromSEXP :: SEXP s 'Complex -> [Complex Double]
fromSEXP (SEXP s 'Complex -> HExp s 'Complex
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Complex v :: Vector 'Complex (Complex Double)
v) = Vector 'Complex (Complex Double) -> [Complex Double]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'Complex (Complex Double)
v
    fromSEXP _ =
        String -> String -> [Complex Double]
forall a. String -> String -> a
failure "fromSEXP" "Complex expected where some other expression appeared."

instance Literal [String] 'R.String where
    mkSEXPIO :: [String] -> IO (SEXP V 'String)
mkSEXPIO =
        SSEXPTYPE 'String
-> [IO (ElemRep V 'String)] -> IO (SEXP V 'String)
forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO SSEXPTYPE 'String
forall k (a :: k). SingI a => Sing a
sing ([IO (SEXP V 'Char)] -> IO (SEXP V 'String))
-> ([String] -> [IO (SEXP V 'Char)])
-> [String]
-> IO (SEXP V 'String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (String -> IO (SEXP V 'Char)) -> [String] -> [IO (SEXP V 'Char)]
forall a b. (a -> b) -> [a] -> [b]
map (\str :: String
str -> TextEncoding
-> String -> (CString -> IO (SEXP V 'Char)) -> IO (SEXP V 'Char)
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 :: SEXP s 'String -> [String]
fromSEXP (SEXP s 'String -> HExp s 'String
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> String v :: Vector 'String (SEXP V 'Char)
v) =
        (SEXP V 'Char -> String) -> [SEXP V 'Char] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(SEXP V 'Char -> HExp V 'Char
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Char xs :: Vector 'Char Word8
xs) -> Vector 'Char Word8 -> String
SVector.toString Vector 'Char Word8
xs) (Vector 'String (SEXP V 'Char) -> [SEXP V 'Char]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'String (SEXP V 'Char)
v)
    fromSEXP _ =
        String -> String -> [String]
forall a. String -> String -> a
failure "fromSEXP" "String expected where some other expression appeared."

instance Literal Text 'R.String where
    mkSEXPIO :: Text -> IO (SEXP V 'String)
mkSEXPIO s :: Text
s =
        SSEXPTYPE 'String
-> [IO (ElemRep V 'String)] -> IO (SEXP V 'String)
forall s (a :: SEXPTYPE).
(Storable (ElemRep s a), IsVector a) =>
SSEXPTYPE a -> [IO (ElemRep s a)] -> IO (SEXP s a)
mkSEXPVectorIO SSEXPTYPE 'String
forall k (a :: k). SingI a => Sing a
sing
          [ ByteString
-> (CStringLen -> IO (SEXP V 'Char)) -> IO (SEXP V 'Char)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen (Text -> ByteString
T.encodeUtf8 Text
s) ((CStringLen -> IO (SEXP V 'Char)) -> IO (ElemRep V 'String))
-> (CStringLen -> IO (SEXP V 'Char)) -> IO (ElemRep V 'String)
forall a b. (a -> b) -> a -> b
$
              (CString -> Int -> IO (SEXP V 'Char))
-> CStringLen -> IO (SEXP V 'Char)
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 :: SEXP s 'String -> Text
fromSEXP (SEXP s 'String -> HExp s 'String
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> String v :: Vector 'String (SEXP V 'Char)
v) =
      case Vector 'String (SEXP V 'Char) -> [SEXP V 'Char]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SVector.toList Vector 'String (SEXP V 'Char)
v of 
        [SEXP V 'Char -> HExp V 'Char
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Char x :: Vector 'Char Word8
x] -> Vector 'Char Word8 -> (ByteString -> IO Text) -> Text
forall a.
NFData a =>
Vector 'Char Word8 -> (ByteString -> IO a) -> a
SVector.unsafeWithByteString Vector 'Char Word8
x ((ByteString -> IO Text) -> Text)
-> (ByteString -> IO Text) -> Text
forall a b. (a -> b) -> a -> b
$ \p :: ByteString
p -> do
           Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
p
        _ -> String -> String -> Text
forall a. String -> String -> a
failure "fromSEXP" "Not a singleton vector"
    fromSEXP _ =
      String -> String -> Text
forall a. String -> String -> a
failure "fromSEXP" "String expected where some other expression appeared."

-- | 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.
toPairList :: MonadR m => [(String, SomeSEXP (Region m))] -> m (SomeSEXP (Region m))
toPairList :: [(String, SomeSEXP (Region m))] -> m (SomeSEXP (Region m))
toPairList [] = SomeSEXP (Region m) -> m (SomeSEXP (Region m))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSEXP (Region m) -> m (SomeSEXP (Region m)))
-> SomeSEXP (Region m) -> m (SomeSEXP (Region m))
forall a b. (a -> b) -> a -> b
$ SEXP (Region m) 'Nil -> SomeSEXP (Region m)
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (SEXP G 'Nil -> SEXP (Region m) 'Nil
forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release SEXP G 'Nil
nilValue)
toPairList ((k :: String
k, SomeSEXP v :: SEXP (Region m) a
v):kvs :: [(String, SomeSEXP (Region m))]
kvs) = do
    -- No need to protect the tag because it's in the symbol table, so won't be
    -- garbage collected.
    SEXP V 'Symbol
tag <- IO (SEXP V 'Symbol) -> m (SEXP V 'Symbol)
forall (m :: * -> *) a. MonadR m => IO a -> m a
io (IO (SEXP V 'Symbol) -> m (SEXP V 'Symbol))
-> IO (SEXP V 'Symbol) -> m (SEXP V 'Symbol)
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO (SEXP V 'Symbol)) -> IO (SEXP V 'Symbol)
forall a. String -> (CString -> IO a) -> IO a
withCString String
k CString -> IO (SEXP V 'Symbol)
R.install
    [(String, SomeSEXP (Region m))] -> m (SomeSEXP (Region m))
forall (m :: * -> *).
MonadR m =>
[(String, SomeSEXP (Region m))] -> m (SomeSEXP (Region m))
toPairList [(String, SomeSEXP (Region m))]
kvs m (SomeSEXP (Region m))
-> (SomeSEXP (Region m) -> m (SomeSEXP (Region m)))
-> m (SomeSEXP (Region m))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      SomeSEXP cdr :: SEXP (Region m) a
cdr@(SEXP (Region m) a -> HExp (Region m) a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> HExp (Region m) a
Nil) ->
        (SEXP (Region m) 'List -> SomeSEXP (Region m))
-> m (SEXP (Region m) 'List) -> m (SomeSEXP (Region m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SEXP (Region m) 'List -> SomeSEXP (Region m)
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (m (SEXP (Region m) 'List) -> m (SomeSEXP (Region m)))
-> m (SEXP (Region m) 'List) -> m (SomeSEXP (Region m))
forall a b. (a -> b) -> a -> b
$ HExp (Region m) 'List -> m (SEXP (Region m) 'List)
forall (m :: * -> *) (a :: SEXPTYPE).
MonadR m =>
HExp (Region m) a -> m (SEXP (Region m) a)
unhexp (HExp (Region m) 'List -> m (SEXP (Region m) 'List))
-> HExp (Region m) 'List -> m (SEXP (Region m) 'List)
forall a b. (a -> b) -> a -> b
$ SEXP (Region m) a
-> SEXP (Region m) a
-> SEXP (Region m) 'Symbol
-> HExp (Region m) 'List
forall (b :: SEXPTYPE) (c :: SEXPTYPE) s (a :: SEXPTYPE).
(IsPairList b, c :∈ '[ 'Symbol, 'Nil]) =>
SEXP s a -> SEXP s b -> SEXP s c -> HExp s 'List
List SEXP (Region m) a
v SEXP (Region m) a
cdr (SEXP V 'Symbol -> SEXP (Region m) 'Symbol
forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease SEXP V 'Symbol
tag)
      SomeSEXP cdr :: SEXP (Region m) a
cdr@(SEXP (Region m) a -> HExp (Region m) a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> List _ _ _) ->
        (SEXP (Region m) 'List -> SomeSEXP (Region m))
-> m (SEXP (Region m) 'List) -> m (SomeSEXP (Region m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SEXP (Region m) 'List -> SomeSEXP (Region m)
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (m (SEXP (Region m) 'List) -> m (SomeSEXP (Region m)))
-> m (SEXP (Region m) 'List) -> m (SomeSEXP (Region m))
forall a b. (a -> b) -> a -> b
$ HExp (Region m) 'List -> m (SEXP (Region m) 'List)
forall (m :: * -> *) (a :: SEXPTYPE).
MonadR m =>
HExp (Region m) a -> m (SEXP (Region m) a)
unhexp (HExp (Region m) 'List -> m (SEXP (Region m) 'List))
-> HExp (Region m) 'List -> m (SEXP (Region m) 'List)
forall a b. (a -> b) -> a -> b
$ SEXP (Region m) a
-> SEXP (Region m) a
-> SEXP (Region m) 'Symbol
-> HExp (Region m) 'List
forall (b :: SEXPTYPE) (c :: SEXPTYPE) s (a :: SEXPTYPE).
(IsPairList b, c :∈ '[ 'Symbol, 'Nil]) =>
SEXP s a -> SEXP s b -> SEXP s c -> HExp s 'List
List SEXP (Region m) a
v SEXP (Region m) a
cdr (SEXP V 'Symbol -> SEXP (Region m) 'Symbol
forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease SEXP V 'Symbol
tag)
      _ -> String -> m (SomeSEXP (Region m))
forall a. String -> a
impossible "toPairList"

-- | Create an association list from a pairlist. R Pairlists are nil-terminated
-- chains of nested cons cells, as in LISP.
fromPairList :: SomeSEXP s -> [(String, SomeSEXP s)]
fromPairList :: SomeSEXP s -> [(String, SomeSEXP s)]
fromPairList (SomeSEXP (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> HExp s a
Nil)) = []
fromPairList (SomeSEXP (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> List car :: SEXP s a
car cdr :: SEXP s b
cdr (SEXP s c -> HExp s c
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Symbol (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Char name :: Vector 'Char Word8
name) _ _))) =
    (Vector 'Char Word8 -> String
SVector.toString Vector 'Char Word8
name, SEXP s a -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a
car) (String, SomeSEXP s)
-> [(String, SomeSEXP s)] -> [(String, SomeSEXP s)]
forall a. a -> [a] -> [a]
: SomeSEXP s -> [(String, SomeSEXP s)]
forall s. SomeSEXP s -> [(String, SomeSEXP s)]
fromPairList (SEXP s b -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s b
cdr)
fromPairList (SomeSEXP (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> List _ _ _)) =
    String -> String -> [(String, SomeSEXP s)]
forall a. String -> String -> a
failure "fromPairList" "Association listed expected but tag not set."
fromPairList _ =
    String -> String -> [(String, SomeSEXP s)]
forall a. String -> String -> a
failure "fromPairList" "Pairlist expected where some other expression appeared."

-- Use the default definitions included in the class declaration.
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 x :: String
x = [String] -> IO (SEXP V 'String)
forall a (ty :: SEXPTYPE). Literal a ty => a -> IO (SEXP V ty)
mkSEXPIO [String
x]
    fromSEXP :: SEXP s 'String -> String
fromSEXP x :: SEXP s 'String
x@(SEXP s 'String -> HExp s 'String
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> String {})
      | [h :: String
h] <- SEXP s 'String -> [String]
forall a (ty :: SEXPTYPE) s. Literal a ty => SEXP s ty -> a
fromSEXP SEXP s 'String
x = String
h
      | Bool
otherwise = String -> String -> String
forall a. String -> String -> a
failure "fromSEXP" "Not a singleton vector."
    fromSEXP _ =
        String -> String -> String
forall a. String -> String -> a
failure "fromSEXP" "String expected where some other expression appeared."

instance SVector.SVECTOR ty a => Literal (SVector.Vector ty a) ty where
    mkSEXPIO :: Vector ty a -> IO (SEXP V ty)
mkSEXPIO = SEXP V ty -> IO (SEXP V ty)
forall (m :: * -> *) a. Monad m => a -> m a
return (SEXP V ty -> IO (SEXP V ty))
-> (Vector ty a -> SEXP V ty) -> Vector ty a -> IO (SEXP V ty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ty a -> SEXP V ty
forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
Vector ty a -> SEXP s ty
SVector.toSEXP
    fromSEXP :: SEXP s ty -> Vector ty a
fromSEXP = SEXP s ty -> Vector ty a
forall (ty :: SEXPTYPE) a s.
SVECTOR ty a =>
SEXP s ty -> Vector ty a
SVector.fromSEXP (SEXP s ty -> Vector ty a)
-> (SEXP s ty -> SEXP s ty) -> SEXP s ty -> Vector ty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSEXPTYPE ty -> SomeSEXP s -> SEXP s ty
forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
R.cast (SSEXPTYPE ty
forall k (a :: k). SingI a => Sing a
sing :: SSEXPTYPE ty)
             (SomeSEXP s -> SEXP s ty)
-> (SEXP s ty -> SomeSEXP s) -> SEXP s ty -> SEXP s ty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s ty -> SomeSEXP s
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 = R V (SEXP V ty) -> IO (SEXP V ty)
forall a s. NFData a => R s a -> IO a
unsafeRunRegion (R V (SEXP V ty) -> IO (SEXP V ty))
-> (MVector V ty a -> R V (SEXP V ty))
-> MVector V ty a
-> IO (SEXP V ty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVector V ty a -> R V (SEXP V ty)
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 :: SEXP s ty -> MVector V ty a
fromSEXP = SEXP V ty -> MVector V ty a
forall s (ty :: SEXPTYPE) a.
VECTOR s ty a =>
SEXP s ty -> MVector s ty a
SMVector.fromSEXP (SEXP V ty -> MVector V ty a)
-> (SEXP s ty -> SEXP V ty) -> SEXP s ty -> MVector V ty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSEXPTYPE ty -> SomeSEXP V -> SEXP V ty
forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
R.cast (SSEXPTYPE ty
forall k (a :: k). SingI a => Sing a
sing :: SSEXPTYPE ty)
             (SomeSEXP V -> SEXP V ty)
-> (SEXP s ty -> SomeSEXP V) -> SEXP s ty -> SEXP V ty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP V ty -> SomeSEXP V
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (SEXP V ty -> SomeSEXP V)
-> (SEXP s ty -> SEXP V ty) -> SEXP s ty -> SomeSEXP V
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s ty -> SEXP V ty
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 = (SEXP s a -> SEXP V a) -> IO (SEXP s a) -> IO (SEXP V a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SEXP s a -> SEXP V a
forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease (IO (SEXP s a) -> IO (SEXP V a))
-> (SEXP s a -> IO (SEXP s a)) -> SEXP s a -> IO (SEXP V a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s a -> IO (SEXP s a)
forall (m :: * -> *) a. Monad m => a -> m a
return
    fromSEXP :: SEXP s a -> SEXP s a
fromSEXP = SSEXPTYPE a -> SomeSEXP s -> SEXP s a
forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
R.cast (SSEXPTYPE a
forall k (a :: k). SingI a => Sing a
sing :: SSEXPTYPE a) (SomeSEXP s -> SEXP s a)
-> (SEXP s a -> SomeSEXP s) -> SEXP s a -> SEXP s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s a -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (SEXP s a -> SomeSEXP s)
-> (SEXP s a -> SEXP s a) -> SEXP s a -> SomeSEXP s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s a -> SEXP s a
forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease

instance Literal (SomeSEXP s) 'R.Any where
    -- The ANYSXP type in R plays the same role as SomeSEXP in H. It is a dummy
    -- type tag, that is never seen in any object. It serves only as a stand-in
    -- when the real type is not known.
    mkSEXPIO :: SomeSEXP s -> IO (SEXP V 'Any)
mkSEXPIO (SomeSEXP s :: SEXP s a
s) = SEXP V 'Any -> IO (SEXP V 'Any)
forall (m :: * -> *) a. Monad m => a -> m a
return (SEXP V 'Any -> IO (SEXP V 'Any))
-> (SEXP s 'Any -> SEXP V 'Any) -> SEXP s 'Any -> IO (SEXP V 'Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s 'Any -> SEXP V 'Any
forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
R.unsafeRelease (SEXP s 'Any -> IO (SEXP V 'Any))
-> SEXP s 'Any -> IO (SEXP V 'Any)
forall a b. (a -> b) -> a -> b
$ SEXP s a -> SEXP s 'Any
forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
R.unsafeCoerce SEXP s a
s
    fromSEXP :: SEXP s 'Any -> SomeSEXP s
fromSEXP = SEXP s 'Any -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (SEXP s 'Any -> SomeSEXP s)
-> (SEXP s 'Any -> SEXP s 'Any) -> SEXP s 'Any -> SomeSEXP s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s 'Any -> SEXP s 'Any
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 = (IO SEXP0 -> IO (FunPtr (IO SEXP0)))
-> R s a -> IO (SEXP V 'ExtPtr)
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 :: SEXP s 'ExtPtr -> R s a
fromSEXP = String -> SEXP s 'ExtPtr -> R s a
forall a. String -> a
unimplemented "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 = ((SEXP0 -> IO SEXP0) -> IO (FunPtr (SEXP0 -> IO SEXP0)))
-> (a -> R s b) -> IO (SEXP V 'ExtPtr)
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 :: SEXP s 'ExtPtr -> a -> R s b
fromSEXP = String -> SEXP s 'ExtPtr -> a -> R s b
forall a. String -> a
unimplemented "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   = ((SEXP0 -> SEXP0 -> IO SEXP0)
 -> IO (FunPtr (SEXP0 -> SEXP0 -> IO SEXP0)))
-> (a -> b -> R s c) -> IO (SEXP V 'ExtPtr)
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 :: SEXP s 'ExtPtr -> a -> b -> R s c
fromSEXP = String -> SEXP s 'ExtPtr -> a -> b -> R s c
forall a. String -> a
unimplemented "Literal (a -> b -> IO c) fromSEXP"

-- | A class for functions that can be converted to functions on SEXPs.
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 a :: R s a
a = (SEXP V la -> SEXP0) -> IO (SEXP V la) -> IO SEXP0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SEXP V la -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp (IO (SEXP V la) -> IO SEXP0) -> IO (SEXP V la) -> IO SEXP0
forall a b. (a -> b) -> a -> b
$ (a -> IO (SEXP V la)
forall a (ty :: SEXPTYPE). Literal a ty => a -> IO (SEXP V ty)
mkSEXPIO (a -> IO (SEXP V la)) -> a -> IO (SEXP V la)
forall a b. (a -> b) -> a -> b
$!) (a -> IO (SEXP V la)) -> IO a -> IO (SEXP V la)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< R s a -> IO a
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 f :: a -> b
f a :: SEXP0
a = b -> wb
forall a b. HFunWrap a b => a -> b
hFunWrap (b -> wb) -> b -> wb
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$! SEXP Any la -> a
forall a (ty :: SEXPTYPE) s. Literal a ty => SEXP s ty -> a
fromSEXP (SSEXPTYPE la -> SomeSEXP s -> SEXP s la
forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
R.cast SSEXPTYPE la
forall k (a :: k). SingI a => Sing a
sing (SEXP0 -> SomeSEXP s
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 :: (b -> IO (FunPtr b)) -> a -> IO (SEXP s 'ExtPtr)
funToSEXP w :: b -> IO (FunPtr b)
w x :: a
x = FunPtr b -> IO (SEXP s 'ExtPtr)
forall a s. FunPtr a -> IO (SEXP s 'ExtPtr)
funPtrToSEXP (FunPtr b -> IO (SEXP s 'ExtPtr))
-> IO (FunPtr b) -> IO (SEXP s 'ExtPtr)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO (FunPtr b)
w (a -> b
forall a b. HFunWrap a b => a -> b
hFunWrap a
x)

$(thWrapperLiterals 3 12)