Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 12 additions & 4 deletions beam-core/Database/Beam/Query/Combinators.hs
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,8 @@ import Control.Monad.Identity
import Control.Monad.Free
import Control.Applicative

import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe
import Data.Proxy
import Data.Time (LocalTime)
Expand All @@ -105,16 +107,22 @@ allFromView_ (DatabaseEntity vw) =
(tableFieldsToExpressions (dbViewSettings vw))
(\_ -> Nothing) snd)

-- | SQL @VALUES@ clause. Introduce the elements of the given list as
-- | SQL @VALUES@ clause. Introduce the elements of the given non-empty list as
-- rows in a joined table.
values_ :: forall be db s a
. ( Projectible be a
, BeamSqlBackend be )
=> [ a ] -> Q be db s a
=> NonEmpty a
-> Q be db s a
values_ rows =
Q $ liftF (QAll (\tblPfx -> fromTable (tableFromValues (map (\row -> project (Proxy @be) row tblPfx) rows)) . Just . (,Just fieldNames))
Q $ liftF (QAll (\tblPfx ->
fromTable
(tableFromValues (NonEmpty.toList (NonEmpty.map (\row -> project (Proxy @be) row tblPfx) rows)))
. Just
. (,Just fieldNames))
(\tblNm' -> fst $ mkFieldNames (qualifiedField tblNm'))
(\_ -> Nothing) snd)
(\_ -> Nothing) snd
)
where
fieldNames = snd $ mkFieldNames @be @a unqualifiedField

Expand Down
3 changes: 2 additions & 1 deletion beam-postgres/test/Database/Beam/Postgres/Test/Select.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ module Database.Beam.Postgres.Test.Select (tests) where

import Data.Aeson
import Data.ByteString (ByteString)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Int
import qualified Data.Vector as V
import Test.Tasty
Expand Down Expand Up @@ -82,7 +83,7 @@ testUuuidInValues getConn = testCase "UUID in values_ works" $
pgCreateExtension @UuidOssp
let ext = getPgExtension $ _uuidOssp $ unCheckDatabase db
runSelectReturningList $ select $ do
v <- values_ [val_ nil]
v <- values_ (val_ nil :| [])
return $ pgUuidGenerateV5 ext v ""
assertEqual "result" [V5.generateNamed nil []] result

Expand Down
3 changes: 2 additions & 1 deletion beam-sqlite/test/Database/Beam/Sqlite/Test/Select.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ import Data.Int (Int32)

import Database.Beam
import Database.Beam.Sqlite
import Data.List.NonEmpty (NonEmpty(..))
import Test.Tasty
import Test.Tasty.ExpectedFailure
import Test.Tasty.HUnit
Expand Down Expand Up @@ -51,5 +52,5 @@ testExceptValues :: TestTree
testExceptValues = testCase "EXCEPT with VALUES works" $
withTestDb $ \conn -> do
result <- runBeamSqlite conn $ runSelectReturningList $ select $
values_ [as_ @Bool $ val_ True, val_ False] `except_` values_ [val_ False]
values_ ((as_ @Bool $ val_ True) :| [val_ False]) `except_` values_ (val_ False :| [])
assertEqual "result" [True] result
1 change: 1 addition & 0 deletions docs/beam-templates/chinook.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ import Control.Monad
import Control.Exception

import Data.IORef
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid ((<>))
import Data.Int
import Data.Text
Expand Down
2 changes: 1 addition & 1 deletion docs/user-guide/queries/select.md
Original file line number Diff line number Diff line change
Expand Up @@ -222,7 +222,7 @@ For example, to get all customers we know to be in New York, California, and Tex
```haskell
!example chinook !on:Sqlite !on:MySQL
do c <- all_ (customer chinookDb)
st <- values_ [ "NY", "CA", "TX" ]
st <- values_ ("NY" :| [ "CA", "TX" ]) -- (:|) is the constructor of NonEmpty
guard_' (just_ st ==?. addressState (customerAddress c))
pure c
```
Expand Down
Loading