Merge pull request #48 from spencerjanssen/update-datetimeoffset

datetimeoffset support

CHANGELOG

@@ -1,3 +1,5 @@
+0.2.7:
+	* Add support for DATETIMEOFFSET
 0.2.6:
 	* Add support for SQLSTATE
 	* Fix copying issues for error messages

app/Main.hs

@@ -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 @@ output (_printedHeaders, count) rowWithHeaders = do
         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

@@ -347,3 +347,59 @@ SQLUSMALLINT TIMESTAMP_STRUCT_second(TIMESTAMP_STRUCT *t){
 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

@@ -56,6 +56,7 @@ executable odbc
     odbc,
     bytestring,
     text,
+    time,
     optparse-applicative
 
 test-suite test

src/Database/ODBC/Conversion.hs

@@ -116,6 +116,12 @@ instance FromValue LocalTime where
        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

@@ -141,6 +141,8 @@ data Value
     -- ^ 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 +163,7 @@ instance Hashable Value where
       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 ?.
@@ -773,6 +776,43 @@ getData dbc stmt i col = fmap (col, ) $
                    (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
@@ -1073,6 +1113,9 @@ data TIME_STRUCT
 -- 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 +1223,33 @@ foreign import ccall "odbc TIMESTAMP_STRUCT_second" odbc_TIMESTAMP_STRUCT_second
 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 +1325,10 @@ sql_type_date = 91
 sql_ss_time2 :: SQLSMALLINT
 sql_ss_time2 = -154
 
+-- ibid.
+sql_ss_timestampoffset :: SQLSMALLINT
+sql_ss_timestampoffset = -155
+
 -- sql_datetime :: SQLSMALLINT
 -- sql_datetime = 9
 

src/Database/ODBC/SQLServer.hs

@@ -35,6 +35,7 @@ module Database.ODBC.SQLServer
   , Internal.Binary(..)
   , Datetime2(..)
   , Smalldatetime(..)
+  , Datetimeoffset(..)
 
     -- * Streaming results
     -- $streaming
@@ -271,6 +272,26 @@ newtype Smalldatetime = Smalldatetime
   { 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 @@ instance ToSql Smalldatetime where
       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 @@ renderValue =
         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.
@@ -559,6 +599,14 @@ renderFractional x = trim (printf "%.7f" (realToFrac x :: Double) :: String)
                  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
 escapeChar8 ch =

test/Main.hs

@@ -38,7 +38,7 @@ import           Data.Word
 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 @@ conversionTo = do
   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 @@ instance Arbitrary Smalldatetime where
     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 ""