packages feed

sqlite-simple 0.4.10.0 → 0.4.11.0

raw patch · 25 files changed

+3212/−3189 lines, 25 filessetup-changed

Files

Database/SQLite/Simple.hs view
@@ -1,804 +1,816 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables, GADTs #-}----------------------------------------------------------------------------------- |--- Module:      Database.SQLite.Simple--- Copyright:   (c) 2011 MailRank, Inc.---              (c) 2011-2012 Leon P Smith---              (c) 2012-2013 Janne Hellsten--- License:     BSD3--- Maintainer:  Janne Hellsten <jjhellst@gmail.com>--- Portability: portable------------------------------------------------------------------------------------module Database.SQLite.Simple (-    -- ** Examples of use-    -- $use--    -- ** The Query type-    -- $querytype--    -- ** Parameter substitution-    -- $subst--    -- *** Positional parameters-    -- $substpos--    -- *** Named parameters-    -- $substnamed--    -- *** Type inference-    -- $inference--    -- ** Substituting a single parameter-    -- $only_param--    -- * Extracting results-    -- $result--    -- ** Handling null values-    -- $null--    -- ** Type conversions-    -- $types--    -- *** Conversion to/from UTCTime-    -- $utctime--    Query(..)-  , Connection(..)-  , ToRow(..)-  , FromRow(..)-  , Only(..)-  , (:.)(..)-  , Base.SQLData(..)-  , Statement-  , ColumnIndex(..)-  , NamedParam(..)-    -- * Connections-  , open-  , close-  , withConnection-  , setTrace-    -- * Queries that return results-  , query-  , query_-  , queryWith_-  , queryNamed-  , lastInsertRowId-  , changes-  , totalChanges-    -- * Queries that stream results-  , fold-  , fold_-  , foldNamed-    -- * Statements that do not return results-  , execute-  , execute_-  , executeNamed-  , field-    -- * Transactions-  , withTransaction-    -- * Low-level statement API for stream access and prepared statements-  , openStatement-  , closeStatement-  , withStatement-  , bind-  , bindNamed-  , reset-  , columnName-  , withBind-  , nextRow-    -- ** Exceptions-  , FormatError(..)-  , ResultError(..)-  , Base.SQLError(..)-  , Base.Error(..)-  ) where--import           Control.Applicative-import           Control.Exception-import           Control.Monad (void, when)-import           Control.Monad.Trans.Reader-import           Control.Monad.Trans.State.Strict-import           Data.Int (Int64)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import           Data.Typeable (Typeable)-import           Database.SQLite.Simple.Types-import qualified Database.SQLite3 as Base-import qualified Database.SQLite3.Direct as BaseD---import           Database.SQLite.Simple.FromField (ResultError(..))-import           Database.SQLite.Simple.Internal-import           Database.SQLite.Simple.Ok-import           Database.SQLite.Simple.ToRow (ToRow(..))-import           Database.SQLite.Simple.ToField (ToField(..))-import           Database.SQLite.Simple.FromRow---- | An SQLite prepared statement.-newtype Statement = Statement Base.Statement---- | Index of a column in a result set. Column indices start from 0.-newtype ColumnIndex = ColumnIndex BaseD.ColumnIndex-    deriving (Eq, Ord, Enum, Num, Real, Integral)--data NamedParam where-    (:=) :: (ToField v) => T.Text -> v -> NamedParam--infixr 3 :=--instance Show NamedParam where-  show (k := v) = show (k, toField v)---- | Exception thrown if a 'Query' was malformed.--- 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]-    } deriving (Eq, Show, Typeable)--instance Exception FormatError---- | Open a database connection to a given file.  Will throw an--- exception if it cannot connect.------ Every 'open' must be closed with a call to 'close'.------ If you specify \":memory:\" or an empty string as the input filename,--- then a private, temporary in-memory database is created for the--- connection.  This database will vanish when you close the--- connection.-open :: String -> IO Connection-open fname = Connection <$> Base.open (T.pack fname)---- | Close a database connection.-close :: Connection -> IO ()-close (Connection c) = Base.close c---- | Opens a database connection, executes an action using this connection, and--- closes the connection, even in the presence of exceptions.-withConnection :: String -> (Connection -> IO a) -> IO a-withConnection connString = bracket (open connString) close--unUtf8 :: BaseD.Utf8 -> T.Text-unUtf8 (BaseD.Utf8 bs) = TE.decodeUtf8 bs---- | <http://www.sqlite.org/c3ref/profile.html>------ Enable/disable tracing of SQL execution.  Tracing can be disabled--- by setting 'Nothing' as the logger callback.------ Warning: If the logger callback throws an exception, your whole--- program may crash.  Enable only for debugging!-setTrace :: Connection -> Maybe (T.Text -> IO ()) -> IO ()-setTrace (Connection db) logger =-  BaseD.setTrace db (fmap (\lf -> lf . unUtf8) logger)---- | Binds parameters to a prepared statement. Once 'nextRow' returns 'Nothing',--- the statement must be reset with the 'reset' function before it can be--- executed again by calling 'nextRow'.-bind :: (ToRow params) => Statement -> params -> IO ()-bind (Statement stmt) params = do-  let qp = toRow params-  stmtParamCount <- Base.bindParameterCount stmt-  when (length qp /= fromIntegral stmtParamCount) (throwColumnMismatch qp stmtParamCount)-  mapM_ (errorCheckParamName qp) [1..stmtParamCount]-  Base.bind stmt qp-  where-    throwColumnMismatch qp nParams = do-      templ <- getQuery stmt-      fmtError ("SQL query contains " ++ show nParams ++ " params, but " ++-                show (length qp) ++ " arguments given") templ qp-    errorCheckParamName qp paramNdx = do-      templ <- getQuery stmt-      name <- Base.bindParameterName stmt paramNdx-      case name of-        Just n ->-          fmtError ("Only unnamed '?' query parameters are accepted, '"++T.unpack n++"' given")-                    templ qp-        Nothing -> return $! ()---- | Binds named parameters to a prepared statement.-bindNamed :: Statement -> [NamedParam] -> IO ()-bindNamed (Statement stmt) params = do-  stmtParamCount <- Base.bindParameterCount stmt-  when (length params /= fromIntegral stmtParamCount) $ throwColumnMismatch stmtParamCount-  bind stmt params-  where-    bind stmt params =-      mapM_ (\(n := v) -> do-              idx <- BaseD.bindParameterIndex stmt (BaseD.Utf8 . TE.encodeUtf8 $ n)-              case idx of-                Just i ->-                  Base.bindSQLData stmt i (toField v)-                Nothing -> do-                  templ <- getQuery stmt-                  fmtError ("Unknown named parameter '" ++ T.unpack n ++ "'")-                    templ params)-            params--    throwColumnMismatch nParams = do-      templ <- getQuery stmt-      fmtError ("SQL query contains " ++ show nParams ++ " params, but " ++-                show (length params) ++ " arguments given") templ params---- | Resets a statement. This does not reset bound parameters, if any, but--- allows the statement to be reexecuted again by invoking 'nextRow'.-reset :: Statement -> IO ()-reset (Statement stmt) = Base.reset stmt---- | Return the name of a a particular column in the result set of a--- 'Statement'.  Throws an 'ArrayException' if the colum index is out--- of bounds.------ <http://www.sqlite.org/c3ref/column_name.html>-columnName :: Statement -> ColumnIndex -> IO T.Text-columnName (Statement stmt) (ColumnIndex n) = BaseD.columnName stmt n >>= takeUtf8-  where-    takeUtf8 (Just s) = return $ unUtf8 s-    takeUtf8 Nothing  =-      throwIO (IndexOutOfBounds ("Column index " ++ show n ++ " out of bounds"))---- | Binds parameters to a prepared statement, and 'reset's the statement when--- the callback completes, even in the presence of exceptions.------ Use 'withBind' to reuse prepared statements.  Because it 'reset's the--- statement /after/ each usage, it avoids a pitfall involving implicit--- transactions.  SQLite creates an implicit transaction if you don't say--- @BEGIN@ explicitly, and does not commit it until all active statements are--- finished with either 'reset' or 'closeStatement'.-withBind :: (ToRow params) => Statement -> params -> IO a -> IO a-withBind stmt params io = do-  bind stmt params-  io `finally` reset stmt---- | Opens a prepared statement. A prepared statement must always be closed with--- a corresponding call to 'closeStatement' before closing the connection. Use--- 'nextRow' to iterate on the values returned. Once 'nextRow' returns--- 'Nothing', you need to invoke 'reset' before reexecuting the statement again--- with 'nextRow'.-openStatement :: Connection -> Query -> IO Statement-openStatement (Connection c) (Query t) = do-  stmt <- Base.prepare c t-  return $ Statement stmt---- | Closes a prepared statement.-closeStatement :: Statement -> IO ()-closeStatement (Statement stmt) = Base.finalize stmt---- | Opens a prepared statement, executes an action using this statement, and--- closes the statement, even in the presence of exceptions.-withStatement :: Connection -> Query -> (Statement -> IO a) -> IO a-withStatement conn query = bracket (openStatement conn query) closeStatement---- A version of 'withStatement' which binds parameters.-withStatementParams :: (ToRow params)-                       => Connection-                       -> Query-                       -> params-                       -> (Statement -> IO a)-                       -> IO a-withStatementParams conn template params action =-  withStatement conn template $ \stmt ->-    -- Don't use withBind here, there is no need to reset the parameters since-    -- we're destroying the statement-    bind stmt (toRow params) >> action stmt---- A version of 'withStatement' which binds named parameters.-withStatementNamedParams :: Connection-                         -> Query-                         -> [NamedParam]-                         -> (Statement -> IO a)-                         -> IO a-withStatementNamedParams conn template namedParams action =-  withStatement conn template $ \stmt -> bindNamed stmt namedParams >> action stmt---- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not--- expected to return results.------ Throws 'FormatError' if the query could not be formatted correctly.-execute :: (ToRow q) => Connection -> Query -> q -> IO ()-execute conn template qs =-  withStatementParams conn template qs $ \(Statement stmt) ->-    void . Base.step $ stmt---doFoldToList :: RowParser row -> Statement -> IO [row]-doFoldToList fromRow_ stmt =-  fmap reverse $ doFold fromRow_ stmt [] (\acc e -> return (e : acc))---- | Perform a @SELECT@ or other SQL query that is expected to return--- results. All results are retrieved and converted before this--- function returns.------ When processing large results, this function will consume a lot of--- client-side memory.  Consider using 'fold' instead.------ Exceptions that may be thrown:------ * 'FormatError': the query string mismatched with given arguments.------ * 'ResultError': result conversion failed.-query :: (ToRow q, FromRow r)-         => Connection -> Query -> q -> IO [r]-query conn templ qs =-  withStatementParams conn templ qs $ \stmt ->-    doFoldToList fromRow stmt---- | A version of 'query' that does not perform query substitution.-query_ :: (FromRow r) => Connection -> Query -> IO [r]-query_ = queryWith_ fromRow---- | A version of 'query' that does not perform query substitution and--- takes an explicit 'RowParser'.-queryWith_ :: RowParser r -> Connection -> Query -> IO [r]-queryWith_ fromRow_ conn query =-  withStatement conn query (doFoldToList fromRow_)---- | A version of 'query' where the query parameters (placeholders)--- are named.------ Example:------ @--- r \<- 'queryNamed' c \"SELECT * FROM posts WHERE id=:id AND date>=:date\" [\":id\" ':=' postId, \":date\" ':=' afterDate]--- @-queryNamed :: (FromRow r) => Connection -> Query -> [NamedParam] -> IO [r]-queryNamed conn templ params =-  withStatementNamedParams conn templ params $ \stmt -> doFoldToList fromRow stmt---- | A version of 'execute' that does not perform query substitution.-execute_ :: Connection -> Query -> IO ()-execute_ conn template =-  withStatement conn template $ \(Statement stmt) ->-    void $ Base.step stmt---- | A version of 'execute' where the query parameters (placeholders)--- are named.-executeNamed :: Connection -> Query -> [NamedParam] -> IO ()-executeNamed conn template params =-  withStatementNamedParams conn template params $ \(Statement stmt) ->-    void $ Base.step stmt---- | Perform a @SELECT@ or other SQL query that is expected to return results.--- Results are converted and fed into the 'action' callback as they are being--- retrieved from the database.------ This allows gives the possibility of processing results in constant space--- (for instance writing them to disk).------ Exceptions that may be thrown:------ * 'FormatError': the query string mismatched with given arguments.------ * 'ResultError': result conversion failed.-fold :: ( FromRow row, ToRow params )-        => Connection-        -> Query-        -> params-        -> a-        -> (a -> row -> IO a)-        -> IO a-fold conn query params initalState action =-  withStatementParams conn query params $ \stmt ->-    doFold fromRow stmt initalState action---- | A version of 'fold' which does not perform parameter substitution.-fold_ :: ( FromRow row )-        => Connection-        -> Query-        -> a-        -> (a -> row -> IO a)-        -> IO a-fold_ conn query initalState action =-  withStatement conn query $ \stmt ->-    doFold fromRow stmt initalState action---- | A version of 'fold' where the query parameters (placeholders) are--- named.-foldNamed :: ( FromRow row )-          => Connection-          -> Query-          -> [NamedParam]-          -> a-          -> (a -> row -> IO a)-          -> IO a-foldNamed conn query params initalState action =-  withStatementNamedParams conn query params $ \stmt ->-    doFold fromRow stmt initalState action--doFold :: RowParser row -> Statement ->  a -> (a -> row -> IO a) -> IO a-doFold fromRow_ stmt initState action =-  loop initState-  where-    loop val = do-      maybeNextRow <- nextRowWith fromRow_ stmt-      case maybeNextRow of-        Just row  -> do-          val' <- action val row-          val' `seq` loop val'-        Nothing   -> return val---- | Extracts the next row from the prepared statement.-nextRow :: (FromRow r) => Statement -> IO (Maybe r)-nextRow = nextRowWith fromRow--nextRowWith :: RowParser r -> Statement -> IO (Maybe r)-nextRowWith fromRow_ (Statement stmt) = do-  statRes <- Base.step stmt-  case statRes of-    Base.Row -> do-      rowRes <- Base.columns stmt-      let nCols = length rowRes-      row <- convertRow fromRow_ rowRes nCols-      return $ Just row-    Base.Done -> return Nothing--convertRow :: RowParser r -> [Base.SQLData] -> Int -> IO r-convertRow fromRow_ rowRes ncols = do-  let rw = RowParseRO ncols-  case runStateT (runReaderT (unRP fromRow_) rw) (0, rowRes) of-    Ok (val,(col,_))-       | col == ncols -> return val-       | otherwise -> errorColumnMismatch (ColumnOutOfBounds col)-    Errors []  -> throwIO $ ConversionFailed "" "" "unknown error"-    Errors [x] ->-      throw x `Control.Exception.catch` (\e -> errorColumnMismatch (e :: ColumnOutOfBounds))-    Errors xs  -> throwIO $ ManyErrors xs-  where-    errorColumnMismatch :: ColumnOutOfBounds -> IO r-    errorColumnMismatch (ColumnOutOfBounds c) = do-      let vals = map (\f -> (gettypename f, ellipsis f)) rowRes-      throwIO (ConversionFailed-               (show ncols ++ " values: " ++ show vals)-               ("at least " ++ show c ++ " slots in target type")-               "mismatch between number of columns to convert and number in target type")--    ellipsis :: Base.SQLData -> T.Text-    ellipsis sql-      | T.length bs > 20 = T.take 15 bs `T.append` "[...]"-      | otherwise        = bs-      where-        bs = T.pack $ show sql----- | Returns the rowid of the most recent successful INSERT on the--- given database connection.------ See also <http://www.sqlite.org/c3ref/last_insert_rowid.html>.-lastInsertRowId :: Connection -> IO Int64-lastInsertRowId (Connection c) = BaseD.lastInsertRowId c---- | <http://www.sqlite.org/c3ref/changes.html>------ Return the number of rows that were changed, inserted, or deleted--- by the most recent @INSERT@, @DELETE@, or @UPDATE@ statement.-changes :: Connection -> IO Int-changes (Connection c) = BaseD.changes c---- | <http://www.sqlite.org/c3ref/total_changes.html>------ Return the total number of row changes caused by @INSERT@, @DELETE@,--- or @UPDATE@ statements since the 'Database' was opened.-totalChanges :: Connection -> IO Int-totalChanges (Connection c) = BaseD.totalChanges c---- | Run an IO action inside a SQL transaction started with @BEGIN--- TRANSACTION@.  If the action throws any kind of an exception, the--- transaction will be rolled back with @ROLLBACK TRANSACTION@.--- Otherwise the results are committed with @COMMIT TRANSACTION@.-withTransaction :: Connection -> IO a -> IO a-withTransaction conn action =-  mask $ \restore -> do-    begin-    r <- restore action `onException` rollback-    commit-    return r-  where-    begin    = execute_ conn "BEGIN TRANSACTION"-    commit   = execute_ conn "COMMIT TRANSACTION"-    rollback = execute_ conn "ROLLBACK TRANSACTION"--fmtError :: Show v => String -> Query -> [v] -> a-fmtError msg q xs =-  throw FormatError {-      fmtMessage  = msg-    , fmtQuery    = q-    , fmtParams   = map show xs-    }--getQuery :: Base.Statement -> IO Query-getQuery stmt =-  toQuery <$> BaseD.statementSql stmt-  where-    toQuery =-      Query . maybe "no query string" (\(BaseD.Utf8 s) -> TE.decodeUtf8 s)---- $use--- An example that creates a table 'test', inserts a couple of rows--- and proceeds to showcase how to update or delete rows.  This--- example also demonstrates the use of 'lastInsertRowId' (how to--- refer to a previously inserted row) and 'executeNamed' (an easier--- to maintain form of query parameter naming).------ >{-# LANGUAGE OverloadedStrings #-}--- >--- >import           Control.Applicative--- >import qualified Data.Text as T--- >import           Database.SQLite.Simple--- >import           Database.SQLite.Simple.FromRow--- >--- >data TestField = TestField Int T.Text deriving (Show)--- >--- >instance FromRow TestField where--- >  fromRow = TestField <$> field <*> field--- >--- >instance ToRow TestField where--- >  toRow (TestField id_ str) = toRow (id_, str)--- >--- >main :: IO ()--- >main = do--- >  conn <- open "test.db"--- >  execute_ conn "CREATE TABLE IF NOT EXISTS test (id INTEGER PRIMARY KEY, str TEXT)"--- >  execute conn "INSERT INTO test (str) VALUES (?)" (Only ("test string 2" :: String))--- >  execute conn "INSERT INTO test (id, str) VALUES (?,?)" (TestField 13 "test string 3")--- >  rowId <- lastInsertRowId conn--- >  executeNamed conn "UPDATE test SET str = :str WHERE id = :id" [":str" := ("updated str" :: T.Text), ":id" := rowId]--- >  r <- query_ conn "SELECT * from test" :: IO [TestField]--- >  mapM_ print r--- >  execute conn "DELETE FROM test WHERE id = ?" (Only rowId)--- >  close conn---- $querytype------ SQL-based applications are somewhat notorious for their--- susceptibility to attacks through the injection of maliciously--- crafted data. The primary reason for widespread vulnerability to--- SQL injections is that many applications are sloppy in handling--- user data when constructing SQL queries.------ This library provides a 'Query' type and a parameter substitution--- facility to address both ease of use and security.  A 'Query' is a--- @newtype@-wrapped 'Text'. It intentionally exposes a tiny API that--- is not compatible with the 'Text' API; this makes it difficult to--- construct queries from fragments of strings.  The 'query' and--- 'execute' functions require queries to be of type 'Query'.------ To most easily construct a query, enable GHC's @OverloadedStrings@--- language extension and write your query as a normal literal string.------ > {-# LANGUAGE OverloadedStrings #-}--- >--- > import Database.SQLite.Simple--- >--- > hello = do--- >   conn <- open "test.db"--- >   [[x]] <- query_ conn "select 2 + 2"--- >   print x------ A 'Query' value does not represent the actual query that will be--- executed, but is a template for constructing the final query.---- $subst------ Since applications need to be able to construct queries with--- parameters that change, this library uses SQLite's parameter--- binding query substitution capability.------ This library restricts parameter substitution to work only with--- named parameters and positional arguments with the \"@?@\" syntax.--- The API does not support for mixing these two types of bindings.--- Unsupported parameters will be rejected and a 'FormatError' will be--- thrown.------ You should always use parameter substitution instead of inlining--- your dynamic parameters into your queries with messy string--- concatenation.  SQLite will automatically quote and escape your--- data into these placeholder parameters; this defeats the single--- most common injection vector for malicious data.---- $substpos------ The 'Query' template accepted by 'query', 'execute' and 'fold' can--- contain any number of \"@?@\" characters.  Both 'query' and--- 'execute' accept a third argument, typically a tuple. When the--- query executes, the first \"@?@\" in the template will be replaced--- with the first element of the tuple, the second \"@?@\" with the--- second element, and so on.  This substitution happens inside the--- native SQLite implementation.------ For example, given the following 'Query' template:------ > select * from user where first_name = ? and age > ?------ And a tuple of this form:------ > ("Boris" :: String, 37 :: Int)------ The query to be executed will look like this after substitution:------ > select * from user where first_name = 'Boris' and age > 37------ If there is a mismatch between the number of \"@?@\" characters in--- your template and the number of elements in your tuple, a--- 'FormatError' will be thrown.------ Note that the substitution functions do not attempt to parse or--- validate your query. It's up to you to write syntactically valid--- SQL, and to ensure that each \"@?@\" in your query template is--- matched with the right tuple element.---- $substnamed------ Named parameters are accepted by 'queryNamed', 'executeNamed' and--- 'foldNamed'.  These functions take a list of 'NamedParam's which--- are key-value pairs binding a value to an argument name.  As is the--- case with \"@?@\" parameters, named parameters are automatically--- escaped by the SQLite library.  The parameter names are prefixed--- with either @:@ or @\@@, e.g. @:foo@ or @\@foo@.------ Example:------ @--- r \<- 'queryNamed' c \"SELECT id,text FROM posts WHERE id = :id AND date >= :date\" [\":id\" ':=' postId, \":date\" ':=' afterDate]--- @------ Note that you can mix different value types in the same list.--- E.g., the following is perfectly legal:------ @--- [\":id\" ':=' (3 :: Int), \":str\" ':=' (\"foo\" :: String)]--- @------ The parameter name (or key) in the 'NamedParam' must match exactly--- the name written in the SQL query.  E.g., if you used @:foo@ in--- your SQL statement, you need to use @\":foo\"@ as the parameter--- key, not @\"foo\"@.  Some libraries like Python's sqlite3--- automatically drop the @:@ character from the name.---- $inference------ Automated type inference means that you will often be able to avoid--- supplying explicit type signatures for the elements of a tuple.--- However, sometimes the compiler will not be able to infer your--- types. Consider a case where you write a numeric literal in a--- parameter tuple:------ > query conn "select ? + ?" (40,2)------ The above query will be rejected by the compiler, because it does--- not know the specific numeric types of the literals @40@ and @2@.--- This is easily fixed:------ > query conn "select ? + ?" (40 :: Double, 2 :: Double)------ The same kind of problem can arise with string literals if you have--- the @OverloadedStrings@ language extension enabled.  Again, just--- use an explicit type signature if this happens.---- $only_param------ Haskell lacks a single-element tuple type, so if you have just one--- value you want substituted into a query, what should you do?------ To represent a single value @val@ as a parameter, write a singleton--- list @[val]@, use 'Just' @val@, or use 'Only' @val@.------ Here's an example using a singleton list:------ > execute conn "insert into users (first_name) values (?)"--- >              ["Nuala"]------ Or you can use named parameters which do not have this restriction.---- $result------ The 'query' and 'query_' functions return a list of values in the--- 'FromRow' typeclass. This class performs automatic extraction--- and type conversion of rows from a query result.------ Here is a simple example of how to extract results:------ > import qualified Data.Text as T--- >--- > xs <- query_ conn "select name,age from users"--- > forM_ xs $ \(name,age) ->--- >   putStrLn $ T.unpack name ++ " is " ++ show (age :: Int)------ Notice two important details about this code:------ * The number of columns we ask for in the query template must---   exactly match the number of elements we specify in a row of the---   result tuple.  If they do not match, a 'ResultError' exception---   will be thrown.------ * Sometimes, the compiler needs our help in specifying types. It---   can infer that @name@ must be a 'Text', due to our use of the---   @unpack@ function. However, we have to tell it the type of @age@,---   as it has no other information to determine the exact type.---- $null------ The type of a result tuple will look something like this:------ > (Text, Int, Int)------ Although SQL can accommodate @NULL@ as a value for any of these--- types, Haskell cannot. If your result contains columns that may be--- @NULL@, be sure that you use 'Maybe' in those positions of of your--- tuple.------ > (Text, Maybe Int, Int)------ If 'query' encounters a @NULL@ in a row where the corresponding--- Haskell type is not 'Maybe', it will throw a 'ResultError'--- exception.---- $only_result------ To specify that a query returns a single-column result, use the--- 'Only' type.------ > xs <- query_ conn "select id from users"--- > forM_ xs $ \(Only dbid) -> {- ... -}---- $types------ Conversion of SQL values to Haskell values is somewhat--- permissive. Here are the rules.------ * For numeric types, any Haskell type that can accurately represent---   an SQLite INTEGER is considered \"compatible\".------ * If a numeric incompatibility is found, 'query' will throw a---   'ResultError'.------ * SQLite's TEXT type is always encoded in UTF-8.  Thus any text---   data coming from an SQLite database should always be compatible---   with Haskell 'String' and 'Text' types.------ * SQLite's BLOB type will only be conversible to a Haskell---   'ByteString'.------ You can extend conversion support to your own types be adding your--- own 'FromField' / 'ToField' instances.---- $utctime------ SQLite's datetime allows for multiple string representations of UTC--- time.  The following formats are supported for reading SQLite times--- into Haskell UTCTime values:------ * YYYY-MM-DD HH:MM------ * YYYY-MM-DD HH:MM:SS------ * YYYY-MM-DD HH:MM:SS.SSS------ * YYYY-MM-DDTHH:MM------ * YYYY-MM-DDTHH:MM:SS------ * YYYY-MM-DDTHH:MM:SS.SSS------ The above may also be optionally followed by a timezone indicator--- of the form \"[+-]HH:MM\" or just \"Z\".------ When Haskell UTCTime values are converted into SQLite values (e.g.,--- parameters for a 'query'), the following format is used:------ * YYYY-MM-DD HH:MM:SS.SSS------ The last \".SSS\" subsecond part is dropped if it's zero.  No--- timezone indicator is used when converting from a UTCTime value--- into an SQLite string.  SQLite assumes all datetimes are in UTC--- time.------ The parser and printers are implemented in <Database-SQLite-Simple-Time.html Database.SQLite.Simple.Time>.------ Read more about SQLite's time strings in <http://sqlite.org/lang_datefunc.html>+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables, GADTs #-}
+
+------------------------------------------------------------------------------
+-- |
+-- Module:      Database.SQLite.Simple
+-- Copyright:   (c) 2011 MailRank, Inc.
+--              (c) 2011-2012 Leon P Smith
+--              (c) 2012-2013 Janne Hellsten
+-- License:     BSD3
+-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
+-- Portability: portable
+--
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple (
+    -- ** Examples of use
+    -- $use
+
+    -- ** The Query type
+    -- $querytype
+
+    -- ** Parameter substitution
+    -- $subst
+
+    -- *** Positional parameters
+    -- $substpos
+
+    -- *** Named parameters
+    -- $substnamed
+
+    -- *** Type inference
+    -- $inference
+
+    -- ** Substituting a single parameter
+    -- $only_param
+
+    -- * Extracting results
+    -- $result
+
+    -- ** Handling null values
+    -- $null
+
+    -- ** Type conversions
+    -- $types
+
+    -- *** Conversion to/from UTCTime
+    -- $utctime
+
+    Query(..)
+  , Connection(..)
+  , ToRow(..)
+  , FromRow(..)
+  , Only(..)
+  , (:.)(..)
+  , Base.SQLData(..)
+  , Statement
+  , ColumnIndex(..)
+  , NamedParam(..)
+    -- * Connections
+  , open
+  , close
+  , withConnection
+  , setTrace
+    -- * Queries that return results
+  , query
+  , query_
+  , queryWith_
+  , queryNamed
+  , lastInsertRowId
+  , changes
+  , totalChanges
+    -- * Queries that stream results
+  , fold
+  , fold_
+  , foldNamed
+    -- * Statements that do not return results
+  , execute
+  , execute_
+  , executeMany
+  , executeNamed
+  , field
+    -- * Transactions
+  , withTransaction
+    -- * Low-level statement API for stream access and prepared statements
+  , openStatement
+  , closeStatement
+  , withStatement
+  , bind
+  , bindNamed
+  , reset
+  , columnName
+  , withBind
+  , nextRow
+    -- ** Exceptions
+  , FormatError(..)
+  , ResultError(..)
+  , Base.SQLError(..)
+  , Base.Error(..)
+  ) where
+
+import           Control.Applicative
+import           Control.Exception
+import           Control.Monad (void, when, forM_)
+import           Control.Monad.Trans.Reader
+import           Control.Monad.Trans.State.Strict
+import           Data.Int (Int64)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import           Data.Typeable (Typeable)
+import           Database.SQLite.Simple.Types
+import qualified Database.SQLite3 as Base
+import qualified Database.SQLite3.Direct as BaseD
+
+
+import           Database.SQLite.Simple.FromField (ResultError(..))
+import           Database.SQLite.Simple.FromRow
+import           Database.SQLite.Simple.Internal
+import           Database.SQLite.Simple.Ok
+import           Database.SQLite.Simple.ToField (ToField(..))
+import           Database.SQLite.Simple.ToRow (ToRow(..))
+
+-- | An SQLite prepared statement.
+newtype Statement = Statement Base.Statement
+
+-- | Index of a column in a result set. Column indices start from 0.
+newtype ColumnIndex = ColumnIndex BaseD.ColumnIndex
+    deriving (Eq, Ord, Enum, Num, Real, Integral)
+
+data NamedParam where
+    (:=) :: (ToField v) => T.Text -> v -> NamedParam
+
+infixr 3 :=
+
+instance Show NamedParam where
+  show (k := v) = show (k, toField v)
+
+-- | Exception thrown if a 'Query' was malformed.
+-- 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]
+    } deriving (Eq, Show, Typeable)
+
+instance Exception FormatError
+
+-- | Open a database connection to a given file.  Will throw an
+-- exception if it cannot connect.
+--
+-- Every 'open' must be closed with a call to 'close'.
+--
+-- If you specify \":memory:\" or an empty string as the input filename,
+-- then a private, temporary in-memory database is created for the
+-- connection.  This database will vanish when you close the
+-- connection.
+open :: String -> IO Connection
+open fname = Connection <$> Base.open (T.pack fname)
+
+-- | Close a database connection.
+close :: Connection -> IO ()
+close (Connection c) = Base.close c
+
+-- | Opens a database connection, executes an action using this connection, and
+-- closes the connection, even in the presence of exceptions.
+withConnection :: String -> (Connection -> IO a) -> IO a
+withConnection connString = bracket (open connString) close
+
+unUtf8 :: BaseD.Utf8 -> T.Text
+unUtf8 (BaseD.Utf8 bs) = TE.decodeUtf8 bs
+
+-- | <http://www.sqlite.org/c3ref/profile.html>
+--
+-- Enable/disable tracing of SQL execution.  Tracing can be disabled
+-- by setting 'Nothing' as the logger callback.
+--
+-- Warning: If the logger callback throws an exception, your whole
+-- program may crash.  Enable only for debugging!
+setTrace :: Connection -> Maybe (T.Text -> IO ()) -> IO ()
+setTrace (Connection db) logger =
+  BaseD.setTrace db (fmap (\lf -> lf . unUtf8) logger)
+
+-- | Binds parameters to a prepared statement. Once 'nextRow' returns 'Nothing',
+-- the statement must be reset with the 'reset' function before it can be
+-- executed again by calling 'nextRow'.
+bind :: (ToRow params) => Statement -> params -> IO ()
+bind (Statement stmt) params = do
+  let qp = toRow params
+  stmtParamCount <- Base.bindParameterCount stmt
+  when (length qp /= fromIntegral stmtParamCount) (throwColumnMismatch qp stmtParamCount)
+  mapM_ (errorCheckParamName qp) [1..stmtParamCount]
+  Base.bind stmt qp
+  where
+    throwColumnMismatch qp nParams = do
+      templ <- getQuery stmt
+      fmtError ("SQL query contains " ++ show nParams ++ " params, but " ++
+                show (length qp) ++ " arguments given") templ qp
+    errorCheckParamName qp paramNdx = do
+      templ <- getQuery stmt
+      name <- Base.bindParameterName stmt paramNdx
+      case name of
+        Just n ->
+          fmtError ("Only unnamed '?' query parameters are accepted, '"++T.unpack n++"' given")
+                    templ qp
+        Nothing -> return $! ()
+
+-- | Binds named parameters to a prepared statement.
+bindNamed :: Statement -> [NamedParam] -> IO ()
+bindNamed (Statement stmt) params = do
+  stmtParamCount <- Base.bindParameterCount stmt
+  when (length params /= fromIntegral stmtParamCount) $ throwColumnMismatch stmtParamCount
+  bind stmt params
+  where
+    bind stmt params =
+      mapM_ (\(n := v) -> do
+              idx <- BaseD.bindParameterIndex stmt (BaseD.Utf8 . TE.encodeUtf8 $ n)
+              case idx of
+                Just i ->
+                  Base.bindSQLData stmt i (toField v)
+                Nothing -> do
+                  templ <- getQuery stmt
+                  fmtError ("Unknown named parameter '" ++ T.unpack n ++ "'")
+                    templ params)
+            params
+
+    throwColumnMismatch nParams = do
+      templ <- getQuery stmt
+      fmtError ("SQL query contains " ++ show nParams ++ " params, but " ++
+                show (length params) ++ " arguments given") templ params
+
+-- | Resets a statement. This does not reset bound parameters, if any, but
+-- allows the statement to be reexecuted again by invoking 'nextRow'.
+reset :: Statement -> IO ()
+reset (Statement stmt) = Base.reset stmt
+
+-- | Return the name of a a particular column in the result set of a
+-- 'Statement'.  Throws an 'ArrayException' if the colum index is out
+-- of bounds.
+--
+-- <http://www.sqlite.org/c3ref/column_name.html>
+columnName :: Statement -> ColumnIndex -> IO T.Text
+columnName (Statement stmt) (ColumnIndex n) = BaseD.columnName stmt n >>= takeUtf8
+  where
+    takeUtf8 (Just s) = return $ unUtf8 s
+    takeUtf8 Nothing  =
+      throwIO (IndexOutOfBounds ("Column index " ++ show n ++ " out of bounds"))
+
+-- | Binds parameters to a prepared statement, and 'reset's the statement when
+-- the callback completes, even in the presence of exceptions.
+--
+-- Use 'withBind' to reuse prepared statements.  Because it 'reset's the
+-- statement /after/ each usage, it avoids a pitfall involving implicit
+-- transactions.  SQLite creates an implicit transaction if you don't say
+-- @BEGIN@ explicitly, and does not commit it until all active statements are
+-- finished with either 'reset' or 'closeStatement'.
+withBind :: (ToRow params) => Statement -> params -> IO a -> IO a
+withBind stmt params io = do
+  bind stmt params
+  io `finally` reset stmt
+
+-- | Opens a prepared statement. A prepared statement must always be closed with
+-- a corresponding call to 'closeStatement' before closing the connection. Use
+-- 'nextRow' to iterate on the values returned. Once 'nextRow' returns
+-- 'Nothing', you need to invoke 'reset' before reexecuting the statement again
+-- with 'nextRow'.
+openStatement :: Connection -> Query -> IO Statement
+openStatement (Connection c) (Query t) = do
+  stmt <- Base.prepare c t
+  return $ Statement stmt
+
+-- | Closes a prepared statement.
+closeStatement :: Statement -> IO ()
+closeStatement (Statement stmt) = Base.finalize stmt
+
+-- | Opens a prepared statement, executes an action using this statement, and
+-- closes the statement, even in the presence of exceptions.
+withStatement :: Connection -> Query -> (Statement -> IO a) -> IO a
+withStatement conn query = bracket (openStatement conn query) closeStatement
+
+-- A version of 'withStatement' which binds parameters.
+withStatementParams :: (ToRow params)
+                       => Connection
+                       -> Query
+                       -> params
+                       -> (Statement -> IO a)
+                       -> IO a
+withStatementParams conn template params action =
+  withStatement conn template $ \stmt ->
+    -- Don't use withBind here, there is no need to reset the parameters since
+    -- we're destroying the statement
+    bind stmt (toRow params) >> action stmt
+
+-- A version of 'withStatement' which binds named parameters.
+withStatementNamedParams :: Connection
+                         -> Query
+                         -> [NamedParam]
+                         -> (Statement -> IO a)
+                         -> IO a
+withStatementNamedParams conn template namedParams action =
+  withStatement conn template $ \stmt -> bindNamed stmt namedParams >> action stmt
+
+-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not
+-- expected to return results.
+--
+-- Throws 'FormatError' if the query could not be formatted correctly.
+execute :: (ToRow q) => Connection -> Query -> q -> IO ()
+execute conn template qs =
+  withStatementParams conn template qs $ \(Statement stmt) ->
+    void . Base.step $ stmt
+
+-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not
+-- expected to return results.
+--
+-- Throws 'FormatError' if the query could not be formatted correctly.
+executeMany :: ToRow q => Connection -> Query -> [q] -> IO ()
+executeMany conn template paramRows = withStatement conn template $ \stmt -> do
+  let Statement stmt' = stmt
+  forM_ paramRows $ \params ->
+    withBind stmt params
+      (void . Base.step $ stmt')
+
+
+doFoldToList :: RowParser row -> Statement -> IO [row]
+doFoldToList fromRow_ stmt =
+  fmap reverse $ doFold fromRow_ stmt [] (\acc e -> return (e : acc))
+
+-- | Perform a @SELECT@ or other SQL query that is expected to return
+-- results. All results are retrieved and converted before this
+-- function returns.
+--
+-- When processing large results, this function will consume a lot of
+-- client-side memory.  Consider using 'fold' instead.
+--
+-- Exceptions that may be thrown:
+--
+-- * 'FormatError': the query string mismatched with given arguments.
+--
+-- * 'ResultError': result conversion failed.
+query :: (ToRow q, FromRow r)
+         => Connection -> Query -> q -> IO [r]
+query conn templ qs =
+  withStatementParams conn templ qs $ \stmt ->
+    doFoldToList fromRow stmt
+
+-- | A version of 'query' that does not perform query substitution.
+query_ :: (FromRow r) => Connection -> Query -> IO [r]
+query_ = queryWith_ fromRow
+
+-- | A version of 'query' that does not perform query substitution and
+-- takes an explicit 'RowParser'.
+queryWith_ :: RowParser r -> Connection -> Query -> IO [r]
+queryWith_ fromRow_ conn query =
+  withStatement conn query (doFoldToList fromRow_)
+
+-- | A version of 'query' where the query parameters (placeholders)
+-- are named.
+--
+-- Example:
+--
+-- @
+-- r \<- 'queryNamed' c \"SELECT * FROM posts WHERE id=:id AND date>=:date\" [\":id\" ':=' postId, \":date\" ':=' afterDate]
+-- @
+queryNamed :: (FromRow r) => Connection -> Query -> [NamedParam] -> IO [r]
+queryNamed conn templ params =
+  withStatementNamedParams conn templ params $ \stmt -> doFoldToList fromRow stmt
+
+-- | A version of 'execute' that does not perform query substitution.
+execute_ :: Connection -> Query -> IO ()
+execute_ conn template =
+  withStatement conn template $ \(Statement stmt) ->
+    void $ Base.step stmt
+
+-- | A version of 'execute' where the query parameters (placeholders)
+-- are named.
+executeNamed :: Connection -> Query -> [NamedParam] -> IO ()
+executeNamed conn template params =
+  withStatementNamedParams conn template params $ \(Statement stmt) ->
+    void $ Base.step stmt
+
+-- | Perform a @SELECT@ or other SQL query that is expected to return results.
+-- Results are converted and fed into the 'action' callback as they are being
+-- retrieved from the database.
+--
+-- This allows gives the possibility of processing results in constant space
+-- (for instance writing them to disk).
+--
+-- Exceptions that may be thrown:
+--
+-- * 'FormatError': the query string mismatched with given arguments.
+--
+-- * 'ResultError': result conversion failed.
+fold :: ( FromRow row, ToRow params )
+        => Connection
+        -> Query
+        -> params
+        -> a
+        -> (a -> row -> IO a)
+        -> IO a
+fold conn query params initalState action =
+  withStatementParams conn query params $ \stmt ->
+    doFold fromRow stmt initalState action
+
+-- | A version of 'fold' which does not perform parameter substitution.
+fold_ :: ( FromRow row )
+        => Connection
+        -> Query
+        -> a
+        -> (a -> row -> IO a)
+        -> IO a
+fold_ conn query initalState action =
+  withStatement conn query $ \stmt ->
+    doFold fromRow stmt initalState action
+
+-- | A version of 'fold' where the query parameters (placeholders) are
+-- named.
+foldNamed :: ( FromRow row )
+          => Connection
+          -> Query
+          -> [NamedParam]
+          -> a
+          -> (a -> row -> IO a)
+          -> IO a
+foldNamed conn query params initalState action =
+  withStatementNamedParams conn query params $ \stmt ->
+    doFold fromRow stmt initalState action
+
+doFold :: RowParser row -> Statement ->  a -> (a -> row -> IO a) -> IO a
+doFold fromRow_ stmt initState action =
+  loop initState
+  where
+    loop val = do
+      maybeNextRow <- nextRowWith fromRow_ stmt
+      case maybeNextRow of
+        Just row  -> do
+          val' <- action val row
+          val' `seq` loop val'
+        Nothing   -> return val
+
+-- | Extracts the next row from the prepared statement.
+nextRow :: (FromRow r) => Statement -> IO (Maybe r)
+nextRow = nextRowWith fromRow
+
+nextRowWith :: RowParser r -> Statement -> IO (Maybe r)
+nextRowWith fromRow_ (Statement stmt) = do
+  statRes <- Base.step stmt
+  case statRes of
+    Base.Row -> do
+      rowRes <- Base.columns stmt
+      let nCols = length rowRes
+      row <- convertRow fromRow_ rowRes nCols
+      return $ Just row
+    Base.Done -> return Nothing
+
+convertRow :: RowParser r -> [Base.SQLData] -> Int -> IO r
+convertRow fromRow_ rowRes ncols = do
+  let rw = RowParseRO ncols
+  case runStateT (runReaderT (unRP fromRow_) rw) (0, rowRes) of
+    Ok (val,(col,_))
+       | col == ncols -> return val
+       | otherwise -> errorColumnMismatch (ColumnOutOfBounds col)
+    Errors []  -> throwIO $ ConversionFailed "" "" "unknown error"
+    Errors [x] ->
+      throw x `Control.Exception.catch` (\e -> errorColumnMismatch (e :: ColumnOutOfBounds))
+    Errors xs  -> throwIO $ ManyErrors xs
+  where
+    errorColumnMismatch :: ColumnOutOfBounds -> IO r
+    errorColumnMismatch (ColumnOutOfBounds c) = do
+      let vals = map (\f -> (gettypename f, ellipsis f)) rowRes
+      throwIO (ConversionFailed
+               (show ncols ++ " values: " ++ show vals)
+               ("at least " ++ show c ++ " slots in target type")
+               "mismatch between number of columns to convert and number in target type")
+
+    ellipsis :: Base.SQLData -> T.Text
+    ellipsis sql
+      | T.length bs > 20 = T.take 15 bs `T.append` "[...]"
+      | otherwise        = bs
+      where
+        bs = T.pack $ show sql
+
+
+-- | Returns the rowid of the most recent successful INSERT on the
+-- given database connection.
+--
+-- See also <http://www.sqlite.org/c3ref/last_insert_rowid.html>.
+lastInsertRowId :: Connection -> IO Int64
+lastInsertRowId (Connection c) = BaseD.lastInsertRowId c
+
+-- | <http://www.sqlite.org/c3ref/changes.html>
+--
+-- Return the number of rows that were changed, inserted, or deleted
+-- by the most recent @INSERT@, @DELETE@, or @UPDATE@ statement.
+changes :: Connection -> IO Int
+changes (Connection c) = BaseD.changes c
+
+-- | <http://www.sqlite.org/c3ref/total_changes.html>
+--
+-- Return the total number of row changes caused by @INSERT@, @DELETE@,
+-- or @UPDATE@ statements since the 'Database' was opened.
+totalChanges :: Connection -> IO Int
+totalChanges (Connection c) = BaseD.totalChanges c
+
+-- | Run an IO action inside a SQL transaction started with @BEGIN
+-- TRANSACTION@.  If the action throws any kind of an exception, the
+-- transaction will be rolled back with @ROLLBACK TRANSACTION@.
+-- Otherwise the results are committed with @COMMIT TRANSACTION@.
+withTransaction :: Connection -> IO a -> IO a
+withTransaction conn action =
+  mask $ \restore -> do
+    begin
+    r <- restore action `onException` rollback
+    commit
+    return r
+  where
+    begin    = execute_ conn "BEGIN TRANSACTION"
+    commit   = execute_ conn "COMMIT TRANSACTION"
+    rollback = execute_ conn "ROLLBACK TRANSACTION"
+
+fmtError :: Show v => String -> Query -> [v] -> a
+fmtError msg q xs =
+  throw FormatError {
+      fmtMessage  = msg
+    , fmtQuery    = q
+    , fmtParams   = map show xs
+    }
+
+getQuery :: Base.Statement -> IO Query
+getQuery stmt =
+  toQuery <$> BaseD.statementSql stmt
+  where
+    toQuery =
+      Query . maybe "no query string" (\(BaseD.Utf8 s) -> TE.decodeUtf8 s)
+
+-- $use
+-- An example that creates a table 'test', inserts a couple of rows
+-- and proceeds to showcase how to update or delete rows.  This
+-- example also demonstrates the use of 'lastInsertRowId' (how to
+-- refer to a previously inserted row) and 'executeNamed' (an easier
+-- to maintain form of query parameter naming).
+--
+-- >{-# LANGUAGE OverloadedStrings #-}
+-- >
+-- >import           Control.Applicative
+-- >import qualified Data.Text as T
+-- >import           Database.SQLite.Simple
+-- >import           Database.SQLite.Simple.FromRow
+-- >
+-- >data TestField = TestField Int T.Text deriving (Show)
+-- >
+-- >instance FromRow TestField where
+-- >  fromRow = TestField <$> field <*> field
+-- >
+-- >instance ToRow TestField where
+-- >  toRow (TestField id_ str) = toRow (id_, str)
+-- >
+-- >main :: IO ()
+-- >main = do
+-- >  conn <- open "test.db"
+-- >  execute_ conn "CREATE TABLE IF NOT EXISTS test (id INTEGER PRIMARY KEY, str TEXT)"
+-- >  execute conn "INSERT INTO test (str) VALUES (?)" (Only ("test string 2" :: String))
+-- >  execute conn "INSERT INTO test (id, str) VALUES (?,?)" (TestField 13 "test string 3")
+-- >  rowId <- lastInsertRowId conn
+-- >  executeNamed conn "UPDATE test SET str = :str WHERE id = :id" [":str" := ("updated str" :: T.Text), ":id" := rowId]
+-- >  r <- query_ conn "SELECT * from test" :: IO [TestField]
+-- >  mapM_ print r
+-- >  execute conn "DELETE FROM test WHERE id = ?" (Only rowId)
+-- >  close conn
+
+-- $querytype
+--
+-- SQL-based applications are somewhat notorious for their
+-- susceptibility to attacks through the injection of maliciously
+-- crafted data. The primary reason for widespread vulnerability to
+-- SQL injections is that many applications are sloppy in handling
+-- user data when constructing SQL queries.
+--
+-- This library provides a 'Query' type and a parameter substitution
+-- facility to address both ease of use and security.  A 'Query' is a
+-- @newtype@-wrapped 'Text'. It intentionally exposes a tiny API that
+-- is not compatible with the 'Text' API; this makes it difficult to
+-- construct queries from fragments of strings.  The 'query' and
+-- 'execute' functions require queries to be of type 'Query'.
+--
+-- To most easily construct a query, enable GHC's @OverloadedStrings@
+-- language extension and write your query as a normal literal string.
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- >
+-- > import Database.SQLite.Simple
+-- >
+-- > hello = do
+-- >   conn <- open "test.db"
+-- >   [[x]] <- query_ conn "select 2 + 2"
+-- >   print x
+--
+-- A 'Query' value does not represent the actual query that will be
+-- executed, but is a template for constructing the final query.
+
+-- $subst
+--
+-- Since applications need to be able to construct queries with
+-- parameters that change, this library uses SQLite's parameter
+-- binding query substitution capability.
+--
+-- This library restricts parameter substitution to work only with
+-- named parameters and positional arguments with the \"@?@\" syntax.
+-- The API does not support for mixing these two types of bindings.
+-- Unsupported parameters will be rejected and a 'FormatError' will be
+-- thrown.
+--
+-- You should always use parameter substitution instead of inlining
+-- your dynamic parameters into your queries with messy string
+-- concatenation.  SQLite will automatically quote and escape your
+-- data into these placeholder parameters; this defeats the single
+-- most common injection vector for malicious data.
+
+-- $substpos
+--
+-- The 'Query' template accepted by 'query', 'execute' and 'fold' can
+-- contain any number of \"@?@\" characters.  Both 'query' and
+-- 'execute' accept a third argument, typically a tuple. When the
+-- query executes, the first \"@?@\" in the template will be replaced
+-- with the first element of the tuple, the second \"@?@\" with the
+-- second element, and so on.  This substitution happens inside the
+-- native SQLite implementation.
+--
+-- For example, given the following 'Query' template:
+--
+-- > select * from user where first_name = ? and age > ?
+--
+-- And a tuple of this form:
+--
+-- > ("Boris" :: String, 37 :: Int)
+--
+-- The query to be executed will look like this after substitution:
+--
+-- > select * from user where first_name = 'Boris' and age > 37
+--
+-- If there is a mismatch between the number of \"@?@\" characters in
+-- your template and the number of elements in your tuple, a
+-- 'FormatError' will be thrown.
+--
+-- Note that the substitution functions do not attempt to parse or
+-- validate your query. It's up to you to write syntactically valid
+-- SQL, and to ensure that each \"@?@\" in your query template is
+-- matched with the right tuple element.
+
+-- $substnamed
+--
+-- Named parameters are accepted by 'queryNamed', 'executeNamed' and
+-- 'foldNamed'.  These functions take a list of 'NamedParam's which
+-- are key-value pairs binding a value to an argument name.  As is the
+-- case with \"@?@\" parameters, named parameters are automatically
+-- escaped by the SQLite library.  The parameter names are prefixed
+-- with either @:@ or @\@@, e.g. @:foo@ or @\@foo@.
+--
+-- Example:
+--
+-- @
+-- r \<- 'queryNamed' c \"SELECT id,text FROM posts WHERE id = :id AND date >= :date\" [\":id\" ':=' postId, \":date\" ':=' afterDate]
+-- @
+--
+-- Note that you can mix different value types in the same list.
+-- E.g., the following is perfectly legal:
+--
+-- @
+-- [\":id\" ':=' (3 :: Int), \":str\" ':=' (\"foo\" :: String)]
+-- @
+--
+-- The parameter name (or key) in the 'NamedParam' must match exactly
+-- the name written in the SQL query.  E.g., if you used @:foo@ in
+-- your SQL statement, you need to use @\":foo\"@ as the parameter
+-- key, not @\"foo\"@.  Some libraries like Python's sqlite3
+-- automatically drop the @:@ character from the name.
+
+-- $inference
+--
+-- Automated type inference means that you will often be able to avoid
+-- supplying explicit type signatures for the elements of a tuple.
+-- However, sometimes the compiler will not be able to infer your
+-- types. Consider a case where you write a numeric literal in a
+-- parameter tuple:
+--
+-- > query conn "select ? + ?" (40,2)
+--
+-- The above query will be rejected by the compiler, because it does
+-- not know the specific numeric types of the literals @40@ and @2@.
+-- This is easily fixed:
+--
+-- > query conn "select ? + ?" (40 :: Double, 2 :: Double)
+--
+-- The same kind of problem can arise with string literals if you have
+-- the @OverloadedStrings@ language extension enabled.  Again, just
+-- use an explicit type signature if this happens.
+
+-- $only_param
+--
+-- Haskell lacks a single-element tuple type, so if you have just one
+-- value you want substituted into a query, what should you do?
+--
+-- To represent a single value @val@ as a parameter, write a singleton
+-- list @[val]@, use 'Just' @val@, or use 'Only' @val@.
+--
+-- Here's an example using a singleton list:
+--
+-- > execute conn "insert into users (first_name) values (?)"
+-- >              ["Nuala"]
+--
+-- Or you can use named parameters which do not have this restriction.
+
+-- $result
+--
+-- The 'query' and 'query_' functions return a list of values in the
+-- 'FromRow' typeclass. This class performs automatic extraction
+-- and type conversion of rows from a query result.
+--
+-- Here is a simple example of how to extract results:
+--
+-- > import qualified Data.Text as T
+-- >
+-- > xs <- query_ conn "select name,age from users"
+-- > forM_ xs $ \(name,age) ->
+-- >   putStrLn $ T.unpack name ++ " is " ++ show (age :: Int)
+--
+-- Notice two important details about this code:
+--
+-- * The number of columns we ask for in the query template must
+--   exactly match the number of elements we specify in a row of the
+--   result tuple.  If they do not match, a 'ResultError' exception
+--   will be thrown.
+--
+-- * Sometimes, the compiler needs our help in specifying types. It
+--   can infer that @name@ must be a 'Text', due to our use of the
+--   @unpack@ function. However, we have to tell it the type of @age@,
+--   as it has no other information to determine the exact type.
+
+-- $null
+--
+-- The type of a result tuple will look something like this:
+--
+-- > (Text, Int, Int)
+--
+-- Although SQL can accommodate @NULL@ as a value for any of these
+-- types, Haskell cannot. If your result contains columns that may be
+-- @NULL@, be sure that you use 'Maybe' in those positions of of your
+-- tuple.
+--
+-- > (Text, Maybe Int, Int)
+--
+-- If 'query' encounters a @NULL@ in a row where the corresponding
+-- Haskell type is not 'Maybe', it will throw a 'ResultError'
+-- exception.
+
+-- $only_result
+--
+-- To specify that a query returns a single-column result, use the
+-- 'Only' type.
+--
+-- > xs <- query_ conn "select id from users"
+-- > forM_ xs $ \(Only dbid) -> {- ... -}
+
+-- $types
+--
+-- Conversion of SQL values to Haskell values is somewhat
+-- permissive. Here are the rules.
+--
+-- * For numeric types, any Haskell type that can accurately represent
+--   an SQLite INTEGER is considered \"compatible\".
+--
+-- * If a numeric incompatibility is found, 'query' will throw a
+--   'ResultError'.
+--
+-- * SQLite's TEXT type is always encoded in UTF-8.  Thus any text
+--   data coming from an SQLite database should always be compatible
+--   with Haskell 'String' and 'Text' types.
+--
+-- * SQLite's BLOB type will only be conversible to a Haskell
+--   'ByteString'.
+--
+-- You can extend conversion support to your own types be adding your
+-- own 'FromField' / 'ToField' instances.
+
+-- $utctime
+--
+-- SQLite's datetime allows for multiple string representations of UTC
+-- time.  The following formats are supported for reading SQLite times
+-- into Haskell UTCTime values:
+--
+-- * YYYY-MM-DD HH:MM
+--
+-- * YYYY-MM-DD HH:MM:SS
+--
+-- * YYYY-MM-DD HH:MM:SS.SSS
+--
+-- * YYYY-MM-DDTHH:MM
+--
+-- * YYYY-MM-DDTHH:MM:SS
+--
+-- * YYYY-MM-DDTHH:MM:SS.SSS
+--
+-- The above may also be optionally followed by a timezone indicator
+-- of the form \"[+-]HH:MM\" or just \"Z\".
+--
+-- When Haskell UTCTime values are converted into SQLite values (e.g.,
+-- parameters for a 'query'), the following format is used:
+--
+-- * YYYY-MM-DD HH:MM:SS.SSS
+--
+-- The last \".SSS\" subsecond part is dropped if it's zero.  No
+-- timezone indicator is used when converting from a UTCTime value
+-- into an SQLite string.  SQLite assumes all datetimes are in UTC
+-- time.
+--
+-- The parser and printers are implemented in <Database-SQLite-Simple-Time.html Database.SQLite.Simple.Time>.
+--
+-- Read more about SQLite's time strings in <http://sqlite.org/lang_datefunc.html>
Database/SQLite/Simple/FromField.hs view
@@ -1,215 +1,215 @@-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor  #-}-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}-{-# LANGUAGE ScopedTypeVariables      #-}----------------------------------------------------------------------------------- |--- Module:      Database.SQLite.Simple.FromField--- Copyright:   (c) 2011 MailRank, Inc.---              (c) 2011-2012 Leon P Smith---              (c) 2012-2013 Janne Hellsten--- License:     BSD3--- Maintainer:  Janne Hellsten <jjhellst@gmail.com>--- Portability: portable------ The 'FromField' typeclass, for converting a single value in a row--- returned by a SQL query into a more useful Haskell representation.------ A Haskell numeric type is considered to be compatible with all--- SQLite numeric types that are less accurate than it. For instance,--- the Haskell 'Double' type is compatible with the SQLite's 32-bit--- @Int@ type because it can represent a @Int@ exactly. On the other hand,--- since a 'Double' might lose precision if representing a 64-bit @BigInt@,--- the two are /not/ considered compatible.------------------------------------------------------------------------------------module Database.SQLite.Simple.FromField-    (-      FromField(..)-    , FieldParser-    , ResultError(..)-    , Field-    , fieldData-    , returnError-    ) where--import           Control.Applicative (Applicative, (<$>), pure)-import           Control.Exception (SomeException(..), Exception)-import           Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy as LB-import           Data.Int (Int8, Int16, Int32, Int64)-import           Data.Time (UTCTime, Day)-import qualified Data.Text as T-import qualified Data.Text.Lazy as LT-import           Data.Typeable (Typeable, typeOf)-import           Data.Word (Word, Word8, Word16, Word32, Word64)-import           GHC.Float (double2Float)--import           Database.SQLite3 as Base-import           Database.SQLite.Simple.Types-import           Database.SQLite.Simple.Internal-import           Database.SQLite.Simple.Ok-import           Database.SQLite.Simple.Time---- | Exception thrown if conversion from a SQL value to a Haskell--- value fails.-data ResultError = Incompatible { errSQLType :: String-                                , errHaskellType :: String-                                , errMessage :: String }-                 -- ^ The SQL and Haskell types are not compatible.-                 | 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 }-                 -- ^ 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-                 -- between metadata and actual data in a row).-                   deriving (Eq, Show, Typeable)--instance Exception ResultError--left :: Exception a => a -> Ok b-left = Errors . (:[]) . SomeException--type FieldParser a = Field -> Ok a---- | A type that may be converted from a SQL type.-class FromField a where-    fromField :: FieldParser a-    -- ^ Convert a SQL value to a Haskell value.-    ---    -- Returns a list of exceptions if the conversion fails.  In the case of-    -- library instances,  this will usually be a single 'ResultError',  but-    -- may be a 'UnicodeException'.-    ---    -- Implementations of 'fromField' should not retain any references to-    -- the 'Field' nor the 'ByteString' arguments after the result has-    -- been evaluated to WHNF.  Such a reference causes the entire-    -- @LibPQ.'PQ.Result'@ to be retained.-    ---    -- For example,  the instance for 'ByteString' uses 'B.copy' to avoid-    -- such a reference,  and that using bytestring functions such as 'B.drop'-    -- and 'B.takeWhile' alone will also trigger this memory leak.--instance (FromField a) => FromField (Maybe a) where-    fromField (Field SQLNull _) = pure Nothing-    fromField f                 = Just <$> fromField f--instance FromField Null where-    fromField (Field SQLNull _) = pure Null-    fromField f                 = returnError ConversionFailed f "data is not null"--takeInt :: (Num a, Typeable a) => Field -> Ok a-takeInt (Field (SQLInteger i) _) = Ok . fromIntegral $ i-takeInt f                        = returnError ConversionFailed f "need an int"--instance FromField Int8 where-    fromField = takeInt--instance FromField Int16 where-    fromField = takeInt--instance FromField Int32 where-    fromField = takeInt--instance FromField Int where-    fromField = takeInt--instance FromField Int64 where-    fromField = takeInt--instance FromField Integer where-    fromField = takeInt--instance FromField Word8 where-    fromField = takeInt--instance FromField Word16 where-    fromField = takeInt--instance FromField Word32 where-    fromField = takeInt--instance FromField Word64 where-    fromField = takeInt--instance FromField Word where-    fromField = takeInt--instance FromField Double where-    fromField (Field (SQLFloat flt) _) = Ok flt-    fromField f                        = returnError ConversionFailed f "expecting an SQLFloat column type"--instance FromField Float where-    fromField (Field (SQLFloat flt) _) = Ok . double2Float $ flt-    fromField f                        = returnError ConversionFailed f "expecting an SQLFloat column type"--instance FromField Bool where-    fromField f@(Field (SQLInteger b) _)-      | (b == 0) || (b == 1) = Ok (b /= 0)-      | otherwise = returnError ConversionFailed f ("bool must be 0 or 1, got " ++ show b)--    fromField f = returnError ConversionFailed f "expecting an SQLInteger column type"--instance FromField T.Text where-    fromField (Field (SQLText txt) _) = Ok txt-    fromField f                       = returnError ConversionFailed f "need a text"--instance FromField LT.Text where-    fromField (Field (SQLText txt) _) = Ok . LT.fromStrict $ txt-    fromField f                       = returnError ConversionFailed f "need a text"--instance FromField [Char] where-  fromField (Field (SQLText t) _) = Ok $ T.unpack t-  fromField f                     = returnError ConversionFailed f "expecting SQLText column type"--instance FromField ByteString where-  fromField (Field (SQLBlob blb) _) = Ok blb-  fromField f                       = returnError ConversionFailed f "expecting SQLBlob column type"--instance FromField LB.ByteString where-  fromField (Field (SQLBlob blb) _) = Ok . LB.fromChunks $ [blb]-  fromField f                       = returnError ConversionFailed f "expecting SQLBlob column type"--instance FromField UTCTime where-  fromField f@(Field (SQLText t) _) =-    case parseUTCTime t of-      Right t -> Ok t-      Left e -> returnError ConversionFailed f ("couldn't parse UTCTime field: " ++ e)--  fromField f = returnError ConversionFailed f "expecting SQLText column type"---instance FromField Day where-  fromField f@(Field (SQLText t) _) =-    case parseDay t of-      Right t -> Ok t-      Left e -> returnError ConversionFailed f ("couldn't parse Day field: " ++ e)--  fromField f = returnError ConversionFailed f "expecting SQLText column type"--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---   exception value and returns it in a 'Left . SomeException'---   constructor.-returnError :: forall a err . (Typeable a, Exception err)-            => (String -> String -> String -> err)-            -> Field -> String -> Ok a-returnError mkErr f = left . mkErr (fieldTypename f)-                                   (show (typeOf (undefined :: a)))+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor  #-}
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE ScopedTypeVariables      #-}
+
+------------------------------------------------------------------------------
+-- |
+-- Module:      Database.SQLite.Simple.FromField
+-- Copyright:   (c) 2011 MailRank, Inc.
+--              (c) 2011-2012 Leon P Smith
+--              (c) 2012-2013 Janne Hellsten
+-- License:     BSD3
+-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
+-- Portability: portable
+--
+-- The 'FromField' typeclass, for converting a single value in a row
+-- returned by a SQL query into a more useful Haskell representation.
+--
+-- A Haskell numeric type is considered to be compatible with all
+-- SQLite numeric types that are less accurate than it. For instance,
+-- the Haskell 'Double' type is compatible with the SQLite's 32-bit
+-- @Int@ type because it can represent a @Int@ exactly. On the other hand,
+-- since a 'Double' might lose precision if representing a 64-bit @BigInt@,
+-- the two are /not/ considered compatible.
+--
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple.FromField
+    (
+      FromField(..)
+    , FieldParser
+    , ResultError(..)
+    , Field
+    , fieldData
+    , returnError
+    ) where
+
+import           Control.Applicative (Applicative, (<$>), pure)
+import           Control.Exception (SomeException(..), Exception)
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as LB
+import           Data.Int (Int8, Int16, Int32, Int64)
+import           Data.Time (UTCTime, Day)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import           Data.Typeable (Typeable, typeOf)
+import           Data.Word (Word, Word8, Word16, Word32, Word64)
+import           GHC.Float (double2Float)
+
+import           Database.SQLite3 as Base
+import           Database.SQLite.Simple.Types
+import           Database.SQLite.Simple.Internal
+import           Database.SQLite.Simple.Ok
+import           Database.SQLite.Simple.Time
+
+-- | Exception thrown if conversion from a SQL value to a Haskell
+-- value fails.
+data ResultError = Incompatible { errSQLType :: String
+                                , errHaskellType :: String
+                                , errMessage :: String }
+                 -- ^ The SQL and Haskell types are not compatible.
+                 | 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 }
+                 -- ^ 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
+                 -- between metadata and actual data in a row).
+                   deriving (Eq, Show, Typeable)
+
+instance Exception ResultError
+
+left :: Exception a => a -> Ok b
+left = Errors . (:[]) . SomeException
+
+type FieldParser a = Field -> Ok a
+
+-- | A type that may be converted from a SQL type.
+class FromField a where
+    fromField :: FieldParser a
+    -- ^ Convert a SQL value to a Haskell value.
+    --
+    -- Returns a list of exceptions if the conversion fails.  In the case of
+    -- library instances,  this will usually be a single 'ResultError',  but
+    -- may be a 'UnicodeException'.
+    --
+    -- Implementations of 'fromField' should not retain any references to
+    -- the 'Field' nor the 'ByteString' arguments after the result has
+    -- been evaluated to WHNF.  Such a reference causes the entire
+    -- @LibPQ.'PQ.Result'@ to be retained.
+    --
+    -- For example,  the instance for 'ByteString' uses 'B.copy' to avoid
+    -- such a reference,  and that using bytestring functions such as 'B.drop'
+    -- and 'B.takeWhile' alone will also trigger this memory leak.
+
+instance (FromField a) => FromField (Maybe a) where
+    fromField (Field SQLNull _) = pure Nothing
+    fromField f                 = Just <$> fromField f
+
+instance FromField Null where
+    fromField (Field SQLNull _) = pure Null
+    fromField f                 = returnError ConversionFailed f "data is not null"
+
+takeInt :: (Num a, Typeable a) => Field -> Ok a
+takeInt (Field (SQLInteger i) _) = Ok . fromIntegral $ i
+takeInt f                        = returnError ConversionFailed f "need an int"
+
+instance FromField Int8 where
+    fromField = takeInt
+
+instance FromField Int16 where
+    fromField = takeInt
+
+instance FromField Int32 where
+    fromField = takeInt
+
+instance FromField Int where
+    fromField = takeInt
+
+instance FromField Int64 where
+    fromField = takeInt
+
+instance FromField Integer where
+    fromField = takeInt
+
+instance FromField Word8 where
+    fromField = takeInt
+
+instance FromField Word16 where
+    fromField = takeInt
+
+instance FromField Word32 where
+    fromField = takeInt
+
+instance FromField Word64 where
+    fromField = takeInt
+
+instance FromField Word where
+    fromField = takeInt
+
+instance FromField Double where
+    fromField (Field (SQLFloat flt) _) = Ok flt
+    fromField f                        = returnError ConversionFailed f "expecting an SQLFloat column type"
+
+instance FromField Float where
+    fromField (Field (SQLFloat flt) _) = Ok . double2Float $ flt
+    fromField f                        = returnError ConversionFailed f "expecting an SQLFloat column type"
+
+instance FromField Bool where
+    fromField f@(Field (SQLInteger b) _)
+      | (b == 0) || (b == 1) = Ok (b /= 0)
+      | otherwise = returnError ConversionFailed f ("bool must be 0 or 1, got " ++ show b)
+
+    fromField f = returnError ConversionFailed f "expecting an SQLInteger column type"
+
+instance FromField T.Text where
+    fromField (Field (SQLText txt) _) = Ok txt
+    fromField f                       = returnError ConversionFailed f "need a text"
+
+instance FromField LT.Text where
+    fromField (Field (SQLText txt) _) = Ok . LT.fromStrict $ txt
+    fromField f                       = returnError ConversionFailed f "need a text"
+
+instance FromField [Char] where
+  fromField (Field (SQLText t) _) = Ok $ T.unpack t
+  fromField f                     = returnError ConversionFailed f "expecting SQLText column type"
+
+instance FromField ByteString where
+  fromField (Field (SQLBlob blb) _) = Ok blb
+  fromField f                       = returnError ConversionFailed f "expecting SQLBlob column type"
+
+instance FromField LB.ByteString where
+  fromField (Field (SQLBlob blb) _) = Ok . LB.fromChunks $ [blb]
+  fromField f                       = returnError ConversionFailed f "expecting SQLBlob column type"
+
+instance FromField UTCTime where
+  fromField f@(Field (SQLText t) _) =
+    case parseUTCTime t of
+      Right t -> Ok t
+      Left e -> returnError ConversionFailed f ("couldn't parse UTCTime field: " ++ e)
+
+  fromField f = returnError ConversionFailed f "expecting SQLText column type"
+
+
+instance FromField Day where
+  fromField f@(Field (SQLText t) _) =
+    case parseDay t of
+      Right t -> Ok t
+      Left e -> returnError ConversionFailed f ("couldn't parse Day field: " ++ e)
+
+  fromField f = returnError ConversionFailed f "expecting SQLText column type"
+
+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
+--   exception value and returns it in a 'Left . SomeException'
+--   constructor.
+returnError :: forall a err . (Typeable a, Exception err)
+            => (String -> String -> String -> err)
+            -> Field -> String -> Ok a
+returnError mkErr f = left . mkErr (fieldTypename f)
+                                   (show (typeOf (undefined :: a)))
Database/SQLite/Simple/FromRow.hs view
@@ -1,136 +1,136 @@-{-# LANGUAGE RecordWildCards #-}----------------------------------------------------------------------------------- |--- Module:      Database.SQLite.Simple.FromRow--- Copyright:   (c) 2011-2012 Leon P Smith---              (c) 2012-2013 Janne Hellsten--- License:     BSD3--- Maintainer:  Janne Hellsten <jjhellst@gmail.com>--- Portability: portable------ The 'FromRow' typeclass, for converting a row of results--- returned by a SQL query into a more useful Haskell representation.------ Predefined instances are provided for tuples containing up to ten--- elements.---------------------------------------------------------------------------------module Database.SQLite.Simple.FromRow-     ( FromRow(..)-     , RowParser-     , field-     , fieldWith-     , numFieldsRemaining-     ) where--import           Control.Applicative (Applicative(..), (<$>))-import           Control.Exception (SomeException(..))-import           Control.Monad (replicateM)-import           Control.Monad.Trans.State.Strict-import           Control.Monad.Trans.Reader-import           Control.Monad.Trans.Class--import           Database.SQLite.Simple.FromField-import           Database.SQLite.Simple.Internal-import           Database.SQLite.Simple.Ok-import           Database.SQLite.Simple.Types---- | A collection type that can be converted from a sequence of fields.--- Instances are provided for tuples up to 10 elements and lists of any length.------ Note that instances can defined outside of sqlite-simple,  which is--- often useful.   For example, here's an instance for a user-defined pair:------ @data User = User { name :: String, fileQuota :: Int }------ instance 'FromRow' User where---     fromRow = User \<$\> 'field' \<*\> 'field'--- @------ The number of calls to 'field' must match the number of fields returned--- in a single row of the query result.  Otherwise,  a 'ConversionFailed'--- exception will be thrown.------ Note the caveats associated with user-defined implementations of--- 'fromRow'.--class FromRow a where-    fromRow :: RowParser a--fieldWith :: FieldParser a -> RowParser a-fieldWith fieldP = RP $ do-    ncols <- asks nColumns-    (column, remaining) <- lift get-    lift (put (column + 1, tail remaining))-    if column >= ncols-    then-      lift (lift (Errors [SomeException (ColumnOutOfBounds (column+1))]))-    else do-      let r = head remaining-          field = Field r column-      lift (lift (fieldP field))--field :: FromField a => RowParser a-field = fieldWith fromField--numFieldsRemaining :: RowParser Int-numFieldsRemaining = RP $ do-  ncols <- asks nColumns-  (columnIdx,_) <- lift get-  return $! ncols - columnIdx--instance (FromField a) => FromRow (Only a) where-    fromRow = Only <$> field--instance (FromField a, FromField b) => FromRow (a,b) where-    fromRow = (,) <$> field <*> field--instance (FromField a, FromField b, FromField c) => FromRow (a,b,c) where-    fromRow = (,,) <$> field <*> field <*> field--instance (FromField a, FromField b, FromField c, FromField d) =>-    FromRow (a,b,c,d) where-    fromRow = (,,,) <$> field <*> field <*> field <*> field--instance (FromField a, FromField b, FromField c, FromField d, FromField e) =>-    FromRow (a,b,c,d,e) where-    fromRow = (,,,,) <$> field <*> field <*> field <*> field <*> field--instance (FromField a, FromField b, FromField c, FromField d, FromField e,-          FromField f) =>-    FromRow (a,b,c,d,e,f) where-    fromRow = (,,,,,) <$> field <*> field <*> field <*> field <*> field-                      <*> field--instance (FromField a, FromField b, FromField c, FromField d, FromField e,-          FromField f, FromField g) =>-    FromRow (a,b,c,d,e,f,g) where-    fromRow = (,,,,,,) <$> field <*> field <*> field <*> field <*> field-                       <*> field <*> field--instance (FromField a, FromField b, FromField c, FromField d, FromField e,-          FromField f, FromField g, FromField h) =>-    FromRow (a,b,c,d,e,f,g,h) where-    fromRow = (,,,,,,,) <$> field <*> field <*> field <*> field <*> field-                        <*> field <*> field <*> field--instance (FromField a, FromField b, FromField c, FromField d, FromField e,-          FromField f, FromField g, FromField h, FromField i) =>-    FromRow (a,b,c,d,e,f,g,h,i) where-    fromRow = (,,,,,,,,) <$> field <*> field <*> field <*> field <*> field-                         <*> field <*> field <*> field <*> field--instance (FromField a, FromField b, FromField c, FromField d, FromField e,-          FromField f, FromField g, FromField h, FromField i, FromField j) =>-    FromRow (a,b,c,d,e,f,g,h,i,j) where-    fromRow = (,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field-                          <*> field <*> field <*> field <*> field <*> field--instance FromField a => FromRow [a] where-    fromRow = do-      n <- numFieldsRemaining-      replicateM n field--instance (FromRow a, FromRow b) => FromRow (a :. b) where-    fromRow = (:.) <$> fromRow <*> fromRow+{-# LANGUAGE RecordWildCards #-}
+
+------------------------------------------------------------------------------
+-- |
+-- Module:      Database.SQLite.Simple.FromRow
+-- Copyright:   (c) 2011-2012 Leon P Smith
+--              (c) 2012-2013 Janne Hellsten
+-- License:     BSD3
+-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
+-- Portability: portable
+--
+-- The 'FromRow' typeclass, for converting a row of results
+-- returned by a SQL query into a more useful Haskell representation.
+--
+-- Predefined instances are provided for tuples containing up to ten
+-- elements.
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple.FromRow
+     ( FromRow(..)
+     , RowParser
+     , field
+     , fieldWith
+     , numFieldsRemaining
+     ) where
+
+import           Control.Applicative (Applicative(..), (<$>))
+import           Control.Exception (SomeException(..))
+import           Control.Monad (replicateM)
+import           Control.Monad.Trans.State.Strict
+import           Control.Monad.Trans.Reader
+import           Control.Monad.Trans.Class
+
+import           Database.SQLite.Simple.FromField
+import           Database.SQLite.Simple.Internal
+import           Database.SQLite.Simple.Ok
+import           Database.SQLite.Simple.Types
+
+-- | A collection type that can be converted from a sequence of fields.
+-- Instances are provided for tuples up to 10 elements and lists of any length.
+--
+-- Note that instances can defined outside of sqlite-simple,  which is
+-- often useful.   For example, here's an instance for a user-defined pair:
+--
+-- @data User = User { name :: String, fileQuota :: Int }
+--
+-- instance 'FromRow' User where
+--     fromRow = User \<$\> 'field' \<*\> 'field'
+-- @
+--
+-- The number of calls to 'field' must match the number of fields returned
+-- in a single row of the query result.  Otherwise,  a 'ConversionFailed'
+-- exception will be thrown.
+--
+-- Note the caveats associated with user-defined implementations of
+-- 'fromRow'.
+
+class FromRow a where
+    fromRow :: RowParser a
+
+fieldWith :: FieldParser a -> RowParser a
+fieldWith fieldP = RP $ do
+    ncols <- asks nColumns
+    (column, remaining) <- lift get
+    lift (put (column + 1, tail remaining))
+    if column >= ncols
+    then
+      lift (lift (Errors [SomeException (ColumnOutOfBounds (column+1))]))
+    else do
+      let r = head remaining
+          field = Field r column
+      lift (lift (fieldP field))
+
+field :: FromField a => RowParser a
+field = fieldWith fromField
+
+numFieldsRemaining :: RowParser Int
+numFieldsRemaining = RP $ do
+  ncols <- asks nColumns
+  (columnIdx,_) <- lift get
+  return $! ncols - columnIdx
+
+instance (FromField a) => FromRow (Only a) where
+    fromRow = Only <$> field
+
+instance (FromField a, FromField b) => FromRow (a,b) where
+    fromRow = (,) <$> field <*> field
+
+instance (FromField a, FromField b, FromField c) => FromRow (a,b,c) where
+    fromRow = (,,) <$> field <*> field <*> field
+
+instance (FromField a, FromField b, FromField c, FromField d) =>
+    FromRow (a,b,c,d) where
+    fromRow = (,,,) <$> field <*> field <*> field <*> field
+
+instance (FromField a, FromField b, FromField c, FromField d, FromField e) =>
+    FromRow (a,b,c,d,e) where
+    fromRow = (,,,,) <$> field <*> field <*> field <*> field <*> field
+
+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
+          FromField f) =>
+    FromRow (a,b,c,d,e,f) where
+    fromRow = (,,,,,) <$> field <*> field <*> field <*> field <*> field
+                      <*> field
+
+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
+          FromField f, FromField g) =>
+    FromRow (a,b,c,d,e,f,g) where
+    fromRow = (,,,,,,) <$> field <*> field <*> field <*> field <*> field
+                       <*> field <*> field
+
+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
+          FromField f, FromField g, FromField h) =>
+    FromRow (a,b,c,d,e,f,g,h) where
+    fromRow = (,,,,,,,) <$> field <*> field <*> field <*> field <*> field
+                        <*> field <*> field <*> field
+
+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
+          FromField f, FromField g, FromField h, FromField i) =>
+    FromRow (a,b,c,d,e,f,g,h,i) where
+    fromRow = (,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
+                         <*> field <*> field <*> field <*> field
+
+instance (FromField a, FromField b, FromField c, FromField d, FromField e,
+          FromField f, FromField g, FromField h, FromField i, FromField j) =>
+    FromRow (a,b,c,d,e,f,g,h,i,j) where
+    fromRow = (,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
+                          <*> field <*> field <*> field <*> field <*> field
+
+instance FromField a => FromRow [a] where
+    fromRow = do
+      n <- numFieldsRemaining
+      replicateM n field
+
+instance (FromRow a, FromRow b) => FromRow (a :. b) where
+    fromRow = (:.) <$> fromRow <*> fromRow
Database/SQLite/Simple/Internal.hs view
@@ -1,70 +1,70 @@-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}---------------------------------------------------------------------------------- |--- Module:      Database.SQLite.Simple.Internal--- Copyright:   (c) 2011-2012 Leon P Smith---              (c) 2012-2013 Janne Hellsten--- License:     BSD3--- Maintainer:  Janne Hellsten <jjhellst@gmail.com>--- Portability: portable------ Internal bits.  This interface is less stable and can change at any time.--- In particular this means that while the rest of the sqlite-simple--- package endeavors to follow the package versioning policy,  this module--- does not.  Also, at the moment there are things in here that aren't--- particularly internal and are exported elsewhere;  these will eventually--- disappear from this module.------------------------------------------------------------------------------------module Database.SQLite.Simple.Internal where--import           Prelude hiding (catch)--import           Control.Exception (Exception)-import           Control.Monad-import           Control.Applicative-import           Data.ByteString (ByteString)-import           Data.ByteString.Char8()-import           Data.Typeable (Typeable)-import           Control.Monad.Trans.State.Strict-import           Control.Monad.Trans.Reader--import           Database.SQLite.Simple.Ok-import qualified Database.SQLite3 as Base---- | Connection to an open database.------ You can use 'connectionHandle' to gain access to the underlying--- <http://hackage.haskell.org/package/direct-sqlite> connection.--- This may be useful if you need to access some direct-sqlite--- functionality that's not exposed in the sqlite-simple API.  This--- should be a safe thing to do although mixing both APIs is--- discouraged.-newtype Connection = Connection { connectionHandle :: Base.Database }--data ColumnOutOfBounds = ColumnOutOfBounds { errorColumnIndex :: !Int }-                      deriving (Eq, Show, Typeable)--instance Exception ColumnOutOfBounds---- | A Field represents metadata about a particular field-data Field = Field {-     result   :: Base.SQLData-   , column   :: {-# UNPACK #-} !Int-   }---- Named type for holding RowParser read-only state.  Just for making--- it easier to make sense out of types in FromRow.-newtype RowParseRO = RowParseRO { nColumns :: Int }--newtype RowParser a = RP { unRP :: ReaderT RowParseRO (StateT (Int, [Base.SQLData]) Ok) a }-   deriving ( Functor, Applicative, Alternative, Monad, MonadPlus )--gettypename :: Base.SQLData -> ByteString-gettypename (Base.SQLInteger _) = "INTEGER"-gettypename (Base.SQLFloat _) = "FLOAT"-gettypename (Base.SQLText _) = "TEXT"-gettypename (Base.SQLBlob _) = "BLOB"-gettypename Base.SQLNull = "NULL"-+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+------------------------------------------------------------------------------
+-- |
+-- Module:      Database.SQLite.Simple.Internal
+-- Copyright:   (c) 2011-2012 Leon P Smith
+--              (c) 2012-2013 Janne Hellsten
+-- License:     BSD3
+-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
+-- Portability: portable
+--
+-- Internal bits.  This interface is less stable and can change at any time.
+-- In particular this means that while the rest of the sqlite-simple
+-- package endeavors to follow the package versioning policy,  this module
+-- does not.  Also, at the moment there are things in here that aren't
+-- particularly internal and are exported elsewhere;  these will eventually
+-- disappear from this module.
+--
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple.Internal where
+
+import           Prelude hiding (catch)
+
+import           Control.Exception (Exception)
+import           Control.Monad
+import           Control.Applicative
+import           Data.ByteString (ByteString)
+import           Data.ByteString.Char8()
+import           Data.Typeable (Typeable)
+import           Control.Monad.Trans.State.Strict
+import           Control.Monad.Trans.Reader
+
+import           Database.SQLite.Simple.Ok
+import qualified Database.SQLite3 as Base
+
+-- | Connection to an open database.
+--
+-- You can use 'connectionHandle' to gain access to the underlying
+-- <http://hackage.haskell.org/package/direct-sqlite> connection.
+-- This may be useful if you need to access some direct-sqlite
+-- functionality that's not exposed in the sqlite-simple API.  This
+-- should be a safe thing to do although mixing both APIs is
+-- discouraged.
+newtype Connection = Connection { connectionHandle :: Base.Database }
+
+data ColumnOutOfBounds = ColumnOutOfBounds { errorColumnIndex :: !Int }
+                      deriving (Eq, Show, Typeable)
+
+instance Exception ColumnOutOfBounds
+
+-- | A Field represents metadata about a particular field
+data Field = Field {
+     result   :: Base.SQLData
+   , column   :: {-# UNPACK #-} !Int
+   }
+
+-- Named type for holding RowParser read-only state.  Just for making
+-- it easier to make sense out of types in FromRow.
+newtype RowParseRO = RowParseRO { nColumns :: Int }
+
+newtype RowParser a = RP { unRP :: ReaderT RowParseRO (StateT (Int, [Base.SQLData]) Ok) a }
+   deriving ( Functor, Applicative, Alternative, Monad, MonadPlus )
+
+gettypename :: Base.SQLData -> ByteString
+gettypename (Base.SQLInteger _) = "INTEGER"
+gettypename (Base.SQLFloat _) = "FLOAT"
+gettypename (Base.SQLText _) = "TEXT"
+gettypename (Base.SQLBlob _) = "BLOB"
+gettypename Base.SQLNull = "NULL"
+
Database/SQLite/Simple/Ok.hs view
@@ -1,82 +1,82 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor      #-}----------------------------------------------------------------------------------- |--- Module:     Database.SQLite.Simple.Ok--- Copyright:  (c) 2012 Leon P Smith---             (c) 2012-2013 Janne Hellsten--- License:    BSD3--- Maintainer: Janne Hellsten <jjhellst@gmail.com>------ The 'Ok' type is a simple error handler,  basically equivalent to--- @Either [SomeException]@.------ One of the primary reasons why this type  was introduced is that--- @Either SomeException@ had not been provided an instance for 'Alternative',--- and it would have been a bad idea to provide an orphaned instance for a--- commonly-used type and typeclass included in @base@.------ Extending the failure case to a list of 'SomeException's enables a--- more sensible 'Alternative' instance definitions:   '<|>' concatinates--- the list of exceptions when both cases fail,  and 'empty' is defined as--- 'Errors []'.   Though '<|>' one could pick one of two exceptions, and--- throw away the other,  and have 'empty' provide a generic exception,--- this avoids cases where 'empty' overrides a more informative exception--- and allows you to see all the different ways your computation has failed.------------------------------------------------------------------------------------module Database.SQLite.Simple.Ok where--import Control.Applicative-import Control.Exception-import Control.Monad(MonadPlus(..))-import Data.Typeable---- FIXME:   [SomeException] should probably be something else,  maybe---          a difference list (or a tree?)--data Ok a = Errors [SomeException] | Ok !a-    deriving(Show, Typeable, Functor)---- | Two 'Errors' cases are considered equal, regardless of what the---   list of exceptions looks like.--instance Eq a => Eq (Ok a) where-    Errors _ == Errors _  = True-    Ok  a    == Ok  b     = a == b-    _        == _         = False--instance Applicative Ok where-    pure = Ok--    Errors es <*> _ = Errors es-    _ <*> Errors es = Errors es-    Ok f <*> Ok a   = Ok (f a)--instance Alternative Ok where-    empty = Errors []--    a@(Ok _)  <|> _         = a-    Errors _  <|> b@(Ok _)  = b-    Errors as <|> Errors bs = Errors (as ++ bs)--instance MonadPlus Ok where-    mzero = empty-    mplus = (<|>)--instance Monad Ok where-    return = Ok--    Errors es >>= _ = Errors es-    Ok a      >>= f = f a--    fail str = Errors [SomeException (ErrorCall str)]---- | a way to reify a list of exceptions into a single exception--newtype ManyErrors = ManyErrors [SomeException]-   deriving (Show, Typeable)--instance Exception ManyErrors+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor      #-}
+
+------------------------------------------------------------------------------
+-- |
+-- Module:     Database.SQLite.Simple.Ok
+-- Copyright:  (c) 2012 Leon P Smith
+--             (c) 2012-2013 Janne Hellsten
+-- License:    BSD3
+-- Maintainer: Janne Hellsten <jjhellst@gmail.com>
+--
+-- The 'Ok' type is a simple error handler,  basically equivalent to
+-- @Either [SomeException]@.
+--
+-- One of the primary reasons why this type  was introduced is that
+-- @Either SomeException@ had not been provided an instance for 'Alternative',
+-- and it would have been a bad idea to provide an orphaned instance for a
+-- commonly-used type and typeclass included in @base@.
+--
+-- Extending the failure case to a list of 'SomeException's enables a
+-- more sensible 'Alternative' instance definitions:   '<|>' concatinates
+-- the list of exceptions when both cases fail,  and 'empty' is defined as
+-- 'Errors []'.   Though '<|>' one could pick one of two exceptions, and
+-- throw away the other,  and have 'empty' provide a generic exception,
+-- this avoids cases where 'empty' overrides a more informative exception
+-- and allows you to see all the different ways your computation has failed.
+--
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple.Ok where
+
+import Control.Applicative
+import Control.Exception
+import Control.Monad(MonadPlus(..))
+import Data.Typeable
+
+-- FIXME:   [SomeException] should probably be something else,  maybe
+--          a difference list (or a tree?)
+
+data Ok a = Errors [SomeException] | Ok !a
+    deriving(Show, Typeable, Functor)
+
+-- | Two 'Errors' cases are considered equal, regardless of what the
+--   list of exceptions looks like.
+
+instance Eq a => Eq (Ok a) where
+    Errors _ == Errors _  = True
+    Ok  a    == Ok  b     = a == b
+    _        == _         = False
+
+instance Applicative Ok where
+    pure = Ok
+
+    Errors es <*> _ = Errors es
+    _ <*> Errors es = Errors es
+    Ok f <*> Ok a   = Ok (f a)
+
+instance Alternative Ok where
+    empty = Errors []
+
+    a@(Ok _)  <|> _         = a
+    Errors _  <|> b@(Ok _)  = b
+    Errors as <|> Errors bs = Errors (as ++ bs)
+
+instance MonadPlus Ok where
+    mzero = empty
+    mplus = (<|>)
+
+instance Monad Ok where
+    return = Ok
+
+    Errors es >>= _ = Errors es
+    Ok a      >>= f = f a
+
+    fail str = Errors [SomeException (ErrorCall str)]
+
+-- | a way to reify a list of exceptions into a single exception
+
+newtype ManyErrors = ManyErrors [SomeException]
+   deriving (Show, Typeable)
+
+instance Exception ManyErrors
Database/SQLite/Simple/Time.hs view
@@ -1,21 +1,21 @@---------------------------------------------------------------------------------- |--- Module:      Database.SQLite.Simple.Time--- Copyright:   (c) 2012 Leon P Smith---              (c) 2012-2014 Janne Hellsten--- License:     BSD3--- Maintainer:  Janne Hellsten <jjhellst@gmail.com>------ Conversions to/from Haskell 'UTCTime' and 'Day' types for SQLite3.--- Offers better performance than direct use of time package's--- 'read'/'show' functionality.------ The parsers are heavily adapted for the specific variant of ISO 8601 that--- SQLite uses,  and the printers attempt to duplicate this syntax.---------------------------------------------------------------------------------module Database.SQLite.Simple.Time (-    module Database.SQLite.Simple.Time.Implementation-  ) where--import Database.SQLite.Simple.Time.Implementation+------------------------------------------------------------------------------
+-- |
+-- Module:      Database.SQLite.Simple.Time
+-- Copyright:   (c) 2012 Leon P Smith
+--              (c) 2012-2014 Janne Hellsten
+-- License:     BSD3
+-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
+--
+-- Conversions to/from Haskell 'UTCTime' and 'Day' types for SQLite3.
+-- Offers better performance than direct use of time package's
+-- 'read'/'show' functionality.
+--
+-- The parsers are heavily adapted for the specific variant of ISO 8601 that
+-- SQLite uses,  and the printers attempt to duplicate this syntax.
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple.Time (
+    module Database.SQLite.Simple.Time.Implementation
+  ) where
+
+import Database.SQLite.Simple.Time.Implementation
Database/SQLite/Simple/Time/Implementation.hs view
@@ -1,200 +1,200 @@---------------------------------------------------------------------------------- |--- Module:      Database.SQLite.Simple.Time.Implementation--- Copyright:   (c) 2012 Leon P Smith---              (c) 2012-2014 Janne Hellsten--- License:     BSD3--- Maintainer:  Janne Hellsten <jjhellst@gmail.com>------ Adapted from Leon P Smith's code for SQLite.------ See <http://sqlite.org/lang_datefunc.html> for date formats used in SQLite.---------------------------------------------------------------------------------module Database.SQLite.Simple.Time.Implementation (-    parseUTCTime-  , parseDay-  , utcTimeToBuilder-  , dayToBuilder-  , timeOfDayToBuilder-  , timeZoneToBuilder-  ) where-import           Blaze.ByteString.Builder (Builder)-import           Blaze.ByteString.Builder.Char8 (fromChar)-import           Blaze.Text.Int (integral)-import           Control.Applicative-import           Control.Monad (when)-import qualified Data.Attoparsec.Text as A-import           Data.Bits ((.&.))-import           Data.ByteString.Internal (w2c)-import           Data.Char (isDigit, ord)-import           Data.Fixed (Pico)-import           Data.Monoid (Monoid(..))-import qualified Data.Text as T-import           Data.Time hiding (getTimeZone, getZonedTime)-import           Prelude hiding (take, (++))-import           Unsafe.Coerce--(++) :: Monoid a => a -> a -> a-(++) = mappend-infixr 5 ++--parseUTCTime   :: T.Text -> Either String UTCTime-parseUTCTime   = A.parseOnly (getUTCTime <* A.endOfInput)--parseDay :: T.Text -> Either String Day-parseDay = A.parseOnly (getDay <* A.endOfInput)--getDay :: A.Parser Day-getDay = do-    yearStr <- A.takeWhile isDigit-    when (T.length yearStr < 4) (fail "year must consist of at least 4 digits")--    let !year = toNum yearStr-    _       <- A.char '-'-    month   <- digits "month"-    _       <- A.char '-'-    day     <- digits "day"--    case fromGregorianValid year month day of-      Nothing -> fail "invalid date"-      Just x  -> return $! x--decimal :: Fractional a => T.Text -> a-decimal str = toNum str / 10^(T.length str)-{-# INLINE decimal #-}--getTimeOfDay :: A.Parser TimeOfDay-getTimeOfDay = do-    hour   <- digits "hours"-    _      <- A.char ':'-    minute <- digits "minutes"-    -- Allow omission of seconds.  If seconds is omitted, don't try to-    -- parse the sub-second part.-    (sec,subsec)-           <- ((,) <$> (A.char ':' *> digits "seconds") <*> fract) <|> pure (0,0)--    let !picos' = sec + subsec--    case makeTimeOfDayValid hour minute picos' of-      Nothing -> fail "invalid time of day"-      Just x  -> return $! x--    where-      fract =-        (A.char '.' *> (decimal <$> A.takeWhile1 isDigit)) <|> pure 0--getTimeZone :: A.Parser TimeZone-getTimeZone = do-    sign  <- A.satisfy (\c -> c == '+' || c == '-')-    hours <- digits "timezone"-    mins  <- (A.char ':' *> digits "timezone minutes") <|> pure 0-    let !absset = 60 * hours + mins-        !offset = if sign == '+' then absset else -absset-    return $! minutesToTimeZone offset--getUTCTime :: A.Parser UTCTime-getUTCTime = do-    day  <- getDay-    _    <- A.char ' ' <|> A.char 'T'-    time <- getTimeOfDay-    -- SQLite doesn't require a timezone postfix.  So make that-    -- optional and default to +0.  'Z' means UTC (zulu time).-    zone <- getTimeZone <|> (A.char 'Z' *> pure utc) <|> (pure utc)-    let (!dayDelta,!time') = localToUTCTimeOfDay zone time-    let !day' = addDays dayDelta day-    let !time'' = timeOfDayToTime time'-    return (UTCTime day' time'')--toNum :: Num n => T.Text -> n-toNum = T.foldl' (\a c -> 10*a + digit c) 0-{-# INLINE toNum #-}--digit :: Num n => Char -> n-digit c = fromIntegral (ord c .&. 0x0f)-{-# INLINE digit #-}--digits :: Num n => String -> A.Parser n-digits msg = do-  x <- A.anyChar-  y <- A.anyChar-  if isDigit x && isDigit y-  then return $! (10 * digit x + digit y)-  else fail (msg ++ " is not 2 digits")-{-# INLINE digits #-}--dayToBuilder :: Day -> Builder-dayToBuilder (toGregorian -> (y,m,d)) = do-    pad4 y ++ fromChar '-' ++ pad2 m ++ fromChar '-' ++ pad2 d--timeOfDayToBuilder :: TimeOfDay -> Builder-timeOfDayToBuilder (TimeOfDay h m s) = do-    pad2 h ++ fromChar ':' ++ pad2 m ++ fromChar ':' ++ showSeconds s--timeZoneToBuilder :: TimeZone -> Builder-timeZoneToBuilder tz-    | m == 0     =  sign h ++ pad2 (abs h)-    | otherwise  =  sign h ++ pad2 (abs h) ++ fromChar ':' ++ pad2 (abs m)-  where-    (h,m) = timeZoneMinutes tz `quotRem` 60-    sign h | h >= 0    = fromChar '+'-           | otherwise = fromChar '-'---- | Output YYYY-MM-DD HH:MM:SS with an optional .SSS fraction part.--- Explicit timezone attribute is not appended as per SQLite3's--- datetime conventions.-utcTimeToBuilder :: UTCTime -> Builder-utcTimeToBuilder (UTCTime day time) =-    dayToBuilder day ++ fromChar ' ' ++ timeOfDayToBuilder (timeToTimeOfDay time)--showSeconds :: Pico -> Builder-showSeconds xyz-    | yz == 0   = pad2 x-    | z  == 0   = pad2 x ++ fromChar '.' ++  showD6 y-    | otherwise = pad2 x ++ fromChar '.' ++  pad6   y ++ showD6 z-  where-    -- A kludge to work around the fact that Data.Fixed isn't very fast and-    -- doesn't give me access to the MkFixed constructor.-    (x_,yz) = (unsafeCoerce xyz :: Integer)     `quotRem` 1000000000000-    x = fromIntegral x_ :: Int-    (fromIntegral -> y, fromIntegral -> z) = yz `quotRem` 1000000--pad6 :: Int -> Builder-pad6 xy = let (x,y) = xy `quotRem` 1000-           in pad3 x ++ pad3 y--showD6 :: Int -> Builder-showD6 xy = case xy `quotRem` 1000 of-              (x,0) -> showD3 x-              (x,y) -> pad3 x ++ showD3 y--pad3 :: Int -> Builder-pad3 abc = let (ab,c) = abc `quotRem` 10-               (a,b)  = ab  `quotRem` 10-            in p a ++ p b ++ p c--showD3 :: Int -> Builder-showD3 abc = case abc `quotRem` 100 of-              (a, 0) -> p a-              (a,bc) -> case bc `quotRem` 10 of-                          (b,0) -> p a ++ p b-                          (b,c) -> p a ++ p b ++ p c---- | p assumes its input is in the range [0..9]-p :: Integral n => n -> Builder-p n = fromChar (w2c (fromIntegral (n + 48)))-{-# INLINE p #-}---- | pad2 assumes its input is in the range [0..99]-pad2 :: Integral n => n -> Builder-pad2 n = let (a,b) = n `quotRem` 10 in p a ++ p b-{-# INLINE pad2 #-}---- | pad4 assumes its input is positive-pad4 :: (Integral n, Show n) => n -> Builder-pad4 abcd | abcd >= 10000 = integral abcd-          | otherwise     = p a ++ p b ++ p c ++ p d-  where (ab,cd) = abcd `quotRem` 100-        (a,b)   = ab   `quotRem` 10-        (c,d)   = cd   `quotRem` 10-{-# INLINE pad4 #-}+------------------------------------------------------------------------------
+-- |
+-- Module:      Database.SQLite.Simple.Time.Implementation
+-- Copyright:   (c) 2012 Leon P Smith
+--              (c) 2012-2014 Janne Hellsten
+-- License:     BSD3
+-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
+--
+-- Adapted from Leon P Smith's code for SQLite.
+--
+-- See <http://sqlite.org/lang_datefunc.html> for date formats used in SQLite.
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple.Time.Implementation (
+    parseUTCTime
+  , parseDay
+  , utcTimeToBuilder
+  , dayToBuilder
+  , timeOfDayToBuilder
+  , timeZoneToBuilder
+  ) where
+import           Blaze.ByteString.Builder (Builder)
+import           Blaze.ByteString.Builder.Char8 (fromChar)
+import           Blaze.Text.Int (integral)
+import           Control.Applicative
+import           Control.Monad (when)
+import qualified Data.Attoparsec.Text as A
+import           Data.Bits ((.&.))
+import           Data.ByteString.Internal (w2c)
+import           Data.Char (isDigit, ord)
+import           Data.Fixed (Pico)
+import           Data.Monoid (Monoid(..))
+import qualified Data.Text as T
+import           Data.Time hiding (getTimeZone, getZonedTime)
+import           Prelude hiding (take, (++))
+import           Unsafe.Coerce
+
+(++) :: Monoid a => a -> a -> a
+(++) = mappend
+infixr 5 ++
+
+parseUTCTime   :: T.Text -> Either String UTCTime
+parseUTCTime   = A.parseOnly (getUTCTime <* A.endOfInput)
+
+parseDay :: T.Text -> Either String Day
+parseDay = A.parseOnly (getDay <* A.endOfInput)
+
+getDay :: A.Parser Day
+getDay = do
+    yearStr <- A.takeWhile isDigit
+    when (T.length yearStr < 4) (fail "year must consist of at least 4 digits")
+
+    let !year = toNum yearStr
+    _       <- A.char '-'
+    month   <- digits "month"
+    _       <- A.char '-'
+    day     <- digits "day"
+
+    case fromGregorianValid year month day of
+      Nothing -> fail "invalid date"
+      Just x  -> return $! x
+
+decimal :: Fractional a => T.Text -> a
+decimal str = toNum str / 10^(T.length str)
+{-# INLINE decimal #-}
+
+getTimeOfDay :: A.Parser TimeOfDay
+getTimeOfDay = do
+    hour   <- digits "hours"
+    _      <- A.char ':'
+    minute <- digits "minutes"
+    -- Allow omission of seconds.  If seconds is omitted, don't try to
+    -- parse the sub-second part.
+    (sec,subsec)
+           <- ((,) <$> (A.char ':' *> digits "seconds") <*> fract) <|> pure (0,0)
+
+    let !picos' = sec + subsec
+
+    case makeTimeOfDayValid hour minute picos' of
+      Nothing -> fail "invalid time of day"
+      Just x  -> return $! x
+
+    where
+      fract =
+        (A.char '.' *> (decimal <$> A.takeWhile1 isDigit)) <|> pure 0
+
+getTimeZone :: A.Parser TimeZone
+getTimeZone = do
+    sign  <- A.satisfy (\c -> c == '+' || c == '-')
+    hours <- digits "timezone"
+    mins  <- (A.char ':' *> digits "timezone minutes") <|> pure 0
+    let !absset = 60 * hours + mins
+        !offset = if sign == '+' then absset else -absset
+    return $! minutesToTimeZone offset
+
+getUTCTime :: A.Parser UTCTime
+getUTCTime = do
+    day  <- getDay
+    _    <- A.char ' ' <|> A.char 'T'
+    time <- getTimeOfDay
+    -- SQLite doesn't require a timezone postfix.  So make that
+    -- optional and default to +0.  'Z' means UTC (zulu time).
+    zone <- getTimeZone <|> (A.char 'Z' *> pure utc) <|> (pure utc)
+    let (!dayDelta,!time') = localToUTCTimeOfDay zone time
+    let !day' = addDays dayDelta day
+    let !time'' = timeOfDayToTime time'
+    return (UTCTime day' time'')
+
+toNum :: Num n => T.Text -> n
+toNum = T.foldl' (\a c -> 10*a + digit c) 0
+{-# INLINE toNum #-}
+
+digit :: Num n => Char -> n
+digit c = fromIntegral (ord c .&. 0x0f)
+{-# INLINE digit #-}
+
+digits :: Num n => String -> A.Parser n
+digits msg = do
+  x <- A.anyChar
+  y <- A.anyChar
+  if isDigit x && isDigit y
+  then return $! (10 * digit x + digit y)
+  else fail (msg ++ " is not 2 digits")
+{-# INLINE digits #-}
+
+dayToBuilder :: Day -> Builder
+dayToBuilder (toGregorian -> (y,m,d)) = do
+    pad4 y ++ fromChar '-' ++ pad2 m ++ fromChar '-' ++ pad2 d
+
+timeOfDayToBuilder :: TimeOfDay -> Builder
+timeOfDayToBuilder (TimeOfDay h m s) = do
+    pad2 h ++ fromChar ':' ++ pad2 m ++ fromChar ':' ++ showSeconds s
+
+timeZoneToBuilder :: TimeZone -> Builder
+timeZoneToBuilder tz
+    | m == 0     =  sign h ++ pad2 (abs h)
+    | otherwise  =  sign h ++ pad2 (abs h) ++ fromChar ':' ++ pad2 (abs m)
+  where
+    (h,m) = timeZoneMinutes tz `quotRem` 60
+    sign h | h >= 0    = fromChar '+'
+           | otherwise = fromChar '-'
+
+-- | Output YYYY-MM-DD HH:MM:SS with an optional .SSS fraction part.
+-- Explicit timezone attribute is not appended as per SQLite3's
+-- datetime conventions.
+utcTimeToBuilder :: UTCTime -> Builder
+utcTimeToBuilder (UTCTime day time) =
+    dayToBuilder day ++ fromChar ' ' ++ timeOfDayToBuilder (timeToTimeOfDay time)
+
+showSeconds :: Pico -> Builder
+showSeconds xyz
+    | yz == 0   = pad2 x
+    | z  == 0   = pad2 x ++ fromChar '.' ++  showD6 y
+    | otherwise = pad2 x ++ fromChar '.' ++  pad6   y ++ showD6 z
+  where
+    -- A kludge to work around the fact that Data.Fixed isn't very fast and
+    -- doesn't give me access to the MkFixed constructor.
+    (x_,yz) = (unsafeCoerce xyz :: Integer)     `quotRem` 1000000000000
+    x = fromIntegral x_ :: Int
+    (fromIntegral -> y, fromIntegral -> z) = yz `quotRem` 1000000
+
+pad6 :: Int -> Builder
+pad6 xy = let (x,y) = xy `quotRem` 1000
+           in pad3 x ++ pad3 y
+
+showD6 :: Int -> Builder
+showD6 xy = case xy `quotRem` 1000 of
+              (x,0) -> showD3 x
+              (x,y) -> pad3 x ++ showD3 y
+
+pad3 :: Int -> Builder
+pad3 abc = let (ab,c) = abc `quotRem` 10
+               (a,b)  = ab  `quotRem` 10
+            in p a ++ p b ++ p c
+
+showD3 :: Int -> Builder
+showD3 abc = case abc `quotRem` 100 of
+              (a, 0) -> p a
+              (a,bc) -> case bc `quotRem` 10 of
+                          (b,0) -> p a ++ p b
+                          (b,c) -> p a ++ p b ++ p c
+
+-- | p assumes its input is in the range [0..9]
+p :: Integral n => n -> Builder
+p n = fromChar (w2c (fromIntegral (n + 48)))
+{-# INLINE p #-}
+
+-- | pad2 assumes its input is in the range [0..99]
+pad2 :: Integral n => n -> Builder
+pad2 n = let (a,b) = n `quotRem` 10 in p a ++ p b
+{-# INLINE pad2 #-}
+
+-- | pad4 assumes its input is positive
+pad4 :: (Integral n, Show n) => n -> Builder
+pad4 abcd | abcd >= 10000 = integral abcd
+          | otherwise     = p a ++ p b ++ p c ++ p d
+  where (ab,cd) = abcd `quotRem` 100
+        (a,b)   = ab   `quotRem` 10
+        (c,d)   = cd   `quotRem` 10
+{-# INLINE pad4 #-}
Database/SQLite/Simple/ToField.hs view
@@ -1,170 +1,170 @@-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor       #-}-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}----------------------------------------------------------------------------------- |--- Module:      Database.SQLite.Simple.ToField--- Copyright:   (c) 2011 MailRank, Inc.---              (c) 2011-2012 Leon P Smith---              (c) 2012-2013 Janne Hellsten--- License:     BSD3--- Maintainer:  Janne Hellsten <jjhellst@gmail.com>--- Portability: portable------ The 'ToField' typeclass, for rendering a parameter to an SQLite--- value to be bound as a SQL query parameter.------------------------------------------------------------------------------------module Database.SQLite.Simple.ToField (ToField(..)) where--import           Blaze.ByteString.Builder (toByteString)-import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy as LB-import           Data.Int (Int8, Int16, Int32, Int64)-import qualified Data.Text as T-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Encoding as T-import           Data.Time (Day, UTCTime)-import           Data.Word (Word, Word8, Word16, Word32, Word64)-import           GHC.Float--import           Database.SQLite3 as Base-import           Database.SQLite.Simple.Types (Null)-import           Database.SQLite.Simple.Time---- | A type that may be used as a single parameter to a SQL query.-class ToField a where-    toField :: a -> SQLData-    -- ^ Prepare a value for substitution into a query string.--instance ToField SQLData where-    toField a = a-    {-# INLINE toField #-}--instance (ToField a) => ToField (Maybe a) where-    toField Nothing  = Base.SQLNull-    toField (Just a) = toField a-    {-# INLINE toField #-}--instance ToField Null where-    toField _ = Base.SQLNull-    {-# INLINE toField #-}--instance ToField Bool where-    toField False = SQLInteger 0-    toField True  = SQLInteger 1-    {-# INLINE toField #-}--instance ToField Int8 where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Int16 where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Int32 where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Int where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Int64 where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Integer where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Word8 where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Word16 where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Word32 where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Word where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Word64 where-    toField = SQLInteger . fromIntegral-    {-# INLINE toField #-}--instance ToField Float where-    toField = SQLFloat . float2Double-    {-# INLINE toField #-}--instance ToField Double where-    toField = SQLFloat-    {-# INLINE toField #-}--instance ToField SB.ByteString where-    toField = SQLBlob-    {-# INLINE toField #-}--instance ToField LB.ByteString where-    toField = toField . SB.concat . LB.toChunks-    {-# INLINE toField #-}--instance ToField T.Text where-    toField = SQLText-    {-# INLINE toField #-}--instance ToField [Char] where-    toField = SQLText . T.pack-    {-# INLINE toField #-}--instance ToField LT.Text where-    toField = toField . LT.toStrict-    {-# INLINE toField #-}--instance ToField UTCTime where-    toField = SQLText . T.decodeUtf8 . toByteString . utcTimeToBuilder-    {-# INLINE toField #-}--instance ToField Day where-    toField = SQLText . T.decodeUtf8 . toByteString . dayToBuilder-    {-# INLINE toField #-}---- TODO enable these---instance ToField ZonedTime where---    toField = SQLText . zonedTimeToBuilder---    {-# INLINE toField #-}------instance ToField LocalTime where---    toField = SQLText . localTimeToBuilder---    {-# INLINE toField #-}------instance ToField Day where---    toField = SQLText . dayToBuilder---    {-# INLINE toField #-}------instance ToField TimeOfDay where---    toField = SQLText . timeOfDayToBuilder---    {-# INLINE toField #-}------instance ToField UTCTimestamp where---    toField = SQLText . utcTimestampToBuilder---    {-# INLINE toField #-}------instance ToField ZonedTimestamp where---    toField = SQLText . zonedTimestampToBuilder---    {-# INLINE toField #-}------instance ToField LocalTimestamp where---    toField = SQLText . localTimestampToBuilder---    {-# INLINE toField #-}------instance ToField Date where---    toField = SQLText . dateToBuilder---    {-# INLINE toField #-}+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor       #-}
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+
+------------------------------------------------------------------------------
+-- |
+-- Module:      Database.SQLite.Simple.ToField
+-- Copyright:   (c) 2011 MailRank, Inc.
+--              (c) 2011-2012 Leon P Smith
+--              (c) 2012-2013 Janne Hellsten
+-- License:     BSD3
+-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
+-- Portability: portable
+--
+-- The 'ToField' typeclass, for rendering a parameter to an SQLite
+-- value to be bound as a SQL query parameter.
+--
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple.ToField (ToField(..)) where
+
+import           Blaze.ByteString.Builder (toByteString)
+import qualified Data.ByteString as SB
+import qualified Data.ByteString.Lazy as LB
+import           Data.Int (Int8, Int16, Int32, Int64)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.Text.Encoding as T
+import           Data.Time (Day, UTCTime)
+import           Data.Word (Word, Word8, Word16, Word32, Word64)
+import           GHC.Float
+
+import           Database.SQLite3 as Base
+import           Database.SQLite.Simple.Types (Null)
+import           Database.SQLite.Simple.Time
+
+-- | A type that may be used as a single parameter to a SQL query.
+class ToField a where
+    toField :: a -> SQLData
+    -- ^ Prepare a value for substitution into a query string.
+
+instance ToField SQLData where
+    toField a = a
+    {-# INLINE toField #-}
+
+instance (ToField a) => ToField (Maybe a) where
+    toField Nothing  = Base.SQLNull
+    toField (Just a) = toField a
+    {-# INLINE toField #-}
+
+instance ToField Null where
+    toField _ = Base.SQLNull
+    {-# INLINE toField #-}
+
+instance ToField Bool where
+    toField False = SQLInteger 0
+    toField True  = SQLInteger 1
+    {-# INLINE toField #-}
+
+instance ToField Int8 where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Int16 where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Int32 where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Int where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Int64 where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Integer where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Word8 where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Word16 where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Word32 where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Word where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Word64 where
+    toField = SQLInteger . fromIntegral
+    {-# INLINE toField #-}
+
+instance ToField Float where
+    toField = SQLFloat . float2Double
+    {-# INLINE toField #-}
+
+instance ToField Double where
+    toField = SQLFloat
+    {-# INLINE toField #-}
+
+instance ToField SB.ByteString where
+    toField = SQLBlob
+    {-# INLINE toField #-}
+
+instance ToField LB.ByteString where
+    toField = toField . SB.concat . LB.toChunks
+    {-# INLINE toField #-}
+
+instance ToField T.Text where
+    toField = SQLText
+    {-# INLINE toField #-}
+
+instance ToField [Char] where
+    toField = SQLText . T.pack
+    {-# INLINE toField #-}
+
+instance ToField LT.Text where
+    toField = toField . LT.toStrict
+    {-# INLINE toField #-}
+
+instance ToField UTCTime where
+    toField = SQLText . T.decodeUtf8 . toByteString . utcTimeToBuilder
+    {-# INLINE toField #-}
+
+instance ToField Day where
+    toField = SQLText . T.decodeUtf8 . toByteString . dayToBuilder
+    {-# INLINE toField #-}
+
+-- TODO enable these
+--instance ToField ZonedTime where
+--    toField = SQLText . zonedTimeToBuilder
+--    {-# INLINE toField #-}
+--
+--instance ToField LocalTime where
+--    toField = SQLText . localTimeToBuilder
+--    {-# INLINE toField #-}
+--
+--instance ToField Day where
+--    toField = SQLText . dayToBuilder
+--    {-# INLINE toField #-}
+--
+--instance ToField TimeOfDay where
+--    toField = SQLText . timeOfDayToBuilder
+--    {-# INLINE toField #-}
+--
+--instance ToField UTCTimestamp where
+--    toField = SQLText . utcTimestampToBuilder
+--    {-# INLINE toField #-}
+--
+--instance ToField ZonedTimestamp where
+--    toField = SQLText . zonedTimestampToBuilder
+--    {-# INLINE toField #-}
+--
+--instance ToField LocalTimestamp where
+--    toField = SQLText . localTimestampToBuilder
+--    {-# INLINE toField #-}
+--
+--instance ToField Date where
+--    toField = SQLText . dateToBuilder
+--    {-# INLINE toField #-}
Database/SQLite/Simple/ToRow.hs view
@@ -1,92 +1,92 @@---------------------------------------------------------------------------------- |--- Module:      Database.SQLite.Simple.ToRow--- Copyright:   (c) 2011 MailRank, Inc.---              (c) 2011-2012 Leon P Smith---              (c) 2012-2013 Janne Hellsten--- License:     BSD3--- Maintainer:  Janne Hellsten <jjhellst@gmail.com>--- Portability: portable------ The 'ToRow' typeclass, for rendering a collection of--- parameters to a SQL query.------ Predefined instances are provided for tuples containing up to ten--- elements.------------------------------------------------------------------------------------module Database.SQLite.Simple.ToRow-    (-      ToRow(..)-    ) where--import Database.SQLite.Simple.ToField (ToField(..))-import Database.SQLite.Simple.Types (Only(..), (:.)(..))--import Database.SQLite3 (SQLData(..))---- | A collection type that can be turned into a list of 'SQLData'--- elements.-class ToRow a where-    toRow :: a -> [SQLData]-    -- ^ 'ToField' a collection of values.--instance ToRow () where-    toRow _ = []--instance (ToField a) => ToRow (Only a) where-    toRow (Only v) = [toField v]--instance (ToField a, ToField b) => ToRow (a,b) where-    toRow (a,b) = [toField a, toField b]--instance (ToField a, ToField b, ToField c) => ToRow (a,b,c) where-    toRow (a,b,c) = [toField a, toField b, toField c]--instance (ToField a, ToField b, ToField c, ToField d) => ToRow (a,b,c,d) where-    toRow (a,b,c,d) = [toField a, toField b, toField c, toField d]--instance (ToField a, ToField b, ToField c, ToField d, ToField e)-    => ToRow (a,b,c,d,e) where-    toRow (a,b,c,d,e) =-        [toField a, toField b, toField c, toField d, toField e]--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f)-    => ToRow (a,b,c,d,e,f) where-    toRow (a,b,c,d,e,f) =-        [toField a, toField b, toField c, toField d, toField e, toField f]--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,-          ToField g)-    => ToRow (a,b,c,d,e,f,g) where-    toRow (a,b,c,d,e,f,g) =-        [toField a, toField b, toField c, toField d, toField e, toField f,-         toField g]--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,-          ToField g, ToField h)-    => ToRow (a,b,c,d,e,f,g,h) where-    toRow (a,b,c,d,e,f,g,h) =-        [toField a, toField b, toField c, toField d, toField e, toField f,-         toField g, toField h]--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,-          ToField g, ToField h, ToField i)-    => ToRow (a,b,c,d,e,f,g,h,i) where-    toRow (a,b,c,d,e,f,g,h,i) =-        [toField a, toField b, toField c, toField d, toField e, toField f,-         toField g, toField h, toField i]--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,-          ToField g, ToField h, ToField i, ToField j)-    => ToRow (a,b,c,d,e,f,g,h,i,j) where-    toRow (a,b,c,d,e,f,g,h,i,j) =-        [toField a, toField b, toField c, toField d, toField e, toField f,-         toField g, toField h, toField i, toField j]--instance (ToField a) => ToRow [a] where-    toRow = map toField--instance (ToRow a, ToRow b) => ToRow (a :. b) where-    toRow (a :. b) = toRow a ++ toRow b+------------------------------------------------------------------------------
+-- |
+-- Module:      Database.SQLite.Simple.ToRow
+-- Copyright:   (c) 2011 MailRank, Inc.
+--              (c) 2011-2012 Leon P Smith
+--              (c) 2012-2013 Janne Hellsten
+-- License:     BSD3
+-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
+-- Portability: portable
+--
+-- The 'ToRow' typeclass, for rendering a collection of
+-- parameters to a SQL query.
+--
+-- Predefined instances are provided for tuples containing up to ten
+-- elements.
+--
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple.ToRow
+    (
+      ToRow(..)
+    ) where
+
+import Database.SQLite.Simple.ToField (ToField(..))
+import Database.SQLite.Simple.Types (Only(..), (:.)(..))
+
+import Database.SQLite3 (SQLData(..))
+
+-- | A collection type that can be turned into a list of 'SQLData'
+-- elements.
+class ToRow a where
+    toRow :: a -> [SQLData]
+    -- ^ 'ToField' a collection of values.
+
+instance ToRow () where
+    toRow _ = []
+
+instance (ToField a) => ToRow (Only a) where
+    toRow (Only v) = [toField v]
+
+instance (ToField a, ToField b) => ToRow (a,b) where
+    toRow (a,b) = [toField a, toField b]
+
+instance (ToField a, ToField b, ToField c) => ToRow (a,b,c) where
+    toRow (a,b,c) = [toField a, toField b, toField c]
+
+instance (ToField a, ToField b, ToField c, ToField d) => ToRow (a,b,c,d) where
+    toRow (a,b,c,d) = [toField a, toField b, toField c, toField d]
+
+instance (ToField a, ToField b, ToField c, ToField d, ToField e)
+    => ToRow (a,b,c,d,e) where
+    toRow (a,b,c,d,e) =
+        [toField a, toField b, toField c, toField d, toField e]
+
+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f)
+    => ToRow (a,b,c,d,e,f) where
+    toRow (a,b,c,d,e,f) =
+        [toField a, toField b, toField c, toField d, toField e, toField f]
+
+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
+          ToField g)
+    => ToRow (a,b,c,d,e,f,g) where
+    toRow (a,b,c,d,e,f,g) =
+        [toField a, toField b, toField c, toField d, toField e, toField f,
+         toField g]
+
+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
+          ToField g, ToField h)
+    => ToRow (a,b,c,d,e,f,g,h) where
+    toRow (a,b,c,d,e,f,g,h) =
+        [toField a, toField b, toField c, toField d, toField e, toField f,
+         toField g, toField h]
+
+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
+          ToField g, ToField h, ToField i)
+    => ToRow (a,b,c,d,e,f,g,h,i) where
+    toRow (a,b,c,d,e,f,g,h,i) =
+        [toField a, toField b, toField c, toField d, toField e, toField f,
+         toField g, toField h, toField i]
+
+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
+          ToField g, ToField h, ToField i, ToField j)
+    => ToRow (a,b,c,d,e,f,g,h,i,j) where
+    toRow (a,b,c,d,e,f,g,h,i,j) =
+        [toField a, toField b, toField c, toField d, toField e, toField f,
+         toField g, toField h, toField i, toField j]
+
+instance (ToField a) => ToRow [a] where
+    toRow = map toField
+
+instance (ToRow a, ToRow b) => ToRow (a :. b) where
+    toRow (a :. b) = toRow a ++ toRow b
Database/SQLite/Simple/Types.hs view
@@ -1,111 +1,111 @@-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}----------------------------------------------------------------------------------- |--- Module:      Database.SQLite.Simple.Types--- Copyright:   (c) 2011 MailRank, Inc.---              (c) 2011-2012 Leon P Smith---              (c) 2012-2013 Janne Hellsten--- License:     BSD3--- Maintainer:  Janne Hellsten <jjhellst@gmail.com>--- Portability: portable------ Top-level module for sqlite-simple.---------------------------------------------------------------------------------------module Database.SQLite.Simple.Types-    (-      Null(..)-    , Only(..)-    , Query(..)-    , (:.)(..)-    ) where--import           Control.Arrow (first)-import           Data.Monoid (Monoid(..))-import           Data.String (IsString(..))-import           Data.Typeable (Typeable)-import qualified Data.Text as T---- | A placeholder for the SQL @NULL@ value.-data Null = Null-          deriving (Read, Show, Typeable)--instance Eq Null where-    _ == _ = False-    _ /= _ = False---- | A query string. This type is intended to make it difficult to--- construct a SQL query by concatenating string fragments, as that is--- an extremely common way to accidentally introduce SQL injection--- vulnerabilities into an application.------ This type is an instance of 'IsString', so the easiest way to--- construct a query is to enable the @OverloadedStrings@ language--- extension and then simply write the query in double quotes.------ > {-# LANGUAGE OverloadedStrings #-}--- >--- > import Database.SQLite.Simple--- >--- > q :: Query--- > q = "select ?"------ The underlying type is a 'Text', and literal Haskell strings that--- contain Unicode characters will be correctly transformed to UTF-8.-newtype Query = Query {-      fromQuery :: T.Text-    } deriving (Eq, Ord, Typeable)--instance Show Query where-    show = show . fromQuery--instance Read Query where-    readsPrec i = fmap (first Query) . readsPrec i--instance IsString Query where-    fromString = Query . T.pack--instance Monoid Query where-    mempty = Query T.empty-    mappend (Query a) (Query b) = Query (T.append a b)-    {-# INLINE mappend #-}---- | A single-value \"collection\".------ This is useful if you need to supply a single parameter to a SQL--- query, or extract a single column from a SQL result.------ Parameter example:------ @query c \"select x from scores where x > ?\" ('Only' (42::Int))@------ Result example:------ @xs <- query_ c \"select id from users\"---forM_ xs $ \\('Only' id) -> {- ... -}@-newtype Only a = Only {-      fromOnly :: a-    } deriving (Eq, Ord, Read, Show, Typeable, Functor)---- | A composite type to parse your custom data structures without--- having to define dummy newtype wrappers every time.--------- > instance FromRow MyData where ...------ > instance FromRow MyData2 where ...--------- then I can do the following for free:------ @--- res <- query' c "..."--- forM res $ \\(MyData{..} :. MyData2{..}) -> do---   ....--- @-data h :. t = h :. t deriving (Eq,Ord,Show,Read,Typeable)--infixr 3 :.+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}
+
+------------------------------------------------------------------------------
+-- |
+-- Module:      Database.SQLite.Simple.Types
+-- Copyright:   (c) 2011 MailRank, Inc.
+--              (c) 2011-2012 Leon P Smith
+--              (c) 2012-2013 Janne Hellsten
+-- License:     BSD3
+-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
+-- Portability: portable
+--
+-- Top-level module for sqlite-simple.
+--
+--
+------------------------------------------------------------------------------
+
+module Database.SQLite.Simple.Types
+    (
+      Null(..)
+    , Only(..)
+    , Query(..)
+    , (:.)(..)
+    ) where
+
+import           Control.Arrow (first)
+import           Data.Monoid (Monoid(..))
+import           Data.String (IsString(..))
+import           Data.Typeable (Typeable)
+import qualified Data.Text as T
+
+-- | A placeholder for the SQL @NULL@ value.
+data Null = Null
+          deriving (Read, Show, Typeable)
+
+instance Eq Null where
+    _ == _ = False
+    _ /= _ = False
+
+-- | A query string. This type is intended to make it difficult to
+-- construct a SQL query by concatenating string fragments, as that is
+-- an extremely common way to accidentally introduce SQL injection
+-- vulnerabilities into an application.
+--
+-- This type is an instance of 'IsString', so the easiest way to
+-- construct a query is to enable the @OverloadedStrings@ language
+-- extension and then simply write the query in double quotes.
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- >
+-- > import Database.SQLite.Simple
+-- >
+-- > q :: Query
+-- > q = "select ?"
+--
+-- The underlying type is a 'Text', and literal Haskell strings that
+-- contain Unicode characters will be correctly transformed to UTF-8.
+newtype Query = Query {
+      fromQuery :: T.Text
+    } deriving (Eq, Ord, Typeable)
+
+instance Show Query where
+    show = show . fromQuery
+
+instance Read Query where
+    readsPrec i = fmap (first Query) . readsPrec i
+
+instance IsString Query where
+    fromString = Query . T.pack
+
+instance Monoid Query where
+    mempty = Query T.empty
+    mappend (Query a) (Query b) = Query (T.append a b)
+    {-# INLINE mappend #-}
+
+-- | A single-value \"collection\".
+--
+-- This is useful if you need to supply a single parameter to a SQL
+-- query, or extract a single column from a SQL result.
+--
+-- Parameter example:
+--
+-- @query c \"select x from scores where x > ?\" ('Only' (42::Int))@
+--
+-- Result example:
+--
+-- @xs <- query_ c \"select id from users\"
+--forM_ xs $ \\('Only' id) -> {- ... -}@
+newtype Only a = Only {
+      fromOnly :: a
+    } deriving (Eq, Ord, Read, Show, Typeable, Functor)
+
+-- | A composite type to parse your custom data structures without
+-- having to define dummy newtype wrappers every time.
+--
+--
+-- > instance FromRow MyData where ...
+--
+-- > instance FromRow MyData2 where ...
+--
+--
+-- then I can do the following for free:
+--
+-- @
+-- res <- query' c "..."
+-- forM res $ \\(MyData{..} :. MyData2{..}) -> do
+--   ....
+-- @
+data h :. t = h :. t deriving (Eq,Ord,Show,Read,Typeable)
+
+infixr 3 :.
README.markdown view
@@ -1,116 +1,114 @@-sqlite-simple: mid-level bindings to the sqlite database-========================================================--This library is a mid-level Haskell binding to the SQLite database.--Sqlite-simple provides a convenient API to sqlite that does some level-of automatic data conversion between the database and Haskell types.-The API has been modeled directly after-[postgresql-simple](http://github.com/lpsmith/postgresql-simple) which-in turn borrows from-[mysql-simple](https://github.com/bos/mysql-simple).--[The sqlite-simple API-reference](https://hackage.haskell.org/package/sqlite-simple/docs/Database-SQLite-Simple.html)-contains more examples of use and information on its features.--The library is well tested and stable.  The library should also be-reasonably performant.  You can find its benchmark suite here:-[db-bench](https://github.com/nurpax/db-bench).  You can read more-about sqlite-simple's expected performance in [my blog about-sqlite-simple performance against direct-sqlite, Python and-C](http://nurpax.github.io/posts/2013-08-17-sqlite-simple-benchmarking.html).--[![Build Status](https://secure.travis-ci.org/nurpax/sqlite-simple.png)](http://travis-ci.org/nurpax/sqlite-simple)--[![Coverage Status](https://coveralls.io/repos/nurpax/sqlite-simple/badge.png?branch=master)](https://coveralls.io/r/nurpax/sqlite-simple?branch=master)--Installation---------------You can install [sqlite-simple from Hackage](http://hackage.haskell.org/package/sqlite-simple)-with:--```-cabal install sqlite-simple-```--A Windows user?  It works but please see [this note](https://gist.github.com/3907344) on direct-sqlite Windows installation.--Examples of use------------------Create a test database by copy&pasting the below snippet to your-shell:--```-sqlite3 test.db "CREATE TABLE test (id INTEGER PRIMARY KEY, str text);\-INSERT INTO test (str) VALUES ('test string');"-```--..and access it in Haskell:--```haskell-{-# LANGUAGE OverloadedStrings #-}-import Control.Applicative-import Database.SQLite.Simple-import Database.SQLite.Simple.FromRow--data TestField = TestField Int String deriving (Show)--instance FromRow TestField where-  fromRow = TestField <$> field <*> field--main :: IO ()-main = do-  conn <- open "test.db"-  execute conn "INSERT INTO test (str) VALUES (?)"-    (Only ("test string 2" :: String))-  r <- query_ conn "SELECT * from test" :: IO [TestField]-  mapM_ print r-  close conn-```--More simple usage examples can be found from [sqlite-simple unit-tests](https://github.com/nurpax/sqlite-simple/blob/master/test/Simple.hs).---Development--------------The development roadmap for sqlite-simple is mostly captured in the-github issue database.--I'm happy to receive bug reports, fixes, documentation enhancements,-and other improvements.--Please report bugs via the-[github issue tracker](http://github.com/nurpax/sqlite-simple/issues).--For general database issues with a Haskell focus, I recommend sending-e-mail to the [database-devel mailing-list](http://www.haskell.org/mailman/listinfo/database-devel).--### Contributing--If you send pull requests for new features, it'd be great if you could also develop unit-tests for any such features.---Credits----------A lot of the code is directly borrowed from-[mysql-simple](http://github.com/bos/mysql-simple) by Bryan O'Sullivan-and from-[postgresql-simple](http://github.com/lpsmith/postgresql-simple) by-Leon P. Smith.  Like Leon in postgresql-simple, I borrow code and-documentation directly from both of these ancestor libraries.--This package builds on top of the-[direct-sqlite](http://hackage.haskell.org/package/direct-sqlite)-package by Irene Knapp.--SQLite is rather weakly-typed and thus the SQL to Haskell type-strictness of the parent projects does not necessarily apply to this-package.+sqlite-simple: mid-level bindings to the sqlite database
+========================================================
+
+This library is a mid-level Haskell binding to the SQLite database.
+
+Sqlite-simple provides a convenient API to sqlite that does some level
+of automatic data conversion between the database and Haskell types.
+The API has been modeled directly after
+[postgresql-simple](http://github.com/lpsmith/postgresql-simple) which
+in turn borrows from
+[mysql-simple](https://github.com/bos/mysql-simple).
+
+[The sqlite-simple API
+reference](https://hackage.haskell.org/package/sqlite-simple/docs/Database-SQLite-Simple.html)
+contains more examples of use and information on its features.
+
+The library is well tested and stable.  The library should also be
+reasonably performant.  You can find its benchmark suite here:
+[db-bench](https://github.com/nurpax/db-bench).  You can read more
+about sqlite-simple's expected performance in [my blog about
+sqlite-simple performance against direct-sqlite, Python and
+C](http://nurpax.github.io/posts/2013-08-17-sqlite-simple-benchmarking.html).
+
+[![Build Status](https://secure.travis-ci.org/nurpax/sqlite-simple.png)](http://travis-ci.org/nurpax/sqlite-simple)
+
+Installation
+------------
+
+You can install [sqlite-simple from Hackage](http://hackage.haskell.org/package/sqlite-simple)
+with:
+
+```
+cabal install sqlite-simple
+```
+
+A Windows user?  It works but please see [this note](https://gist.github.com/3907344) on direct-sqlite Windows installation.
+
+Examples of use
+---------------
+
+Create a test database by copy&pasting the below snippet to your
+shell:
+
+```
+sqlite3 test.db "CREATE TABLE test (id INTEGER PRIMARY KEY, str text);\
+INSERT INTO test (str) VALUES ('test string');"
+```
+
+..and access it in Haskell:
+
+```haskell
+{-# LANGUAGE OverloadedStrings #-}
+import Control.Applicative
+import Database.SQLite.Simple
+import Database.SQLite.Simple.FromRow
+
+data TestField = TestField Int String deriving (Show)
+
+instance FromRow TestField where
+  fromRow = TestField <$> field <*> field
+
+main :: IO ()
+main = do
+  conn <- open "test.db"
+  execute conn "INSERT INTO test (str) VALUES (?)"
+    (Only ("test string 2" :: String))
+  r <- query_ conn "SELECT * from test" :: IO [TestField]
+  mapM_ print r
+  close conn
+```
+
+More simple usage examples can be found from [sqlite-simple unit
+tests](https://github.com/nurpax/sqlite-simple/blob/master/test/Simple.hs).
+
+
+Development
+-----------
+
+The development roadmap for sqlite-simple is mostly captured in the
+github issue database.
+
+I'm happy to receive bug reports, fixes, documentation enhancements,
+and other improvements.
+
+Please report bugs via the
+[github issue tracker](http://github.com/nurpax/sqlite-simple/issues).
+
+For general database issues with a Haskell focus, I recommend sending
+e-mail to the [database-devel mailing
+list](http://www.haskell.org/mailman/listinfo/database-devel).
+
+### Contributing
+
+If you send pull requests for new features, it'd be great if you could also develop unit
+tests for any such features.
+
+
+Credits
+-------
+
+A lot of the code is directly borrowed from
+[mysql-simple](http://github.com/bos/mysql-simple) by Bryan O'Sullivan
+and from
+[postgresql-simple](http://github.com/lpsmith/postgresql-simple) by
+Leon P. Smith.  Like Leon in postgresql-simple, I borrow code and
+documentation directly from both of these ancestor libraries.
+
+This package builds on top of the
+[direct-sqlite](http://hackage.haskell.org/package/direct-sqlite)
+package by Irene Knapp.
+
+SQLite is rather weakly-typed and thus the SQL to Haskell type
+strictness of the parent projects does not necessarily apply to this
+package.
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
changelog view
@@ -1,86 +1,89 @@-0.4.10.0-	* Expose sqlite3_changes/total_changes--0.4.9.0-	* Provide queryWith_ to allow more fine-grained access to-	  constructing queries.-	* Expose error data constructors (pull request #42)-	* Improve haddocks--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--0.4.6.0-	* Add "named parameters" variants of query & al.  Named params-	  allow queries like:-	  res <- queryNamed conn "SELECT * FROM posts WHERE id = :id" [":id" := postId]-	* Add FromField instances for Int8, Word, Word8, Word16, Word32-	  and Word64.-	* Fix typos in some type conversion error messages.-	* Improved test coverage.--0.4.5.2-	* Build fix for GHC 7.4--0.4.5.1-	* Docs changes - uploaded new version to Hackage to update the-	Hackage page.--0.4.5.0--	* Various improvements to documentation.  Especially UTCTime-	  parsing and printing, and how it relates to SQLite datetimes is-	  better documented now.--	* Improved date/time parsing performance by adapting Leon-	  P. Smith's parsers from postgresql-simple for SQLite.  UTCTime-	  handling is also better defined now.--	* Improved query performance-	  (https://github.com/nurpax/sqlite-simple/issues/23)--	* Improved tests for all areas touched by the above change.--v0.4.4.0--	* Add FromField instance for Float--	* Improve error handling for day parsing--	* + with tests--v0.4.1.0 - v0.4.3.0 (missed tagging v0.4.2.0)--	* Improvements to withBind functionality and documentation-	  (see https://github.com/nurpax/sqlite-simple/pull/26)--	* Add columnName accessor for statements--	* Expose MonadPlus on RowParser--	* Allow access to the underlying direct-sqilte connection from an-	  sqlite-simple connection--	* Add Data.Text.Lazy and lazy ByteString From/ToField instances--v0.4.0.0--	* Add lastInsertRowId--	* Expose SQLite statements based streaming API-	  (see https://github.com/nurpax/sqlite-simple/pull/22)--v0.3.0.0--	* Add fold, fold_, withConnection--v0.2.0.0 - v0.2.1.0--	* Optimizations to improve query rows/sec performance+0.4.11.0
+	* Add executeMany
+
+0.4.10.0
+	* Expose sqlite3_changes/total_changes
+
+0.4.9.0
+	* Provide queryWith_ to allow more fine-grained access to
+	  constructing queries.
+	* Expose error data constructors (pull request #42)
+	* Improve haddocks
+
+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
+
+0.4.6.0
+	* Add "named parameters" variants of query & al.  Named params
+	  allow queries like:
+	  res <- queryNamed conn "SELECT * FROM posts WHERE id = :id" [":id" := postId]
+	* Add FromField instances for Int8, Word, Word8, Word16, Word32
+	  and Word64.
+	* Fix typos in some type conversion error messages.
+	* Improved test coverage.
+
+0.4.5.2
+	* Build fix for GHC 7.4
+
+0.4.5.1
+	* Docs changes - uploaded new version to Hackage to update the
+	Hackage page.
+
+0.4.5.0
+
+	* Various improvements to documentation.  Especially UTCTime
+	  parsing and printing, and how it relates to SQLite datetimes is
+	  better documented now.
+
+	* Improved date/time parsing performance by adapting Leon
+	  P. Smith's parsers from postgresql-simple for SQLite.  UTCTime
+	  handling is also better defined now.
+
+	* Improved query performance
+	  (https://github.com/nurpax/sqlite-simple/issues/23)
+
+	* Improved tests for all areas touched by the above change.
+
+v0.4.4.0
+
+	* Add FromField instance for Float
+
+	* Improve error handling for day parsing
+
+	* + with tests
+
+v0.4.1.0 - v0.4.3.0 (missed tagging v0.4.2.0)
+
+	* Improvements to withBind functionality and documentation
+	  (see https://github.com/nurpax/sqlite-simple/pull/26)
+
+	* Add columnName accessor for statements
+
+	* Expose MonadPlus on RowParser
+
+	* Allow access to the underlying direct-sqilte connection from an
+	  sqlite-simple connection
+
+	* Add Data.Text.Lazy and lazy ByteString From/ToField instances
+
+v0.4.0.0
+
+	* Add lastInsertRowId
+
+	* Expose SQLite statements based streaming API
+	  (see https://github.com/nurpax/sqlite-simple/pull/22)
+
+v0.3.0.0
+
+	* Add fold, fold_, withConnection
+
+v0.2.0.0 - v0.2.1.0
+
+	* Optimizations to improve query rows/sec performance
sqlite-simple.cabal view
@@ -1,104 +1,104 @@-Name:                sqlite-simple-Version:             0.4.10.0-Synopsis:            Mid-Level SQLite client library-Description:-    Mid-level SQLite client library, based on postgresql-simple.-    .-    Main documentation (with examples): <sqlite-simple/docs/Database-SQLite-Simple.html Database.SQLite.Simple>-    .-    You can view the project page at <http://github.com/nurpax/sqlite-simple>-    for more information.--License:             BSD3-License-file:        LICENSE-Author:              Bryan O'Sullivan, Leon P Smith, Janne Hellsten-Maintainer:          Janne Hellsten <jjhellst@gmail.com>-Copyright:           (c) 2011 MailRank, Inc.,-                     (c) 2011-2012 Leon P Smith,-                     (c) 2012-2014 Janne Hellsten-Homepage:            http://github.com/nurpax/sqlite-simple-bug-reports:         http://github.com/nurpax/sqlite-simple/issues-Stability:           stable-Category:            Database-Build-type:          Simple--Cabal-version:       >= 1.10--extra-source-files:  README.markdown-                     changelog--Library-  Default-language:  Haskell2010-  Exposed-modules:-     Database.SQLite.Simple-     Database.SQLite.Simple.Ok-     Database.SQLite.Simple.FromField-     Database.SQLite.Simple.FromRow-     Database.SQLite.Simple.Internal-     Database.SQLite.Simple.ToField-     Database.SQLite.Simple.ToRow-     Database.SQLite.Simple.Types-     Database.SQLite.Simple.Time-     Database.SQLite.Simple.Time.Implementation--  Build-depends:-    attoparsec >= 0.10.3,-    base < 5,-    blaze-builder,-    blaze-textual,-    bytestring >= 0.9,-    containers,-    direct-sqlite >= 2.3.13 && < 2.4,-    text >= 0.11,-    time,-    transformers--  default-extensions:-      DoAndIfThenElse-    , OverloadedStrings-    , BangPatterns-    , ViewPatterns-    , TypeOperators--  ghc-options: -Wall -fno-warn-name-shadowing--source-repository head-  type:     git-  location: http://github.com/nurpax/sqlite-simple---test-suite test-  default-language: Haskell2010-  type:             exitcode-stdio-1.0--  hs-source-dirs: test-  main-is:        Main.hs-  other-modules:  Common-                , Debug-                , DirectSqlite-                , Errors-                , Fold-                , ParamConv-                , Simple-                , Statement-                , TestImports-                , UserInstances-                , Utf8Strings--  ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind--  default-extensions:-      NamedFieldPuns-    , OverloadedStrings-    , Rank2Types-    , RecordWildCards--  build-depends: base-               , base16-bytestring-               , bytestring >= 0.9-               , HUnit-               , sqlite-simple-               , direct-sqlite-               , text-               , time-+Name:                sqlite-simple
+Version:             0.4.11.0
+Synopsis:            Mid-Level SQLite client library
+Description:
+    Mid-level SQLite client library, based on postgresql-simple.
+    .
+    Main documentation (with examples): <sqlite-simple/docs/Database-SQLite-Simple.html Database.SQLite.Simple>
+    .
+    You can view the project page at <http://github.com/nurpax/sqlite-simple>
+    for more information.
+
+License:             BSD3
+License-file:        LICENSE
+Author:              Bryan O'Sullivan, Leon P Smith, Janne Hellsten
+Maintainer:          Janne Hellsten <jjhellst@gmail.com>
+Copyright:           (c) 2011 MailRank, Inc.,
+                     (c) 2011-2012 Leon P Smith,
+                     (c) 2012-2014 Janne Hellsten
+Homepage:            http://github.com/nurpax/sqlite-simple
+bug-reports:         http://github.com/nurpax/sqlite-simple/issues
+Stability:           stable
+Category:            Database
+Build-type:          Simple
+
+Cabal-version:       >= 1.10
+
+extra-source-files:  README.markdown
+                     changelog
+
+Library
+  Default-language:  Haskell2010
+  Exposed-modules:
+     Database.SQLite.Simple
+     Database.SQLite.Simple.Ok
+     Database.SQLite.Simple.FromField
+     Database.SQLite.Simple.FromRow
+     Database.SQLite.Simple.Internal
+     Database.SQLite.Simple.ToField
+     Database.SQLite.Simple.ToRow
+     Database.SQLite.Simple.Types
+     Database.SQLite.Simple.Time
+     Database.SQLite.Simple.Time.Implementation
+
+  Build-depends:
+    attoparsec >= 0.10.3,
+    base < 5,
+    blaze-builder,
+    blaze-textual,
+    bytestring >= 0.9,
+    containers,
+    direct-sqlite >= 2.3.13 && < 2.4,
+    text >= 0.11,
+    time,
+    transformers
+
+  default-extensions:
+      DoAndIfThenElse
+    , OverloadedStrings
+    , BangPatterns
+    , ViewPatterns
+    , TypeOperators
+
+  ghc-options: -Wall -fno-warn-name-shadowing
+
+source-repository head
+  type:     git
+  location: http://github.com/nurpax/sqlite-simple
+
+
+test-suite test
+  default-language: Haskell2010
+  type:             exitcode-stdio-1.0
+
+  hs-source-dirs: test
+  main-is:        Main.hs
+  other-modules:  Common
+                , Debug
+                , DirectSqlite
+                , Errors
+                , Fold
+                , ParamConv
+                , Simple
+                , Statement
+                , TestImports
+                , UserInstances
+                , Utf8Strings
+
+  ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
+
+  default-extensions:
+      NamedFieldPuns
+    , OverloadedStrings
+    , Rank2Types
+    , RecordWildCards
+
+  build-depends: base
+               , base16-bytestring
+               , bytestring >= 0.9
+               , HUnit
+               , sqlite-simple
+               , direct-sqlite
+               , text
+               , time
+
test/Common.hs view
@@ -1,18 +1,18 @@--module Common (-    -- Note: Do not add more exports for SQLite.Simple here.  This is-    -- so that we trap we by default export enough out of-    -- Database.SQLite.Simple to make it useful as a single import.-    module Database.SQLite.Simple-  , module Test.HUnit-  , TestEnv(..)-) where--import Test.HUnit-import Database.SQLite.Simple--data TestEnv-    = TestEnv-        { conn     :: Connection-            -- ^ Connection shared by all the tests-        }+
+module Common (
+    -- Note: Do not add more exports for SQLite.Simple here.  This is
+    -- so that we trap we by default export enough out of
+    -- Database.SQLite.Simple to make it useful as a single import.
+    module Database.SQLite.Simple
+  , module Test.HUnit
+  , TestEnv(..)
+) where
+
+import Test.HUnit
+import Database.SQLite.Simple
+
+data TestEnv
+    = TestEnv
+        { conn     :: Connection
+            -- ^ Connection shared by all the tests
+        }
test/Debug.hs view
@@ -1,29 +1,29 @@-{-# LANGUAGE OverloadedStrings #-}--module Debug (-    testDebugTracing) where--import Control.Concurrent-import Common---- Simplest SELECT-testDebugTracing :: TestEnv -> Test-testDebugTracing TestEnv{..} = TestCase $ do-  chan <- newChan-  let logger m = writeChan chan m-  setTrace conn (Just logger)-  execute_ conn "SELECT null"-  msg <- readChan chan-  "SELECT null" @=? msg-  execute conn "SELECT 1+?" (Only (2 :: Int))-  execute conn "SELECT 1+?" (Only (3 :: Int))-  msg <- readChan chan-  "SELECT 1+2" @=? msg-  msg <- readChan chan-  "SELECT 1+3" @=? msg-  -- Check that disabling works too-  setTrace conn Nothing-  execute_ conn "SELECT null"-  writeChan chan "empty"-  msg <- readChan chan-  "empty" @=? msg+{-# LANGUAGE OverloadedStrings #-}
+
+module Debug (
+    testDebugTracing) where
+
+import Control.Concurrent
+import Common
+
+-- Simplest SELECT
+testDebugTracing :: TestEnv -> Test
+testDebugTracing TestEnv{..} = TestCase $ do
+  chan <- newChan
+  let logger m = writeChan chan m
+  setTrace conn (Just logger)
+  execute_ conn "SELECT null"
+  msg <- readChan chan
+  "SELECT null" @=? msg
+  execute conn "SELECT 1+?" (Only (2 :: Int))
+  execute conn "SELECT 1+?" (Only (3 :: Int))
+  msg <- readChan chan
+  "SELECT 1+2" @=? msg
+  msg <- readChan chan
+  "SELECT 1+3" @=? msg
+  -- Check that disabling works too
+  setTrace conn Nothing
+  execute_ conn "SELECT null"
+  writeChan chan "empty"
+  msg <- readChan chan
+  "empty" @=? msg
test/DirectSqlite.hs view
@@ -1,23 +1,23 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}--module DirectSqlite (-    testDirectSqlite-  ) where--import Common--import Control.Exception (bracket)-import qualified Database.SQLite3 as DS--testDirectSqlite :: TestEnv -> Test-testDirectSqlite TestEnv{..} = TestCase $ do-  let dsConn = connectionHandle conn-  bracket (DS.prepare dsConn "SELECT 1+1") DS.finalize testDirect-  [Only (res :: Int)] <- query_ (Connection dsConn) "SELECT 1+2"-  assertEqual "1+2" 3 res-  where-    testDirect stmt = do-      DS.Row <- DS.step stmt-      res <- DS.column stmt 0-      assertEqual "1+1" (SQLInteger 2) res+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module DirectSqlite (
+    testDirectSqlite
+  ) where
+
+import Common
+
+import Control.Exception (bracket)
+import qualified Database.SQLite3 as DS
+
+testDirectSqlite :: TestEnv -> Test
+testDirectSqlite TestEnv{..} = TestCase $ do
+  let dsConn = connectionHandle conn
+  bracket (DS.prepare dsConn "SELECT 1+1") DS.finalize testDirect
+  [Only (res :: Int)] <- query_ (Connection dsConn) "SELECT 1+2"
+  assertEqual "1+2" 3 res
+  where
+    testDirect stmt = do
+      DS.Row <- DS.step stmt
+      res <- DS.column stmt 0
+      assertEqual "1+1" (SQLInteger 2) res
test/Errors.hs view
@@ -1,179 +1,179 @@-{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}--module Errors (-    testErrorsColumns-  , testErrorsInvalidParams-  , testErrorsInvalidNamedParams-  , testErrorsWithStatement-  , testErrorsColumnName-  , testErrorsTransaction-  ) where--import           Prelude hiding (catch)-import           Control.Exception-import qualified Data.ByteString as B-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.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) (\(e :: ResultError) -> length (show e) `seq` return True) >>=-    assertBool "assertResultError exc"--assertFormatErrorCaught :: IO a -> Assertion-assertFormatErrorCaught action = do-  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) (\(e :: SQLError) -> length (show e) `seq` return True) >>=-    assertBool "assertSQLError exc"--assertOOBCaught :: IO a -> Assertion-assertOOBCaught action = do-  catch (action >> return False) (\(e :: ArrayException) -> length (show e) `seq` return True) >>=-    assertBool "assertOOBCaught exc"--testErrorsColumns :: TestEnv -> Test-testErrorsColumns TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE cols (id INTEGER PRIMARY KEY, t TEXT)"-  execute_ conn "INSERT INTO cols (t) VALUES ('test string')"-  rows <- query_ conn "SELECT t FROM cols" :: IO [Only String]-  assertEqual "row count" 1 (length rows)-  assertEqual "string" (Only "test string") (head rows)-  -- Mismatched number of output columns (selects two, dest type has 1 field)-  assertResultErrorCaught (query_ conn "SELECT id,t FROM cols" :: IO [Only Int])-  -- Same as above but the other way round (select 1, dst has two)-  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)"-  execute conn "INSERT INTO cols_blobs (id, b) VALUES (?,?)" (1 :: Int, d)-  assertResultErrorCaught-    (do [Only _t1] <- query conn "SELECT b FROM cols_blobs WHERE id = ?" (Only (1 :: Int)) :: IO [Only String]-        return ())-  execute_ conn "CREATE TABLE cols_bools (id INTEGER PRIMARY KEY, b BOOLEAN)"-  -- 3 = invalid value for bool, must be 0 or 1-  execute_ conn "INSERT INTO cols_bools (b) VALUES (3)"-  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-  execute_ conn "CREATE TABLE invparams (id INTEGER PRIMARY KEY, t TEXT)"-  -- Test that only unnamed params are accepted-  assertFormatErrorCaught-    (execute conn "INSERT INTO invparams (t) VALUES (:v)" (Only ("foo" :: String)))-  assertFormatErrorCaught-    (execute conn "INSERT INTO invparams (id, t) VALUES (:v,$1)" (3::Int, "foo" :: String))-  -- In this case, we have two bound params but only one given to-  -- execute.  This should cause an error.-  assertFormatErrorCaught-    (execute conn "INSERT INTO invparams (id, t) VALUES (?, ?)" (Only (3::Int)))--testErrorsInvalidNamedParams :: TestEnv -> Test-testErrorsInvalidNamedParams TestEnv{..} = TestCase $ do-  -- Test that only unnamed params are accepted-  assertFormatErrorCaught-    (queryNamed conn "SELECT :foo" [":foox" := (1 :: Int)] :: IO [Only Int])-  -- In this case, we have two bound params but only one given to-  -- 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-  execute_ conn "CREATE TABLE invstat (id INTEGER PRIMARY KEY, t TEXT)"-  assertSQLErrorCaught $-    withStatement conn "SELECT id, t, t1 FROM invstat" $ \_stmt ->-      assertFailure "Error not detected"--testErrorsColumnName :: TestEnv -> Test-testErrorsColumnName TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE invcolumn (id INTEGER PRIMARY KEY, t TEXT)"-  assertOOBCaught $-    withStatement conn "SELECT id FROM invcolumn" $ \stmt ->-      columnName stmt (ColumnIndex (-1)) >> assertFailure "Error not detected"--testErrorsTransaction :: TestEnv -> Test-testErrorsTransaction TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE trans (id INTEGER PRIMARY KEY, t TEXT)"-  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"-  e <- rowExists-  False @=? e-  assertFormatErrorCaught-    (withTransaction conn $ do-        -- this execute should be automatically rolled back on error-        executeNamed conn-          "INSERT INTO trans (t) VALUES (:txt)" [":txt" := ("foo" :: String)]-        -- intentional mistake here to hit an error & cause rollback of txn-        executeNamed conn-          "INSERT INTO trans (t) VALUES (:txt)" [":missing" := ("foo" :: String)])-  e <- rowExists-  False @=? e-  where-    rowExists = do-      rows <- query_ conn "SELECT t FROM trans" :: IO [Only String]-      case rows of-        [Only txt] -> do-          "foo" @=? txt-          return True-        [] ->-          return False-        _ -> error "should have only one row"+{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
+
+module Errors (
+    testErrorsColumns
+  , testErrorsInvalidParams
+  , testErrorsInvalidNamedParams
+  , testErrorsWithStatement
+  , testErrorsColumnName
+  , testErrorsTransaction
+  ) where
+
+import           Prelude hiding (catch)
+import           Control.Exception
+import qualified Data.ByteString as B
+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.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) (\(e :: ResultError) -> length (show e) `seq` return True) >>=
+    assertBool "assertResultError exc"
+
+assertFormatErrorCaught :: IO a -> Assertion
+assertFormatErrorCaught action = do
+  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) (\(e :: SQLError) -> length (show e) `seq` return True) >>=
+    assertBool "assertSQLError exc"
+
+assertOOBCaught :: IO a -> Assertion
+assertOOBCaught action = do
+  catch (action >> return False) (\(e :: ArrayException) -> length (show e) `seq` return True) >>=
+    assertBool "assertOOBCaught exc"
+
+testErrorsColumns :: TestEnv -> Test
+testErrorsColumns TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE cols (id INTEGER PRIMARY KEY, t TEXT)"
+  execute_ conn "INSERT INTO cols (t) VALUES ('test string')"
+  rows <- query_ conn "SELECT t FROM cols" :: IO [Only String]
+  assertEqual "row count" 1 (length rows)
+  assertEqual "string" (Only "test string") (head rows)
+  -- Mismatched number of output columns (selects two, dest type has 1 field)
+  assertResultErrorCaught (query_ conn "SELECT id,t FROM cols" :: IO [Only Int])
+  -- Same as above but the other way round (select 1, dst has two)
+  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)"
+  execute conn "INSERT INTO cols_blobs (id, b) VALUES (?,?)" (1 :: Int, d)
+  assertResultErrorCaught
+    (do [Only _t1] <- query conn "SELECT b FROM cols_blobs WHERE id = ?" (Only (1 :: Int)) :: IO [Only String]
+        return ())
+  execute_ conn "CREATE TABLE cols_bools (id INTEGER PRIMARY KEY, b BOOLEAN)"
+  -- 3 = invalid value for bool, must be 0 or 1
+  execute_ conn "INSERT INTO cols_bools (b) VALUES (3)"
+  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
+  execute_ conn "CREATE TABLE invparams (id INTEGER PRIMARY KEY, t TEXT)"
+  -- Test that only unnamed params are accepted
+  assertFormatErrorCaught
+    (execute conn "INSERT INTO invparams (t) VALUES (:v)" (Only ("foo" :: String)))
+  assertFormatErrorCaught
+    (execute conn "INSERT INTO invparams (id, t) VALUES (:v,$1)" (3::Int, "foo" :: String))
+  -- In this case, we have two bound params but only one given to
+  -- execute.  This should cause an error.
+  assertFormatErrorCaught
+    (execute conn "INSERT INTO invparams (id, t) VALUES (?, ?)" (Only (3::Int)))
+
+testErrorsInvalidNamedParams :: TestEnv -> Test
+testErrorsInvalidNamedParams TestEnv{..} = TestCase $ do
+  -- Test that only unnamed params are accepted
+  assertFormatErrorCaught
+    (queryNamed conn "SELECT :foo" [":foox" := (1 :: Int)] :: IO [Only Int])
+  -- In this case, we have two bound params but only one given to
+  -- 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
+  execute_ conn "CREATE TABLE invstat (id INTEGER PRIMARY KEY, t TEXT)"
+  assertSQLErrorCaught $
+    withStatement conn "SELECT id, t, t1 FROM invstat" $ \_stmt ->
+      assertFailure "Error not detected"
+
+testErrorsColumnName :: TestEnv -> Test
+testErrorsColumnName TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE invcolumn (id INTEGER PRIMARY KEY, t TEXT)"
+  assertOOBCaught $
+    withStatement conn "SELECT id FROM invcolumn" $ \stmt ->
+      columnName stmt (ColumnIndex (-1)) >> assertFailure "Error not detected"
+
+testErrorsTransaction :: TestEnv -> Test
+testErrorsTransaction TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE trans (id INTEGER PRIMARY KEY, t TEXT)"
+  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"
+  e <- rowExists
+  False @=? e
+  assertFormatErrorCaught
+    (withTransaction conn $ do
+        -- this execute should be automatically rolled back on error
+        executeNamed conn
+          "INSERT INTO trans (t) VALUES (:txt)" [":txt" := ("foo" :: String)]
+        -- intentional mistake here to hit an error & cause rollback of txn
+        executeNamed conn
+          "INSERT INTO trans (t) VALUES (:txt)" [":missing" := ("foo" :: String)])
+  e <- rowExists
+  False @=? e
+  where
+    rowExists = do
+      rows <- query_ conn "SELECT t FROM trans" :: IO [Only String]
+      case rows of
+        [Only txt] -> do
+          "foo" @=? txt
+          return True
+        [] ->
+          return False
+        _ -> error "should have only one row"
test/Fold.hs view
@@ -1,21 +1,21 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}--module Fold (-    testFolds) where--import Common--testFolds :: TestEnv -> Test-testFolds TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE testf (id INTEGER PRIMARY KEY, t INT)"-  execute_ conn "INSERT INTO testf (t) VALUES (4)"-  execute_ conn "INSERT INTO testf (t) VALUES (5)"-  execute_ conn "INSERT INTO testf (t) VALUES (6)"-  val <- fold_ conn "SELECT id,t FROM testf" ([],[]) sumValues-  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)+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
+
+module Fold (
+    testFolds) where
+
+import Common
+
+testFolds :: TestEnv -> Test
+testFolds TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE testf (id INTEGER PRIMARY KEY, t INT)"
+  execute_ conn "INSERT INTO testf (t) VALUES (4)"
+  execute_ conn "INSERT INTO testf (t) VALUES (5)"
+  execute_ conn "INSERT INTO testf (t) VALUES (6)"
+  val <- fold_ conn "SELECT id,t FROM testf" ([],[]) sumValues
+  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/Main.hs view
@@ -1,81 +1,82 @@--import Common-import Control.Exception (bracket)-import Control.Monad     (when)-import System.Exit       (exitFailure)-import System.IO--import Simple-import ParamConv-import Errors-import Utf8Strings-import UserInstances-import TestImports()-import Fold-import Statement-import Debug-import DirectSqlite-import TestImports--tests :: [TestEnv -> Test]-tests =-    [ TestLabel "Simple"    . testSimpleSelect-    , TestLabel "Simple"    . testSimpleOnePlusOne-    , TestLabel "Simple"    . testSimpleParams-    , TestLabel "Simple"    . testSimpleTime-    , TestLabel "Simple"    . testSimpleTimeFract-    , TestLabel "Simple"    . testSimpleInsertId-    , TestLabel "Simple"    . testSimpleUTCTime-    , TestLabel "Simple"    . testSimpleUTCTimeTZ-    , TestLabel "Simple"    . testSimpleUTCTimeParams-    , TestLabel "Simple"    . testSimpleQueryCov-    , TestLabel "Simple"    . testSimpleStrings-    , TestLabel "Simple"    . testSimpleChanges-    , TestLabel "ParamConv" . testParamConvNull-    , TestLabel "ParamConv" . testParamConvInt-    , TestLabel "ParamConv" . testParamConvIntWidths-    , TestLabel "ParamConv" . testParamConvIntWidthsFromField-    , TestLabel "ParamConv" . testParamConvFloat-    , TestLabel "ParamConv" . testParamConvDateTime-    , TestLabel "ParamConv" . testParamConvBools-    , TestLabel "ParamConv" . testParamConvToRow-    , TestLabel "ParamConv" . testParamConvFromRow-    , TestLabel "ParamConv" . testParamConvComposite-    , TestLabel "ParamConv" . testParamNamed-    , TestLabel "Errors"    . testErrorsColumns-    , TestLabel "Errors"    . testErrorsInvalidParams-    , TestLabel "Errors"    . testErrorsInvalidNamedParams-    , TestLabel "Errors"    . testErrorsWithStatement-    , TestLabel "Errors"    . testErrorsColumnName-    , TestLabel "Errors"    . testErrorsTransaction-    , TestLabel "Utf8"      . testUtf8Simplest-    , TestLabel "Utf8"      . testBlobs-    , TestLabel "Instances" . testUserFromField-    , TestLabel "Fold"      . testFolds-    , TestLabel "Statement" . testBind-    , TestLabel "Statement" . testDoubleBind-    , TestLabel "Statement" . testPreparedStatements-    , TestLabel "Debug"     . testDebugTracing-    , TestLabel "Direct"    . testDirectSqlite-    , TestLabel "Imports"   . testImports-    ]---- | 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 Connection-testConnect = open ":memory:"--withTestEnv :: (TestEnv -> IO a) -> IO a-withTestEnv cb =-  withConn $ \conn -> cb TestEnv { conn = conn }-  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+
+import Common
+import Control.Exception (bracket)
+import Control.Monad     (when)
+import System.Exit       (exitFailure)
+import System.IO
+
+import Debug
+import DirectSqlite
+import Errors
+import Fold
+import ParamConv
+import Simple
+import Statement
+import TestImports()
+import TestImports
+import UserInstances
+import Utf8Strings
+
+tests :: [TestEnv -> Test]
+tests =
+    [ TestLabel "Simple"    . testSimpleSelect
+    , TestLabel "Simple"    . testSimpleOnePlusOne
+    , TestLabel "Simple"    . testSimpleParams
+    , TestLabel "Simple"    . testSimpleTime
+    , TestLabel "Simple"    . testSimpleTimeFract
+    , TestLabel "Simple"    . testSimpleInsertId
+    , TestLabel "Simple"    . testSimpleMultiInsert
+    , TestLabel "Simple"    . testSimpleUTCTime
+    , TestLabel "Simple"    . testSimpleUTCTimeTZ
+    , TestLabel "Simple"    . testSimpleUTCTimeParams
+    , TestLabel "Simple"    . testSimpleQueryCov
+    , TestLabel "Simple"    . testSimpleStrings
+    , TestLabel "Simple"    . testSimpleChanges
+    , TestLabel "ParamConv" . testParamConvNull
+    , TestLabel "ParamConv" . testParamConvInt
+    , TestLabel "ParamConv" . testParamConvIntWidths
+    , TestLabel "ParamConv" . testParamConvIntWidthsFromField
+    , TestLabel "ParamConv" . testParamConvFloat
+    , TestLabel "ParamConv" . testParamConvDateTime
+    , TestLabel "ParamConv" . testParamConvBools
+    , TestLabel "ParamConv" . testParamConvToRow
+    , TestLabel "ParamConv" . testParamConvFromRow
+    , TestLabel "ParamConv" . testParamConvComposite
+    , TestLabel "ParamConv" . testParamNamed
+    , TestLabel "Errors"    . testErrorsColumns
+    , TestLabel "Errors"    . testErrorsInvalidParams
+    , TestLabel "Errors"    . testErrorsInvalidNamedParams
+    , TestLabel "Errors"    . testErrorsWithStatement
+    , TestLabel "Errors"    . testErrorsColumnName
+    , TestLabel "Errors"    . testErrorsTransaction
+    , TestLabel "Utf8"      . testUtf8Simplest
+    , TestLabel "Utf8"      . testBlobs
+    , TestLabel "Instances" . testUserFromField
+    , TestLabel "Fold"      . testFolds
+    , TestLabel "Statement" . testBind
+    , TestLabel "Statement" . testDoubleBind
+    , TestLabel "Statement" . testPreparedStatements
+    , TestLabel "Debug"     . testDebugTracing
+    , TestLabel "Direct"    . testDirectSqlite
+    , TestLabel "Imports"   . testImports
+    ]
+
+-- | 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 Connection
+testConnect = open ":memory:"
+
+withTestEnv :: (TestEnv -> IO a) -> IO a
+withTestEnv cb =
+  withConn $ \conn -> cb TestEnv { conn = conn }
+  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
test/ParamConv.hs view
@@ -1,244 +1,244 @@-{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}--module ParamConv (-    testParamConvNull-  , testParamConvInt-  , testParamConvIntWidths-  , testParamConvIntWidthsFromField-  , testParamConvFloat-  , testParamConvBools-  , testParamConvDateTime-  , testParamConvFromRow-  , testParamConvToRow-  , testParamConvComposite-  , testParamNamed) where--import           Control.Applicative-import           Data.Int-import           Data.Word-import           Data.Time-import qualified Data.Text as T-import           Database.SQLite.Simple.Types (Null(..))--import Common--one, two, three :: Int-one   = 1-two   = 2-three = 3--testParamConvNull :: TestEnv -> Test-testParamConvNull TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE nulltype (id INTEGER PRIMARY KEY, t1 TEXT)"-  [Only r] <- (query_ conn "SELECT NULL") :: IO [Only Null]-  execute conn "INSERT INTO nulltype (id, t1) VALUES (?,?)" (one, r)-  [Only mr1] <- query_ conn "SELECT t1 FROM nulltype WHERE id = 1" :: IO [Only (Maybe String)]-  assertEqual "nulls" Nothing mr1-  execute conn "INSERT INTO nulltype (id, t1) VALUES (?,?)" (two, "foo" :: String)-  [mr2] <- query_ conn "SELECT t1 FROM nulltype WHERE id = 2" :: IO [Only (Maybe String)]-  assertEqual "nulls" (Just "foo") (fromOnly mr2)--testParamConvInt :: TestEnv -> Test-testParamConvInt TestEnv{..} = TestCase $ do-  [Only r] <- (query conn "SELECT ?" (Only one)) :: IO [Only Int]-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only one)) :: IO [Only Integer]-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?+?" (one, two)) :: IO [Only Int]-  assertEqual "value" 3 r-  [Only r] <- (query conn "SELECT ?+?" (one, 15 :: Int64)) :: IO [Only Int]-  assertEqual "value" 16 r-  [Only r] <- (query conn "SELECT ?+?" (two, 14 :: Int32)) :: IO [Only Int]-  assertEqual "value" 16 r-  [Only r] <- (query conn "SELECT ?+?" (two, 14 :: Integer)) :: IO [Only Int]-  assertEqual "value" 16 r-  -- This overflows 32-bit ints, verify that we get more than 32-bits out-  [Only r] <- (query conn "SELECT 255*?" (Only (0x7FFFFFFF :: Int32))) :: IO [Only Int64]-  assertEqual "> 32-bit result"-    (255*0x7FFFFFFF :: Int64) (fromIntegral r)-  [Only r] <- (query conn "SELECT 2*?" (Only (0x7FFFFFFFFF :: Int64))) :: IO [Only Int64]-  assertEqual "> 32-bit result & param"-    (2*0x7FFFFFFFFF :: Int64) (fromIntegral r)-  [Only r] <- (query_ conn "SELECT NULL") :: IO [Only (Maybe Int)]-  assertEqual "should see nothing" Nothing r-  [Only r] <- (query_ conn "SELECT 3") :: IO [Only (Maybe Int)]-  assertEqual "should see Just 3" (Just 3) r-  [Only r] <- (query conn "SELECT ?") (Only (Nothing :: Maybe Int)) :: IO [Only (Maybe Int)]-  assertEqual "should see nothing" Nothing r-  [Only r] <- (query conn "SELECT ?") (Only (Just three :: Maybe Int)) :: IO [Only (Maybe Int)]-  assertEqual "should see 4" (Just 3) r--testParamConvIntWidths :: TestEnv -> Test-testParamConvIntWidths TestEnv{..} = TestCase $ do-  [Only r] <- (query conn "SELECT ?" (Only (1 :: Int8))) :: IO [Only Int]-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int8))) :: IO [Only Int] -- wrap around-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int16))) :: IO [Only Int]-  assertEqual "value" 257 r-  [Only r] <- (query conn "SELECT ?" (Only (258 :: Int32))) :: IO [Only Int]-  assertEqual "value" 258 r-  [Only r] <- (query conn "SELECT ?" (Only (1 :: Word8))) :: IO [Only Int]-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only (257 :: Word8))) :: IO [Only Int] -- wrap around-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only (257 :: Word16))) :: IO [Only Int]-  assertEqual "value" 257 r-  [Only r] <- (query conn "SELECT ?" (Only (257 :: Word32))) :: IO [Only Int]-  assertEqual "value" 257 r-  [Only r] <- (query conn "SELECT ?" (Only (0x100000000 :: Word64))) :: IO [Only Int]-  assertEqual "value" 0x100000000 r-  [Only r] <- (query conn "SELECT ?" (Only (1 :: Integer))) :: IO [Only Int]-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only (1 :: Word))) :: IO [Only Int]-  assertEqual "value" 1 r--testParamConvIntWidthsFromField :: TestEnv -> Test-testParamConvIntWidthsFromField TestEnv{..} = TestCase $ do-  [Only r] <- (query conn "SELECT ?" (Only (1 :: Int))) :: IO [Only Int8]-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int))) :: IO [Only Int8] -- wrap around-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only (65536 :: Int))) :: IO [Only Int16] -- wrap around-  assertEqual "value" 0 r-  [Only r] <- (query conn "SELECT ?" (Only (65536 :: Int))) :: IO [Only Int32] -- wrap around-  assertEqual "value" 65536 r-  [Only r] <- (query conn "SELECT ?" (Only (258 :: Int))) :: IO [Only Int32]-  assertEqual "value" 258 r-  [Only r] <- (query conn "SELECT ?" (Only (1 :: Int))) :: IO [Only Word8]-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int))) :: IO [Only Word8] -- wrap around-  assertEqual "value" 1 r-  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int))) :: IO [Only Word16]-  assertEqual "value" 257 r-  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int))) :: IO [Only Word32]-  assertEqual "value" 257 r-  [Only r] <- (query conn "SELECT ?" (Only (0x100000000 :: Int64))) :: IO [Only Word64]-  assertEqual "value" 0x100000000 r-  [Only r] <- (query conn "SELECT ?" (Only (1 :: Int))) :: IO [Only Word]-  assertEqual "value" 1 r--testParamConvFloat :: TestEnv -> Test-testParamConvFloat TestEnv{..} = TestCase $ do-  [Only r] <- query conn "SELECT ?" (Only (1.0 :: Double)) :: IO [Only Double]-  assertEqual "value" 1.0 r-  [Only r] <- query conn "SELECT ?*0.25" (Only (8.0 :: Double)) :: IO [Only Double]-  assertEqual "value" 2.0 r--testParamConvDateTime :: TestEnv -> Test-testParamConvDateTime TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE dt (id INTEGER PRIMARY KEY, t1 DATE, t2 TIMESTAMP)"-  execute_ conn "INSERT INTO dt (t1, t2) VALUES (date('now'), datetime('now'))"-  _rows <- query_ conn "SELECT t1,t2 from dt" :: IO [(Day, UTCTime)]-  -- TODO should _rows be forced to make sure parsers kick on the-  -- returned data?-  execute conn "INSERT INTO dt (t1,t2) VALUES (?,?)"-    (read "2012-08-12" :: Day, read "2012-08-12 01:01:01" :: UTCTime)-  [_,(t1,t2)] <- query_ conn "SELECT t1,t2 from dt" :: IO [(Day, UTCTime)]-  assertEqual "day" (read "2012-08-12" :: Day) t1-  assertEqual "day" (read "2012-08-12 01:01:01" :: UTCTime) t2---testParamConvBools :: TestEnv -> Test-testParamConvBools TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE bt (id INTEGER PRIMARY KEY, b BOOLEAN)"-  -- Booleans are ints with values 0 or 1 on SQLite-  execute_ conn "INSERT INTO bt (b) VALUES (0)"-  execute_ conn "INSERT INTO bt (b) VALUES (1)"-  [Only r1, Only r2] <- query_ conn "SELECT b from bt" :: IO [Only Bool]-  assertEqual "bool" False r1-  assertEqual "bool" True r2-  execute conn "INSERT INTO bt (b) VALUES (?)" (Only True)-  execute conn "INSERT INTO bt (b) VALUES (?)" (Only False)-  execute conn "INSERT INTO bt (b) VALUES (?)" (Only False)-  [Only r3, Only r4, Only r5] <--    query_ conn "SELECT b from bt where id in (3, 4, 5) ORDER BY id" :: IO [Only Bool]-  assertEqual "bool" True r3-  assertEqual "bool" False r4-  assertEqual "bool" False r5--testParamConvFromRow :: TestEnv -> Test-testParamConvFromRow TestEnv{..} = TestCase $ do-  [(1,2)] <- query_ conn "SELECT 1,2" :: IO [(Int,Int)]-  [(1,2,3)] <- query_ conn "SELECT 1,2,3" :: IO [(Int,Int,Int)]-  [(1,2,3,4)] <- query_ conn "SELECT 1,2,3,4" :: IO [(Int,Int,Int,Int)]-  [(1,2,3,4,5)] <- query_ conn "SELECT 1,2,3,4,5" :: IO [(Int,Int,Int,Int,Int)]-  [(1,2,3,4,5,6)] <- query_ conn "SELECT 1,2,3,4,5,6" :: IO [(Int,Int,Int,Int,Int,Int)]-  [(1,2,3,4,5,6,7)] <- query_ conn "SELECT 1,2,3,4,5,6,7" :: IO [(Int,Int,Int,Int,Int,Int,Int)]-  [(1,2,3,4,5,6,7,8)] <- query_ conn "SELECT 1,2,3,4,5,6,7,8" :: IO [(Int,Int,Int,Int,Int,Int,Int,Int)]-  [(1,2,3,4,5,6,7,8,9)] <- query_ conn "SELECT 1,2,3,4,5,6,7,8,9" :: IO [(Int,Int,Int,Int,Int,Int,Int,Int,Int)]-  [(1,2,3,4,5,6,7,8,9,10)] <- query_ conn "SELECT 1,2,3,4,5,6,7,8,9,10" :: IO [(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int)]-  [[1,2,3]] <- query_ conn "SELECT 1,2,3" :: IO [[Int]]-  return ()--testParamConvToRow :: TestEnv -> Test-testParamConvToRow TestEnv{..} = TestCase $ do-  [Only (s :: Int)] <- query conn "SELECT 13" ()-  13 @=? s-  [Only (s :: Int)] <- query conn "SELECT ?" (Only one)-  1 @=? s-  [Only (s :: Int)] <- query conn "SELECT ?+?" (one, two)-  (1+2) @=? s-  [Only (s :: Int)] <- query conn "SELECT ?+?+?" (one, two, three)-  (1+2+3) @=? s-  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?" (one, two, three, 4 :: Int)-  (1+2+3+4) @=? s-  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?" (one, two, three, 4 :: Int, 5 :: Int)-  (1+2+3+4+5) @=? s-  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?" (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int)-  (1+2+3+4+5+6) @=? s-  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?+?"-                         (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int, 7 :: Int)-  (1+2+3+4+5+6+7) @=? s-  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?+?+?"-                         (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int, 7 :: Int, 8 :: Int)-  (1+2+3+4+5+6+7+8) @=? s-  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?+?+?+?"-                         (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int, 7 :: Int, 8 :: Int, 9 :: Int)-  (1+2+3+4+5+6+7+8+9) @=? s-  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?+?+?+?+?"-                         (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int, 7 :: Int, 8 :: Int, 9 :: Int, 10 :: Int)-  (1+2+3+4+5+6+7+8+9+10) @=? s--data TestTuple  = TestTuple  Int64 Int64 deriving (Eq, Show)-data TestTuple2 = TestTuple2 T.Text T.Text deriving (Eq, Show)--instance FromRow TestTuple where-  fromRow = TestTuple <$> field <*> field--instance FromRow TestTuple2 where-  fromRow = TestTuple2 <$> field <*> field--instance ToRow TestTuple where-  toRow (TestTuple a b) = [SQLInteger a, SQLInteger b]--instance ToRow TestTuple2 where-  toRow (TestTuple2 a b) = [SQLText a, SQLText b]--testParamConvComposite :: TestEnv -> Test-testParamConvComposite TestEnv{..} = TestCase $ do-  [t1] <- query_ conn "SELECT 1,2"-  TestTuple 1 2 @=? t1-  [t2] <- query_ conn "SELECT 'foo','bar'"-  TestTuple2 "foo" "bar" @=? t2-  [a :. b] <- query_ conn "SELECT 4,5,'baz','xyzz'"-  TestTuple 4 5 :. TestTuple2 "baz" "xyzz" @=? a :. b-  [TestTuple x y :. TestTuple2 z w] <- query conn "SELECT ?,?,?,?" (a :. b)-  x @=? 4-  y @=? 5-  z @=? "baz"-  w @=? "xyzz"--testParamNamed :: TestEnv -> Test-testParamNamed TestEnv{..} = TestCase $ do-  [Only t1] <- queryNamed conn "SELECT :foo / :bar" [":foo" := two, ":bar" := one]-  t1 @=? (2 :: Int)-  [(t1,t2)] <- queryNamed conn "SELECT :foo,:bar" [":foo" := ("foo" :: T.Text), ":bar" := one]-  t1 @=? ("foo" :: T.Text)-  t2 @=? one-  execute_ conn "CREATE TABLE np (id INTEGER PRIMARY KEY, b BOOLEAN)"-  executeNamed conn "INSERT INTO np (b) VALUES (:b)" [":b" := True]-  [Only t1] <- query_ conn "SELECT b FROM np"-  True @=? t1--+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
+
+module ParamConv (
+    testParamConvNull
+  , testParamConvInt
+  , testParamConvIntWidths
+  , testParamConvIntWidthsFromField
+  , testParamConvFloat
+  , testParamConvBools
+  , testParamConvDateTime
+  , testParamConvFromRow
+  , testParamConvToRow
+  , testParamConvComposite
+  , testParamNamed) where
+
+import           Control.Applicative
+import           Data.Int
+import           Data.Word
+import           Data.Time
+import qualified Data.Text as T
+import           Database.SQLite.Simple.Types (Null(..))
+
+import Common
+
+one, two, three :: Int
+one   = 1
+two   = 2
+three = 3
+
+testParamConvNull :: TestEnv -> Test
+testParamConvNull TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE nulltype (id INTEGER PRIMARY KEY, t1 TEXT)"
+  [Only r] <- (query_ conn "SELECT NULL") :: IO [Only Null]
+  execute conn "INSERT INTO nulltype (id, t1) VALUES (?,?)" (one, r)
+  [Only mr1] <- query_ conn "SELECT t1 FROM nulltype WHERE id = 1" :: IO [Only (Maybe String)]
+  assertEqual "nulls" Nothing mr1
+  execute conn "INSERT INTO nulltype (id, t1) VALUES (?,?)" (two, "foo" :: String)
+  [mr2] <- query_ conn "SELECT t1 FROM nulltype WHERE id = 2" :: IO [Only (Maybe String)]
+  assertEqual "nulls" (Just "foo") (fromOnly mr2)
+
+testParamConvInt :: TestEnv -> Test
+testParamConvInt TestEnv{..} = TestCase $ do
+  [Only r] <- (query conn "SELECT ?" (Only one)) :: IO [Only Int]
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only one)) :: IO [Only Integer]
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?+?" (one, two)) :: IO [Only Int]
+  assertEqual "value" 3 r
+  [Only r] <- (query conn "SELECT ?+?" (one, 15 :: Int64)) :: IO [Only Int]
+  assertEqual "value" 16 r
+  [Only r] <- (query conn "SELECT ?+?" (two, 14 :: Int32)) :: IO [Only Int]
+  assertEqual "value" 16 r
+  [Only r] <- (query conn "SELECT ?+?" (two, 14 :: Integer)) :: IO [Only Int]
+  assertEqual "value" 16 r
+  -- This overflows 32-bit ints, verify that we get more than 32-bits out
+  [Only r] <- (query conn "SELECT 255*?" (Only (0x7FFFFFFF :: Int32))) :: IO [Only Int64]
+  assertEqual "> 32-bit result"
+    (255*0x7FFFFFFF :: Int64) (fromIntegral r)
+  [Only r] <- (query conn "SELECT 2*?" (Only (0x7FFFFFFFFF :: Int64))) :: IO [Only Int64]
+  assertEqual "> 32-bit result & param"
+    (2*0x7FFFFFFFFF :: Int64) (fromIntegral r)
+  [Only r] <- (query_ conn "SELECT NULL") :: IO [Only (Maybe Int)]
+  assertEqual "should see nothing" Nothing r
+  [Only r] <- (query_ conn "SELECT 3") :: IO [Only (Maybe Int)]
+  assertEqual "should see Just 3" (Just 3) r
+  [Only r] <- (query conn "SELECT ?") (Only (Nothing :: Maybe Int)) :: IO [Only (Maybe Int)]
+  assertEqual "should see nothing" Nothing r
+  [Only r] <- (query conn "SELECT ?") (Only (Just three :: Maybe Int)) :: IO [Only (Maybe Int)]
+  assertEqual "should see 4" (Just 3) r
+
+testParamConvIntWidths :: TestEnv -> Test
+testParamConvIntWidths TestEnv{..} = TestCase $ do
+  [Only r] <- (query conn "SELECT ?" (Only (1 :: Int8))) :: IO [Only Int]
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int8))) :: IO [Only Int] -- wrap around
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int16))) :: IO [Only Int]
+  assertEqual "value" 257 r
+  [Only r] <- (query conn "SELECT ?" (Only (258 :: Int32))) :: IO [Only Int]
+  assertEqual "value" 258 r
+  [Only r] <- (query conn "SELECT ?" (Only (1 :: Word8))) :: IO [Only Int]
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only (257 :: Word8))) :: IO [Only Int] -- wrap around
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only (257 :: Word16))) :: IO [Only Int]
+  assertEqual "value" 257 r
+  [Only r] <- (query conn "SELECT ?" (Only (257 :: Word32))) :: IO [Only Int]
+  assertEqual "value" 257 r
+  [Only r] <- (query conn "SELECT ?" (Only (0x100000000 :: Word64))) :: IO [Only Int]
+  assertEqual "value" 0x100000000 r
+  [Only r] <- (query conn "SELECT ?" (Only (1 :: Integer))) :: IO [Only Int]
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only (1 :: Word))) :: IO [Only Int]
+  assertEqual "value" 1 r
+
+testParamConvIntWidthsFromField :: TestEnv -> Test
+testParamConvIntWidthsFromField TestEnv{..} = TestCase $ do
+  [Only r] <- (query conn "SELECT ?" (Only (1 :: Int))) :: IO [Only Int8]
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int))) :: IO [Only Int8] -- wrap around
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only (65536 :: Int))) :: IO [Only Int16] -- wrap around
+  assertEqual "value" 0 r
+  [Only r] <- (query conn "SELECT ?" (Only (65536 :: Int))) :: IO [Only Int32] -- wrap around
+  assertEqual "value" 65536 r
+  [Only r] <- (query conn "SELECT ?" (Only (258 :: Int))) :: IO [Only Int32]
+  assertEqual "value" 258 r
+  [Only r] <- (query conn "SELECT ?" (Only (1 :: Int))) :: IO [Only Word8]
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int))) :: IO [Only Word8] -- wrap around
+  assertEqual "value" 1 r
+  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int))) :: IO [Only Word16]
+  assertEqual "value" 257 r
+  [Only r] <- (query conn "SELECT ?" (Only (257 :: Int))) :: IO [Only Word32]
+  assertEqual "value" 257 r
+  [Only r] <- (query conn "SELECT ?" (Only (0x100000000 :: Int64))) :: IO [Only Word64]
+  assertEqual "value" 0x100000000 r
+  [Only r] <- (query conn "SELECT ?" (Only (1 :: Int))) :: IO [Only Word]
+  assertEqual "value" 1 r
+
+testParamConvFloat :: TestEnv -> Test
+testParamConvFloat TestEnv{..} = TestCase $ do
+  [Only r] <- query conn "SELECT ?" (Only (1.0 :: Double)) :: IO [Only Double]
+  assertEqual "value" 1.0 r
+  [Only r] <- query conn "SELECT ?*0.25" (Only (8.0 :: Double)) :: IO [Only Double]
+  assertEqual "value" 2.0 r
+
+testParamConvDateTime :: TestEnv -> Test
+testParamConvDateTime TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE dt (id INTEGER PRIMARY KEY, t1 DATE, t2 TIMESTAMP)"
+  execute_ conn "INSERT INTO dt (t1, t2) VALUES (date('now'), datetime('now'))"
+  _rows <- query_ conn "SELECT t1,t2 from dt" :: IO [(Day, UTCTime)]
+  -- TODO should _rows be forced to make sure parsers kick on the
+  -- returned data?
+  execute conn "INSERT INTO dt (t1,t2) VALUES (?,?)"
+    (read "2012-08-12" :: Day, read "2012-08-12 01:01:01" :: UTCTime)
+  [_,(t1,t2)] <- query_ conn "SELECT t1,t2 from dt" :: IO [(Day, UTCTime)]
+  assertEqual "day" (read "2012-08-12" :: Day) t1
+  assertEqual "day" (read "2012-08-12 01:01:01" :: UTCTime) t2
+
+
+testParamConvBools :: TestEnv -> Test
+testParamConvBools TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE bt (id INTEGER PRIMARY KEY, b BOOLEAN)"
+  -- Booleans are ints with values 0 or 1 on SQLite
+  execute_ conn "INSERT INTO bt (b) VALUES (0)"
+  execute_ conn "INSERT INTO bt (b) VALUES (1)"
+  [Only r1, Only r2] <- query_ conn "SELECT b from bt" :: IO [Only Bool]
+  assertEqual "bool" False r1
+  assertEqual "bool" True r2
+  execute conn "INSERT INTO bt (b) VALUES (?)" (Only True)
+  execute conn "INSERT INTO bt (b) VALUES (?)" (Only False)
+  execute conn "INSERT INTO bt (b) VALUES (?)" (Only False)
+  [Only r3, Only r4, Only r5] <-
+    query_ conn "SELECT b from bt where id in (3, 4, 5) ORDER BY id" :: IO [Only Bool]
+  assertEqual "bool" True r3
+  assertEqual "bool" False r4
+  assertEqual "bool" False r5
+
+testParamConvFromRow :: TestEnv -> Test
+testParamConvFromRow TestEnv{..} = TestCase $ do
+  [(1,2)] <- query_ conn "SELECT 1,2" :: IO [(Int,Int)]
+  [(1,2,3)] <- query_ conn "SELECT 1,2,3" :: IO [(Int,Int,Int)]
+  [(1,2,3,4)] <- query_ conn "SELECT 1,2,3,4" :: IO [(Int,Int,Int,Int)]
+  [(1,2,3,4,5)] <- query_ conn "SELECT 1,2,3,4,5" :: IO [(Int,Int,Int,Int,Int)]
+  [(1,2,3,4,5,6)] <- query_ conn "SELECT 1,2,3,4,5,6" :: IO [(Int,Int,Int,Int,Int,Int)]
+  [(1,2,3,4,5,6,7)] <- query_ conn "SELECT 1,2,3,4,5,6,7" :: IO [(Int,Int,Int,Int,Int,Int,Int)]
+  [(1,2,3,4,5,6,7,8)] <- query_ conn "SELECT 1,2,3,4,5,6,7,8" :: IO [(Int,Int,Int,Int,Int,Int,Int,Int)]
+  [(1,2,3,4,5,6,7,8,9)] <- query_ conn "SELECT 1,2,3,4,5,6,7,8,9" :: IO [(Int,Int,Int,Int,Int,Int,Int,Int,Int)]
+  [(1,2,3,4,5,6,7,8,9,10)] <- query_ conn "SELECT 1,2,3,4,5,6,7,8,9,10" :: IO [(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int)]
+  [[1,2,3]] <- query_ conn "SELECT 1,2,3" :: IO [[Int]]
+  return ()
+
+testParamConvToRow :: TestEnv -> Test
+testParamConvToRow TestEnv{..} = TestCase $ do
+  [Only (s :: Int)] <- query conn "SELECT 13" ()
+  13 @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?" (Only one)
+  1 @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?+?" (one, two)
+  (1+2) @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?+?+?" (one, two, three)
+  (1+2+3) @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?" (one, two, three, 4 :: Int)
+  (1+2+3+4) @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?" (one, two, three, 4 :: Int, 5 :: Int)
+  (1+2+3+4+5) @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?" (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int)
+  (1+2+3+4+5+6) @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?+?"
+                         (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int, 7 :: Int)
+  (1+2+3+4+5+6+7) @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?+?+?"
+                         (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int, 7 :: Int, 8 :: Int)
+  (1+2+3+4+5+6+7+8) @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?+?+?+?"
+                         (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int, 7 :: Int, 8 :: Int, 9 :: Int)
+  (1+2+3+4+5+6+7+8+9) @=? s
+  [Only (s :: Int)] <- query conn "SELECT ?+?+?+?+?+?+?+?+?+?"
+                         (one, two, three, 4 :: Int, 5 :: Int, 6 :: Int, 7 :: Int, 8 :: Int, 9 :: Int, 10 :: Int)
+  (1+2+3+4+5+6+7+8+9+10) @=? s
+
+data TestTuple  = TestTuple  Int64 Int64 deriving (Eq, Show)
+data TestTuple2 = TestTuple2 T.Text T.Text deriving (Eq, Show)
+
+instance FromRow TestTuple where
+  fromRow = TestTuple <$> field <*> field
+
+instance FromRow TestTuple2 where
+  fromRow = TestTuple2 <$> field <*> field
+
+instance ToRow TestTuple where
+  toRow (TestTuple a b) = [SQLInteger a, SQLInteger b]
+
+instance ToRow TestTuple2 where
+  toRow (TestTuple2 a b) = [SQLText a, SQLText b]
+
+testParamConvComposite :: TestEnv -> Test
+testParamConvComposite TestEnv{..} = TestCase $ do
+  [t1] <- query_ conn "SELECT 1,2"
+  TestTuple 1 2 @=? t1
+  [t2] <- query_ conn "SELECT 'foo','bar'"
+  TestTuple2 "foo" "bar" @=? t2
+  [a :. b] <- query_ conn "SELECT 4,5,'baz','xyzz'"
+  TestTuple 4 5 :. TestTuple2 "baz" "xyzz" @=? a :. b
+  [TestTuple x y :. TestTuple2 z w] <- query conn "SELECT ?,?,?,?" (a :. b)
+  x @=? 4
+  y @=? 5
+  z @=? "baz"
+  w @=? "xyzz"
+
+testParamNamed :: TestEnv -> Test
+testParamNamed TestEnv{..} = TestCase $ do
+  [Only t1] <- queryNamed conn "SELECT :foo / :bar" [":foo" := two, ":bar" := one]
+  t1 @=? (2 :: Int)
+  [(t1,t2)] <- queryNamed conn "SELECT :foo,:bar" [":foo" := ("foo" :: T.Text), ":bar" := one]
+  t1 @=? ("foo" :: T.Text)
+  t2 @=? one
+  execute_ conn "CREATE TABLE np (id INTEGER PRIMARY KEY, b BOOLEAN)"
+  executeNamed conn "INSERT INTO np (b) VALUES (:b)" [":b" := True]
+  [Only t1] <- query_ conn "SELECT b FROM np"
+  True @=? t1
+
+
test/Simple.hs view
@@ -1,257 +1,268 @@-{-# LANGUAGE OverloadedStrings #-}--module Simple (-    testSimpleOnePlusOne-  , testSimpleSelect-  , testSimpleParams-  , testSimpleTime-  , testSimpleTimeFract-  , testSimpleInsertId-  , testSimpleUTCTime-  , testSimpleUTCTimeTZ-  , testSimpleUTCTimeParams-  , testSimpleQueryCov-  , testSimpleStrings-  , testSimpleChanges-  ) where--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---- Simplest SELECT-testSimpleOnePlusOne :: TestEnv -> Test-testSimpleOnePlusOne TestEnv{..} = TestCase $ do-  rows <- query_ conn "SELECT 1+1" :: IO [Only Int]-  assertEqual "row count" 1 (length rows)-  assertEqual "value" (Only 2) (head rows)--testSimpleSelect :: TestEnv -> Test-testSimpleSelect TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE test1 (id INTEGER PRIMARY KEY, t TEXT)"-  execute_ conn "INSERT INTO test1 (t) VALUES ('test string')"-  rows <- query_ conn "SELECT t FROM test1" :: IO [Only String]-  assertEqual "row count" 1 (length rows)-  assertEqual "string" (Only "test string") (head rows)-  rows <- query_ conn "SELECT id,t FROM test1" :: IO [(Int, String)]-  assertEqual "int,string" (1, "test string") (head rows)-  -- Add another row-  execute_ conn "INSERT INTO test1 (t) VALUES ('test string 2')"-  rows <- query_ conn "SELECT id,t FROM test1" :: IO [(Int, String)]-  assertEqual "row count" 2 (length rows)-  assertEqual "int,string" (1, "test string") (rows !! 0)-  assertEqual "int,string" (2, "test string 2") (rows !! 1)-  [Only r] <- query_ conn "SELECT NULL" :: IO [Only (Maybe Int)]-  assertEqual "nulls" Nothing r-  [Only r] <- query_ conn "SELECT 1" :: IO [Only (Maybe Int)]-  assertEqual "nulls" (Just 1) r-  [Only r] <- query_ conn "SELECT 1.0" :: IO [Only Double]-  assertEqual "doubles" 1.0 r-  [Only r] <- query_ conn "SELECT 1.0" :: IO [Only Float]-  assertEqual "floats" 1.0 r--testSimpleParams :: TestEnv -> Test-testSimpleParams TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE testparams (id INTEGER PRIMARY KEY, t TEXT)"-  execute_ conn "CREATE TABLE testparams2 (id INTEGER, t TEXT, t2 TEXT)"-  [Only i] <- query conn "SELECT ?" (Only (42 :: Int))  :: IO [Only Int]-  assertEqual "select int param" 42 i-  execute conn "INSERT INTO testparams (t) VALUES (?)" (Only ("test string" :: String))-  rows <- query conn "SELECT t FROM testparams WHERE id = ?" (Only (1 :: Int)) :: IO [Only String]-  assertEqual "row count" 1 (length rows)-  assertEqual "string" (Only "test string") (head rows)-  execute_ conn "INSERT INTO testparams (t) VALUES ('test2')"-  [Only row] <- query conn "SELECT t FROM testparams WHERE id = ?" (Only (1 :: Int)) :: IO [Only String]-  assertEqual "select params" "test string" row-  [Only row] <- query conn "SELECT t FROM testparams WHERE id = ?" (Only (2 :: Int)) :: IO [Only String]-  assertEqual "select params" "test2" row-  [Only r1, Only r2] <- query conn "SELECT t FROM testparams WHERE (id = ? OR id = ?)" (1 :: Int, 2 :: Int) :: IO [Only String]-  assertEqual "select params" "test string" r1-  assertEqual "select params" "test2" r2-  [Only i] <- query conn "SELECT ?+?" [42 :: Int, 1 :: Int] :: IO [Only Int]-  assertEqual "select int param" 43 i-  [Only d] <- query conn "SELECT ?" [2.0 :: Double] :: IO [Only Double]-  assertEqual "select double param" 2.0 d-  [Only f] <- query conn "SELECT ?" [4.0 :: Float] :: IO [Only Float]-  assertEqual "select double param" 4.0 f--testSimpleTime :: TestEnv -> Test-testSimpleTime TestEnv{..} = TestCase $ do-  let timestr = "2012-08-20 20:19:58"-      time    = read timestr :: UTCTime-  execute_ conn "CREATE TABLE time (t TIMESTAMP)"-  execute conn "INSERT INTO time (t) VALUES (?)" (Only time)-  [Only t] <- query_ conn "SELECT * FROM time" :: IO [Only UTCTime]-  assertEqual "UTCTime conv" time t-  [Only t] <- query conn "SELECT * FROM time WHERE t = ?" (Only time) :: IO [Only UTCTime]-  assertEqual "UTCTime conv2" time t-  -- Try inserting timestamp directly as a string-  execute_ conn "CREATE TABLE time2 (t TIMESTAMP)"-  execute_ conn (Query (T.concat ["INSERT INTO time2 (t) VALUES ('", T.pack timestr, "')"]))-  [Only t] <- query_ conn "SELECT * FROM time2" :: IO [Only UTCTime]-  assertEqual "UTCTime" time t-  rows <- query conn "SELECT * FROM time2 WHERE t = ?" (Only time) :: IO [Only UTCTime]-  assertEqual "should see one row result" 1 (length rows)-  assertEqual "UTCTime" time t-  -- Days-  let daystr = "2013-08-21"-      day    = read daystr :: Day-  [Only day'] <- query_ conn (Query (T.concat ["SELECT '", T.pack daystr, "'"]))-  day @?= day'-  [Only day''] <- query conn "SELECT ?" (Only day)-  day @?= day''-  -- database timestamp -> day conversion is treated as an error, but-  -- try converting a timestamp to a date and see we get it back ok-  [Only dayx] <- query_ conn "SELECT date('2013-08-21 08:00:03.256887')"-  day @?= dayx--testSimpleTimeFract :: TestEnv -> Test-testSimpleTimeFract TestEnv{..} = TestCase $ do-  let timestr = "2012-08-17 08:00:03.256887"-      time    = read timestr :: UTCTime-  -- Try inserting timestamp directly as a string-  execute_ conn "CREATE TABLE timefract (t TIMESTAMP)"-  execute_ conn (Query (T.concat ["INSERT INTO timefract (t) VALUES ('", T.pack timestr, "')"]))-  [Only t] <- query_ conn "SELECT * FROM timefract" :: IO [Only UTCTime]-  assertEqual "UTCTime" time t-  rows <- query conn "SELECT * FROM timefract WHERE t = ?" (Only time) :: IO [Only UTCTime]-  assertEqual "should see one row result" 1 (length rows)-  assertEqual "UTCTime" time t--testSimpleInsertId :: TestEnv -> Test-testSimpleInsertId TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE test_row_id (id INTEGER PRIMARY KEY, t TEXT)"-  execute conn "INSERT INTO test_row_id (t) VALUES (?)" (Only ("test string" :: String))-  id1 <- lastInsertRowId conn-  execute_ conn "INSERT INTO test_row_id (t) VALUES ('test2')"-  id2 <- lastInsertRowId conn-  1 @=? id1-  2 @=? id2-  rows <- query conn "SELECT t FROM test_row_id WHERE id = ?" (Only (1 :: Int)) :: IO [Only String]-  1 @=?  (length rows)-  (Only "test string") @=? (head rows)-  [Only row] <- query conn "SELECT t FROM test_row_id WHERE id = ?" (Only (2 :: Int)) :: IO [Only String]-  "test2" @=? row--testSimpleUTCTime :: TestEnv -> Test-testSimpleUTCTime TestEnv{..} = TestCase $ do-  -- Time formats understood by sqlite: http://sqlite.org/lang_datefunc.html-  let timestrs = [ "2012-08-17 13:25"-                 , "2012-08-17 13:25:44"-                 , "2012-08-17 13:25:44.123"-                 ]-      timestrsWithT = map (T.map (\c -> if c == ' ' then 'T' else c)) timestrs-  execute_ conn "CREATE TABLE utctimes (t TIMESTAMP)"-  mapM_ (\t -> execute conn "INSERT INTO utctimes (t) VALUES (?)" (Only t)) timestrs-  mapM_ (\t -> execute conn "INSERT INTO utctimes (t) VALUES (?)" (Only t)) timestrsWithT-  dates <- query_ conn "SELECT t from utctimes" :: IO [Only UTCTime]-  mapM_ matchDates (zip (timestrs ++ timestrsWithT) dates)-  let zulu = "2012-08-17 13:25"-  [d] <- query conn "SELECT ?" (Only (T.append zulu "Z"))-  matchDates (zulu, d)-  let zulu = "2012-08-17 13:25:00"-  [d] <- query conn "SELECT ?" (Only (T.append zulu "Z"))-  matchDates (zulu, d)-  where-    matchDates (str,(Only date)) = do-      -- Remove 'T' when reading in to Haskell-      let t = read (makeReadable str) :: UTCTime-      t @=? date--    makeReadable s =-      let s' = if T.length s < T.length "YYYY-MM-DD HH:MM:SS" then T.append s ":00" else s-      in T.unpack . T.replace "T" " " $ s'--testSimpleUTCTimeTZ :: TestEnv -> Test-testSimpleUTCTimeTZ TestEnv{..} = TestCase $ do-  -- Time formats understood by sqlite: http://sqlite.org/lang_datefunc.html-  let timestrs = [ "2013-02-03 13:00:00-02:00"-                 , "2013-02-03 13:00:00-01:00"-                 , "2013-02-03 13:00:00-03:00"-                 , "2013-02-03 13:00:00Z"-                 , "2013-02-03 13:00:00+00:00"-                 , "2013-02-03 13:00:00+03:00"-                 , "2013-02-03 13:00:00+02:00"-                 , "2013-02-03 13:00:00+04:00"-                 ]-  execute_ conn "CREATE TABLE utctimestz (t TIMESTAMP)"-  mapM_ (\t -> execute conn "INSERT INTO utctimestz (t) VALUES (?)" (Only t)) timestrs-  dates <- query_ conn "SELECT t from utctimestz" :: IO [Only UTCTime]-  mapM_ matchDates (zip (timestrs) dates)-  where-    matchDates (str,(Only date)) = do-      -- Remove 'T' when reading in to Haskell-      let t = read . T.unpack $ str :: UTCTime-      t @=? date--testSimpleUTCTimeParams :: TestEnv -> Test-testSimpleUTCTimeParams TestEnv{..} = TestCase $ do-  let times = [ "2012-08-17 08:00:03"-              , "2012-08-17 08:00:03.2"-              , "2012-08-17 08:00:03.256"-              , "2012-08-17 08:00:03.4192"-              ]-  -- Try inserting timestamp directly as a string-  mapM_ assertResult times-  where-    assertResult tstr = do-      let utct = read . T.unpack $ tstr :: UTCTime-      [Only t] <- query conn "SELECT ?" (Only utct) :: IO [Only T.Text]-      assertEqual "UTCTime" tstr t--testSimpleQueryCov :: TestEnv -> Test-testSimpleQueryCov TestEnv{..} = TestCase $ do-  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-testSimpleStrings TestEnv{..} = TestCase $ do-  [Only s] <- query_ conn "SELECT 'str1'"  :: IO [Only T.Text]-  s @=? "str1"-  [Only s] <- query_ conn "SELECT 'strLazy'"  :: IO [Only LT.Text]-  s @=? "strLazy"-  [Only s] <- query conn "SELECT ?" (Only ("strP" :: T.Text)) :: IO [Only T.Text]-  s @=? "strP"-  [Only s] <- query conn "SELECT ?" (Only ("strPLazy" :: LT.Text)) :: IO [Only T.Text]-  s @=? "strPLazy"-  -- ByteStrings are blobs in sqlite storage, so use ByteString for-  -- both input and output-  [Only s] <- query conn "SELECT ?" (Only ("strBsP" :: BS.ByteString)) :: IO [Only BS.ByteString]-  s @=? "strBsP"-  [Only s] <- query conn "SELECT ?" (Only ("strBsPLazy" :: LBS.ByteString)) :: IO [Only BS.ByteString]-  s @=? "strBsPLazy"-  [Only s] <- query conn "SELECT ?" (Only ("strBsPLazy2" :: BS.ByteString)) :: IO [Only LBS.ByteString]-  s @=? "strBsPLazy2"--testSimpleChanges :: TestEnv -> Test-testSimpleChanges TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE testchanges (id INTEGER PRIMARY KEY, t TEXT)"-  execute conn "INSERT INTO testchanges(t) VALUES (?)" (Only ("test string" :: String))-  numChanges <- changes conn-  assertEqual "changed/inserted rows" 1 numChanges-  execute conn "INSERT INTO testchanges(t) VALUES (?)" (Only ("test string 2" :: String))-  numChanges <- changes conn-  assertEqual "changed/inserted rows" 1 numChanges-  execute_ conn "UPDATE testchanges SET t = 'foo' WHERE id = 1"-  numChanges <- changes conn-  assertEqual "changed/inserted rows" 1 numChanges-  execute_ conn "UPDATE testchanges SET t = 'foo' WHERE id = 100"-  numChanges <- changes conn-  assertEqual "changed/inserted rows" 0 numChanges-  execute_ conn "UPDATE testchanges SET t = 'foo'"-  numChanges <- changes conn-  assertEqual "changed/inserted rows" 2 numChanges+{-# LANGUAGE OverloadedStrings #-}
+
+module Simple (
+    testSimpleOnePlusOne
+  , testSimpleSelect
+  , testSimpleParams
+  , testSimpleTime
+  , testSimpleTimeFract
+  , testSimpleInsertId
+  , testSimpleMultiInsert
+  , testSimpleUTCTime
+  , testSimpleUTCTimeTZ
+  , testSimpleUTCTimeParams
+  , testSimpleQueryCov
+  , testSimpleStrings
+  , testSimpleChanges
+  ) where
+
+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
+
+-- Simplest SELECT
+testSimpleOnePlusOne :: TestEnv -> Test
+testSimpleOnePlusOne TestEnv{..} = TestCase $ do
+  rows <- query_ conn "SELECT 1+1" :: IO [Only Int]
+  assertEqual "row count" 1 (length rows)
+  assertEqual "value" (Only 2) (head rows)
+
+testSimpleSelect :: TestEnv -> Test
+testSimpleSelect TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE test1 (id INTEGER PRIMARY KEY, t TEXT)"
+  execute_ conn "INSERT INTO test1 (t) VALUES ('test string')"
+  rows <- query_ conn "SELECT t FROM test1" :: IO [Only String]
+  assertEqual "row count" 1 (length rows)
+  assertEqual "string" (Only "test string") (head rows)
+  rows <- query_ conn "SELECT id,t FROM test1" :: IO [(Int, String)]
+  assertEqual "int,string" (1, "test string") (head rows)
+  -- Add another row
+  execute_ conn "INSERT INTO test1 (t) VALUES ('test string 2')"
+  rows <- query_ conn "SELECT id,t FROM test1" :: IO [(Int, String)]
+  assertEqual "row count" 2 (length rows)
+  assertEqual "int,string" (1, "test string") (rows !! 0)
+  assertEqual "int,string" (2, "test string 2") (rows !! 1)
+  [Only r] <- query_ conn "SELECT NULL" :: IO [Only (Maybe Int)]
+  assertEqual "nulls" Nothing r
+  [Only r] <- query_ conn "SELECT 1" :: IO [Only (Maybe Int)]
+  assertEqual "nulls" (Just 1) r
+  [Only r] <- query_ conn "SELECT 1.0" :: IO [Only Double]
+  assertEqual "doubles" 1.0 r
+  [Only r] <- query_ conn "SELECT 1.0" :: IO [Only Float]
+  assertEqual "floats" 1.0 r
+
+testSimpleParams :: TestEnv -> Test
+testSimpleParams TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE testparams (id INTEGER PRIMARY KEY, t TEXT)"
+  execute_ conn "CREATE TABLE testparams2 (id INTEGER, t TEXT, t2 TEXT)"
+  [Only i] <- query conn "SELECT ?" (Only (42 :: Int))  :: IO [Only Int]
+  assertEqual "select int param" 42 i
+  execute conn "INSERT INTO testparams (t) VALUES (?)" (Only ("test string" :: String))
+  rows <- query conn "SELECT t FROM testparams WHERE id = ?" (Only (1 :: Int)) :: IO [Only String]
+  assertEqual "row count" 1 (length rows)
+  assertEqual "string" (Only "test string") (head rows)
+  execute_ conn "INSERT INTO testparams (t) VALUES ('test2')"
+  [Only row] <- query conn "SELECT t FROM testparams WHERE id = ?" (Only (1 :: Int)) :: IO [Only String]
+  assertEqual "select params" "test string" row
+  [Only row] <- query conn "SELECT t FROM testparams WHERE id = ?" (Only (2 :: Int)) :: IO [Only String]
+  assertEqual "select params" "test2" row
+  [Only r1, Only r2] <- query conn "SELECT t FROM testparams WHERE (id = ? OR id = ?)" (1 :: Int, 2 :: Int) :: IO [Only String]
+  assertEqual "select params" "test string" r1
+  assertEqual "select params" "test2" r2
+  [Only i] <- query conn "SELECT ?+?" [42 :: Int, 1 :: Int] :: IO [Only Int]
+  assertEqual "select int param" 43 i
+  [Only d] <- query conn "SELECT ?" [2.0 :: Double] :: IO [Only Double]
+  assertEqual "select double param" 2.0 d
+  [Only f] <- query conn "SELECT ?" [4.0 :: Float] :: IO [Only Float]
+  assertEqual "select double param" 4.0 f
+
+testSimpleTime :: TestEnv -> Test
+testSimpleTime TestEnv{..} = TestCase $ do
+  let timestr = "2012-08-20 20:19:58"
+      time    = read timestr :: UTCTime
+  execute_ conn "CREATE TABLE time (t TIMESTAMP)"
+  execute conn "INSERT INTO time (t) VALUES (?)" (Only time)
+  [Only t] <- query_ conn "SELECT * FROM time" :: IO [Only UTCTime]
+  assertEqual "UTCTime conv" time t
+  [Only t] <- query conn "SELECT * FROM time WHERE t = ?" (Only time) :: IO [Only UTCTime]
+  assertEqual "UTCTime conv2" time t
+  -- Try inserting timestamp directly as a string
+  execute_ conn "CREATE TABLE time2 (t TIMESTAMP)"
+  execute_ conn (Query (T.concat ["INSERT INTO time2 (t) VALUES ('", T.pack timestr, "')"]))
+  [Only t] <- query_ conn "SELECT * FROM time2" :: IO [Only UTCTime]
+  assertEqual "UTCTime" time t
+  rows <- query conn "SELECT * FROM time2 WHERE t = ?" (Only time) :: IO [Only UTCTime]
+  assertEqual "should see one row result" 1 (length rows)
+  assertEqual "UTCTime" time t
+  -- Days
+  let daystr = "2013-08-21"
+      day    = read daystr :: Day
+  [Only day'] <- query_ conn (Query (T.concat ["SELECT '", T.pack daystr, "'"]))
+  day @?= day'
+  [Only day''] <- query conn "SELECT ?" (Only day)
+  day @?= day''
+  -- database timestamp -> day conversion is treated as an error, but
+  -- try converting a timestamp to a date and see we get it back ok
+  [Only dayx] <- query_ conn "SELECT date('2013-08-21 08:00:03.256887')"
+  day @?= dayx
+
+testSimpleTimeFract :: TestEnv -> Test
+testSimpleTimeFract TestEnv{..} = TestCase $ do
+  let timestr = "2012-08-17 08:00:03.256887"
+      time    = read timestr :: UTCTime
+  -- Try inserting timestamp directly as a string
+  execute_ conn "CREATE TABLE timefract (t TIMESTAMP)"
+  execute_ conn (Query (T.concat ["INSERT INTO timefract (t) VALUES ('", T.pack timestr, "')"]))
+  [Only t] <- query_ conn "SELECT * FROM timefract" :: IO [Only UTCTime]
+  assertEqual "UTCTime" time t
+  rows <- query conn "SELECT * FROM timefract WHERE t = ?" (Only time) :: IO [Only UTCTime]
+  assertEqual "should see one row result" 1 (length rows)
+  assertEqual "UTCTime" time t
+
+testSimpleInsertId :: TestEnv -> Test
+testSimpleInsertId TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE test_row_id (id INTEGER PRIMARY KEY, t TEXT)"
+  execute conn "INSERT INTO test_row_id (t) VALUES (?)" (Only ("test string" :: String))
+  id1 <- lastInsertRowId conn
+  execute_ conn "INSERT INTO test_row_id (t) VALUES ('test2')"
+  id2 <- lastInsertRowId conn
+  1 @=? id1
+  2 @=? id2
+  rows <- query conn "SELECT t FROM test_row_id WHERE id = ?" (Only (1 :: Int)) :: IO [Only String]
+  1 @=?  (length rows)
+  (Only "test string") @=? (head rows)
+  [Only row] <- query conn "SELECT t FROM test_row_id WHERE id = ?" (Only (2 :: Int)) :: IO [Only String]
+  "test2" @=? row
+
+testSimpleMultiInsert :: TestEnv -> Test
+testSimpleMultiInsert TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE test_multi_insert (id INTEGER PRIMARY KEY, t1 TEXT, t2 TEXT)"
+  executeMany conn "INSERT INTO test_multi_insert (t1, t2) VALUES (?, ?)" ([("foo", "bar"), ("baz", "bat")] :: [(String, String)])
+  id2 <- lastInsertRowId conn
+  2 @=? id2
+
+  rows <- query_ conn "SELECT id,t1,t2 FROM test_multi_insert" :: IO [(Int, String, String)]
+  [(1, "foo", "bar"), (2, "baz", "bat")] @=? rows
+
+testSimpleUTCTime :: TestEnv -> Test
+testSimpleUTCTime TestEnv{..} = TestCase $ do
+  -- Time formats understood by sqlite: http://sqlite.org/lang_datefunc.html
+  let timestrs = [ "2012-08-17 13:25"
+                 , "2012-08-17 13:25:44"
+                 , "2012-08-17 13:25:44.123"
+                 ]
+      timestrsWithT = map (T.map (\c -> if c == ' ' then 'T' else c)) timestrs
+  execute_ conn "CREATE TABLE utctimes (t TIMESTAMP)"
+  mapM_ (\t -> execute conn "INSERT INTO utctimes (t) VALUES (?)" (Only t)) timestrs
+  mapM_ (\t -> execute conn "INSERT INTO utctimes (t) VALUES (?)" (Only t)) timestrsWithT
+  dates <- query_ conn "SELECT t from utctimes" :: IO [Only UTCTime]
+  mapM_ matchDates (zip (timestrs ++ timestrsWithT) dates)
+  let zulu = "2012-08-17 13:25"
+  [d] <- query conn "SELECT ?" (Only (T.append zulu "Z"))
+  matchDates (zulu, d)
+  let zulu = "2012-08-17 13:25:00"
+  [d] <- query conn "SELECT ?" (Only (T.append zulu "Z"))
+  matchDates (zulu, d)
+  where
+    matchDates (str,(Only date)) = do
+      -- Remove 'T' when reading in to Haskell
+      let t = read (makeReadable str) :: UTCTime
+      t @=? date
+
+    makeReadable s =
+      let s' = if T.length s < T.length "YYYY-MM-DD HH:MM:SS" then T.append s ":00" else s
+      in T.unpack . T.replace "T" " " $ s'
+
+testSimpleUTCTimeTZ :: TestEnv -> Test
+testSimpleUTCTimeTZ TestEnv{..} = TestCase $ do
+  -- Time formats understood by sqlite: http://sqlite.org/lang_datefunc.html
+  let timestrs = [ "2013-02-03 13:00:00-02:00"
+                 , "2013-02-03 13:00:00-01:00"
+                 , "2013-02-03 13:00:00-03:00"
+                 , "2013-02-03 13:00:00Z"
+                 , "2013-02-03 13:00:00+00:00"
+                 , "2013-02-03 13:00:00+03:00"
+                 , "2013-02-03 13:00:00+02:00"
+                 , "2013-02-03 13:00:00+04:00"
+                 ]
+  execute_ conn "CREATE TABLE utctimestz (t TIMESTAMP)"
+  mapM_ (\t -> execute conn "INSERT INTO utctimestz (t) VALUES (?)" (Only t)) timestrs
+  dates <- query_ conn "SELECT t from utctimestz" :: IO [Only UTCTime]
+  mapM_ matchDates (zip (timestrs) dates)
+  where
+    matchDates (str,(Only date)) = do
+      -- Remove 'T' when reading in to Haskell
+      let t = read . T.unpack $ str :: UTCTime
+      t @=? date
+
+testSimpleUTCTimeParams :: TestEnv -> Test
+testSimpleUTCTimeParams TestEnv{..} = TestCase $ do
+  let times = [ "2012-08-17 08:00:03"
+              , "2012-08-17 08:00:03.2"
+              , "2012-08-17 08:00:03.256"
+              , "2012-08-17 08:00:03.4192"
+              ]
+  -- Try inserting timestamp directly as a string
+  mapM_ assertResult times
+  where
+    assertResult tstr = do
+      let utct = read . T.unpack $ tstr :: UTCTime
+      [Only t] <- query conn "SELECT ?" (Only utct) :: IO [Only T.Text]
+      assertEqual "UTCTime" tstr t
+
+testSimpleQueryCov :: TestEnv -> Test
+testSimpleQueryCov TestEnv{..} = TestCase $ do
+  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
+testSimpleStrings TestEnv{..} = TestCase $ do
+  [Only s] <- query_ conn "SELECT 'str1'"  :: IO [Only T.Text]
+  s @=? "str1"
+  [Only s] <- query_ conn "SELECT 'strLazy'"  :: IO [Only LT.Text]
+  s @=? "strLazy"
+  [Only s] <- query conn "SELECT ?" (Only ("strP" :: T.Text)) :: IO [Only T.Text]
+  s @=? "strP"
+  [Only s] <- query conn "SELECT ?" (Only ("strPLazy" :: LT.Text)) :: IO [Only T.Text]
+  s @=? "strPLazy"
+  -- ByteStrings are blobs in sqlite storage, so use ByteString for
+  -- both input and output
+  [Only s] <- query conn "SELECT ?" (Only ("strBsP" :: BS.ByteString)) :: IO [Only BS.ByteString]
+  s @=? "strBsP"
+  [Only s] <- query conn "SELECT ?" (Only ("strBsPLazy" :: LBS.ByteString)) :: IO [Only BS.ByteString]
+  s @=? "strBsPLazy"
+  [Only s] <- query conn "SELECT ?" (Only ("strBsPLazy2" :: BS.ByteString)) :: IO [Only LBS.ByteString]
+  s @=? "strBsPLazy2"
+
+testSimpleChanges :: TestEnv -> Test
+testSimpleChanges TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE testchanges (id INTEGER PRIMARY KEY, t TEXT)"
+  execute conn "INSERT INTO testchanges(t) VALUES (?)" (Only ("test string" :: String))
+  numChanges <- changes conn
+  assertEqual "changed/inserted rows" 1 numChanges
+  execute conn "INSERT INTO testchanges(t) VALUES (?)" (Only ("test string 2" :: String))
+  numChanges <- changes conn
+  assertEqual "changed/inserted rows" 1 numChanges
+  execute_ conn "UPDATE testchanges SET t = 'foo' WHERE id = 1"
+  numChanges <- changes conn
+  assertEqual "changed/inserted rows" 1 numChanges
+  execute_ conn "UPDATE testchanges SET t = 'foo' WHERE id = 100"
+  numChanges <- changes conn
+  assertEqual "changed/inserted rows" 0 numChanges
+  execute_ conn "UPDATE testchanges SET t = 'foo'"
+  numChanges <- changes conn
+  assertEqual "changed/inserted rows" 2 numChanges
test/Statement.hs view
@@ -1,50 +1,50 @@-{-# LANGUAGE OverloadedStrings #-}--module Statement (-    testBind-  , testDoubleBind-  , testPreparedStatements-  ) where--import Common-import Data.Maybe(fromJust)--testBind :: TestEnv -> Test-testBind TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE test_bind (id INTEGER PRIMARY KEY, t TEXT)"-  execute_ conn "INSERT INTO test_bind VALUES(1, 'result')"-  withStatement conn "SELECT t FROM test_bind WHERE id=?" $ \stmt ->-    withBind stmt [1::Int] $ do-      row <- nextRow stmt :: IO (Maybe (Only String))-      assertEqual "result" (Only "result") (fromJust row)--testDoubleBind :: TestEnv -> Test-testDoubleBind TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE test_double_bind (id INTEGER PRIMARY KEY, t TEXT)"-  execute_ conn "INSERT INTO test_double_bind VALUES(1, 'first result')"-  execute_ conn "INSERT INTO test_double_bind VALUES(2, 'second result')"-  withStatement conn "SELECT t FROM test_double_bind WHERE id=?" $ \stmt -> do-    withBind stmt [1::Int] $ do-      row <- nextRow stmt :: IO (Maybe (Only String))-      assertEqual "first result" (Only "first result") (fromJust row)--    withBind stmt [2::Int] $ do-      row <- nextRow stmt :: IO (Maybe (Only String))-      assertEqual "second result" (Only "second result") (fromJust row)--testPreparedStatements :: TestEnv -> Test-testPreparedStatements TestEnv{..} = TestCase $ do-  execute_ conn "CREATE TABLE ps (id INTEGER PRIMARY KEY, t TEXT)"-  execute_ conn "INSERT INTO ps VALUES(1, 'first result')"-  execute_ conn "INSERT INTO ps VALUES(2, 'second result')"-  withStatement conn "SELECT t FROM ps WHERE id=?" $ \stmt -> do-    colName <- columnName stmt 0-    colName @?= "t"-    elems <- mapM (queryOne stmt) [1 :: Int, 2]-    ["first result" :: String, "second result"] @=? elems-    where-      queryOne stmt rowId =-        withBind stmt (Only rowId) $ do-          Just (Only r) <- nextRow stmt-          Nothing <- nextRow stmt :: IO (Maybe (Only String))-          return r+{-# LANGUAGE OverloadedStrings #-}
+
+module Statement (
+    testBind
+  , testDoubleBind
+  , testPreparedStatements
+  ) where
+
+import Common
+import Data.Maybe(fromJust)
+
+testBind :: TestEnv -> Test
+testBind TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE test_bind (id INTEGER PRIMARY KEY, t TEXT)"
+  execute_ conn "INSERT INTO test_bind VALUES(1, 'result')"
+  withStatement conn "SELECT t FROM test_bind WHERE id=?" $ \stmt ->
+    withBind stmt [1::Int] $ do
+      row <- nextRow stmt :: IO (Maybe (Only String))
+      assertEqual "result" (Only "result") (fromJust row)
+
+testDoubleBind :: TestEnv -> Test
+testDoubleBind TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE test_double_bind (id INTEGER PRIMARY KEY, t TEXT)"
+  execute_ conn "INSERT INTO test_double_bind VALUES(1, 'first result')"
+  execute_ conn "INSERT INTO test_double_bind VALUES(2, 'second result')"
+  withStatement conn "SELECT t FROM test_double_bind WHERE id=?" $ \stmt -> do
+    withBind stmt [1::Int] $ do
+      row <- nextRow stmt :: IO (Maybe (Only String))
+      assertEqual "first result" (Only "first result") (fromJust row)
+
+    withBind stmt [2::Int] $ do
+      row <- nextRow stmt :: IO (Maybe (Only String))
+      assertEqual "second result" (Only "second result") (fromJust row)
+
+testPreparedStatements :: TestEnv -> Test
+testPreparedStatements TestEnv{..} = TestCase $ do
+  execute_ conn "CREATE TABLE ps (id INTEGER PRIMARY KEY, t TEXT)"
+  execute_ conn "INSERT INTO ps VALUES(1, 'first result')"
+  execute_ conn "INSERT INTO ps VALUES(2, 'second result')"
+  withStatement conn "SELECT t FROM ps WHERE id=?" $ \stmt -> do
+    colName <- columnName stmt 0
+    colName @?= "t"
+    elems <- mapM (queryOne stmt) [1 :: Int, 2]
+    ["first result" :: String, "second result"] @=? elems
+    where
+      queryOne stmt rowId =
+        withBind stmt (Only rowId) $ do
+          Just (Only r) <- nextRow stmt
+          Nothing <- nextRow stmt :: IO (Maybe (Only String))
+          return r
test/TestImports.hs view
@@ -1,45 +1,45 @@--module TestImports (-    testImports-  ) where---- Test file to test that we can do most things with a single import-import           Control.Applicative-import qualified Data.Text as T--import           Common--data TestType = TestType Int Int Int---- Hook up sqlite-simple to know how to read Test rows-instance FromRow TestType where-  fromRow = TestType <$> field <*> field <*> field--test1 :: IO ()-test1 = do-  conn <- open ":memory:"-  execute_ conn "CREATE TABLE testimp (id INTEGER PRIMARY KEY, id2 INTEGER, id3 INTEGER)"-  execute_ conn "INSERT INTO testimp (id, id2, id3) VALUES (1, 2, 3)"-  [_v] <- query_ conn "SELECT * FROM testimp" :: IO [TestType]-  [_v] <- query conn "SELECT ?+?" (3::Int,4::Int) :: IO [(Only Int)]-  close conn--test2 :: Connection -> IO ()-test2 conn = do-  execute_ conn "CREATE TABLE testimp (id INTEGER PRIMARY KEY)"-  execute_ conn "INSERT INTO testimp (id) VALUES (1)"-  [Only _v] <- query_ conn (Query q) :: IO [Only Int]-  return ()-  where-    q = T.concat ["SELECT * FROM ", "testimp"]--test3 :: Connection -> IO ()-test3 conn = do-  [_v] <- query conn "SELECT ?+?" (3::Int,4::Int) :: IO [(Only Int)]-  return ()--testImports :: TestEnv -> Test-testImports env = TestCase $ do-  test1-  withConnection ":memory:" test2-  test3 (conn env)+
+module TestImports (
+    testImports
+  ) where
+
+-- Test file to test that we can do most things with a single import
+import           Control.Applicative
+import qualified Data.Text as T
+
+import           Common
+
+data TestType = TestType Int Int Int
+
+-- Hook up sqlite-simple to know how to read Test rows
+instance FromRow TestType where
+  fromRow = TestType <$> field <*> field <*> field
+
+test1 :: IO ()
+test1 = do
+  conn <- open ":memory:"
+  execute_ conn "CREATE TABLE testimp (id INTEGER PRIMARY KEY, id2 INTEGER, id3 INTEGER)"
+  execute_ conn "INSERT INTO testimp (id, id2, id3) VALUES (1, 2, 3)"
+  [_v] <- query_ conn "SELECT * FROM testimp" :: IO [TestType]
+  [_v] <- query conn "SELECT ?+?" (3::Int,4::Int) :: IO [(Only Int)]
+  close conn
+
+test2 :: Connection -> IO ()
+test2 conn = do
+  execute_ conn "CREATE TABLE testimp (id INTEGER PRIMARY KEY)"
+  execute_ conn "INSERT INTO testimp (id) VALUES (1)"
+  [Only _v] <- query_ conn (Query q) :: IO [Only Int]
+  return ()
+  where
+    q = T.concat ["SELECT * FROM ", "testimp"]
+
+test3 :: Connection -> IO ()
+test3 conn = do
+  [_v] <- query conn "SELECT ?+?" (3::Int,4::Int) :: IO [(Only Int)]
+  return ()
+
+testImports :: TestEnv -> Test
+testImports env = TestCase $ do
+  test1
+  withConnection ":memory:" test2
+  test3 (conn env)
test/UserInstances.hs view
@@ -1,33 +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)]-  (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)]-  "toField test2" @=? r+{-# 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)]
+  (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)]
+  "toField test2" @=? r