Permalink
Browse files

Use doFold instead of stepStmt to build up the result list

This should produce less intermediate allocations as a single row at a
time is read from the database and converted to the resulting type.
In the previous implementation, all the result rows were stored into a
single list of SQLData fields which was then converted to another list
of the target type.
  • Loading branch information...
1 parent 439a0fc commit 3239d474f033b2ab048744c9ea177b1e36930cce @nurpax committed Dec 16, 2012
Showing with 6 additions and 32 deletions.
  1. +6 −12 Database/SQLite/Simple.hs
  2. +0 −20 Database/SQLite/Simple/Internal.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
------------------------------------------------------------------------------
-- |
@@ -161,13 +160,14 @@ query :: (ToRow q, FromRow r)
=> Connection -> Query -> q -> IO [r]
query conn templ qs =
withStatement conn templ $ \stmt ->
- withBind templ stmt (toRow qs) (stepStmt stmt >>= finishQuery)
+ withBind templ stmt (toRow qs)
+ (doFold stmt [] (\acc e -> return (e : acc)) >>= return . reverse)
-- | A version of 'query' that does not perform query substitution.
query_ :: (FromRow r) => Connection -> Query -> IO [r]
-query_ conn (Query que) = do
- result <- exec conn que
- finishQuery result
+query_ conn query = do
+ withStatement conn query $ \stmt ->
+ (doFold stmt [] (\acc e -> return (e : acc)) >>= return . reverse)
-- | A version of 'execute' that does not perform query substitution.
execute_ :: Connection -> Query -> IO ()
@@ -223,12 +223,6 @@ doFold stmt initState action = loop 0 initState
loop (i+1) val'
Base.Done -> return val
-finishQuery :: (FromRow r) => Result -> IO [r]
-finishQuery rows = mapM doRow $ zip rows [0..]
- where
- ncols = length . head $ rows
- doRow (rowRes, rowNdx) = convertRow rowRes rowNdx ncols
-
convertRow :: (FromRow r) => [Base.SQLData] -> Int -> Int -> IO r
convertRow rowRes rowNdx ncols = do
let rw = Row rowNdx rowRes
@@ -23,15 +23,11 @@ module Database.SQLite.Simple.Internal where
import Prelude hiding (catch)
import Control.Applicative
-import Control.Monad.Fix (fix)
-import Control.Exception
import Data.ByteString (ByteString)
import Data.ByteString.Char8()
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
-import qualified Data.Text as T
-
import Database.SQLite.Simple.Ok
import qualified Database.SQLite3 as Base
@@ -62,19 +58,3 @@ gettypename (Base.SQLText _) = "TEXT"
gettypename (Base.SQLBlob _) = "BLOB"
gettypename Base.SQLNull = "NULL"
-exec :: Connection -> T.Text -> IO Result
-exec (Connection conn) q =
- bracket (Base.prepare conn q) Base.finalize stepStmt
-
-
--- Run a query on a prepared statement
-stepStmt :: Base.Statement -> IO Result
-stepStmt stmt =
- flip fix [] $ \loop acc -> do
- res <- Base.step stmt
- case res of
- Base.Done ->
- return (reverse acc)
- Base.Row -> do
- !cols <- Base.columns stmt
- loop (cols : acc)

0 comments on commit 3239d47

Please sign in to comment.