-- |
-- 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 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."

-- |  Create a SEXP value and protect it in current region
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)

-- | 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 :: 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)

-- | 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 :: 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"

-- | 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 :: 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
    -- No need to protect the tag because it's in the symbol table, so won't be
    -- garbage collected.
    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)

-- | 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 :: 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."

-- 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 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
    -- 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 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"

-- | 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 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)