odbc 0.0.2 → 0.0.3

raw patch · 3 files changed

+110/−13 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• odbc.cabal +1/−1
• src/Database/ODBC/Internal.hs +42/−12
• test/Main.hs +67/−0

@@ -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

@@ -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

@@ -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