odbc 0.2.6 → 0.3.0
raw patch · 9 files changed
+258/−14 lines, 9 filesnew-uploader
Files
- CHANGELOG +3/−0
- README.md +3/−6
- app/Main.hs +4/−0
- cbits/odbc.c +56/−0
- odbc.cabal +2/−1
- src/Database/ODBC/Conversion.hs +6/−0
- src/Database/ODBC/Internal.hs +124/−6
- src/Database/ODBC/SQLServer.hs +48/−0
- test/Main.hs +12/−1
CHANGELOG view
@@ -1,3 +1,6 @@+0.3.0:+ * Add support for DATETIMEOFFSET+ * Add support for text-2.0 0.2.6: * Add support for SQLSTATE * Fix copying issues for error messages
README.md view
@@ -1,4 +1,4 @@-# odbc [](https://travis-ci.org/fpco/odbc) [](https://ci.appveyor.com/project/chrisdone/odbc-0os0b)+# odbc [](https://github.com/fpco/odbc/actions) [](https://ci.appveyor.com/project/chrisdone/odbc-0os0b) Haskell binding to the ODBC API, with a strong emphasis on stability, testing and simplicity.@@ -7,15 +7,12 @@ The following database drivers are tested against in CI: -* Microsoft SQL Server 2017+* Microsoft SQL Server 2019 The following operating systems are tested against in CI: * Windows [](https://ci.appveyor.com/project/chrisdone/odbc-0os0b)-* Linux [](https://travis-ci.org/fpco/odbc)--I develop and test this library on OS X, but currently do not have a-reliable way to run Microsoft SQL Server on Travis CI.+* Linux [](https://github.com/fpco/odbc/actions) ## How ODBC works
app/Main.hs view
@@ -5,6 +5,9 @@ module Main (main) where +import Data.List+import Data.Time.LocalTime (ZonedTime(..))+import qualified Data.Text as T import qualified Data.Text.IO as T import Control.Exception import qualified Data.Text as T@@ -90,3 +93,4 @@ ODBC.ByteValue b -> show b ODBC.TimeOfDayValue v -> show v ODBC.LocalTimeValue v -> show v+ ODBC.ZonedTimeValue lt tz -> show $ ZonedTime lt tz
cbits/odbc.c view
@@ -347,3 +347,59 @@ SQLUINTEGER TIMESTAMP_STRUCT_fraction(TIMESTAMP_STRUCT *t){ return t->fraction; }++////////////////////////////////////////////////////////////////////////////////+// Definition and accessors for SQL_SS_TIMESTAMPOFFSET_STRUCT+// The strcut definition is from+// https://docs.microsoft.com/en-us/sql/relational-databases/native-client-odbc-date-time/data-type-support-for-odbc-date-and-time-improvements+typedef struct tagTIMESTAMPOFFSET_STRUCT {+ SQLSMALLINT year;+ SQLUSMALLINT month;+ SQLUSMALLINT day;+ SQLUSMALLINT hour;+ SQLUSMALLINT minute;+ SQLUSMALLINT second;+ SQLUINTEGER fraction;+ SQLSMALLINT timezone_hour;+ SQLSMALLINT timezone_minute;+} TIMESTAMPOFFSET_STRUCT;++#if (ODBCVER >= 0x0300)+ typedef TIMESTAMPOFFSET_STRUCT SQL_SS_TIMESTAMPOFFSET_STRUCT;+#endif++SQLSMALLINT TIMESTAMPOFFSET_STRUCT_year(TIMESTAMPOFFSET_STRUCT *t){+ return t->year;+}++SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_month(TIMESTAMPOFFSET_STRUCT *t){+ return t->month;+}++SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_day(TIMESTAMPOFFSET_STRUCT *t){+ return t->day;+}++SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_hour(TIMESTAMPOFFSET_STRUCT *t){+ return t->hour;+}++SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_minute(TIMESTAMPOFFSET_STRUCT *t){+ return t->minute;+}++SQLUSMALLINT TIMESTAMPOFFSET_STRUCT_second(TIMESTAMPOFFSET_STRUCT *t){+ return t->second;+}++SQLUINTEGER TIMESTAMPOFFSET_STRUCT_fraction(TIMESTAMPOFFSET_STRUCT *t){+ return t->fraction;+}++SQLSMALLINT TIMESTAMPOFFSET_STRUCT_timezone_hour(TIMESTAMPOFFSET_STRUCT *t){+ return t->timezone_hour;+}++SQLSMALLINT TIMESTAMPOFFSET_STRUCT_timezone_minute(TIMESTAMPOFFSET_STRUCT *t){+ return t->timezone_minute;+}
odbc.cabal view
@@ -5,7 +5,7 @@ suite runs on OS X, Windows and Linux. copyright: FP Complete 2018 maintainer: chrisdone@fpcomplete.com-version: 0.2.6+version: 0.3.0 license: BSD3 license-file: LICENSE build-type: Simple@@ -56,6 +56,7 @@ odbc, bytestring, text,+ time, optparse-applicative test-suite test
src/Database/ODBC/Conversion.hs view
@@ -116,6 +116,12 @@ LocalTimeValue x -> pure (id x) v -> Left ("Expected LocalTime, but got: " ++ show v)) +instance FromValue ZonedTime where+ fromValue =+ (\case+ ZonedTimeValue lt tz -> pure (ZonedTime lt tz)+ v -> Left ("Expected ZonedTime, but got: " ++ show v))+ -------------------------------------------------------------------------------- -- Producing rows
src/Database/ODBC/Internal.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE CPP #-} -- | ODBC database API. --@@ -62,7 +63,14 @@ 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@@ -141,6 +149,8 @@ -- ^ Time of day (hh, mm, ss + fractional) values. | LocalTimeValue !LocalTime -- ^ Local date and time.+ | ZonedTimeValue !LocalTime !TimeZone+ -- ^ Date and time with time zone. | NullValue -- ^ SQL null value. deriving (Eq, Show, Typeable, Ord, Generic, Data)@@ -161,6 +171,7 @@ DayValue x -> hashWithSalt salt (show x) TimeOfDayValue !x -> hashWithSalt salt (show x) LocalTimeValue x -> hashWithSalt salt (show x)+ ZonedTimeValue x y -> hashWithSalt salt (show (ZonedTime x y)) NullValue -> hashWithSalt salt () -- | A parameter to a query that corresponds to a ?.@@ -396,7 +407,7 @@ (assertSuccessOrNoData dbc "odbc_SQLExecDirectW"- (T.useAsPtr+ (useAsPtrCompat string (\wstring len -> odbc_SQLExecDirectW@@ -446,7 +457,7 @@ 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@@ -585,7 +596,7 @@ -- | 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@@ -616,7 +627,7 @@ digits <- peek digitsp isnull <- peek nullp namelen' <- peek namelenp- name <- T.fromPtr namep (fromIntegral namelen')+ name <- fromPtrCompat namep (fromIntegral namelen') evaluate Column { columnType = typ@@ -773,6 +784,43 @@ (fmap fromIntegral (odbc_TIME_STRUCT_hour datePtr)) <*> (fmap fromIntegral (odbc_TIME_STRUCT_minute datePtr)) <*> (fmap fromIntegral (odbc_TIME_STRUCT_second datePtr))))+ | colType == sql_ss_timestampoffset ->+ withCallocBytes+ 20 -- The TIMESTAMPOFFSET_STRUCT contains 3 SQLSMALLINTs,+ -- 5 SQLUSMALLINTs, and 1 SQLUINTEGER. These correspond to 3 short+ -- ints, 5 unsigned short ints, and 1 unsigned long int. That's+ -- 3 * 2 bytes + 5 * 2 bytes + 1 * 4 bytes = 20 bytes.+ (\datePtr -> do+ mlen <-+ getTypedData+ dbc+ stmt+ sql_c_binary+ i+ (coerce datePtr)+ (SQLLEN 20)+ case mlen of+ Nothing -> pure NullValue+ Just {} ->+ liftM2+ ZonedTimeValue+ (LocalTime <$>+ (fromGregorian <$>+ (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_year datePtr)) <*>+ (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_month datePtr)) <*>+ (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_day datePtr))) <*>+ (TimeOfDay <$>+ (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_hour datePtr)) <*>+ (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_minute datePtr)) <*>+ (liftM2 (+)+ (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_second datePtr))+ (fmap ((/ 1000000000) . fromIntegral) (odbc_TIMESTAMPOFFSET_STRUCT_fraction datePtr)))))+ (TimeZone <$>+ (liftM2 (+)+ (fmap ((* 60) . fromIntegral) (odbc_TIMESTAMPOFFSET_STRUCT_timezone_hour datePtr))+ (fmap fromIntegral (odbc_TIMESTAMPOFFSET_STRUCT_timezone_minute datePtr))) <*>+ pure False <*>+ pure "")) | colType == sql_type_timestamp -> withMallocBytes 16@@ -891,12 +939,13 @@ -- | 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@@ -908,7 +957,7 @@ 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) @@ -1073,6 +1122,9 @@ -- https://docs.microsoft.com/en-us/sql/odbc/reference/appendixes/c-data-types data TIMESTAMP_STRUCT +-- https://docs.microsoft.com/en-us/sql/relational-databases/native-client-odbc-date-time/data-type-support-for-odbc-date-and-time-improvements?view=sql-server-2017+data TIMESTAMPOFFSET_STRUCT+ -------------------------------------------------------------------------------- -- Foreign functions @@ -1180,6 +1232,33 @@ foreign import ccall "odbc TIMESTAMP_STRUCT_fraction" odbc_TIMESTAMP_STRUCT_fraction :: Ptr TIMESTAMP_STRUCT -> IO SQLUINTEGER +foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_year" odbc_TIMESTAMPOFFSET_STRUCT_year+ :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLSMALLINT++foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_month" odbc_TIMESTAMPOFFSET_STRUCT_month+ :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT++foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_day" odbc_TIMESTAMPOFFSET_STRUCT_day+ :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT++foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_hour" odbc_TIMESTAMPOFFSET_STRUCT_hour+ :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT++foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_minute" odbc_TIMESTAMPOFFSET_STRUCT_minute+ :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT++foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_second" odbc_TIMESTAMPOFFSET_STRUCT_second+ :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUSMALLINT++foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_fraction" odbc_TIMESTAMPOFFSET_STRUCT_fraction+ :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLUINTEGER++foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_timezone_hour" odbc_TIMESTAMPOFFSET_STRUCT_timezone_hour+ :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLSMALLINT++foreign import ccall "odbc TIMESTAMPOFFSET_STRUCT_timezone_minute" odbc_TIMESTAMPOFFSET_STRUCT_timezone_minute+ :: Ptr TIMESTAMPOFFSET_STRUCT -> IO SQLSMALLINT+ -------------------------------------------------------------------------------- -- Foreign utils @@ -1255,6 +1334,10 @@ sql_ss_time2 :: SQLSMALLINT sql_ss_time2 = -154 +-- ibid.+sql_ss_timestampoffset :: SQLSMALLINT+sql_ss_timestampoffset = -155+ -- sql_datetime :: SQLSMALLINT -- sql_datetime = 9 @@ -1360,3 +1443,38 @@ -- <https://docs.rs/odbc-sys/0.6.3/odbc_sys/constant.SQL_SS_LENGTH_UNLIMITED.html> 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
src/Database/ODBC/SQLServer.hs view
@@ -35,6 +35,7 @@ , Internal.Binary(..) , Datetime2(..) , Smalldatetime(..)+ , Datetimeoffset(..) -- * Streaming results -- $streaming@@ -271,6 +272,26 @@ { unSmalldatetime :: LocalTime } deriving (Eq, Ord, Show, Typeable, Generic, Data, FromValue) +-- | Use this type to discard the 'timeZoneMinutes' and 'timeZoneName'+-- components of a 'ZonedTime'.+--+-- <https://docs.microsoft.com/en-us/sql/t-sql/data-types/datetimeoffset-transact-sql?view=sql-server-2017>+newtype Datetimeoffset = Datetimeoffset+ { unDatetimeoffset :: ZonedTime+ } deriving (Show, Typeable, Generic, Data, FromValue)++-- | SQL Server considers two datetimeoffset values to be equal as long as they+-- represent the same instant in time; i.e. they are equavalent to the same UTC+-- time and date. This instance reproduces that behaviour.+instance Eq Datetimeoffset where+ Datetimeoffset x == Datetimeoffset y = zonedTimeToUTC x == zonedTimeToUTC y++-- | SQL Server considers datetimeoffset values to be ordered according to their+-- UTC equivalent values. This instance reproduces that behaviour.+instance Ord Datetimeoffset where+ compare (Datetimeoffset x) (Datetimeoffset y) =+ compare (zonedTimeToUTC x) (zonedTimeToUTC y)+ -------------------------------------------------------------------------------- -- Conversion to SQL @@ -394,6 +415,12 @@ shrink (LocalTime dd (TimeOfDay hh mm _ss)) = LocalTime dd (TimeOfDay hh mm 0) +-- | Corresponds to DATETIMEOFFSET type of SQL Server. The+-- 'timeZoneSummerOnly' and 'timeZoneName' components will be lost when+-- serializing to SQL.+instance ToSql Datetimeoffset where+ toSql (Datetimeoffset (ZonedTime lt tzone)) = toSql $ ZonedTimeValue lt tzone+ -------------------------------------------------------------------------------- -- Top-level functions @@ -548,6 +575,19 @@ hh mm (renderFractional ss)+ ZonedTimeValue (LocalTime d (TimeOfDay hh mm ss)) tzone ->+ Formatting.sformat+ ("'" % Formatting.dateDash % " " % Formatting.left 2 '0' % ":" %+ Formatting.left 2 '0' %+ ":" %+ Formatting.string %+ Formatting.string %+ "'")+ d+ hh+ mm+ (renderFractional ss)+ (renderTimeZone tzone) -- | Obviously, this is not fast. But it is correct. A faster version -- can be written later.@@ -558,6 +598,14 @@ reverse (case dropWhile (== '0') (reverse s) of s'@('.':_) -> '0' : s' s' -> s')++renderTimeZone :: TimeZone -> String+renderTimeZone (TimeZone 0 _ _) = "Z"+renderTimeZone (TimeZone t _ _) | t < 0 = '-' : renderTimeZone' (negate t)+renderTimeZone (TimeZone t _ _) = '+' : renderTimeZone' t++renderTimeZone' :: Int -> String+renderTimeZone' t = printf "%02d:%02d" (t `div` 60) (t `mod` 60) -- | A very conservative character escape. escapeChar8 :: Word8 -> Text
test/Main.hs view
@@ -38,7 +38,7 @@ import Database.ODBC.Conversion (FromValue(..)) import Database.ODBC.Internal (Value (..), Connection, ODBCException(..), Step(..), Binary) import qualified Database.ODBC.Internal as Internal-import Database.ODBC.SQLServer (splitQueryParametrized, joinQueryParametrized, Datetime2(..), Smalldatetime(..), ToSql(..))+import Database.ODBC.SQLServer (splitQueryParametrized, joinQueryParametrized, Datetime2(..), Datetimeoffset(..), Smalldatetime(..), ToSql(..)) import qualified Database.ODBC.SQLServer as SQLServer import Database.ODBC.TH (partsParser, Part(..)) import System.Environment@@ -149,6 +149,7 @@ quickCheckRoundtrip @Datetime2 "Datetime2" "datetime2" quickCheckRoundtrip @Smalldatetime "Smalldatetime" "smalldatetime" quickCheckRoundtrip @TestDateTime "TestDateTime" "datetime"+ quickCheckRoundtrip @Datetimeoffset "Datetimeoffset" "datetimeoffset" quickCheckOneway @TimeOfDay "TimeOfDay" "time" quickCheckRoundtrip @TestTimeOfDay "TimeOfDay" "time" quickCheckRoundtrip @Float "Float" "real"@@ -743,3 +744,13 @@ pure (Smalldatetime (LocalTime day (timeToTimeOfDay (secondsToDiffTime (minutes * 60)))))++instance Arbitrary Datetimeoffset where+ arbitrary = do+ lt <- arbitrary+ -- Pick a time zone offset between -12 hours and +14 hours. According to+ -- https://en.wikipedia.org/wiki/List_of_UTC_time_offsets the lowest offset+ -- is -12 hours (at Baker Island and Howland Island), while the highest+ -- offset is +14 hours (at Line Islands).+ offset <- choose (-12 * 60, 14 * 60)+ return $ Datetimeoffset $ ZonedTime lt $ TimeZone offset False ""