diff --git a/Database/SQLite/Simple.hs b/Database/SQLite/Simple.hs --- a/Database/SQLite/Simple.hs +++ b/Database/SQLite/Simple.hs @@ -39,9 +39,15 @@ -- ** Type conversions -- $types + Query(..) + , Connection + , ToRow(..) + , FromRow(..) + , Only(..) + , (:.)(..) -- * Connections - open + , open , close -- * Queries that return results , query @@ -50,12 +56,6 @@ , execute , execute_ , field - , Query - , Connection - , ToRow - , FromRow - , Only(..) - , (:.)(..) -- ** Exceptions , FormatError(fmtMessage, fmtQuery, fmtParams) , ResultError(errSQLType, errHaskellType, errMessage) @@ -148,9 +148,6 @@ -- -- * 'FormatError': the query string mismatched with given arguments. -- --- * 'QueryError': the result contains no columns (i.e. you should be --- using 'execute' instead of 'query'). --- -- * 'ResultError': result conversion failed. query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r] @@ -254,7 +251,7 @@ -- > import Database.SQLite.Simple -- > -- > hello = do --- > conn <- connect defaultConnectInfo +-- > conn <- open "test.db" -- > query conn "select 2 + 2" -- -- A 'Query' value does not represent the actual query that will be @@ -327,85 +324,14 @@ -- Haskell lacks a single-element tuple type, so if you have just one -- value you want substituted into a query, what should you do? -- --- The obvious approach would appear to be something like this: --- --- > instance (Param a) => QueryParam a where --- > ... --- --- Unfortunately, this wreaks havoc with type inference, so we take a --- different tack. To represent a single value @val@ as a parameter, write --- a singleton list @[val]@, use 'Just' @val@, or use 'Only' @val@. +-- 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"] --- $in --- --- Suppose you want to write a query using an @IN@ clause: --- --- > select * from users where first_name in ('Anna', 'Boris', 'Carla') --- --- In such cases, it's common for both the elements and length of the --- list after the @IN@ keyword to vary from query to query. --- --- To address this case, use the 'In' type wrapper, and use a single --- \"@?@\" character to represent the list. Omit the parentheses --- around the list; these will be added for you. --- --- Here's an example: --- --- > query conn "select * from users where first_name in ?" $ --- > In ["Anna", "Boris", "Carla"] --- --- If your 'In'-wrapped list is empty, the string @\"(null)\"@ will be --- substituted instead, to ensure that your clause remains --- syntactically valid. - --- $many --- --- If you know that you have many rows of data to insert into a table, --- it is much more efficient to perform all the insertions in a single --- multi-row @INSERT@ statement than individually. --- --- The 'executeMany' function is intended specifically for helping --- with multi-row @INSERT@ and @UPDATE@ statements. Its rules for --- query substitution are different than those for 'execute'. --- --- What 'executeMany' searches for in your 'Query' template is a --- single substring of the form: --- --- > values (?,?,?) --- --- The rules are as follows: --- --- * The keyword @VALUES@ is matched case insensitively. --- --- * There must be no other \"@?@\" characters anywhere in your --- template. --- --- * There must one or more \"@?@\" in the parentheses. --- --- * Extra white space is fine. --- --- The last argument to 'executeMany' is a list of parameter --- tuples. These will be substituted into the query where the @(?,?)@ --- string appears, in a form suitable for use in a multi-row @INSERT@ --- or @UPDATE@. --- --- Here is an example: --- --- > executeMany conn --- > "insert into users (first_name,last_name) values (?,?)" --- > [("Boris","Karloff"),("Ed","Wood")] --- --- The query that will be executed here will look like this --- (reformatted for tidiness): --- --- > insert into users (first_name,last_name) values --- > ('Boris','Karloff'),('Ed','Wood') - -- $result -- -- The 'query' and 'query_' functions return a list of values in the @@ -414,11 +340,11 @@ -- -- Here is a simple example of how to extract results: -- --- > import qualified Data.Text as Text +-- > import qualified Data.Text as T -- > -- > xs <- query_ conn "select name,age from users" -- > forM_ xs $ \(name,age) -> --- > putStrLn $ Text.unpack name ++ " is " ++ show (age :: Int) +-- > putStrLn $ T.unpack name ++ " is " ++ show (age :: Int) -- -- Notice two important details about this code: -- diff --git a/Database/SQLite/Simple/FromField.hs b/Database/SQLite/Simple/FromField.hs --- a/Database/SQLite/Simple/FromField.hs +++ b/Database/SQLite/Simple/FromField.hs @@ -39,9 +39,12 @@ import qualified Data.ByteString.Char8 as B import Data.Int (Int16, Int32, Int64) import Data.Time (UTCTime, Day) +import Data.Time.Format (parseTime) import qualified Data.Text as T import Data.Typeable (Typeable, typeOf) +import System.Locale (defaultTimeLocale) + import Database.SQLite3 as Base import Database.SQLite.Simple.Types import Database.SQLite.Simple.Internal @@ -138,7 +141,11 @@ fromField f = returnError ConversionFailed f "expecting SQLBlob column type" instance FromField UTCTime where - fromField (Field (SQLText t) _) = Ok . read . T.unpack $ t + fromField f@(Field (SQLText t) _) = + case parseTime defaultTimeLocale "%F %X%Q" . T.unpack $ t of + Just t -> Ok t + Nothing -> returnError ConversionFailed f "couldn't parse UTCTime field" + fromField f = returnError ConversionFailed f "expecting SQLText column type" instance FromField Day where diff --git a/Database/SQLite/Simple/ToField.hs b/Database/SQLite/Simple/ToField.hs --- a/Database/SQLite/Simple/ToField.hs +++ b/Database/SQLite/Simple/ToField.hs @@ -25,8 +25,10 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as LT import Data.Time (Day, UTCTime) +import Data.Time.Format (formatTime) import Data.Word (Word, Word8, Word16, Word32, Word64) import GHC.Float +import System.Locale (defaultTimeLocale) import Database.SQLite3 as Base import Database.SQLite.Simple.Types (Null) @@ -127,7 +129,7 @@ {-# INLINE toField #-} instance ToField UTCTime where - toField = SQLText . T.pack . show + toField = SQLText . T.pack . formatTime defaultTimeLocale "%F %X%Q" {-# INLINE toField #-} instance ToField Day where diff --git a/sqlite-simple.cabal b/sqlite-simple.cabal --- a/sqlite-simple.cabal +++ b/sqlite-simple.cabal @@ -1,5 +1,5 @@ Name: sqlite-simple -Version: 0.1.0.1 +Version: 0.1.0.2 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple. @@ -39,9 +39,10 @@ base < 5, bytestring >= 0.9, containers, - direct-sqlite >= 2.0, + direct-sqlite >= 2.0 && < 2.1, text >= 0.11.1, time, + old-locale >= 1.0.0.0, transformers default-extensions: @@ -70,6 +71,7 @@ Errors ParamConv Utf8Strings + TestImports ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind @@ -84,6 +86,7 @@ , bytestring , HUnit , sqlite-simple + , direct-sqlite , text , time diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -10,11 +10,15 @@ import Errors import Utf8Strings +import TestImports() + tests :: [TestEnv -> Test] tests = [ TestLabel "Simple" . testSimpleSelect , TestLabel "Simple" . testSimpleOnePlusOne , TestLabel "Simple" . testSimpleParams + , TestLabel "Simple" . testSimpleTime + , TestLabel "Simple" . testSimpleTimeFract , TestLabel "ParamConv" . testParamConvInt , TestLabel "ParamConv" . testParamConvFloat , TestLabel "ParamConv" . testParamConvDateTime diff --git a/test/Simple.hs b/test/Simple.hs --- a/test/Simple.hs +++ b/test/Simple.hs @@ -1,9 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} module Simple ( testSimpleOnePlusOne , testSimpleSelect - , testSimpleParams) where + , testSimpleParams + , testSimpleTime + , testSimpleTimeFract) where +import qualified Data.Text as T +import Data.Time (UTCTime) import Common -- Simplest SELECT @@ -50,3 +55,35 @@ assertEqual "select params" "test2" row [Only i] <- query conn "SELECT ?+?" [42 :: Int, 1 :: Int] :: IO [Only Int] assertEqual "select int param" 43 i + +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 + +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 diff --git a/test/TestImports.hs b/test/TestImports.hs new file mode 100644 --- /dev/null +++ b/test/TestImports.hs @@ -0,0 +1,30 @@ + +module 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 Database.SQLite.Simple + +data Test = Test Int Int Int + +-- Hook up sqlite-simple to know how to read Nvbugs +instance FromRow Test where + fromRow = Test <$> field <*> field <*> field + +foo :: IO () +foo = do + conn <- open ":memory:" + [Only _v] <- query_ conn "SELECT * FROM test" :: IO [Only Int] + [_v] <- query_ conn "SELECT * FROM test" :: IO [(Int,Int)] + [_v] <- query_ conn "SELECT * FROM test" :: IO [Test] + [_v] <- query conn "SELECT ?+?" (3::Int,4::Int):: IO [(Only Int)] + close conn + +foo2 :: IO () +foo2 = do + conn <- open ":memory:" + [Only _v] <- query_ conn (Query q) :: IO [Only Int] + close conn + where + q = T.concat ["SELECT * FROM ", "test"]