diff --git a/Database/Beam/Sqlite/Syntax.hs b/Database/Beam/Sqlite/Syntax.hs --- a/Database/Beam/Sqlite/Syntax.hs +++ b/Database/Beam/Sqlite/Syntax.hs @@ -75,6 +75,7 @@ import GHC.TypeLits import Database.SQLite.Simple (SQLData(..)) +import Database.SQLite.Simple.ToField (toField) import GHC.Float import GHC.Generics @@ -825,6 +826,8 @@ defaultE = SqliteExpressionDefault inE e es = SqliteExpressionSyntax (parens (fromSqliteExpression e) <> emit " IN " <> parens (commas (map fromSqliteExpression es))) + inSelectE e sel = + SqliteExpressionSyntax (parens (fromSqliteExpression e) <> emit " IN " <> parens (fromSqliteSelect sel)) instance IsSql99ConcatExpressionSyntax SqliteExpressionSyntax where concatE [] = valueE (sqlValueSyntax ("" :: T.Text)) @@ -961,8 +964,7 @@ sqlValueSyntax bs = SqliteValueSyntax (emitValue (SQLBlob bs)) instance HasSqlValueSyntax SqliteValueSyntax UTCTime where - sqlValueSyntax tm = SqliteValueSyntax (emitValue (SQLText (fromString tmStr))) - where tmStr = formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S%Q")) tm + sqlValueSyntax tm = SqliteValueSyntax (emitValue (toField tm)) instance HasSqlValueSyntax SqliteValueSyntax LocalTime where sqlValueSyntax tm = SqliteValueSyntax (emitValue (SQLText (fromString tmStr))) diff --git a/beam-sqlite.cabal b/beam-sqlite.cabal --- a/beam-sqlite.cabal +++ b/beam-sqlite.cabal @@ -1,5 +1,5 @@ name: beam-sqlite -version: 0.5.1.2 +version: 0.5.2.0 synopsis: Beam driver for SQLite description: Beam driver for the embedded database. See @@ -25,21 +25,21 @@ other-modules: Database.Beam.Sqlite.SqliteSpecific build-depends: base >=4.7 && <5, - beam-core >=0.9 && <0.10, + beam-core >=0.10 && <0.11, beam-migrate >=0.5 && <0.6, sqlite-simple >=0.4 && <0.5, - text >=1.0 && <1.3, + text >=1.0 && <2.1, bytestring >=0.10 && <0.12, hashable >=1.2 && <1.5, - time >=1.6 && <1.12, + time >=1.6 && <1.13, dlist >=0.8 && <1.1, mtl >=2.1 && <2.3, free >=4.12 && <5.2, scientific >=0.3 && <0.4, monad-control >=1.0 && <1.1, network-uri >=2.6 && <2.7, - aeson >=0.11 && <2.1, + aeson >=0.11 && <2.2, attoparsec >=0.13 && <0.15, transformers-base >=0.4 && <0.5 default-language: Haskell2010 diff --git a/test/Database/Beam/Sqlite/Test/Insert.hs b/test/Database/Beam/Sqlite/Test/Insert.hs --- a/test/Database/Beam/Sqlite/Test/Insert.hs +++ b/test/Database/Beam/Sqlite/Test/Insert.hs @@ -2,7 +2,7 @@ import Data.Int (Int32) import Data.Text (Text) -import Data.Time (LocalTime) +import Data.Time (LocalTime, Day(..), UTCTime(..), fromGregorian, getCurrentTime, secondsToDiffTime) import Database.Beam import Database.Beam.Backend.SQL.BeamExtensions import Database.Beam.Sqlite hiding (runInsertReturningList) @@ -27,6 +27,7 @@ , ttLastName :: C f Text , ttAge :: C f Int32 , ttDateJoined :: C f LocalTime + , ttDateLoggedIn :: C f UTCTime } deriving (Generic, Beamable) deriving instance Show (TestTableT Identity) @@ -47,20 +48,24 @@ testInsertReturningColumnOrder :: TestTree testInsertReturningColumnOrder = testCase "runInsertReturningList with mismatching column order" $ do + now <- getCurrentTime + let zeroUtcTime = UTCTime (ModifiedJulianDay 0) 0 + let oneUtcTime = UTCTime (fromGregorian 1 0 0) (secondsToDiffTime 0) + withTestDb $ \conn -> do - execute_ conn "CREATE TABLE test_table ( date_joined TIMESTAMP NOT NULL, first_name TEXT NOT NULL, id INT PRIMARY KEY, age INT NOT NULL, last_name TEXT NOT NULL )" + execute_ conn "CREATE TABLE test_table ( date_joined TIMESTAMP NOT NULL, date_logged_in TIMESTAMP WITH TIME ZONE NOT NULL, first_name TEXT NOT NULL, id INT PRIMARY KEY, age INT NOT NULL, last_name TEXT NOT NULL )" inserted <- runBeamSqlite conn $ runInsertReturningList $ insert (dbTestTable testDatabase) $ - insertExpressions [ TestTable 0 (concat_ [ "j", "im" ]) "smith" 19 currentTimestamp_ - , TestTable 1 "sally" "apple" ((val_ 56 + val_ 109) `div_` 5) currentTimestamp_ - , TestTable 4 "blah" "blah" (-1) currentTimestamp_ ] + insertExpressions [ TestTable 0 (concat_ [ "j", "im" ]) "smith" 19 currentTimestamp_ (val_ zeroUtcTime) + , TestTable 1 "sally" "apple" ((val_ 56 + val_ 109) `div_` 5) currentTimestamp_ (val_ oneUtcTime) + , TestTable 4 "blah" "blah" (-1) currentTimestamp_ (val_ now) ] let dateJoined = ttDateJoined (head inserted) - expected = [ TestTable 0 "jim" "smith" 19 dateJoined - , TestTable 1 "sally" "apple" 33 dateJoined - , TestTable 4 "blah" "blah" (-1) dateJoined ] + expected = [ TestTable 0 "jim" "smith" 19 dateJoined zeroUtcTime + , TestTable 1 "sally" "apple" 33 dateJoined oneUtcTime + , TestTable 4 "blah" "blah" (-1) dateJoined now ] assertEqual "insert values" inserted expected diff --git a/test/Database/Beam/Sqlite/Test/Select.hs b/test/Database/Beam/Sqlite/Test/Select.hs --- a/test/Database/Beam/Sqlite/Test/Select.hs +++ b/test/Database/Beam/Sqlite/Test/Select.hs @@ -1,5 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} + module Database.Beam.Sqlite.Test.Select (tests) where +import Data.Int (Int32) + import Database.Beam import Database.Beam.Sqlite import Test.Tasty @@ -12,6 +16,7 @@ tests = testGroup "Selection tests" [ expectFail testExceptValues , testInRowValues + , testInSelect ] data Pair f = Pair @@ -27,6 +32,19 @@ p = val_ $ Pair False False return $ p `in_` [p, p] assertEqual "result" [True] result + +testInSelect :: TestTree +testInSelect = testCase "IN (SELECT ...) works" $ + withTestDb $ \conn -> do + result <- runBeamSqlite conn $ runSelectReturningList $ select $ do + let x = as_ @Int32 (val_ 1) + return $ x `inQuery_` (pure (as_ @Int32 $ val_ 1)) + assertEqual "result" [True] result + + result <- runBeamSqlite conn $ runSelectReturningList $ select $ do + let x = as_ @Int32 (val_ 1) + return $ x `inQuery_` (pure (as_ @Int32 $ val_ 2)) + assertEqual "result" [False] result -- | Regression test for testExceptValues :: TestTree