sqlite-simple 0.1.0.2 → 0.2.0.0
raw patch · 9 files changed
+75/−29 lines, 9 filesdep ~direct-sqlite
Dependency ranges changed: direct-sqlite
Files
- Database/SQLite/Simple.hs +11/−13
- Database/SQLite/Simple/FromField.hs +9/−1
- Database/SQLite/Simple/FromRow.hs +1/−1
- Database/SQLite/Simple/Internal.hs +2/−2
- README.markdown +9/−4
- sqlite-simple.cabal +3/−2
- test/Main.hs +2/−1
- test/TestImports.hs +5/−5
- test/UserInstances.hs +33/−0
Database/SQLite/Simple.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PatternGuards #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} @@ -45,6 +44,7 @@ , FromRow(..) , Only(..) , (:.)(..)+ , Base.SQLData(..) -- * Connections , open@@ -67,12 +67,10 @@ import Control.Monad (void, when) import Control.Monad.Trans.Reader import Control.Monad.Trans.State.Strict-import Data.ByteString (ByteString) import qualified Data.Text as T import Data.Typeable (Typeable) import Database.SQLite.Simple.Types import qualified Database.SQLite3 as Base-import qualified Data.ByteString.Char8 as B import Database.SQLite.Simple.FromField (ResultError(..))@@ -87,7 +85,7 @@ data FormatError = FormatError { fmtMessage :: String , fmtQuery :: Query- , fmtParams :: [ByteString]+ , fmtParams :: [String] } deriving (Eq, Show, Typeable) instance Exception FormatError@@ -102,7 +100,7 @@ -- connection. This database will vanish when you close the -- connection. open :: String -> IO Connection-open fname = Connection <$> Base.open fname+open fname = Connection <$> Base.open (T.pack fname) -- | Close a database connection. close :: Connection -> IO ()@@ -111,7 +109,7 @@ withBind :: Query -> Base.Statement -> [Base.SQLData] -> IO r -> IO r withBind templ stmt qp action = do stmtParamCount <- Base.bindParameterCount stmt- when (length qp /= stmtParamCount) (throwColumnMismatch qp stmtParamCount)+ when (length qp /= fromIntegral stmtParamCount) (throwColumnMismatch qp stmtParamCount) mapM_ errorCheckParamName [1..stmtParamCount] Base.bind stmt qp action@@ -123,7 +121,7 @@ name <- Base.bindParameterName stmt paramNdx case name of Just n ->- fmtError ("Only unnamed '?' query parameters are accepted, '"++n++"' given")+ fmtError ("Only unnamed '?' query parameters are accepted, '"++T.unpack n++"' given") templ qp Nothing -> return () @@ -132,8 +130,8 @@ -- -- Throws 'FormatError' if the query could not be formatted correctly. execute :: (ToRow q) => Connection -> Query -> q -> IO ()-execute (Connection c) template@(Query t) qs = do- bracket (Base.prepare c (T.unpack t)) Base.finalize go+execute (Connection c) template@(Query t) qs =+ bracket (Base.prepare c t) Base.finalize go where go stmt = withBind template stmt (toRow qs) (void $ Base.step stmt) @@ -151,8 +149,8 @@ -- * 'ResultError': result conversion failed. query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r]-query (Connection conn) templ@(Query t) qs = do- bracket (Base.prepare conn (T.unpack t)) Base.finalize go+query (Connection conn) templ@(Query t) qs =+ bracket (Base.prepare conn t) Base.finalize go where go stmt = withBind templ stmt (toRow qs) (stepStmt stmt >>= finishQuery) @@ -165,7 +163,7 @@ -- | A version of 'execute' that does not perform query substitution. execute_ :: Connection -> Query -> IO () execute_ (Connection conn) (Query que) =- bracket (Base.prepare conn (T.unpack que)) Base.finalize go+ bracket (Base.prepare conn que) Base.finalize go where go stmt = void $ Base.step stmt @@ -195,7 +193,7 @@ fmtError msg q xs = throw FormatError { fmtMessage = msg , fmtQuery = q- , fmtParams = map (B.pack . show) xs+ , fmtParams = map show xs } -- $use
Database/SQLite/Simple/FromField.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}-{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ -- |@@ -31,6 +31,8 @@ , FieldParser , ResultError(..) , Field+ , fieldData+ , returnError ) where import Control.Applicative (Applicative, (<$>), pure)@@ -154,6 +156,12 @@ fieldTypename :: Field -> String fieldTypename = B.unpack . gettypename . result++-- | Return the actual SQL data for a database field. This allows+-- user-defined 'FromField' instances to access the SQL data+-- associated with a field being parsed.+fieldData :: Field -> SQLData+fieldData = result -- | Given one of the constructors from 'ResultError', the field, -- and an 'errMessage', this fills in the other fields in the
Database/SQLite/Simple/FromRow.hs view
@@ -68,7 +68,7 @@ column <- lift get lift (put (column + 1)) let ncols = length rowresult- if (column >= ncols)+ if column >= ncols then do let vals = map (\c -> (gettypename (rowresult !! c) , ellipsis (rowresult !! c)))
Database/SQLite/Simple/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} ------------------------------------------------------------------------------ -- | -- Module: Database.SQLite.Simple.Internal@@ -63,7 +63,7 @@ exec :: Connection -> T.Text -> IO Result exec (Connection conn) q =- bracket (Base.prepare conn (T.unpack q)) Base.finalize stepStmt+ bracket (Base.prepare conn q) Base.finalize stepStmt -- Run a query a prepared statement stepStmt :: Base.Statement -> IO Result
README.markdown view
@@ -13,12 +13,17 @@ The library has been fairly well unit tested, but I still consider it somewhat experimental. -Building---------+[](http://travis-ci.org/nurpax/sqlite-simple) -The usual cabal/cabal-dev instructions apply.+Installation+------------ -[](http://travis-ci.org/nurpax/sqlite-simple)+You can install [sqlite-simple from Hackage](http://hackage.haskell.org/package/sqlite-simple)+with:++```+cabal install sqlite-simple+``` Examples of use ---------------
sqlite-simple.cabal view
@@ -1,5 +1,5 @@ Name: sqlite-simple-Version: 0.1.0.2+Version: 0.2.0.0 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple.@@ -39,7 +39,7 @@ base < 5, bytestring >= 0.9, containers,- direct-sqlite >= 2.0 && < 2.1,+ direct-sqlite >= 2.2 && < 2.3, text >= 0.11.1, time, old-locale >= 1.0.0.0,@@ -72,6 +72,7 @@ ParamConv Utf8Strings TestImports+ UserInstances ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
test/Main.hs view
@@ -9,7 +9,7 @@ import ParamConv import Errors import Utf8Strings-+import UserInstances import TestImports() tests :: [TestEnv -> Test]@@ -26,6 +26,7 @@ , TestLabel "Errors" . testErrorsInvalidParams , TestLabel "Utf8" . testUtf8Simplest , TestLabel "Utf8" . testBlobs+ , TestLabel "Instances" . testUserFromField ] -- | Action for connecting to the database that will be used for testing.
test/TestImports.hs view
@@ -6,18 +6,18 @@ import qualified Data.Text as T import Database.SQLite.Simple -data Test = Test Int Int Int+data TestType = TestType Int Int Int --- Hook up sqlite-simple to know how to read Nvbugs-instance FromRow Test where- fromRow = Test <$> field <*> field <*> field+-- Hook up sqlite-simple to know how to read Test rows+instance FromRow TestType where+ fromRow = TestType <$> field <*> field <*> field foo :: IO () foo = do conn <- open ":memory:" [Only _v] <- query_ conn "SELECT * FROM test" :: IO [Only Int] [_v] <- query_ conn "SELECT * FROM test" :: IO [(Int,Int)]- [_v] <- query_ conn "SELECT * FROM test" :: IO [Test]+ [_v] <- query_ conn "SELECT * FROM test" :: IO [TestType] [_v] <- query conn "SELECT ?+?" (3::Int,4::Int):: IO [(Only Int)] close conn
+ test/UserInstances.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveDataTypeable #-}++module UserInstances (testUserFromField) where++import Common+import Data.Typeable (Typeable)+import qualified Data.Text as T+import Database.SQLite.Simple.FromField+import Database.SQLite.Simple.Ok+import Database.SQLite.Simple.ToField++newtype MyType = MyType String deriving (Eq, Show, Typeable)++instance FromField MyType where+ fromField f = cvt f . fieldData $ f where+ -- Prefix with "fromField " to really ensure we got here+ cvt _ (SQLText s) = Ok $ MyType ("fromField "++(T.unpack s))+ cvt f _ = returnError ConversionFailed f "expecting SQLText type"++instance ToField MyType where+ -- Prefix with "toField " to really ensure we got here+ toField (MyType s) = SQLText . T.pack $ ("toField " ++ s)++testUserFromField :: TestEnv -> Test+testUserFromField TestEnv{..} = TestCase $ do+ execute_ conn "CREATE TABLE fromfield (t TEXT)"+ execute conn "INSERT INTO fromfield (t) VALUES (?)" (Only ("test string" :: String))+ [Only r] <- query_ conn "SELECT t FROM fromfield" :: IO [(Only MyType)]+ assertEqual "fromField" (MyType "fromField test string") r+ execute_ conn "DELETE FROM fromfield"+ execute conn "INSERT INTO fromfield (t) VALUES (?)" (Only (MyType "test2"))+ [Only r] <- query_ conn "SELECT t FROM fromfield" :: IO [(Only String)]+ assertEqual "toield" "toField test2" r