From cf169fae167dfeb6ce0afc4b953be981a6f3803d Mon Sep 17 00:00:00 2001 From: Brandon Simmons Date: Wed, 3 May 2023 12:32:37 -0400 Subject: [PATCH 1/4] text v2/v1 compat. Closes https://github.com/fpco/odbc/issues/55 --- src/Database/ODBC/Internal.hs | 56 +++++++++++++++++++++++++++++++---- 1 file changed, 50 insertions(+), 6 deletions(-) diff --git a/src/Database/ODBC/Internal.hs b/src/Database/ODBC/Internal.hs index 5c6f357..1609d14 100644 --- a/src/Database/ODBC/Internal.hs +++ b/src/Database/ODBC/Internal.hs @@ -11,6 +11,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CPP #-} -- | ODBC database API. -- @@ -62,7 +63,14 @@ import Data.Int import Data.String import Data.Text (Text) import qualified Data.Text as T +#if MIN_VERSION_text(2,0,0) +import qualified Data.ByteString.Internal as SI +import qualified Data.Text.Encoding.Error as T +import qualified Data.Text.Encoding as T +#else import qualified Data.Text.Foreign as T +import Data.Text.Foreign (I16) +#endif import Data.Time import Foreign hiding (void) import Foreign.C @@ -399,7 +407,7 @@ withExecDirect dbc string params cont = (assertSuccessOrNoData dbc "odbc_SQLExecDirectW" - (T.useAsPtr + (useAsPtrCompat string (\wstring len -> odbc_SQLExecDirectW @@ -449,7 +457,7 @@ withBindParameter dbc parameter_number param cont statement_handle = go param go = \case TextParam text -> - T.useAsPtr -- Pass as wide char UTF-16. + useAsPtrCompat -- Pass as wide char UTF-16. text (\ptr len_in_chars -> runBind @@ -588,7 +596,7 @@ fetchStatementRows dbc stmt = do -- | Describe the given column by its integer index. describeColumn :: Ptr EnvAndDbc -> SQLHSTMT s -> Int16 -> IO Column describeColumn dbPtr stmt i = - T.useAsPtr + useAsPtrCompat (T.replicate 1000 (fromString "0")) (\namep namelen -> (withMalloc @@ -619,7 +627,7 @@ describeColumn dbPtr stmt i = digits <- peek digitsp isnull <- peek nullp namelen' <- peek namelenp - name <- T.fromPtr namep (fromIntegral namelen') + name <- fromPtrCompat namep (fromIntegral namelen') evaluate Column { columnType = typ @@ -931,12 +939,13 @@ getBinaryData dbc stmt column = do -- | Get the column's data as a text string. getTextData :: Ptr EnvAndDbc -> SQLHSTMT s -> SQLUSMALLINT -> IO Value getTextData dbc stmt column = do + -- We need to fetch as UTF-16LE (see callsite), then convert to Text mavailableChars <- getSize dbc stmt sql_c_wchar column case mavailableChars of Just 0 -> pure (TextValue mempty) Nothing -> pure NullValue Just availableBytes -> do - let allocBytes = availableBytes + 2 + let allocBytes = availableBytes + 2 -- room for NULL withMallocBytes (fromIntegral allocBytes) (\bufferp -> do @@ -948,7 +957,7 @@ getTextData dbc stmt column = do column (coerce bufferp) (SQLLEN (fromIntegral allocBytes))) - t <- T.fromPtr bufferp (fromIntegral (div availableBytes 2)) + t <- fromPtrCompat bufferp (fromIntegral (div availableBytes 2)) let !v = TextValue t pure v) @@ -1434,3 +1443,38 @@ sql_c_time = coerce sql_time -- sql_ss_length_unlimited :: SQLULEN sql_ss_length_unlimited = 0 + + +#if MIN_VERSION_text(2,0,0) +type I16 = Int +#endif + +-- FIXME fail with Randomized with seed 1862667972 +-- (on 9.2 as well) + +-------- 'T.fromPtr' but compatible with text v1 and v2 + +fromPtrCompat :: Ptr Word16 -> I16 -> IO Text +#if MIN_VERSION_text(2,0,0) +fromPtrCompat bufferp len16 = do + let lenBytes = len16 * 2 + noFinalizer = return () -- N.B. inner bufferp is 'free'd after this withMallocBytes block + -- invariant: this does no additional allocation + tempBS <- S.unsafePackCStringFinalizer (castPtr bufferp) lenBytes noFinalizer + -- invariant: this makes a copy: + return $! T.decodeUtf16LEWith T.strictDecode tempBS +#else +fromPtrCompat = T.fromPtr +#endif + +useAsPtrCompat :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a +#if MIN_VERSION_text(2,0,0) +useAsPtrCompat t cont16 = do + let (fp8, len8) = SI.toForeignPtr0 $ T.encodeUtf16LE t + fp16 = castForeignPtr fp8 + len16 = len8 `div` 2 + withForeignPtr fp16 $ \p16 -> + cont16 p16 (fromIntegral len16) +#else +useAsPtrCompat = T.useAsPtr +#endif From 662268ba4d968a23e67dfd13b1ec9d4d90481493 Mon Sep 17 00:00:00 2001 From: Brandon Simmons Date: Wed, 3 May 2023 15:01:36 -0400 Subject: [PATCH 2/4] version bump to: 0.2.7 --- odbc.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/odbc.cabal b/odbc.cabal index 3e05d82..f8ad94f 100644 --- a/odbc.cabal +++ b/odbc.cabal @@ -5,7 +5,7 @@ description: Haskell binding to the ODBC API. This has been tested suite runs on OS X, Windows and Linux. copyright: FP Complete 2018 maintainer: chrisdone@fpcomplete.com -version: 0.2.6 +version: 0.2.7 license: BSD3 license-file: LICENSE build-type: Simple From 2a42f5628f40e6b2bc2284363331ec4d01ca5703 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Mon, 4 Mar 2024 13:04:25 -0600 Subject: [PATCH 3/4] CHANGELOG for text 2.0 changes --- CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG b/CHANGELOG index 6e6efe1..ecf6609 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,6 @@ 0.2.7: * Add support for DATETIMEOFFSET + * Add support for text-2.0 0.2.6: * Add support for SQLSTATE * Fix copying issues for error messages From 99ce87081bb093ba62b01a29d98a70f07aecb86d Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Mon, 4 Mar 2024 13:05:14 -0600 Subject: [PATCH 4/4] Bump to 0.3.0 for new ZonedTimeValue constructor --- CHANGELOG | 2 +- odbc.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index ecf6609..972d97d 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,4 +1,4 @@ -0.2.7: +0.3.0: * Add support for DATETIMEOFFSET * Add support for text-2.0 0.2.6: diff --git a/odbc.cabal b/odbc.cabal index f8ad94f..54287ad 100644 --- a/odbc.cabal +++ b/odbc.cabal @@ -5,7 +5,7 @@ description: Haskell binding to the ODBC API. This has been tested suite runs on OS X, Windows and Linux. copyright: FP Complete 2018 maintainer: chrisdone@fpcomplete.com -version: 0.2.7 +version: 0.3.0 license: BSD3 license-file: LICENSE build-type: Simple