direct-sqlite 1.1 → 2.0

raw patch · 4 files changed

+166/−21 lines, 4 filesdep +HUnitdep +base16-bytestringdep +direct-sqlitedep −utf8-stringdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, base16-bytestring, direct-sqlite, text

Dependencies removed: utf8-string

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• Database/SQLite3.hsc +41/−10
• LICENSE +1/−1
• direct-sqlite.cabal +39/−10
• test/Main.hs +85/−0

@@ -16,6 +16,8 @@                          step,                          reset,                          finalize,+                         bindParameterCount,+                         bindParameterName,                          bindBlob,                          bindDouble,                          bindInt,@@ -30,7 +32,8 @@  import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BSI-import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import Data.Typeable import Foreign import Foreign.C@@ -81,7 +84,7 @@  data SQLData = SQLInteger Int64              | SQLFloat Double-             | SQLText String+             | SQLText T.Text              | SQLBlob BS.ByteString              | SQLNull                deriving (Eq, Show, Typeable)@@ -165,7 +168,7 @@ errmsg (Database database) = do   message <- errmsgC database   byteString <- BS.packCString message-  return $ UTF8.toString byteString+  return $ T.unpack $ T.decodeUtf8 byteString  sqlError :: Maybe Database -> String -> Error -> IO a sqlError maybeDatabase functionName error = do@@ -182,7 +185,7 @@   openC :: CString -> Ptr (Ptr ()) -> IO Int openError :: String -> IO (Either Database Error) openError path = do-  BS.useAsCString (UTF8.fromString path)+  BS.useAsCString (T.encodeUtf8 $ T.pack path)                   (\path -> do                      alloca (\database -> do                                error <- openC path database@@ -216,7 +219,7 @@   prepareC :: Ptr () -> CString -> Int -> Ptr (Ptr ()) -> Ptr (Ptr ()) -> IO Int prepareError :: Database -> String -> IO (Either Statement Error) prepareError (Database database) text = do-  BS.useAsCString (UTF8.fromString text)+  BS.useAsCString (T.encodeUtf8 $ T.pack text)                   (\text -> do                      alloca (\statement -> do                                error <- prepareC database text (-1) statement nullPtr@@ -273,6 +276,34 @@     ErrorOK -> return ()     _ -> sqlError Nothing "finalize" error ++foreign import ccall "sqlite3_bind_parameter_count"+  bindParameterCountC :: Ptr () -> IO Int++-- | Find the number SQL parameters in a prepared statement.+bindParameterCount :: Statement -> IO Int+bindParameterCount (Statement stmt) = do+  bindParameterCountC stmt++maybeNullCString :: CString -> IO (Maybe BS.ByteString)+maybeNullCString s =+  if s == nullPtr then return Nothing else fmap Just (BS.packCString s)++foreign import ccall "sqlite3_bind_parameter_name"+  bindParameterNameC :: Ptr () -> Int -> IO CString++-- | Return the N-th SQL parameter name.+--+-- Named parameters are returned as-is.  E.g. \":v\" is returned as+-- @Just \":v\"@.  Unnamed parameters, however, are converted to+-- @Nothing@.+--+-- Note that the column index starts at 1, not 0.+bindParameterName :: Statement -> Int -> IO (Maybe String)+bindParameterName (Statement stmt) colNdx = do+  mn <- bindParameterNameC stmt colNdx >>= maybeNullCString+  return (mn >>= return . T.unpack . T.decodeUtf8)+ foreign import ccall "sqlite3_bind_blob"   bindBlobC :: Ptr () -> Int -> Ptr () -> Int -> Ptr () -> IO Int bindBlobError :: Statement -> Int -> BS.ByteString -> IO Error@@ -344,16 +375,16 @@  foreign import ccall "sqlite3_bind_text"   bindTextC :: Ptr () -> Int -> CString -> Int -> Ptr () -> IO Int-bindTextError :: Statement -> Int -> String -> IO Error+bindTextError :: Statement -> Int -> T.Text -> IO Error bindTextError (Statement statement) parameterIndex text = do-  byteString <- return $ UTF8.fromString text+  byteString <- return $ T.encodeUtf8 text   size <- return $ BS.length byteString   BS.useAsCString byteString                   (\dataC -> do                      error <- bindTextC statement parameterIndex dataC size                                         (intPtrToPtr (-1))                      return $ decodeError error)-bindText :: Statement -> Int -> String -> IO ()+bindText :: Statement -> Int -> T.Text -> IO () bindText statement parameterIndex text = do   error <- bindTextError statement parameterIndex text   case error of@@ -407,11 +438,11 @@  foreign import ccall "sqlite3_column_text"   columnTextC :: Ptr () -> Int -> IO CString-columnText :: Statement -> Int -> IO String+columnText :: Statement -> Int -> IO T.Text columnText (Statement statement) columnIndex = do   text <- columnTextC statement columnIndex   byteString <- BS.packCString text-  return $ UTF8.toString byteString+  return $ T.decodeUtf8 byteString  foreign import ccall "sqlite3_column_count"   columnCountC :: Ptr () -> IO Int

@@ -1,4 +1,4 @@-Copyright (c) 2009 Dan Knapp+Copyright (c) 2012 Irene Knapp  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation

@@ -1,16 +1,17 @@ name: direct-sqlite-version: 1.1-cabal-version: >= 1.6+version: 2.0 build-type: Simple license: BSD3 license-file: LICENSE-copyright: Copyright (c) 2009 Dan Knapp-author: Dan Knapp-maintainer: dankna@gmail.com-homepage: http://www.dankna.com/software/-bug-reports: http://www.dankna.com/issues/create/+copyright: Copyright (c) 2012 Irene Knapp+author: Irene Knapp <ireney.knapp@gmail.com>+maintainer: ireney.knapp@gmail.com+homepage: http://ireneknapp.com/software/+bug-reports: http://ireneknapp.com/issues/create/ category: Database synopsis: Low-level binding to SQLite3.  Includes UTF8 and BLOB support.+Cabal-version: >= 1.10+Build-type: Simple description:   This package is not very different from the other SQLite3 bindings out there, but   it fixes a few deficiencies I was finding.  It is not as complete as bindings-sqlite3,@@ -18,15 +19,43 @@   from the database.  In particular, it supports strings encoded as UTF8, and BLOBs   represented as ByteStrings.   +  Version 2.0 uses Text for strings instead of String.+  +  Version 1.1.0.1 switches to the Faction packaging system and makes no other+  changes.+     Version 1.1 adds the SQLite amalgamation file (version 3.7.5) to the project, so that   there are no external dependencies.  Source-Repository head-  type: darcs-  location: http://dankna.com/software/darcs/direct-sqlite/+  type: git+  location: git://github.com/IreneKnapp/direct-sqlite.git  Library   exposed-modules: Database.SQLite3   c-sources: sqlite3.c-  build-depends: bytestring, base >= 4.1 && < 5, utf8-string >= 0.3.5+  build-depends: base >= 4.1 && < 5,+                 bytestring >= 0.9.2.1 && < 1,+                 text >= 0.11.2.2 && < 1+  default-language: Haskell2010 ++test-suite test+  type:           exitcode-stdio-1.0++  hs-source-dirs: test+  main-is:        Main.hs++  ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind++  extensions: NamedFieldPuns+            , OverloadedStrings+            , Rank2Types+            , RecordWildCards++  build-depends: base+               , base16-bytestring+               , bytestring+               , HUnit+               , direct-sqlite+               , text

@@ -0,0 +1,85 @@++import Control.Exception (bracket)+import Control.Monad     (when)+import System.Exit       (exitFailure)+import System.IO+import Test.HUnit++import Database.SQLite3++data TestEnv =+  TestEnv {+    conn :: Database+    -- ^ Database shared by all the tests+  , withConn :: forall a. (Database -> IO a) -> IO a+    -- ^ Bracket for spawning additional connections+  }++tests :: [TestEnv -> Test]+tests =+    [ TestLabel "Simple" . testSimplest+    , TestLabel "Params" . testBindParamCounts+    , TestLabel "Params" . testBindParamName+    ]++-- Simplest SELECT+testSimplest :: TestEnv -> Test+testSimplest TestEnv{..} = TestCase $ do+  stmt <- prepare conn "SELECT 1+1"+  Row <- step stmt+  res <- column stmt 0+  Done <- step stmt+  finalize stmt+  assertEqual "1+1" (SQLInteger 2) res++-- Test bindParameterCount+testBindParamCounts :: TestEnv -> Test+testBindParamCounts TestEnv{..} = TestCase $ do+  nParams <- bracket (prepare conn "SELECT $a") finalize bindParameterCount+  assertEqual "single $a" 1 nParams+  nParams <- bracket (prepare conn "SELECT (?1+?1+?1+?2+?3)") finalize bindParameterCount+  assertEqual "3 unique ?NNNs" 3 nParams+  nParams <- bracket (prepare conn "SELECT (?+?+?)") finalize bindParameterCount+  assertEqual "3 positional" 3 nParams++-- Test bindParameterName+testBindParamName :: TestEnv -> Test+testBindParamName TestEnv{..} = TestCase $ do+  bracket (prepare conn "SELECT :v + :v2") finalize (testNames [Just ":v", Just ":v2"])+  bracket (prepare conn "SELECT ?1 + ?1") finalize (testNames [Just "?1"])+  bracket (prepare conn "SELECT ?1 + ?2") finalize (testNames [Just "?1", Just "?2"])+  bracket (prepare conn "SELECT ? + ?") finalize (testNames [Nothing, Nothing])+  bracket (prepare conn "SELECT $1 + $2") finalize (testNames [Just "$1", Just "$2"])+  where+    testNames names stmt = do+      count <- bindParameterCount stmt+      assertEqual "count match" count (length names)+      mapM_ (\(ndx,expecting) -> do+                name <- bindParameterName stmt ndx+                assertEqual "name match" expecting name) $ zip [1..] names++-- | Action for connecting to the database that will be used for+-- testing.+--+-- Note that some tests, such as Notify, use multiple connections, and+-- assume that 'testConnect' connects to the same database every time+-- it is called.+testConnect :: IO Database+testConnect = open ":memory:"++withTestEnv :: (TestEnv -> IO a) -> IO a+withTestEnv cb =+    withConn $ \conn ->+        cb TestEnv+            { conn     = conn+            , withConn = withConn+            }+  where+    withConn = bracket testConnect close++main :: IO ()+main = do+  mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]+  Counts{cases, tried, errors, failures} <-+    withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests+  when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure