{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoCUSKs #-}
{-# LANGUAGE NoNamedWildCards #-}
{-# LANGUAGE NoStarIsType #-}

-- | Model of R vector 'SEXPTYPE' s with related utilities.
module Variable.R.SEXP where

import Data.Aeson (ToJSON (..))
import Data.Complex (Complex)
import Data.Int (Int32)
import Data.Singletons
import Data.Singletons.TH
import Data.Text (Text, pack)
import Data.Time.Calendar (Day)
import Data.Vector (Vector)
import qualified Data.Vector as V
import qualified Data.Vector.Algorithms.Merge as VA
import GHC.Float
import GHC.ST (runST)
import Type.Reflection (Typeable, typeRep)
import Variable.Constraints

-- Auto-generation of all the basic types and classes from Data.Singletons.
-- Most language extensions of this model are to support this. See
-- https://github.com/goldfirere/singletons/blob/master/README.md
$(singletons [d|data SEXPTYPE = LGLSXP | INTSXP | REALSXP | CPLSXP | STRSXP | VECSXP|])

deriving instance Show SEXPTYPE

deriving instance Eq SEXPTYPE

{- TYPES -}

-- | The "element" type of an 'RTypeRep'. See 'RTypeRep' for more.
type family SEXPElem (s :: SEXPTYPE) = h | h -> s where
  SEXPElem 'LGLSXP = Bool
  SEXPElem 'INTSXP = Int32
  SEXPElem 'REALSXP = Double
  -- NOTE Complex does not implement ToJSON and therefore cannot be wrapped in
  -- SomeRTypeRep. Its usage for our purposes is questionable.
  SEXPElem 'CPLSXP = Complex Double
  SEXPElem 'STRSXP = Text
  SEXPElem 'VECSXP = (Text, SomeRTypeRep)

-- | 'RTypeRep s' is a Haskell representation of 's', an 'SEXPTYPE', in R.
-- 'Nothing' elements represent `NA` values.
--
-- R SEXP vector types do not distinguish between vectors and their elements,
-- but Haskell does. 'SEXPElem' provides a one-to-one correspondence between
-- 'Vector (Maybe a)' and the supported 'SEXPTYPE' s in R by providing a map
-- between the 'a' and its corresponding Haskell type. 'SEXPElem s' for some
-- 'SEXPTYPE' 's' is chosen such that the conversion from a Haskell value of
-- type 'RTypeRep s' and the R type 's' is as seamless as possible.
--
-- Each 'SEXPElem s' is wrapped in 'Maybe' within an 'RTypeRep s' to allow for
-- typed `NA` values in R. For example, 'Nothing' in an @RTypeRep 'LGLSXP@
-- corresponds to `NA_logical_`.
--
-- A Haskell programmer can work with 'RTypeRep s' types directly, with little
-- to no overhead relative to working with any other 'Data.Vector.Vector (Maybe
-- a)'. Some additional utilities to facilitate conversions are provided as
-- part of the 'AsRTypeRep' class with various aliases, e.g.  'AsLogical'. See
-- the examples.
--
-- To work with 'RTypeRep' directly you will need at a minimum the `DataKinds`
-- extension, and in many cases also the `TypeFamilies` and `FlexibleContexts`
-- extensions.
--
-- ==== __Examples__
--
-- The following mimics R's `mean` function behavior, with an `na.rm` argument
-- removing `NA` values. It is generic over types that can be converted to
-- @RTypeRep 'REALSXP@. The auxiliary function `mean` returns 'NaN :: Double'
-- on an empty vector.
--
-- >>> :set -XOverloadedStrings -XDataKinds -XFlexibleContexts
-- >>> import Variable
-- >>> import qualified Data.Vector as V
-- >>> import GHC.Float (int2Double)
-- >>> :{
-- >>> mean :: V.Vector Double -> Double
-- >>> mean v = V.sum v / int2Double (V.length v)
-- >>>
-- >>> rMean :: (AsNumeric a) => Bool -> a -> RTypeRep 'REALSXP
-- >>> rMean narm = summarizeWith (op narm) . as_numeric
-- >>>   where op True = Just . mean . V.catMaybes
-- >>>         op False = fmap mean . V.sequence
-- >>> :}
-- >>> rMean False (as_integer [True, True]) == V.singleton (Just 1)
-- True
-- >>> rMean False (as_integer [1, 2]) == V.singleton (Just 1.5)
-- True
-- >>> rMean True (as_integer [Just 1, Just 2, Nothing]) == V.singleton (Just 1.5)
-- True
-- >>> rMean False (as_integer [Just 1, Just 2, Nothing]) == V.singleton Nothing
-- True
--
-- ==== __R list representation__
--
-- @RTypeRep 'VECSXP@ is worth a few comments, as it presents the greatest
-- challenge for matching to Haskell's type system:
--
-- * R's list type can be named or unnamed, with the latter case meaning that
-- `names(xs)` is `NULL`. @RTypeRep 'VECSXP@ is a vector of key-value pairs,
-- and therefore each element has a name. Unnamed lists are represented by
-- @RTypeRep 'VECSXP@ with names matching the index of the list.
-- * R lists are inhomogeneous, unlike the atomic vectors. That is captured in
-- the existential type 'SomeRTypeRep', providing the value of each key-value
-- pair within a @RTypeRep 'VECSXP@. Type information about the @RTypeRep s@
-- stored in 'SomeRTypeRep' can be recovered using tools from the `singletons`
-- package. See the "Advanced usage" section.
-- * 'Nothing' elements within @RTypeRep 'VECSXP@ have no equivalent in R and
-- hence probably should not be used.
--
-- ==== __Some caveats__
--
-- * At present, all conversions will pass through JSON, via types
-- in the `aeson` package, and to R via the `jsonlite` package. Therefore, the
-- conversion from 'RTypeRep' to its R counterpart depends on those interim
-- conversions, and in particular on the conversion from numeric types
-- ('INTSXP', 'REALSXP' etc.) to 'Scientific', from the `scientific` package in
-- Haskell.
-- * It is unclear how close the Haskell 'Double' corresponds to an element of
-- R's `numeric` or 'REALSXP' vector. Documentation for both
-- [Haskell](https://hackage.haskell.org/package/base-4.18.0.0/docs/Prelude.html#t:Double)
-- and R state the types conform to the IEEE double-precision standard, in other words the [binary64
-- format](https://en.wikipedia.org/wiki/Double-precision_floating-point_format).
-- and which has precision of 16 decimal digits, with maximum values of `2e308`.
-- Haskell's documentation is less clear on that point and leaves open the
-- possibility of greater precision.
--
-- ==== __Advanced usage__
--
-- Users can take advantage of the tools from the `singletons` package to
-- extract do type-level programming with 'RTypeRep', including recovering the
-- type erased within 'SomeRTypeRep'. See 'sexpTypeOfErased' and 'as_list' for
-- an example.
type RTypeRep (s :: SEXPTYPE) = Vector (Maybe (SEXPElem s))

-- | Constraints for 'SomeRTypeRep'.
type RTypeRepConstraints (s :: SEXPTYPE) = (SingI s, Typeable s, VariableConstraints (SEXPElem s))

-- | Existential type used within inhomogeneous lists of R vectors, in
-- @RTypeRep 'VECSXP@.
data SomeRTypeRep
  = forall s. (RTypeRepConstraints s) => SomeRTypeRep (RTypeRep s)

instance Show SomeRTypeRep where
  show :: SomeRTypeRep -> String
show (SomeRTypeRep Vector (Maybe (SEXPElem s))
x) = forall a. Show a => a -> String
show Vector (Maybe (SEXPElem s))
x

instance ToJSON SomeRTypeRep where
  toJSON :: SomeRTypeRep -> Value
toJSON (SomeRTypeRep Vector (Maybe (SEXPElem s))
x) = forall a. ToJSON a => a -> Value
toJSON Vector (Maybe (SEXPElem s))
x

{- CONVERSIONS -}

-- NOTE trying to clean this up with constraints like a ~ SEXPElem s leads to
-- overlapping instances in many cases, for reasons that aren't entirely clear
-- to me but are related to the fact that you can't provide a typeclass
-- instance for a type function SEXPElem s directly.  A possible solution to
-- help clean up this section, particularly for the VECSXP conversions, is to
-- write an internal wrapper just for the purpose of defining such instances,
-- with the `as_*` helpers would unwrap. See how that is done in
-- Data.Singletons. --bbrown

-- | Convert Haskell types to 'RTypeRep s'. It is up to the user to define
-- conversions in a manner consistent with R's behavior. 'Nothing' elements of
-- an 'RTypeRep s' correspond to the `NA` value in R, where appropriate.
--
-- Note: It never makes sense to produce a 'Nothing' element within an
-- @RTypeRep 'VECSXP@.
class AsRTypeRep s a where
  as_rtyperep :: a -> RTypeRep s

type AsLogical = AsRTypeRep 'LGLSXP

type AsInteger = AsRTypeRep 'INTSXP

type AsNumeric = AsRTypeRep 'REALSXP

type AsComplex = AsRTypeRep 'CPLSXP

type AsCharacter = AsRTypeRep 'STRSXP

type AsList = AsRTypeRep 'VECSXP

-- Singleton instances
instance AsRTypeRep 'LGLSXP Bool where
  as_rtyperep :: Bool -> RTypeRep 'LGLSXP
as_rtyperep = forall a. a -> Vector a
V.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

instance AsRTypeRep 'LGLSXP (Maybe Bool) where
  as_rtyperep :: Maybe Bool -> RTypeRep 'LGLSXP
as_rtyperep = forall a. a -> Vector a
V.singleton

instance AsRTypeRep 'INTSXP Int32 where
  as_rtyperep :: Int32 -> RTypeRep 'INTSXP
as_rtyperep = forall a. a -> Vector a
V.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

instance AsRTypeRep 'INTSXP (Maybe Int32) where
  as_rtyperep :: Maybe Int32 -> RTypeRep 'INTSXP
as_rtyperep = forall a. a -> Vector a
V.singleton

instance AsRTypeRep 'REALSXP Double where
  as_rtyperep :: Double -> RTypeRep 'REALSXP
as_rtyperep = forall a. a -> Vector a
V.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

instance AsRTypeRep 'REALSXP (Maybe Double) where
  as_rtyperep :: Maybe Double -> RTypeRep 'REALSXP
as_rtyperep = forall a. a -> Vector a
V.singleton

instance AsRTypeRep 'CPLSXP (Complex Double) where
  as_rtyperep :: Complex Double -> RTypeRep 'CPLSXP
as_rtyperep = forall a. a -> Vector a
V.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

instance AsRTypeRep 'CPLSXP (Maybe (Complex Double)) where
  as_rtyperep :: Maybe (Complex Double) -> RTypeRep 'CPLSXP
as_rtyperep = forall a. a -> Vector a
V.singleton

instance AsRTypeRep 'STRSXP Text where
  as_rtyperep :: Text -> RTypeRep 'STRSXP
as_rtyperep = forall a. a -> Vector a
V.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

instance AsRTypeRep 'STRSXP (Maybe Text) where
  as_rtyperep :: Maybe Text -> RTypeRep 'STRSXP
as_rtyperep = forall a. a -> Vector a
V.singleton

instance AsRTypeRep 'STRSXP String where
  as_rtyperep :: String -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

instance AsRTypeRep 'STRSXP (Maybe String) where
  as_rtyperep :: Maybe String -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP Int32 where
  as_rtyperep :: Int32 -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance AsRTypeRep 'STRSXP (Maybe Int32) where
  as_rtyperep :: Maybe Int32 -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP Bool where
  as_rtyperep :: Bool -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance AsRTypeRep 'STRSXP (Maybe Bool) where
  as_rtyperep :: Maybe Bool -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP Double where
  as_rtyperep :: Double -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance AsRTypeRep 'STRSXP (Maybe Double) where
  as_rtyperep :: Maybe Double -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP Int where
  as_rtyperep :: Int -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance AsRTypeRep 'STRSXP (Maybe Int) where
  as_rtyperep :: Maybe Int -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP Integer where
  as_rtyperep :: Integer -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance AsRTypeRep 'STRSXP (Maybe Integer) where
  as_rtyperep :: Maybe Integer -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP Day where
  as_rtyperep :: Day -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance AsRTypeRep 'STRSXP (Maybe Day) where
  as_rtyperep :: Maybe Day -> RTypeRep 'STRSXP
as_rtyperep = forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

-- Identity-ish instances
instance AsRTypeRep 'LGLSXP (Vector Bool) where
  as_rtyperep :: Vector Bool -> RTypeRep 'LGLSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. a -> Maybe a
Just

instance AsRTypeRep 'LGLSXP [Bool] where
  as_rtyperep :: [Bool] -> RTypeRep 'LGLSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'LGLSXP (Vector (Maybe Bool)) where
  as_rtyperep :: Vector (Maybe Bool) -> RTypeRep 'LGLSXP
as_rtyperep = forall a. a -> a
id

instance AsRTypeRep 'LGLSXP [Maybe Bool] where
  as_rtyperep :: [Maybe Bool] -> RTypeRep 'LGLSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'INTSXP (Vector Int32) where
  as_rtyperep :: Vector Int32 -> RTypeRep 'INTSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. a -> Maybe a
Just

instance AsRTypeRep 'INTSXP [Int32] where
  as_rtyperep :: [Int32] -> RTypeRep 'INTSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'INTSXP (Vector (Maybe Int32)) where
  as_rtyperep :: Vector (Maybe Int32) -> RTypeRep 'INTSXP
as_rtyperep = forall a. a -> a
id

instance AsRTypeRep 'INTSXP [Maybe Int32] where
  as_rtyperep :: [Maybe Int32] -> RTypeRep 'INTSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'INTSXP (Vector Bool) where
  as_rtyperep :: Vector Bool -> RTypeRep 'INTSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Bool
b -> if Bool
b then Int32
1 else Int32
0))

instance AsRTypeRep 'INTSXP [Bool] where
  as_rtyperep :: [Bool] -> RTypeRep 'INTSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'INTSXP (Vector (Maybe Bool)) where
  as_rtyperep :: Vector (Maybe Bool) -> RTypeRep 'INTSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
b -> if Bool
b then Int32
1 else Int32
0))

instance AsRTypeRep 'INTSXP [Maybe Bool] where
  as_rtyperep :: [Maybe Bool] -> RTypeRep 'INTSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'REALSXP (Vector Double) where
  as_rtyperep :: Vector Double -> RTypeRep 'REALSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. a -> Maybe a
Just

instance AsRTypeRep 'REALSXP [Double] where
  as_rtyperep :: [Double] -> RTypeRep 'REALSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'REALSXP (Vector (Maybe Double)) where
  as_rtyperep :: Vector (Maybe Double) -> RTypeRep 'REALSXP
as_rtyperep = forall a. a -> a
id

instance AsRTypeRep 'REALSXP [Maybe Double] where
  as_rtyperep :: [Maybe Double] -> RTypeRep 'REALSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'REALSXP (Vector (Maybe Int32)) where
  as_rtyperep :: Vector (Maybe Int32) -> RTypeRep 'REALSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Double
int2Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum))

instance AsRTypeRep 'REALSXP (Vector Int32) where
  as_rtyperep :: Vector Int32 -> RTypeRep 'REALSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Double
int2Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum))

instance AsRTypeRep 'REALSXP (Vector (Maybe Int)) where
  as_rtyperep :: Vector (Maybe Int) -> RTypeRep 'REALSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
int2Double)

instance AsRTypeRep 'REALSXP (Vector Int) where
  as_rtyperep :: Vector Int -> RTypeRep 'REALSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
int2Double)

instance AsRTypeRep 'REALSXP (Vector (Maybe Bool)) where
  as_rtyperep :: Vector (Maybe Bool) -> RTypeRep 'REALSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Double
int2Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum))

instance AsRTypeRep 'REALSXP (Vector Bool) where
  as_rtyperep :: Vector Bool -> RTypeRep 'REALSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Double
int2Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum))

instance AsRTypeRep 'CPLSXP (Vector (Complex Double)) where
  as_rtyperep :: Vector (Complex Double) -> RTypeRep 'CPLSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. a -> Maybe a
Just

instance AsRTypeRep 'CPLSXP [Complex Double] where
  as_rtyperep :: [Complex Double] -> RTypeRep 'CPLSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'CPLSXP (Vector (Maybe (Complex Double))) where
  as_rtyperep :: Vector (Maybe (Complex Double)) -> RTypeRep 'CPLSXP
as_rtyperep = forall a. a -> a
id

instance AsRTypeRep 'CPLSXP [Maybe (Complex Double)] where
  as_rtyperep :: [Maybe (Complex Double)] -> RTypeRep 'CPLSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP (Vector Text) where
  as_rtyperep :: Vector Text -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. a -> Maybe a
Just

instance AsRTypeRep 'STRSXP [Text] where
  as_rtyperep :: [Text] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP (Vector (Maybe Text)) where
  as_rtyperep :: Vector (Maybe Text) -> RTypeRep 'STRSXP
as_rtyperep = forall a. a -> a
id

instance AsRTypeRep 'STRSXP [Maybe Text] where
  as_rtyperep :: [Maybe Text] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP (Vector String) where
  as_rtyperep :: Vector String -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack)

instance AsRTypeRep 'STRSXP [String] where
  as_rtyperep :: [String] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP (Vector (Maybe String)) where
  as_rtyperep :: Vector (Maybe String) -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
pack)

instance AsRTypeRep 'STRSXP [Maybe String] where
  as_rtyperep :: [Maybe String] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

-- Conversions
instance AsRTypeRep 'STRSXP (Vector Int32) where
  as_rtyperep :: Vector Int32 -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

instance AsRTypeRep 'STRSXP (Vector (Maybe Int32)) where
  as_rtyperep :: Vector (Maybe Int32) -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP [Int32] where
  as_rtyperep :: [Int32] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP [Maybe Int32] where
  as_rtyperep :: [Maybe Int32] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP (Vector Bool) where
  as_rtyperep :: Vector Bool -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

instance AsRTypeRep 'STRSXP (Vector (Maybe Bool)) where
  as_rtyperep :: Vector (Maybe Bool) -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP [Bool] where
  as_rtyperep :: [Bool] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP [Maybe Bool] where
  as_rtyperep :: [Maybe Bool] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP (Vector Double) where
  as_rtyperep :: Vector Double -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

instance AsRTypeRep 'STRSXP (Vector (Maybe Double)) where
  as_rtyperep :: Vector (Maybe Double) -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP [Double] where
  as_rtyperep :: [Double] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP [Maybe Double] where
  as_rtyperep :: [Maybe Double] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP (Vector Int) where
  as_rtyperep :: Vector Int -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

instance AsRTypeRep 'STRSXP (Vector (Maybe Int)) where
  as_rtyperep :: Vector (Maybe Int) -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP [Int] where
  as_rtyperep :: [Int] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP [Maybe Int] where
  as_rtyperep :: [Maybe Int] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP (Vector Integer) where
  as_rtyperep :: Vector Integer -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

instance AsRTypeRep 'STRSXP (Vector (Maybe Integer)) where
  as_rtyperep :: Vector (Maybe Integer) -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP [Integer] where
  as_rtyperep :: [Integer] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP [Maybe Integer] where
  as_rtyperep :: [Maybe Integer] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP (Vector Day) where
  as_rtyperep :: Vector Day -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

instance AsRTypeRep 'STRSXP (Vector (Maybe Day)) where
  as_rtyperep :: Vector (Maybe Day) -> RTypeRep 'STRSXP
as_rtyperep = forall a b. (a -> b) -> Vector a -> Vector b
V.map (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance AsRTypeRep 'STRSXP [Day] where
  as_rtyperep :: [Day] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'STRSXP [Maybe Day] where
  as_rtyperep :: [Maybe Day] -> RTypeRep 'STRSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

-- | 'as_list' utility, allowing to match the s in RTypeRep s with that of
-- @Sing s.@ Pattern matching on @Sing s@ is needed here to allow this to be
-- identity in the case of @RTypeRep 'VECSXP@. Otherwise, the type checker
-- cannot infer that @s@ in the input @RTypeRep s@ indeed matches @'VECSXP@.
as_listA :: (RTypeRepConstraints s) => Sing s -> RTypeRep s -> RTypeRep 'VECSXP
as_listA :: forall (s :: SEXPTYPE).
RTypeRepConstraints s =>
Sing s -> RTypeRep s -> RTypeRep 'VECSXP
as_listA Sing s
sxp RTypeRep s
rv = case Sing s
sxp of
  Sing s
SSEXPTYPE s
SVECSXP -> RTypeRep s
rv
  Sing s
_ -> forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Int
ix, Maybe (SEXPElem s)
v) -> forall a. a -> Maybe a
Just (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
ix, forall (s :: SEXPTYPE).
RTypeRepConstraints s =>
RTypeRep s -> SomeRTypeRep
SomeRTypeRep forall a b. (a -> b) -> a -> b
$ forall a. a -> Vector a
V.singleton Maybe (SEXPElem s)
v)) (forall a. Vector a -> Vector (Int, a)
V.indexed RTypeRep s
rv)

-- Singleton list instance
-- To create an inhomogeneous list of RTypeRep, do it manally: first convert
-- each to Maybe (Text, SomeRTypeRep).
instance (RTypeRepConstraints s, a ~ SEXPElem s) => AsRTypeRep 'VECSXP (Vector (Maybe a)) where
  as_rtyperep :: Vector (Maybe a) -> RTypeRep 'VECSXP
as_rtyperep = forall (s :: SEXPTYPE).
RTypeRepConstraints s =>
Sing s -> RTypeRep s -> RTypeRep 'VECSXP
as_listA (forall {k} (a :: k). SingI a => Sing a
sing @s)

instance (RTypeRepConstraints s, a ~ SEXPElem s) => AsRTypeRep 'VECSXP [a] where
  as_rtyperep :: [a] -> RTypeRep 'VECSXP
as_rtyperep = forall (s :: SEXPTYPE).
RTypeRepConstraints s =>
Sing s -> RTypeRep s -> RTypeRep 'VECSXP
as_listA (forall {k} (a :: k). SingI a => Sing a
sing @s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

-- NOTE: Example of overlapping instance (error appears when invoked).
-- Guess is that the type checker cannot determine that a ~ SEXPElem s is never
-- (a ~ SEXPElem s) => Maybe a.
-- instance (RTypeRepConstraints s, a ~ SEXPElem s) => AsRTypeRep 'VECSXP (Vector a) where
--  as_rtyperep = as_listA (sing @s) . V.map Just

-- Conversions with loss
instance AsRTypeRep 'INTSXP Integer where
  as_rtyperep :: Integer -> RTypeRep 'INTSXP
as_rtyperep Integer
i
    | Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
mm Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
mn = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep (forall a. Num a => Integer -> a
fromInteger Integer
i :: Int32)
    | Bool
otherwise = forall a. a -> Vector a
V.singleton forall a. Maybe a
Nothing
    where
      mm :: Integer
mm = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int32)
      mn :: Integer
mn = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: Int32)

instance AsRTypeRep 'INTSXP (Maybe Integer) where
  as_rtyperep :: Maybe Integer -> RTypeRep 'INTSXP
as_rtyperep = \case
    Maybe Integer
Nothing -> forall a. a -> Vector a
V.singleton forall a. Maybe a
Nothing
    Just Integer
ii -> forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep Integer
ii

instance AsRTypeRep 'INTSXP (Vector Integer) where
  as_rtyperep :: Vector Integer -> RTypeRep 'INTSXP
as_rtyperep = forall a b. (a -> Vector b) -> Vector a -> Vector b
V.concatMap forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep

instance AsRTypeRep 'INTSXP [Integer] where
  as_rtyperep :: [Integer] -> RTypeRep 'INTSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

instance AsRTypeRep 'INTSXP (Vector (Maybe Integer)) where
  as_rtyperep :: Vector (Maybe Integer) -> RTypeRep 'INTSXP
as_rtyperep = forall a b. (a -> Vector b) -> Vector a -> Vector b
V.concatMap forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep

instance AsRTypeRep 'INTSXP [Maybe Integer] where
  as_rtyperep :: [Maybe Integer] -> RTypeRep 'INTSXP
as_rtyperep = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList

-- | Analogous to R's @as.logical@.
as_logical :: (AsLogical a) => a -> RTypeRep 'LGLSXP
as_logical :: forall a. AsLogical a => a -> RTypeRep 'LGLSXP
as_logical = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep

-- | Analogous to R's @as.integer@.
as_integer :: (AsInteger a) => a -> RTypeRep 'INTSXP
as_integer :: forall a. AsInteger a => a -> RTypeRep 'INTSXP
as_integer = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep

-- | Analogous to R's @as.numeric@.
as_numeric :: (AsNumeric a) => a -> RTypeRep 'REALSXP
as_numeric :: forall a. AsNumeric a => a -> RTypeRep 'REALSXP
as_numeric = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep

-- | Analogous to R's @as.character@. Includes versions to directly construct
-- character vectors from lists or vector containing Show elements.
as_character :: (AsCharacter a) => a -> RTypeRep 'STRSXP
as_character :: forall a. AsCharacter a => a -> RTypeRep 'STRSXP
as_character = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep

-- | @as_list v@ is analogous to R's @as.list(v)@ for 'v' of the supported
-- @RTypeRep s@. Note R's @...@ syntax is not supported here. The constraints
-- provided are those of 'SomeRTypeRep'.
as_list :: (AsList v) => v -> RTypeRep 'VECSXP
as_list :: forall v. AsList v => v -> RTypeRep 'VECSXP
as_list = forall (s :: SEXPTYPE) a. AsRTypeRep s a => a -> RTypeRep s
as_rtyperep

{- UTILITIES -}

-- | Run a routine with 'SomeRTypeRep', whose 'RTypeRep s' type you cannot
-- inspect.
withSomeRTypeRep :: SomeRTypeRep -> (forall s. (RTypeRepConstraints s) => RTypeRep s -> t) -> t
withSomeRTypeRep :: forall t.
SomeRTypeRep
-> (forall (s :: SEXPTYPE).
    RTypeRepConstraints s =>
    RTypeRep s -> t)
-> t
withSomeRTypeRep (SomeRTypeRep RTypeRep s
sexp) forall (s :: SEXPTYPE). RTypeRepConstraints s => RTypeRep s -> t
f = forall (s :: SEXPTYPE). RTypeRepConstraints s => RTypeRep s -> t
f RTypeRep s
sexp

-- | R has no element-of-vector type, only vector types. This utiltity takes
-- Haskell functions that summarize an R vector, and wrap the output in the
-- appropriate RTypeRep, as a singleton, mimicing what R would do and (I hope)
-- lowering the overhead.
summarizeWith :: (RTypeRep s -> Maybe (SEXPElem s')) -> RTypeRep s -> RTypeRep s'
summarizeWith :: forall (s :: SEXPTYPE) (s' :: SEXPTYPE).
(RTypeRep s -> Maybe (SEXPElem s')) -> RTypeRep s -> RTypeRep s'
summarizeWith RTypeRep s -> Maybe (SEXPElem s')
f = forall a. a -> Vector a
V.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTypeRep s -> Maybe (SEXPElem s')
f

-- | Sort a 'RTypeRep' using 'Data.Vector.Algorithms.MergeSort.sort'.
sort :: (Ord (SEXPElem s)) => RTypeRep s -> RTypeRep s
sort :: forall (s :: SEXPTYPE).
Ord (SEXPElem s) =>
RTypeRep s -> RTypeRep s
sort = forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
V.modify forall (m :: Type -> Type) (v :: Type -> Type -> Type) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m ()
VA.sort

-- | Sort a 'Vector' and return unique elements using
-- 'Data.Vector.Algorithms.MergeSort.sortUniq'.
sortUniq :: (Ord a) => Vector a -> Vector a
sortUniq :: forall a. Ord a => Vector a -> Vector a
sortUniq Vector a
v = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MVector s a
mv <- forall (m :: Type -> Type) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw Vector a
v
  MVector s a
mv' <- forall (m :: Type -> Type) (v :: Type -> Type -> Type) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m (v (PrimState m) e)
VA.sortUniq MVector s a
mv
  forall (m :: Type -> Type) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector s a
mv'

-- | Return the 'Sing s' associated with a value of 'RTypeRep s'.
singOfRTypeRep :: forall r. (SingI r) => RTypeRep r -> Sing r
singOfRTypeRep :: forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Sing r
singOfRTypeRep RTypeRep r
_ = forall {k} (a :: k). SingI a => Sing a
sing @r

-- | Return the 'SEXPTYPE' of an 'RTypeRep (s :: SEXPTYPE)'.
--
-- >>> sexpTypeOf (V.fromList [True]) == LGLSXP
-- >>> sexpTypeOf (V.fromList [1 :: Double]) == REALSXP
sexpTypeOf :: forall (r :: SEXPTYPE). (SingI r) => RTypeRep r -> SEXPTYPE
sexpTypeOf :: forall (r :: SEXPTYPE). SingI r => RTypeRep r -> SEXPTYPE
sexpTypeOf RTypeRep r
_ = forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). SingI a => Sing a
sing @r

sexpTypeOfElem :: forall (r :: SEXPTYPE). (SingI r) => SEXPElem r -> SEXPTYPE
sexpTypeOfElem :: forall (r :: SEXPTYPE). SingI r => SEXPElem r -> SEXPTYPE
sexpTypeOfElem SEXPElem r
_ = forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). SingI a => Sing a
sing @r

-- | Recover the 'Sing r' from 'SomeRTypeRep', which recovers the type
-- information lost in the existential type.
sexpTypeOfErased :: SomeRTypeRep -> SEXPTYPE
sexpTypeOfErased :: SomeRTypeRep -> SEXPTYPE
sexpTypeOfErased = (forall t.
SomeRTypeRep
-> (forall (s :: SEXPTYPE).
    RTypeRepConstraints s =>
    RTypeRep s -> t)
-> t
`withSomeRTypeRep` forall (r :: SEXPTYPE). SingI r => RTypeRep r -> SEXPTYPE
sexpTypeOf)

-- | Show the 'SEXPElem r' type of the given 'RTypeRep r'.
showSEXPElemOf :: forall r. (Typeable (SEXPElem r)) => RTypeRep r -> String
showSEXPElemOf :: forall (r :: SEXPTYPE).
Typeable (SEXPElem r) =>
RTypeRep r -> String
showSEXPElemOf RTypeRep r
_ = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(SEXPElem r)

-- | 'showSEXPElemOf' converted to 'Text'.
textSEXPElemOf :: forall r. (Typeable (SEXPElem r)) => RTypeRep r -> Text
textSEXPElemOf :: forall (r :: SEXPTYPE). Typeable (SEXPElem r) => RTypeRep r -> Text
textSEXPElemOf = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: SEXPTYPE).
Typeable (SEXPElem r) =>
RTypeRep r -> String
showSEXPElemOf

-- | Show the 'r :: SEXPTYPE' of the given 'RTypeRep r'.
showSEXPTYPEOf :: forall (r :: SEXPTYPE). (SingI r) => RTypeRep r -> String
showSEXPTYPEOf :: forall (r :: SEXPTYPE). SingI r => RTypeRep r -> String
showSEXPTYPEOf = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: SEXPTYPE). SingI r => RTypeRep r -> SEXPTYPE
sexpTypeOf

-- | 'showSEXPTYPEOf' converted to 'Text'.
textSEXPTYPEOf :: forall r. (SingI r) => RTypeRep r -> Text
textSEXPTYPEOf :: forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Text
textSEXPTYPEOf = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: SEXPTYPE). SingI r => RTypeRep r -> String
showSEXPTYPEOf

textSEXPTYPEOfElem :: forall r. (SingI r) => SEXPElem r -> Text
textSEXPTYPEOfElem :: forall (r :: SEXPTYPE). SingI r => SEXPElem r -> Text
textSEXPTYPEOfElem = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: SEXPTYPE). SingI r => SEXPElem r -> SEXPTYPE
sexpTypeOfElem

-- | Show the 'SEXPTYPE' of an underlying 'SomeRTypeRep'.
showSEXPTYPEOfErased :: SomeRTypeRep -> String
showSEXPTYPEOfErased :: SomeRTypeRep -> String
showSEXPTYPEOfErased SomeRTypeRep
v = forall t.
SomeRTypeRep
-> (forall (s :: SEXPTYPE).
    RTypeRepConstraints s =>
    RTypeRep s -> t)
-> t
withSomeRTypeRep SomeRTypeRep
v forall (r :: SEXPTYPE). SingI r => RTypeRep r -> String
showSEXPTYPEOf

-- | Show the 'SEXPTYPE' of an underlying 'SomeRTypeRep', as 'Text'.
textSEXPTYPEOfErased :: SomeRTypeRep -> Text
textSEXPTYPEOfErased :: SomeRTypeRep -> Text
textSEXPTYPEOfErased SomeRTypeRep
v = forall t.
SomeRTypeRep
-> (forall (s :: SEXPTYPE).
    RTypeRepConstraints s =>
    RTypeRep s -> t)
-> t
withSomeRTypeRep SomeRTypeRep
v forall (r :: SEXPTYPE). SingI r => RTypeRep r -> Text
textSEXPTYPEOf