packages feed

sqlite-simple 0.4.12.0 → 0.4.12.1

raw patch · 27 files changed

+3349/−3341 lines, 27 filessetup-changed

Files

Database/SQLite/Simple.hs view
@@ -1,820 +1,820 @@-{-# 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
-  , 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 = queryWith fromRow
-
--- | 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 takes an explicit 'RowParser'.
-queryWith :: (ToRow q) => RowParser r -> Connection -> Query -> q -> IO [r]
-queryWith fromRow_ conn templ qs =
-  withStatementParams conn templ qs $ \stmt -> doFoldToList fromRow_ stmt
-
--- | 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+  , 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 = queryWith fromRow++-- | 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 takes an explicit 'RowParser'.+queryWith :: (ToRow q) => RowParser r -> Connection -> Query -> q -> IO [r]+queryWith fromRow_ conn templ qs =+  withStatementParams conn templ qs $ \stmt -> doFoldToList fromRow_ stmt++-- | 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 :.
LICENSE view
@@ -1,94 +1,94 @@-Copyright (c) 2012, Janne Hellsten
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Leon P Smith nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
-Copyright (c) 2011, Leon P Smith
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Leon P Smith nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
-Copyright (c) 2011, MailRank, Inc.
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
-OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.
+Copyright (c) 2012, Janne Hellsten++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Leon P Smith nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+++Copyright (c) 2011, Leon P Smith++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Leon P Smith nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+++Copyright (c) 2011, MailRank, Inc.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
README.markdown view
@@ -1,114 +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)
-
-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 view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++import Distribution.Simple++main = defaultMain
changelog view
@@ -1,92 +1,95 @@-0.4.12.0
-	* Add queryWith
-
-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
+0.4.12.1+	* Add Setup.hs (https://github.com/fpco/stackage/issues/2145)++0.4.12.0+	* Add queryWith++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.12.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.12.1+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,82 +1,82 @@-
-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
++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,268 +1,268 @@-{-# 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
+{-# 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
test/Utf8Strings.hs view
@@ -1,28 +1,28 @@--- -*- coding: utf-8 -*-
-
-module Utf8Strings (testUtf8Simplest
-                  , testBlobs) where
-
-import Common
-import qualified Data.ByteString as B
-import Data.Word
-
-testUtf8Simplest :: TestEnv -> Test
-testUtf8Simplest TestEnv{..} = TestCase $ do
-  execute_ conn "CREATE TABLE utf (id INTEGER, t TEXT)"
-  execute_ conn "INSERT INTO utf (id, t) VALUES (1, 'ääöö')"
-  execute conn "INSERT INTO utf (id, t) VALUES (?,?)" (2 :: Int, "ääööåå" :: String)
-  [Only t1] <- query conn "SELECT t FROM utf WHERE id = ?" (Only (1 :: Int))
-  assertEqual "utf8" ("ääöö" :: String) t1
-  [Only t2] <- query conn "SELECT t FROM utf WHERE id = ?" (Only (2 :: Int))
-  assertEqual "utf8" ("ääööåå" :: String) t2
-
-testBlobs :: TestEnv -> Test
-testBlobs TestEnv{..} = TestCase $ do
-  let d = B.pack ([0..127] :: [Word8])
-  execute_ conn "CREATE TABLE blobs (id INTEGER, b BLOB)"
-  execute conn "INSERT INTO blobs (id, b) VALUES (?,?)" (1 :: Int, d)
-  [Only t1] <- query conn "SELECT b FROM blobs WHERE id = ?" (Only (1 :: Int))
-  assertEqual "blob" d t1
-  assertEqual "blob nul char" 0 (B.index d 0)
-  assertEqual "blob first char" 1 (B.index d 1)
+-- -*- coding: utf-8 -*-++module Utf8Strings (testUtf8Simplest+                  , testBlobs) where++import Common+import qualified Data.ByteString as B+import Data.Word++testUtf8Simplest :: TestEnv -> Test+testUtf8Simplest TestEnv{..} = TestCase $ do+  execute_ conn "CREATE TABLE utf (id INTEGER, t TEXT)"+  execute_ conn "INSERT INTO utf (id, t) VALUES (1, 'ääöö')"+  execute conn "INSERT INTO utf (id, t) VALUES (?,?)" (2 :: Int, "ääööåå" :: String)+  [Only t1] <- query conn "SELECT t FROM utf WHERE id = ?" (Only (1 :: Int))+  assertEqual "utf8" ("ääöö" :: String) t1+  [Only t2] <- query conn "SELECT t FROM utf WHERE id = ?" (Only (2 :: Int))+  assertEqual "utf8" ("ääööåå" :: String) t2++testBlobs :: TestEnv -> Test+testBlobs TestEnv{..} = TestCase $ do+  let d = B.pack ([0..127] :: [Word8])+  execute_ conn "CREATE TABLE blobs (id INTEGER, b BLOB)"+  execute conn "INSERT INTO blobs (id, b) VALUES (?,?)" (1 :: Int, d)+  [Only t1] <- query conn "SELECT b FROM blobs WHERE id = ?" (Only (1 :: Int))+  assertEqual "blob" d t1+  assertEqual "blob nul char" 0 (B.index d 0)+  assertEqual "blob first char" 1 (B.index d 1)