diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## 0.10.8.0 + +* Added `sqlElemAny`, a version of `sqlElem` that uses `= any` under + the hood. (Thanks to @simmsb). + ## 0.10.7.0 * Added `unsafeCastSqlType`, `typedNull` and `untypedNull`, allowing diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014-2018 Purely Agile Limited; 2019-2025 Tom Ellis +Copyright (c) 2014-2018 Purely Agile Limited; 2019-2026 Tom Ellis All rights reserved. diff --git a/Test/Test.hs b/Test/Test.hs --- a/Test/Test.hs +++ b/Test/Test.hs @@ -1134,6 +1134,15 @@ testH (A.pure (O.sqlElem 999 (O.sqlArray O.sqlInt4 [5,6,7]))) (`shouldBe` [False]) +testSqlElemAny :: Test +testSqlElemAny = do + it "checks presence of the element (SqlInt4)" $ + testH (A.pure (O.sqlElemAny 5 (O.sqlArray O.sqlInt4 [5,6,7]))) + (`shouldBe` [True]) + it "checks absence of the element (SqlInt4)" $ + testH (A.pure (O.sqlElemAny 999 (O.sqlArray O.sqlInt4 [5,6,7]))) + (`shouldBe` [False]) + type JsonTest a = SpecWith (Select (Field a) -> PGS.Connection -> Expectation) -- Test opaleye's equivalent of c1->'c' testJsonGetFieldValue :: (O.SqlIsJson a, DefaultFromField a Json.Value) @@ -1658,6 +1667,7 @@ testArrayAppend testArrayPosition testSqlElem + testSqlElemAny describe "joins" $ do testLeftJoin testLeftJoinNullable diff --git a/opaleye.cabal b/opaleye.cabal --- a/opaleye.cabal +++ b/opaleye.cabal @@ -1,6 +1,6 @@ name: opaleye -copyright: Copyright (c) 2014-2018 Purely Agile Limited; 2019-2025 Tom Ellis -version: 0.10.7.0 +copyright: Copyright (c) 2014-2018 Purely Agile Limited; 2019-2026 Tom Ellis +version: 0.10.8.0 synopsis: An SQL-generating DSL targeting PostgreSQL description: An SQL-generating DSL targeting PostgreSQL. Allows Postgres queries to be written within Haskell in a @@ -16,7 +16,7 @@ extra-doc-files: README.md CHANGELOG.md *.md -tested-with: GHC==9.10, GHC==9.8, GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8 +tested-with: GHC==9.12, GHC==9.10, GHC==9.8, GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8 source-repository head type: git @@ -30,7 +30,7 @@ hs-source-dirs: src build-depends: aeson >= 0.6 && < 2.3 - , base >= 4.9 && < 4.21 + , base >= 4.9 && < 4.22 , base16-bytestring >= 0.1.1.6 && < 1.1 , case-insensitive >= 1.2 && < 1.3 , bytestring >= 0.10 && < 0.13 diff --git a/src/Opaleye/Internal/HaskellDB/PrimQuery.hs b/src/Opaleye/Internal/HaskellDB/PrimQuery.hs --- a/src/Opaleye/Internal/HaskellDB/PrimQuery.hs +++ b/src/Opaleye/Internal/HaskellDB/PrimQuery.hs @@ -23,6 +23,7 @@ | BaseTableAttrExpr Attribute | CompositeExpr PrimExpr Attribute -- ^ Composite Type Query | BinExpr BinOp PrimExpr PrimExpr + | AnyExpr BinOp PrimExpr PrimExpr -- ^ ANY() | UnExpr UnOp PrimExpr | AggrExpr (Aggr' PrimExpr) | WndwExpr WndwOp Partition diff --git a/src/Opaleye/Internal/HaskellDB/Sql.hs b/src/Opaleye/Internal/HaskellDB/Sql.hs --- a/src/Opaleye/Internal/HaskellDB/Sql.hs +++ b/src/Opaleye/Internal/HaskellDB/Sql.hs @@ -48,6 +48,7 @@ data SqlExpr = ColumnSqlExpr SqlColumn | CompositeSqlExpr SqlExpr String | BinSqlExpr String SqlExpr SqlExpr + | AnySqlExpr String SqlExpr SqlExpr | SubscriptSqlExpr SqlExpr SqlExpr | PrefixSqlExpr String SqlExpr | PostfixSqlExpr String SqlExpr diff --git a/src/Opaleye/Internal/HaskellDB/Sql/Default.hs b/src/Opaleye/Internal/HaskellDB/Sql/Default.hs --- a/src/Opaleye/Internal/HaskellDB/Sql/Default.hs +++ b/src/Opaleye/Internal/HaskellDB/Sql/Default.hs @@ -124,6 +124,10 @@ (leftE, paren rightE) _ -> (paren leftE, paren rightE) in BinSqlExpr (showBinOp op) expL expR + AnyExpr op e1 e2 -> + let leftE = sqlExpr gen e1 + rightE = sqlExpr gen e2 + in AnySqlExpr (showBinOp op) (ParensSqlExpr leftE) rightE UnExpr op e -> let (op',t) = sqlUnOp op e' = sqlExpr gen e in case t of diff --git a/src/Opaleye/Internal/HaskellDB/Sql/Print.hs b/src/Opaleye/Internal/HaskellDB/Sql/Print.hs --- a/src/Opaleye/Internal/HaskellDB/Sql/Print.hs +++ b/src/Opaleye/Internal/HaskellDB/Sql/Print.hs @@ -181,6 +181,7 @@ ParensSqlExpr e -> parens (ppSqlExpr e) SubscriptSqlExpr e1 e2 -> ppSqlExpr e1 <> brackets (ppSqlExpr e2) BinSqlExpr op e1 e2 -> ppSqlExpr e1 <+> text op <+> ppSqlExpr e2 + AnySqlExpr op e1 e2 -> ppSqlExpr e1 <+> text op <+> text "ANY" <+> parens (ppSqlExpr e2) PrefixSqlExpr op e -> text op <+> ppSqlExpr e PostfixSqlExpr op e -> ppSqlExpr e <+> text op FunSqlExpr f es -> text f <> parens (commaH ppSqlExpr es) diff --git a/src/Opaleye/Operators.hs b/src/Opaleye/Operators.hs --- a/src/Opaleye/Operators.hs +++ b/src/Opaleye/Operators.hs @@ -86,6 +86,7 @@ , index , arrayPosition , sqlElem + , sqlElemAny -- * Range operators , overlap , liesWithin @@ -438,11 +439,19 @@ -- | Whether the element (needle) exists in the array (haystack). -- N.B. this is implemented hackily using @array_position@. If you --- need it to be implemented using @= any@ then please open an issue. +-- want the equivalent implemented using @= any@ then use +-- 'sqlElemAny'. sqlElem :: F.Field_ n a -- ^ Needle -> F.Field (T.SqlArray_ n a) -- ^ Haystack -> F.Field T.SqlBool sqlElem f fs = (O.not . F.isNull . arrayPosition fs) f + +-- | Whether the element (needle) exists in the array (haystack). +-- This is implemented using @= any@. +sqlElemAny :: F.Field_ n a -- ^ Needle + -> F.Field (T.SqlArray_ n a) -- ^ Haystack + -> F.Field T.SqlBool +sqlElemAny (Column f) (Column fs) = Column $ HPQ.AnyExpr (HPQ.:==) f fs overlap :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool overlap = C.binOp (HPQ.:&&)