From b9efd7c56a2f367f465fc39a6ee82d2f77cfe740 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Sat, 12 Apr 2025 19:28:02 +0300 Subject: [PATCH 1/6] Add patterns for TRUE-FALSE --- src/Python/Internal/Types.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Python/Internal/Types.hs b/src/Python/Internal/Types.hs index f62ee70..3e615fe 100644 --- a/src/Python/Internal/Types.hs +++ b/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) From 61bf556c0e281a40c126266a85c8183c3f6d6e4a Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Sat, 12 Apr 2025 20:04:15 +0300 Subject: [PATCH 2/6] Add {From,To} instances for bytestrings --- inline-python.cabal | 1 + src/Python/Inline/Literal.hs | 44 ++++++++++++++++++++++++++++++++++++ test/TST/FromPy.hs | 8 +++++++ test/TST/Roundtrip.hs | 5 ++++ test/TST/ToPy.hs | 15 ++++++++---- 5 files changed, 69 insertions(+), 4 deletions(-) diff --git a/inline-python.cabal b/inline-python.cabal index 2a4de70..b54b5bb 100644 --- a/inline-python.cabal +++ b/inline-python.cabal @@ -93,6 +93,7 @@ library test , exceptions , containers , vector + , bytestring hs-source-dirs: test Exposed-modules: TST.Run diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs index 959dd1b..a6282a1 100644 --- a/src/Python/Inline/Literal.hs +++ b/src/Python/Inline/Literal.hs @@ -20,6 +20,9 @@ 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.Lazy qualified as BL import Data.Set qualified as Set import Data.Map.Strict qualified as Map import Data.Vector.Generic qualified as VG @@ -34,6 +37,8 @@ import Data.Vector.Unboxed qualified as VU import Foreign.Ptr import Foreign.C.Types import Foreign.Storable +import Foreign.Marshal.Alloc (mallocBytes) +import Foreign.Marshal.Utils (copyBytes) import GHC.Float (float2Double, double2Float) import Language.C.Inline qualified as C @@ -530,6 +535,45 @@ vectorToPy vec = runProgram $ do n = VG.length vec n_c = fromIntegral n :: CLLong + +-- | @since 0.1.2@. 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 0.1.2@. 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 0.1.2@. Converted to @bytes@ +instance ToPy BL.ByteString where + basicToPy = basicToPy . BL.toStrict + +-- | @since 0.1.2@. Accepts @bytes@ and @bytearray@ +instance FromPy BL.ByteString where + basicFromPy = fmap BL.fromStrict . basicFromPy + + ---------------------------------------------------------------- -- Functions marshalling ---------------------------------------------------------------- diff --git a/test/TST/FromPy.hs b/test/TST/FromPy.hs index 5f3279b..6e39005 100644 --- a/test/TST/FromPy.hs +++ b/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 |] diff --git a/test/TST/Roundtrip.hs b/test/TST/Roundtrip.hs index 0b2f4f8..a2f7113 100644 --- a/test/TST/Roundtrip.hs +++ b/test/TST/Roundtrip.hs @@ -13,9 +13,12 @@ import Foreign.C.Types import Test.Tasty import Test.Tasty.QuickCheck import Test.QuickCheck.Instances.Vector () +import Test.QuickCheck.Instances.ByteString () import Python.Inline import Python.Inline.QQ +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as BL import Data.Vector qualified as V #if MIN_VERSION_vector(0,13,2) import Data.Vector.Strict qualified as VV @@ -74,6 +77,8 @@ tests = testGroup "Roundtrip" #if MIN_VERSION_vector(0,13,2) -- , testRoundtrip @(VV.Vector Int) #endif + , testRoundtrip @BS.ByteString + -- , testRoundtrip @BL.ByteString ] , testGroup "OutOfRange" [ testOutOfRange @Int8 @Int16 diff --git a/test/TST/ToPy.hs b/test/TST/ToPy.hs index 12b48d1..7cd5611 100644 --- a/test/TST/ToPy.hs +++ b/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) From 544ce5e7291c66c771e1e207d3f349fec7ec71dd Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Sat, 12 Apr 2025 20:07:05 +0300 Subject: [PATCH 3/6] Improve haddock --- src/Python/Inline/Literal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs index a6282a1..87142d2 100644 --- a/src/Python/Inline/Literal.hs +++ b/src/Python/Inline/Literal.hs @@ -488,7 +488,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. From 835738e5797dd044a83925960c751949f70ad174 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Sat, 12 Apr 2025 21:41:18 +0300 Subject: [PATCH 4/6] Add {From,To}Py instance for Text --- inline-python.cabal | 1 + src/Python/Inline/Literal.hs | 36 +++++++++++++++++++++++++++++++++++- test/TST/Roundtrip.hs | 7 ++++++- 3 files changed, 42 insertions(+), 2 deletions(-) diff --git a/inline-python.cabal b/inline-python.cabal index b54b5bb..e6c0db2 100644 --- a/inline-python.cabal +++ b/inline-python.cabal @@ -94,6 +94,7 @@ library test , containers , vector , bytestring + , text hs-source-dirs: test Exposed-modules: TST.Run diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs index 87142d2..0da93fc 100644 --- a/src/Python/Inline/Literal.hs +++ b/src/Python/Inline/Literal.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} -- | @@ -25,6 +26,9 @@ import Data.ByteString.Unsafe qualified as BS 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 @@ -37,7 +41,7 @@ import Data.Vector.Unboxed qualified as VU import Foreign.Ptr import Foreign.C.Types import Foreign.Storable -import Foreign.Marshal.Alloc (mallocBytes) +import Foreign.Marshal.Alloc (alloca,mallocBytes) import Foreign.Marshal.Utils (copyBytes) import GHC.Float (float2Double, double2Float) @@ -574,6 +578,36 @@ instance FromPy BL.ByteString where basicFromPy = fmap BL.fromStrict . basicFromPy +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 + +instance ToPy TL.Text where + basicToPy = basicToPy . TL.toStrict + + +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 + +instance FromPy TL.Text where + basicFromPy = fmap TL.fromStrict . basicFromPy + + + ---------------------------------------------------------------- -- Functions marshalling ---------------------------------------------------------------- diff --git a/test/TST/Roundtrip.hs b/test/TST/Roundtrip.hs index a2f7113..06c7e7a 100644 --- a/test/TST/Roundtrip.hs +++ b/test/TST/Roundtrip.hs @@ -8,12 +8,15 @@ import Data.Word 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 @@ -78,7 +81,9 @@ tests = testGroup "Roundtrip" -- , testRoundtrip @(VV.Vector Int) #endif , testRoundtrip @BS.ByteString - -- , testRoundtrip @BL.ByteString + , testRoundtrip @BL.ByteString + , testRoundtrip @T.Text + , testRoundtrip @TL.Text ] , testGroup "OutOfRange" [ testOutOfRange @Int8 @Int16 From a6922ec097fc15ffb661f88d82740bb6367eedd8 Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 15 Apr 2025 15:50:29 +0300 Subject: [PATCH 5/6] Add @since annotations everywhere --- ChangeLog.md | 4 ++++ src/Python/Inline/Literal.hs | 14 ++++++++------ 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index e310142..b23d0c2 100644 --- a/ChangeLog.md +++ b/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. diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs index 0da93fc..13a7bc9 100644 --- a/src/Python/Inline/Literal.hs +++ b/src/Python/Inline/Literal.hs @@ -540,7 +540,7 @@ vectorToPy vec = runProgram $ do n_c = fromIntegral n :: CLLong --- | @since 0.1.2@. Converted to @bytes@ +-- | @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 @@ -549,7 +549,7 @@ instance ToPy BS.ByteString where NULL -> unsafeRunPy mustThrowPyError _ -> return py --- | @since 0.1.2@. Accepts @bytes@ and @bytearray@ +-- | @since NEXT_VERSION@. Accepts @bytes@ and @bytearray@ instance FromPy BS.ByteString where basicFromPy py = pyIO $ do [CU.exp| int { PyBytes_Check($(PyObject* py)) } |] >>= \case @@ -569,15 +569,15 @@ instance FromPy BS.ByteString where copyBytes hs_buf py_buf sz BS.unsafePackMallocCStringLen (hs_buf, sz) --- | @since 0.1.2@. Converted to @bytes@ +-- | @since NEXT_VERSION@. Converted to @bytes@ instance ToPy BL.ByteString where basicToPy = basicToPy . BL.toStrict --- | @since 0.1.2@. Accepts @bytes@ and @bytearray@ +-- | @since NEXT_VERSION@. Accepts @bytes@ and @bytearray@ instance FromPy BL.ByteString where basicFromPy = fmap BL.fromStrict . basicFromPy - +-- | @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 @@ -589,10 +589,11 @@ instance ToPy T.Text where 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 @@ -603,6 +604,7 @@ instance FromPy T.Text where return $! T.decodeUtf8Lenient bs _ -> throwM BadPyType +-- | @since NEXT_VERSION@. instance FromPy TL.Text where basicFromPy = fmap TL.fromStrict . basicFromPy From 7dc38eda5e509e8adc0d5e95607fe1d0d026fd5f Mon Sep 17 00:00:00 2001 From: Alexey Khudyakov Date: Tue, 15 Apr 2025 16:02:56 +0300 Subject: [PATCH 6/6] Add instances for ShortByteString --- src/Python/Inline/Literal.hs | 32 ++++++++++++++++++++++++++++++++ test/TST/Roundtrip.hs | 2 ++ 2 files changed, 34 insertions(+) diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs index 13a7bc9..28fbbf5 100644 --- a/src/Python/Inline/Literal.hs +++ b/src/Python/Inline/Literal.hs @@ -14,6 +14,7 @@ module Python.Inline.Literal , fromPy' ) where +import Control.Exception (evaluate) import Control.Monad import Control.Monad.Catch import Control.Monad.Trans.Cont @@ -23,6 +24,7 @@ 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 @@ -577,6 +579,36 @@ instance ToPy BL.ByteString where 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 diff --git a/test/TST/Roundtrip.hs b/test/TST/Roundtrip.hs index 06c7e7a..232c4e7 100644 --- a/test/TST/Roundtrip.hs +++ b/test/TST/Roundtrip.hs @@ -22,6 +22,7 @@ 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 @@ -82,6 +83,7 @@ tests = testGroup "Roundtrip" #endif , testRoundtrip @BS.ByteString , testRoundtrip @BL.ByteString + , testRoundtrip @SBS.ShortByteString , testRoundtrip @T.Text , testRoundtrip @TL.Text ]