Add Literal instance for Text.

We add a simple instance for text that goes via String representation.

Author: qnikst

inline-r/src/Language/R/Literal.hs

@@ -57,6 +57,8 @@ import Control.DeepSeq ( NFData )
 import Control.Monad ( void, zipWithM_ )
 import Data.Int (Int32)
 import Data.Complex (Complex)
+import Data.Text (Text)
+import qualified Data.Text as T
 import Foreign ( FunPtr, castPtr )
 import Foreign.C.String ( withCString )
 import Foreign.Storable ( Storable, pokeElemOff )
@@ -171,6 +173,17 @@ instance Literal [String] 'R.String where
  fromSEXP _ =
  failure "fromSEXP" "String expected where some other expression appeared."
 
+instance Literal Text 'R.String where
+ mkSEXPIO s =
+ mkSEXPVectorIO sing
+ [GHC.withCString utf8 (T.unpack s) (R.mkCharCE R.CE_UTF8)]
+ fromSEXP (hexp -> String v) =
+ case map (\(hexp -> Char xs) -> SVector.toString xs) (SVector.toList v) of
+ [x] -> T.pack x
+ _ -> failure "fromSEXP" "Not a singleton vector"
+ fromSEXP _ =
+ 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.

inline-r/tests/test-qq.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Main where
 
@@ -17,6 +18,7 @@ import H.Prelude as H
 import qualified Data.Vector.SEXP as SVector
 import qualified Data.Vector.SEXP.Mutable as SMVector
 import Control.Memory.Region
+import Data.Text (Text)
 
 import Control.Applicative
 import Control.Monad.Trans (liftIO)
@@ -108,9 +110,11 @@ main = H.withEmbeddedR H.defaultConfig $ H.runRegion $ do
  ("c(7, 2, 3)" @=?) =<< [r| v = v2_hs; v[1] <- 7; v |]
  io . assertEqual "" "fromList [1,2,3]" . Prelude.show =<< SVector.unsafeFreeze v1
 
- let utf8string = "abcd çéõßø"
+ let utf8string = "abcd çéõßø" :: String
  io . assertEqual "" utf8string =<< fromSEXP <$> R.cast (sing :: R.SSEXPTYPE 'R.String) <$> [r| utf8string_hs |]
 
+ let utf8string1 = "abcd çéõßø" :: Text
+ io . assertEqual "" utf8string1 =<< fromSEXP <$> R.cast (sing :: R.SSEXPTYPE 'R.String) <$> [r| utf8string1_hs |]
 
  -- Disable gctorture, otherwise test takes too long to execute.
  _ <- [r| gctorture2(0) |]