sqlite-simple 0.4.7.0 → 0.4.8.0
raw patch · 8 files changed
+88/−30 lines, 8 files
Files
- Database/SQLite/Simple.hs +5/−4
- Database/SQLite/Simple/FromField.hs +9/−9
- Database/SQLite/Simple/FromRow.hs +4/−4
- changelog +4/−0
- sqlite-simple.cabal +1/−1
- test/Errors.hs +56/−10
- test/Fold.hs +2/−0
- test/Simple.hs +7/−2
Database/SQLite/Simple.hs view
@@ -82,6 +82,7 @@ , closeStatement , withStatement , bind+ , bindNamed , reset , columnName , withBind@@ -131,9 +132,9 @@ -- This may occur if the number of \'@?@\' characters in the query -- string does not match the number of parameters provided. data FormatError = FormatError {- fmtMessage :: !String- , fmtQuery :: !Query- , fmtParams :: ![String]+ fmtMessage :: String+ , fmtQuery :: Query+ , fmtParams :: [String] } deriving (Eq, Show, Typeable) instance Exception FormatError@@ -195,7 +196,7 @@ Just n -> fmtError ("Only unnamed '?' query parameters are accepted, '"++T.unpack n++"' given") templ qp- Nothing -> return ()+ Nothing -> return $! () -- | Binds named parameters to a prepared statement. bindNamed :: Statement -> [NamedParam] -> IO ()
Database/SQLite/Simple/FromField.hs view
@@ -55,18 +55,18 @@ -- | Exception thrown if conversion from a SQL value to a Haskell -- value fails.-data ResultError = Incompatible { errSQLType :: !String- , errHaskellType :: !String- , errMessage :: !String }+data ResultError = Incompatible { errSQLType :: String+ , errHaskellType :: String+ , errMessage :: String } -- ^ The SQL and Haskell types are not compatible.- | UnexpectedNull { errSQLType :: !String- , errHaskellType :: !String- , errMessage :: !String }+ | UnexpectedNull { errSQLType :: String+ , errHaskellType :: String+ , errMessage :: String } -- ^ A SQL @NULL@ was encountered when the Haskell -- type did not permit it.- | ConversionFailed { errSQLType :: !String- , errHaskellType :: !String- , errMessage :: !String }+ | ConversionFailed { errSQLType :: String+ , errHaskellType :: String+ , errMessage :: String } -- ^ The SQL value could not be parsed, or could not -- be represented as a valid Haskell value, or an -- unexpected low-level error occurred (e.g. mismatch
Database/SQLite/Simple/FromRow.hs view
@@ -60,10 +60,10 @@ fieldWith :: FieldParser a -> RowParser a fieldWith fieldP = RP $ do- RowParseRO{..} <- ask+ ncols <- asks nColumns (column, remaining) <- lift get lift (put (column + 1, tail remaining))- if column >= nColumns+ if column >= ncols then lift (lift (Errors [SomeException (ColumnOutOfBounds (column+1))])) else do@@ -76,9 +76,9 @@ numFieldsRemaining :: RowParser Int numFieldsRemaining = RP $ do- RowParseRO{..} <- ask+ ncols <- asks nColumns (columnIdx,_) <- lift get- return $! nColumns - columnIdx+ return $! ncols - columnIdx instance (FromField a) => FromRow (Only a) where fromRow = Only <$> field
changelog view
@@ -1,6 +1,10 @@+0.4.8.0+ * Export `bindNamed'+ 0.4.7.0 * Add `withTransaction' for running IO actions inside SQL transactions with automated rollback if any exceptions are thrown.+ 0.4.6.1 * Fix unit test build break with older bytestring versions
sqlite-simple.cabal view
@@ -1,5 +1,5 @@ Name: sqlite-simple-Version: 0.4.7.0+Version: 0.4.8.0 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple.
test/Errors.hs view
@@ -9,32 +9,42 @@ , testErrorsTransaction ) where -import Prelude hiding (catch)-import Control.Exception+import Prelude hiding (catch)+import Control.Exception import qualified Data.ByteString as B-import Data.Word+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import Data.Word+import Data.Time (Day, UTCTime) -import Common-import Database.SQLite3 (SQLError)+import Common+import Database.SQLite.Simple.Types (Null)+import Database.SQLite3 (SQLError) +-- The "length (show e) `seq` .." trickery below is to force evaluate+-- the contents of error messages. Another option would be to log+-- them (would be useful), but I don't know if HUnit has any logging+-- mechanisms. Just printing them as is will look like the tests are+-- hitting errors and would be confusing. assertResultErrorCaught :: IO a -> Assertion assertResultErrorCaught action = do- catch (action >> return False) (\((!_) :: ResultError) -> return True) >>=+ catch (action >> return False) (\(e :: ResultError) -> length (show e) `seq` return True) >>= assertBool "assertResultError exc" assertFormatErrorCaught :: IO a -> Assertion assertFormatErrorCaught action = do- catch (action >> return False) (\((!_) :: FormatError) -> return True) >>=+ catch (action >> return False) (\(e :: FormatError) -> length (show e) `seq` return True) >>= assertBool "assertFormatError exc" assertSQLErrorCaught :: IO a -> Assertion assertSQLErrorCaught action = do- catch (action >> return False) (\((!_) :: SQLError) -> return True) >>=+ catch (action >> return False) (\(e :: SQLError) -> length (show e) `seq` return True) >>= assertBool "assertSQLError exc" assertOOBCaught :: IO a -> Assertion assertOOBCaught action = do- catch (action >> return False) (\((!_) :: ArrayException) -> return True) >>=+ catch (action >> return False) (\(e :: ArrayException) -> length (show e) `seq` return True) >>= assertBool "assertOOBCaught exc" testErrorsColumns :: TestEnv -> Test@@ -50,6 +60,30 @@ assertResultErrorCaught (query_ conn "SELECT id FROM cols" :: IO [(Int, String)]) -- Mismatching types (source int,text doesn't match dst string,int assertResultErrorCaught (query_ conn "SELECT id, t FROM cols" :: IO [(String, Int)])+ -- Mismatching types (source string doesn't match dst integer+ assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only Integer])+ -- Mismatching types (sources don't match destination float/double type)+ assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only Double])+ assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only Double])+ assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only Float])+ assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only Float])+ -- Mismatching types (sources don't match destination bool type, or is out of bounds)+ assertResultErrorCaught (query_ conn "SELECT 'true'" :: IO [Only Bool])+ assertResultErrorCaught (query_ conn "SELECT 2" :: IO [Only Bool])+ -- Mismatching types (sources don't match destination string types (text, string)+ assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only T.Text])+ assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only LT.Text])+ assertResultErrorCaught (query_ conn "SELECT 1.0" :: IO [Only T.Text])+ assertResultErrorCaught (query_ conn "SELECT 1.0" :: IO [Only LT.Text])+ -- Mismatching types (sources don't match destination string types (time/date)+ assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only UTCTime])+ assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only Day])+ -- Mismatching types (sources don't match destination bytestring)+ [Only (_ :: B.ByteString)] <- query_ conn "SELECT X'3177'"+ assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only B.ByteString])+ assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only LB.ByteString])+ assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only B.ByteString])+ assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only LB.ByteString]) -- Trying to get a blob into a string let d = B.pack ([0..127] :: [Word8]) execute_ conn "CREATE TABLE cols_blobs (id INTEGER, b BLOB)"@@ -63,6 +97,12 @@ assertResultErrorCaught (do [Only _t1] <- query_ conn "SELECT b FROM cols_bools" :: IO [Only Bool] return ())+ [Only (nullVal :: Null)] <- query_ conn "SELECT NULL"+ False @=? nullVal == nullVal+ False @=? nullVal /= nullVal+ assertResultErrorCaught+ (do [Only (_t1 :: Null)] <- query_ conn "SELECT 1" :: IO [Only Null]+ return ()) testErrorsInvalidParams :: TestEnv -> Test testErrorsInvalidParams TestEnv{..} = TestCase $ do@@ -86,6 +126,9 @@ -- execute. This should cause an error. assertFormatErrorCaught (queryNamed conn "SELECT :foo + :bar" [":foo" := (1 :: Int)] :: IO [Only Int])+ -- Can't use named params in SQL string with the unnamed query/exec variants+ assertFormatErrorCaught+ (query conn "SELECT :foo" (Only (1 :: Int)) :: IO [Only Int]) testErrorsWithStatement :: TestEnv -> Test testErrorsWithStatement TestEnv{..} = TestCase $ do@@ -104,8 +147,11 @@ testErrorsTransaction :: TestEnv -> Test testErrorsTransaction TestEnv{..} = TestCase $ do execute_ conn "CREATE TABLE trans (id INTEGER PRIMARY KEY, t TEXT)"- withTransaction conn $ do+ v <- withTransaction conn $ do executeNamed conn "INSERT INTO trans (t) VALUES (:txt)" [":txt" := ("foo" :: String)]+ [Only r] <- query_ conn "SELECT t FROM trans" :: IO [Only String]+ return r+ v @=? "foo" e <- rowExists True @=? e execute_ conn "DELETE FROM trans"
test/Fold.hs view
@@ -15,5 +15,7 @@ assertEqual "fold_" ([3,2,1], [6,5,4]) val val <- fold conn "SELECT id,t FROM testf WHERE id > ?" (Only (1 :: Int)) ([],[]) sumValues assertEqual "fold" ([3,2], [6,5]) val+ val <- foldNamed conn "SELECT id,t FROM testf WHERE id > :id" [":id" := (1 :: Int)] ([],[]) sumValues+ assertEqual "fold" ([3,2], [6,5]) val where sumValues (accId, accT) (id_ :: Int, t :: Int) = return $ (id_ : accId, t : accT)
test/Simple.hs view
@@ -14,12 +14,13 @@ , testSimpleStrings ) where -import qualified Data.Text as T-import qualified Data.Text.Lazy as LT import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS -- orphan IsString instance in older byteString import Data.ByteString.Lazy.Char8 ()+import Data.Monoid ((<>), mappend, mempty)+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT import Data.Time (UTCTime, Day) import Common@@ -209,7 +210,11 @@ let str = "SELECT 1+1" :: T.Text q = "SELECT 1+1" :: Query fromQuery q @=? str+ show str @=? show q+ q @=? ((read . show $ q) :: Query) q @=? q+ q @=? (Query "SELECT 1" <> Query "+1")+ q @=? foldr mappend mempty ["SELECT ", "1", "+", "1"] True @=? q <= q testSimpleStrings :: TestEnv -> Test