Instances or text and bytestrings

ChangeLog.md

@@ -1,3 +1,7 @@
+NEXT_VERSION [..]
+----------------
+* `FromPy`/`ToPy` instances for text and bytestrings data types.
+
 0.1.1.1 [2025.03.10]
 --------------------
 * Crash of python's main thread when one attempts to interrupt it fixed.

inline-python.cabal

@@ -93,6 +93,8 @@ library test
                   , exceptions
                   , containers
                   , vector
+                  , bytestring
+                  , text
   hs-source-dirs:   test
   Exposed-modules:
     TST.Run

src/Python/Inline/Literal.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP                      #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE MagicHash                #-}
 {-# LANGUAGE QuasiQuotes              #-}
 {-# LANGUAGE TemplateHaskell          #-}
 -- |
@@ -13,15 +14,23 @@ module Python.Inline.Literal
   , fromPy'
   ) where
 
+import Control.Exception           (evaluate)
 import Control.Monad
 import Control.Monad.Catch
 import Control.Monad.Trans.Cont
 import Data.Bits
 import Data.Char
 import Data.Int
 import Data.Word
+import Data.ByteString             qualified as BS
+import Data.ByteString.Unsafe      qualified as BS
+import Data.ByteString.Short       qualified as SBS
+import Data.ByteString.Lazy        qualified as BL
 import Data.Set                    qualified as Set
 import Data.Map.Strict             qualified as Map
+import Data.Text                   qualified as T
+import Data.Text.Encoding          qualified as T
+import Data.Text.Lazy              qualified as TL
 import Data.Vector.Generic         qualified as VG
 import Data.Vector.Generic.Mutable qualified as MVG
 import Data.Vector                 qualified as V
@@ -34,6 +43,8 @@ import Data.Vector.Unboxed         qualified as VU
 import Foreign.Ptr
 import Foreign.C.Types
 import Foreign.Storable
+import Foreign.Marshal.Alloc     (alloca,mallocBytes)
+import Foreign.Marshal.Utils     (copyBytes)
 import GHC.Float                 (float2Double, double2Float)
 
 import Language.C.Inline         qualified as C
@@ -483,7 +494,7 @@ instance FromPy a => FromPy (VV.Vector a) where
 #endif
 
 
--- | Fold over iterable. Function takes ownership over iterator.
+-- | Fold over python's iterator. Function takes ownership over iterator.
 foldPyIterable
   :: Ptr PyObject                -- ^ Python iterator (not checked)
   -> (a -> Ptr PyObject -> Py a) -- ^ Step function. It takes borrowed pointer.
@@ -530,6 +541,107 @@ vectorToPy vec = runProgram $ do
     n   = VG.length vec
     n_c = fromIntegral n :: CLLong
 
+
+-- | @since NEXT_VERSION@. Converted to @bytes@
+instance ToPy BS.ByteString where
+  basicToPy bs = pyIO $ BS.unsafeUseAsCStringLen bs $ \(ptr,len) -> do
+    let c_len = fromIntegral len :: CLLong
+    py <- [CU.exp| PyObject* { PyBytes_FromStringAndSize($(char* ptr), $(long long c_len)) }|]
+    case py of
+      NULL -> unsafeRunPy mustThrowPyError
+      _    -> return py
+
+-- | @since NEXT_VERSION@. Accepts @bytes@ and @bytearray@
+instance FromPy BS.ByteString where
+  basicFromPy py = pyIO $ do
+    [CU.exp| int { PyBytes_Check($(PyObject* py)) } |] >>= \case
+      TRUE -> do
+        sz  <- [CU.exp| int64_t { PyBytes_GET_SIZE( $(PyObject* py)) } |]
+        buf <- [CU.exp| char*   { PyBytes_AS_STRING($(PyObject* py)) } |]
+        fini buf (fromIntegral sz)
+      _ -> [CU.exp| int { PyByteArray_Check($(PyObject* py)) } |] >>= \case
+        TRUE -> do
+          sz  <- [CU.exp| int64_t { PyByteArray_GET_SIZE( $(PyObject* py)) } |]
+          buf <- [CU.exp| char*   { PyByteArray_AS_STRING($(PyObject* py)) } |]
+          fini buf (fromIntegral sz)
+        _ -> throwM BadPyType
+    where
+      fini py_buf sz = do
+        hs_buf <- mallocBytes sz
+        copyBytes hs_buf py_buf sz
+        BS.unsafePackMallocCStringLen (hs_buf, sz)
+
+-- | @since NEXT_VERSION@. Converted to @bytes@
+instance ToPy BL.ByteString where
+  basicToPy = basicToPy . BL.toStrict
+
+-- | @since NEXT_VERSION@. Accepts @bytes@ and @bytearray@
+instance FromPy BL.ByteString where
+  basicFromPy = fmap BL.fromStrict . basicFromPy
+
+
+-- | @since NEXT_VERSION@. Accepts @bytes@ and @bytearray@
+instance FromPy SBS.ShortByteString where
+  basicFromPy py = pyIO $ do
+    [CU.exp| int { PyBytes_Check($(PyObject* py)) } |] >>= \case
+      TRUE -> do
+        sz  <- [CU.exp| int64_t { PyBytes_GET_SIZE( $(PyObject* py)) } |]
+        buf <- [CU.exp| char*   { PyBytes_AS_STRING($(PyObject* py)) } |]
+        fini buf (fromIntegral sz)
+      _ -> [CU.exp| int { PyByteArray_Check($(PyObject* py)) } |] >>= \case
+        TRUE -> do
+          sz  <- [CU.exp| int64_t { PyByteArray_GET_SIZE( $(PyObject* py)) } |]
+          buf <- [CU.exp| char*   { PyByteArray_AS_STRING($(PyObject* py)) } |]
+          fini buf (fromIntegral sz)
+        _ -> throwM BadPyType
+    where
+      fini buf sz = do
+        bs <- BS.unsafePackCStringLen (buf, sz)
+        evaluate $ SBS.toShort bs
+
+-- | @since NEXT_VERSION@. Converted to @bytes@
+instance ToPy SBS.ShortByteString where
+  basicToPy bs = pyIO $ SBS.useAsCStringLen bs $ \(ptr,len) -> do
+    let c_len = fromIntegral len :: CLLong
+    py <- [CU.exp| PyObject* { PyBytes_FromStringAndSize($(char* ptr), $(long long c_len)) }|]
+    case py of
+      NULL -> unsafeRunPy mustThrowPyError
+      _    -> return py
+
+
+-- | @since NEXT_VERSION@.
+instance ToPy T.Text where
+  -- NOTE: Is there ore efficient way to access
+  basicToPy str = pyIO $ BS.unsafeUseAsCStringLen bs $ \(ptr,len) -> do
+    let c_len = fromIntegral len :: CLLong
+    py <- [CU.exp| PyObject* { PyUnicode_FromStringAndSize($(char* ptr), $(long long c_len)) } |]
+    case py of
+      NULL -> unsafeRunPy mustThrowPyError
+      _    -> pure py
+    where
+      bs = T.encodeUtf8 str
+
+-- | @since NEXT_VERSION@.
+instance ToPy TL.Text where
+  basicToPy = basicToPy . TL.toStrict
+
+-- | @since NEXT_VERSION@.
+instance FromPy T.Text where
+  basicFromPy py = pyIO $ do
+    [CU.exp| int { PyUnicode_Check($(PyObject* py)) } |] >>= \case
+      TRUE -> alloca $ \p_size -> do
+        buf <- [CU.exp| const char* { PyUnicode_AsUTF8AndSize($(PyObject* py), $(long* p_size)) } |]
+        sz  <- peek p_size
+        bs  <- BS.unsafePackCStringLen (buf, fromIntegral sz)
+        return $! T.decodeUtf8Lenient bs
+      _ -> throwM BadPyType
+
+-- | @since NEXT_VERSION@.
+instance FromPy TL.Text where
+  basicFromPy = fmap TL.fromStrict . basicFromPy
+
+
+
 ----------------------------------------------------------------
 -- Functions marshalling
 ----------------------------------------------------------------

src/Python/Internal/Types.hs

@@ -23,6 +23,8 @@ module Python.Internal.Types
   , pattern IPY_ERR_COMPILE
   , pattern IPY_ERR_PYTHON
   , pattern NULL
+  , pattern FALSE
+  , pattern TRUE
   ) where
 
 import Control.Monad.IO.Class
@@ -148,3 +150,9 @@ pattern IPY_ERR_COMPILE = 2
 pattern NULL :: Ptr a
 pattern NULL <- ((== nullPtr) -> True) where
   NULL = nullPtr
+
+pattern FALSE :: CInt
+pattern FALSE = 0
+
+pattern TRUE :: CInt
+pattern TRUE <- ((/= 0) -> True)

test/TST/FromPy.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings   #-}
 -- |
 module TST.FromPy (tests) where
 
+import Data.ByteString qualified as BS
 import Control.Monad.IO.Class
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -31,6 +33,12 @@ tests = testGroup "FromPy"
     [ testCase "asdf" $ eq @String (Just "asdf") [pye| "asdf" |]
     , testCase "фыва" $ eq @String (Just "фыва") [pye| "фыва" |]
     ]
+  , testGroup "ByteString"
+    [ testCase "empty" $ eq @BS.ByteString (Just "") [pye| b'' |]
+    , testCase "x00"   $ eq @BS.ByteString (Just $ BS.pack [0]) [pye| b'\x00' |]
+    , testCase "empty arr" $ eq @BS.ByteString (Just "") [pye| bytearray(b'') |]
+    , testCase "x00 arr"   $ eq @BS.ByteString (Just $ BS.pack [0]) [pye| bytearray(b'\x00') |]
+    ]
   , testGroup "Bool"
     [ testCase "True->Bool"  $ eq @Bool (Just True)  [pye| True  |]
     , testCase "False->Bool" $ eq @Bool (Just False) [pye| False |]

test/TST/Roundtrip.hs

@@ -8,17 +8,24 @@
 import Data.Typeable
 import Data.Set        (Set)
 import Data.Map.Strict (Map)
+import Data.Text       qualified as T
+import Data.Text.Lazy  qualified as TL
 import Foreign.C.Types
 
 import Test.Tasty
 import Test.Tasty.QuickCheck
 import Test.QuickCheck.Instances.Vector ()
+import Test.QuickCheck.Instances.ByteString ()
+import Test.QuickCheck.Instances.Text ()
 import Python.Inline
 import Python.Inline.QQ
 
+import Data.ByteString             qualified as BS
+import Data.ByteString.Lazy        qualified as BL
+import Data.ByteString.Short       qualified as SBS
 import Data.Vector                 qualified as V
 #if MIN_VERSION_vector(0,13,2)
 import Data.Vector.Strict          qualified as VV
 #endif
 import Data.Vector.Storable        qualified as VS
 import Data.Vector.Primitive       qualified as VP
@@ -74,6 +81,11 @@
 #if MIN_VERSION_vector(0,13,2)
 --    , testRoundtrip @(VV.Vector Int)
 #endif
+    , testRoundtrip @BS.ByteString
+    , testRoundtrip @BL.ByteString
+    , testRoundtrip @SBS.ShortByteString
+    , testRoundtrip @T.Text
+    , testRoundtrip @TL.Text
     ]
   , testGroup "OutOfRange"
     [ testOutOfRange @Int8   @Int16

test/TST/ToPy.hs

@@ -1,8 +1,10 @@
+{-# LANGUAGE OverloadedStrings #-}
 -- |
 module TST.ToPy (tests) where
 
-import Data.Set qualified as Set
-import Data.Map.Strict qualified as Map
+import Data.ByteString      qualified as BS
+import Data.Set             qualified as Set
+import Data.Map.Strict      qualified as Map
 import Test.Tasty
 import Test.Tasty.HUnit
 import Python.Inline
@@ -16,8 +18,13 @@ tests = testGroup "ToPy"
   , testCase "Double"         $ runPy $ let i = 1234.25 :: Double in [py_| assert i_hs == 1234.25 |]
   , testCase "Char ASCII"     $ runPy $ let c = 'a'    in [py_| assert c_hs == 'a' |]
   , testCase "Char unicode"   $ runPy $ let c = 'ы'    in [py_| assert c_hs == 'ы' |]
-  , testCase "String ASCII"   $ runPy $ let c = "asdf" in [py_| assert c_hs == 'asdf' |]
-  , testCase "String unicode" $ runPy $ let c = "фыва" in [py_| assert c_hs == 'фыва' |]
+  , testCase "String ASCII"   $ runPy $ let c = "asdf"::String in [py_| assert c_hs == 'asdf' |]
+  , testCase "String unicode" $ runPy $ let c = "фыва"::String in [py_| assert c_hs == 'фыва' |]
+    -- Byte objects
+  , testCase "empty ByteString" $ runPy $
+      let bs = BS.empty in [py_| assert bs_hs == b'' |]
+  , testCase "0 ByteString" $ runPy $
+      let bs = BS.pack [0] in [py_| assert bs_hs == b'\x00' |]
     -- Container types
   , testCase "Tuple2" $ runPy $
       let x = (1::Int, 333::Int)