diff --git a/odbc.cabal b/odbc.cabal --- a/odbc.cabal +++ b/odbc.cabal @@ -5,7 +5,7 @@ suite runs on OS X, Windows and Linux. copyright: FP Complete 2018 maintainer: chrisdone@fpcomplete.com -version: 0.0.2 +version: 0.0.3 license: BSD3 license-file: LICENSE build-type: Simple diff --git a/src/Database/ODBC/Internal.hs b/src/Database/ODBC/Internal.hs --- a/src/Database/ODBC/Internal.hs +++ b/src/Database/ODBC/Internal.hs @@ -220,7 +220,7 @@ (withHDBC conn "exec" - (\dbc -> withExecDirect dbc string (const (pure ())))) + (\dbc -> withExecDirect dbc string (fetchAllResults dbc))) -- | Query and return a list of rows. query :: @@ -285,13 +285,18 @@ withStmt dbc (\stmt -> do - assertSuccessOrNoData - dbc - "odbc_SQLExecDirectW" - (T.useAsPtr - string - (\wstring len -> - odbc_SQLExecDirectW dbc stmt (coerce wstring) (fromIntegral len))) + void + (assertSuccessOrNoData + dbc + "odbc_SQLExecDirectW" + (T.useAsPtr + string + (\wstring len -> + odbc_SQLExecDirectW + dbc + stmt + (coerce wstring) + (fromIntegral len)))) cont stmt) -- | Run the function with a statement. @@ -353,6 +358,18 @@ then loop state0 else pure state0 +-- | Fetch all results from possible multiple statements. +fetchAllResults :: Ptr EnvAndDbc -> SQLHSTMT s -> IO () +fetchAllResults dbc stmt = do + retcode <- + assertSuccessOrNoData + dbc + "odbc_SQLMoreResults" + (odbc_SQLMoreResults dbc stmt) + when + (retcode == sql_success || retcode == sql_success_with_info) + (fetchAllResults dbc stmt) + -- | Fetch all rows from a statement. fetchStatementRows :: Ptr EnvAndDbc -> SQLHSTMT s -> IO [[Maybe Value]] fetchStatementRows dbc stmt = do @@ -433,6 +450,7 @@ getData dbc stmt i col = if | colType == sql_longvarchar -> getBytesData dbc stmt i | colType == sql_varchar -> getBytesData dbc stmt i + | colType == sql_char -> getBytesData dbc stmt i | colType == sql_wvarchar -> getTextData dbc stmt i | colType == sql_wlongvarchar -> getTextData dbc stmt i | colType == sql_binary -> getBinaryData dbc stmt i @@ -483,6 +501,18 @@ (FloatValue . (realToFrac :: Double -> Float)) (peek floatPtr) pure (Just d)) + | colType == sql_decimal -> + withMalloc + (\floatPtr -> do + mlen <- + getTypedData dbc stmt sql_c_double i (coerce floatPtr) (SQLLEN 8) + -- NUMERIC/DECIMAL can be read as FLOAT + -- Float is 8 bytes: https://technet.microsoft.com/en-us/library/ms172424(v=sql.110).aspx + case mlen of + Nothing -> pure Nothing + Just {} -> do + !d <- fmap DoubleValue (peek floatPtr) + pure (Just d)) | colType == sql_integer -> withMalloc (\intPtr -> do @@ -747,12 +777,12 @@ throwIO (UnsuccessfulReturnCode label (coerce retcode) string) -- | Check that the RETCODE is successful or no data. -assertSuccessOrNoData :: Ptr EnvAndDbc -> String -> IO RETCODE -> IO () +assertSuccessOrNoData :: Ptr EnvAndDbc -> String -> IO RETCODE -> IO RETCODE assertSuccessOrNoData dbc label m = do retcode <- m if retcode == sql_success || retcode == sql_success_with_info || retcode == sql_no_data - then pure () + then pure retcode else do ptr <- odbc_error dbc string <- @@ -956,8 +986,8 @@ -- sql_numeric :: SQLSMALLINT -- sql_numeric = 2 --- sql_decimal :: SQLSMALLINT --- sql_decimal = 3 +sql_decimal :: SQLSMALLINT +sql_decimal = 3 sql_integer :: SQLSMALLINT sql_integer = 4 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -72,6 +72,20 @@ Internal.exec c "CREATE TABLE wibble (i integer)" Internal.exec c "DELETE FROM wibble" Internal.close c) + it + "Internal.exec multiple statements (https://github.com/fpco/odbc/issues/9)" + (do c <- connectWithString + Internal.exec c "SELECT 1; SELECT 2" + Internal.close c) + it + "Internal.exec error in multiple statements (https://github.com/fpco/odbc/issues/9)" + (do c <- connectWithString + shouldThrow + (Internal.exec c "SELECT 1; SELECT nothing FROM doesntexist") + (\case + Internal.UnsuccessfulReturnCode "odbc_SQLMoreResults" (-1) _ -> + True + _ -> False)) -- | Test fields with large data like megabytes of text. Just to check -- we don't have some kind of hard limit problem. @@ -102,6 +116,7 @@ quickCheckRoundtrip @TestTimeOfDay "TimeOfDay" "time" quickCheckRoundtrip @Float "Float" "real" quickCheckRoundtrip @Double "Double" "float" + quickCheckRoundtrip @Decimal "Double" ("decimal(" <> show decimalPrecision <> ", " <> show decimalScale <> ")") quickCheckRoundtrip @Double "Float" "float" quickCheckRoundtrip @Word8 "Word8" "tinyint" quickCheckRoundtrip @Int "Int" "bigint" @@ -109,6 +124,7 @@ quickCheckRoundtrip @Text "Text" "ntext" quickCheckRoundtrip @Text "Text" ("nvarchar(" <> (show maxStringLen) <> ")") quickCheckRoundtrip @ByteString "ByteString" "text" + quickCheckRoundtrip @TestChar "ByteString" ("char(" <> (show maxStringLen) <> ")") quickCheckRoundtrip @ByteString "ByteString" ("varchar(" <> (show maxStringLen) <> ")") quickCheckRoundtrip @TestBinary "ByteString" ("binary(" <> (show maxStringLen) <> ")") quickCheckRoundtrip @Binary "ByteString" ("varbinary(" <> (show maxStringLen) <> ")") @@ -493,6 +509,57 @@ (TestBinary (SQLServer.Binary (S.take maxStringLen (bytes <> S.replicate maxStringLen 0)))) + +-- | The maximum total number of decimal digits that will be stored, +-- both to the left and to the right of the decimal point. The +-- precision must be a value from 1 through the maximum precision of +-- 38. The default precision is 18. +decimalPrecision :: Int +decimalPrecision = 20 + +-- | The number of decimal digits that will be stored to the right of +-- the decimal point. This number is subtracted from p to determine +-- the maximum number of digits to the left of the decimal point. The +-- maximum number of decimal digits that can be stored to the right of +-- the decimal point. Scale must be a value from 0 through p. Scale +-- can be specified only if precision is specified. The default scale +-- is 0; therefore, 0 <= s <= p. Maximum storage sizes vary, based on +-- the precision. +decimalScale :: Int +decimalScale = 10 + +newtype Decimal = Decimal Double + deriving (Show, Eq, Ord, SQLServer.ToSql, FromValue) + +instance Arbitrary Decimal where + arbitrary = do + left :: Int <- choose (minBound,maxBound) + right :: Int <- choose (minBound,maxBound) + pure + (Decimal + (read (take leftLen (show left) ++ "." ++ take rightLen (show (abs right))))) + where + leftLen = decimalPrecision - decimalScale + rightLen = decimalScale + +newtype TestChar = TestChar ByteString + deriving (Show, Eq, Ord, SQLServer.ToSql, FromValue) + +instance Arbitrary TestChar where + arbitrary = do + t <- + fmap + (S8.filter (\c -> isAscii c && validTextChar c) . + S8.pack . take maxStringLen) + arbitrary + pure + (TestChar + (S.take + maxStringLen + ((if S.null t + then "a" + else t) <> + S8.replicate maxStringLen ' '))) instance Arbitrary Day where arbitrary = do