opaleye 0.7.1.0 → 0.7.2.0

raw patch · 21 files changed

+848/−323 lines, 21 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• LICENSE +1/−1
• README.md +30/−7
• Test/Opaleye/Test/Arbitrary.hs +230/−136
• Test/QuickCheck.hs +19/−12
• Test/Test.hs +79/−22
• opaleye.cabal +9/−7
• src/Opaleye/Aggregate.hs +6/−0
• src/Opaleye/Exists.hs +21/−0
• src/Opaleye/Experimental/Enum.hs +102/−7
• src/Opaleye/Internal/HaskellDB/PrimQuery.hs +2/−1
• src/Opaleye/Internal/HaskellDB/Sql/Default.hs +1/−0
• src/Opaleye/Internal/HaskellDB/Sql/Print.hs +8/−5
• src/Opaleye/Internal/JSONBuildObjectFields.hs +39/−0
• src/Opaleye/Internal/Optimize.hs +3/−2
• src/Opaleye/Internal/PGTypesExternal.hs +10/−0
• src/Opaleye/Internal/PrimQuery.hs +12/−10
• src/Opaleye/Internal/Print.hs +31/−23
• src/Opaleye/Internal/Sql.hs +25/−7
• src/Opaleye/Operators.hs +128/−60
• src/Opaleye/SqlTypes.hs +78/−23

@@ -1,3 +1,17 @@+## 0.7.2.0++* Added `jsonAgg`, `jsonBuildObject` and `jsonBuildObjectField`.  Thanks+  to Nathan Jaremko.++* Added `now` function. Thanks to Nathan Jaremko.++* Added `Opaleye.Exists.exists`. Thanks to @duairc.++* Added `Opaleye.Experimental.Enum`++* Added `Opaleye.Operators.array_position` and+  `Opaleye.Operators.sqlElem`.  Thanks to Ashesh Ambasta.+ ## 0.7.1.0  * Added `Opaleye.Experimental.Enum` for an easy way to deal with

@@ -1,4 +1,4 @@-Copyright (c) 2014-2018 Purely Agile Limited; 2019-2020 Tom Ellis+Copyright (c) 2014-2018 Purely Agile Limited; 2019-2021 Tom Ellis  All rights reserved. 

@@ -1,4 +1,4 @@-# Brief introduction to Opaleye [![Hackage version](https://img.shields.io/hackage/v/opaleye.svg?label=Hackage)](https://hackage.haskell.org/package/opaleye) [![Linux build status](https://img.shields.io/travis/tomjaguarpaw/haskell-opaleye/master.svg?label=Linux%20build)](https://travis-ci.org/tomjaguarpaw/haskell-opaleye)+# Brief introduction to Opaleye [![Hackage version](https://img.shields.io/hackage/v/opaleye.svg?label=Hackage)](https://hackage.haskell.org/package/opaleye) [![Build status](https://img.shields.io/github/workflow/status/tomjaguarpaw/haskell-opaleye/ci/master.svg)](https://github.com/tomjaguarpaw/haskell-opaleye/actions)  Opaleye is a Haskell library that provides an SQL-generating embedded domain specific language for targeting Postgres.  You need Opaleye if@@ -67,6 +67,13 @@ discussion of or questions about Opaleye even if they don't relate to a bug or issue. +## PRs++You are welcome to make PRs to Opaleye.  If you would like to discuss+the design of your PR before you start work on it feel free to do so+by [filing a new+issue](https://github.com/tomjaguarpaw/haskell-opaleye/issues/new).+ # `Internal` modules  Opaleye exports a number of modules named `Opaleye.Internal....`.@@ -94,13 +101,29 @@  # Backup maintainers -In the event of the main developer becoming unreachable, please-contact the following who are authorised to make bugfixes and-dependency version bumps:+The only person authorised to merge to `master` or upload this package+to Hackage is Tom Ellis. -* Adam Bergmark-* Erik Hesselink-* Oliver Charles+However, to ensure continuity of service to Opaleye users there are+backup maintainers.++* If Tom Ellis is unavailable or unresponsive to maintenance requests+for three months then full ownership of the project, including the+GitHub repository, Hackage upload rights, and the right to amend this+backup maintainers policy, passes to Oliver Charles+(ollie@ocharles.org.uk).++* If Tom Ellis is unavailable or unresponsive to maintenance requests+for four months, and this policy has not been changed to the contrary,+then full ownership of the project, including the GitHub repository,+Hackage upload rights, and the right to amend this backup maintainers+policy passes to Shane O'Brien (@duairc).++* If Tom Ellis is unavailable or unresponsive to maintenance requests+for six months, and this policy has not been changed to the contrary,+then full ownership of the project, including the GitHub repository,+Hackage upload rights, and the right to amend this backup maintainers+policy passes to Joe Hermaszewski (@expipiplus1).  # Contributors 

@@ -142,86 +142,143 @@ instance Show ArbitraryFields where   show = const "Fields" -recurseSafelyOneof :: [TQ.Gen a] -> [TQ.Gen a] -> [TQ.Gen a] -> TQ.Gen a-recurseSafelyOneof r0 r1 r2 =-  recurseSafely (TQ.oneof r0) (TQ.oneof r1) (TQ.oneof r2)--recurseSafely :: TQ.Gen a -> TQ.Gen a -> TQ.Gen a -> TQ.Gen a-recurseSafely r0 r1 r2 = do-    -- The range of choose is inclusive-    c <- TQ.choose (1, 10 :: Int)--    if c <= 3-    then r0-    else if c <= 8-    then r1-    else if c <= 10-    then r2-    else error "Impossible"+recurseSafelyOneof :: Int+                   -> [TQ.Gen a]+                   -> [Int -> TQ.Gen a]+                   -> [Int -> Int -> TQ.Gen a]+                   -> TQ.Gen a+recurseSafelyOneof size r0 r1 r2 =+  if size <= 1+  then TQ.oneof r0+  else TQ.oneof $+         fmap (\g -> g (size - 1)) r1+         ++ fmap (\g -> do+                     -- TQ.choose is inclusive+                     size1 <- TQ.choose (1, size - 2)+                     let size2 = size - size1 - 1+                     -- size1 and size2 are between 1 and size - 2+                     -- inclusive.  Their sum is size - 1.+                     g size1 size2) r2 -instance TQ.Arbitrary ArbitrarySelect where-  arbitrary = recurseSafelyOneof+arbitrarySelect :: Int -> TQ.Gen (O.Select Fields)+arbitrarySelect size =+  fmap (\case ArbitrarySelect q -> q) $+               recurseSafelyOneof+                  size                   arbitrarySelectRecurse0                   arbitrarySelectRecurse1                   arbitrarySelectRecurse2 -instance TQ.Arbitrary ArbitrarySelectArr where-  arbitrary = recurseSafelyOneof+arbitrarySelectArr :: Int -> TQ.Gen (O.SelectArr Fields Fields)+arbitrarySelectArr size =+  fmap (\case ArbitrarySelectArr q -> q) $+               recurseSafelyOneof+                  size                   arbitrarySelectArrRecurse0                   arbitrarySelectArrRecurse1                   arbitrarySelectArrRecurse2 -instance TQ.Arbitrary ArbitraryKleisli where-  arbitrary = recurseSafelyOneof+arbitraryKleisli :: Int -> TQ.Gen (Fields -> O.Select Fields)+arbitraryKleisli size =+  fmap (\case ArbitraryKleisli q -> q) $+               recurseSafelyOneof+                  size                   arbitraryKleisliRecurse0                   arbitraryKleisliRecurse1                   arbitraryKleisliRecurse2 --- It would be better if ArbitrarySelect recursively called this, but--- it will do for now.+arbitrarySelectMaybe :: Int -> TQ.Gen (O.Select (O.MaybeFields Fields))+arbitrarySelectMaybe size = do+  fmap (\case ArbitrarySelectMaybe q -> q) $+               recurseSafelyOneof+                  size+                  arbitrarySelectMaybeRecurse0+                  arbitrarySelectMaybeRecurse1+                  arbitrarySelectMaybeRecurse2++arbitrarySelectArrMaybe :: Int+                        -> TQ.Gen (O.SelectArr (O.MaybeFields Fields) (O.MaybeFields Fields))+arbitrarySelectArrMaybe size = do+  fmap (\case ArbitrarySelectArrMaybe q -> q) $+               recurseSafelyOneof+                  size+                  arbitrarySelectArrMaybeRecurse0+                  arbitrarySelectArrMaybeRecurse1+                  []++-- [Note] Size of expressions ----- We are skirting close to generating infinite query territory here!--- We should be careful about precisely how we recurse.+-- 19 seems to be the biggest size we can get away with.  At 24 we see+-- a lot of errors like the below in GitHub Actions (although not+-- locally).  The Opaleye QuickCheck test process dies without+-- printing any error. One would expect QuickCheck to print an error+-- between its most recent success ("+++ OK, passed 1000 tests.") and+-- cabal-install's output ("Test suite test: FAIL").  Since QuickCheck+-- doesn't print anything I expect that the Opaleye test process must+-- be dying in a drastic way (perhaps OOM killed by the OS or perhaps+-- libpq is segfaulting).+--+-- Running 1 test suites...+-- Test suite test: RUNNING...+-- NOTICE:  table "table1" does not exist, skipping+-- NOTICE:  table "TABLE2" does not exist, skipping+-- NOTICE:  table "table3" does not exist, skipping+-- NOTICE:  table "table4" does not exist, skipping+-- NOTICE:  table "keywordtable" does not exist, skipping+-- NOTICE:  table "table6" does not exist, skipping+-- NOTICE:  table "table7" does not exist, skipping+-- NOTICE:  table "table5" does not exist, skipping+-- NOTICE:  table "table8" does not exist, skipping+-- NOTICE:  table "table10" does not exist, skipping+-- NOTICE:  table "table9" does not exist, skipping+-- +++ OK, passed 1000 tests.+-- +++ OK, passed 1000 tests.+-- +++ OK, passed 1000 tests.+-- +++ OK, passed 1000 tests.+-- +++ OK, passed 1000 tests.+-- +++ OK, passed 1000 tests.+-- Test suite test: FAIL+-- Test suite logged to:+-- /tmp/extra-dir-43542418781377/opaleye-0.7.1.0/dist-newstyle/build/x86_64-linux/ghc-8.8.4/opaleye-0.7.1.0/t/test/test/opaleye-0.7.1.0-test.log+-- 0 of 1 test suites (0 of 1 test cases) passed.+-- cabal: Tests failed for test:test from opaleye-0.7.1.0.+--+-- neil: Failed when running system command: cabal v2-exec cabal v2-test+-- CallStack (from HasCallStack):+--   error, called at src/System/Process/Extra.hs:34:9 in extra-1.7.8-ba0157cc68fafaa3027316e0961d40ff9f524d841ce1db561c650f9b1f917124:System.Process.Extra+--   system_, called at src/Cabal.hs:248:13 in main:Cabal+-- Error: Process completed with exit code 1.++instance TQ.Arbitrary ArbitrarySelect where+  arbitrary = do+    size <- TQ.choose (1, 19)+    fmap ArbitrarySelect (arbitrarySelect size)++instance TQ.Arbitrary ArbitrarySelectArr where+  arbitrary = do+    size <- TQ.choose (1, 19)+    fmap ArbitrarySelectArr (arbitrarySelectArr size)++instance TQ.Arbitrary ArbitraryKleisli where+  arbitrary = do+    size <- TQ.choose (1, 19)+    fmap ArbitraryKleisli (arbitraryKleisli size)+ instance TQ.Arbitrary ArbitrarySelectMaybe where   arbitrary = do-    TQ.oneof $-      (fmap . fmap) ArbitrarySelectMaybe $-      map (\fg -> do { ArbitrarySelect q <- TQ.arbitrary-                     ; f <- fg-                     ; return (f q)-                     })-      genSelectArrMaybeMapper-      ++-      [ do-          ArbitrarySelect q <- TQ.arbitrary-          return (fmap fieldsToMaybeFields q)-      ]-      ++-      [ do-          ArbitrarySelectMaybe qm <- TQ.arbitrary-          ArbitrarySelectArrMaybe q <- TQ.arbitrary-          return (q <<< qm)-      ]+    size <- TQ.choose (1, 19)+    fmap ArbitrarySelectMaybe (arbitrarySelectMaybe size)  instance TQ.Arbitrary ArbitrarySelectArrMaybe where   arbitrary = do-    TQ.oneof $-      (fmap . fmap) ArbitrarySelectArrMaybe $-      [ do-          ArbitrarySelectMaybe q <- TQ.arbitrary-          return (P.lmap (const ()) q)-      , do-          ArbitrarySelectArr q <- TQ.arbitrary-          return (traverse' q)-      ]-    where traverse' = O.traverseMaybeFieldsExplicit unpackFields unpackFields-+    size <- TQ.choose (1, 19)+    fmap ArbitrarySelectArrMaybe (arbitrarySelectArrMaybe size)  -- [Note] Testing strategy -- -- We have to be very careful otherwise we will generate -- infinite-sized expressions.  On the other hand we probably generate--- far too small small expressions.  We should probably improve that+-- far too many small expressions.  We should probably improve that -- but explicitly passing a size parameter to the sub-generators. -- -- The idea here is that only arbitrary... generators can do@@ -230,120 +287,155 @@ -- again, but can return functions to which arbitrary argument can be -- applied by arbitrary... generators. +arbitraryG :: Functor f => (a -> b) -> [[f a]] -> [f b]+arbitraryG arbitraryC = (fmap . fmap) arbitraryC . concat+ arbitrarySelectRecurse0 :: [TQ.Gen ArbitrarySelect] arbitrarySelectRecurse0 =-  (fmap . fmap) ArbitrarySelect $+  arbitraryG ArbitrarySelect+  [   genSelect+  ] -arbitrarySelectRecurse1 :: [TQ.Gen ArbitrarySelect]+arbitrarySelectRecurse1 :: [Int -> TQ.Gen ArbitrarySelect] arbitrarySelectRecurse1 =-  (fmap . fmap) ArbitrarySelect $+  arbitraryG (fmap ArbitrarySelect)+  [   -- I'm not sure this is neccessary anymore.  It should be covered by   -- other generation pathways.-  [ do-      ArbitrarySelectArr q <- TQ.arbitrary-      return (q <<< pure emptyChoices)-  ]-  ++-  map (\fg -> do { ArbitrarySelect q <- TQ.arbitrary-                 ; f <- fg-                 ; return (f q) })+  map (\fg size -> fg <*> arbitrarySelectArr size)+      [ pure (<<< pure emptyChoices) ]+  ,+  map (\fg size -> fg <*> arbitrarySelect size)       genSelectMapper+  ] -arbitrarySelectRecurse2 :: [TQ.Gen ArbitrarySelect]+arbitrarySelectRecurse2 :: [Int -> Int -> TQ.Gen ArbitrarySelect] arbitrarySelectRecurse2 =-    (fmap . fmap) ArbitrarySelect $-    map (\fg -> do { ArbitrarySelect q1 <- TQ.arbitrary-                   ; ArbitrarySelect q2 <- TQ.arbitrary-                   ; f <- fg-                   ; pure (f q1 q2)-                   })+  arbitraryG ((fmap . fmap) ArbitrarySelect)+    [+    map (\fg size1 size2 -> fg <*> arbitrarySelect size1 <*> arbitrarySelect size2)     genSelectArrPoly-    ++-    map (\fg -> do { ArbitrarySelectArr q1 <- TQ.arbitrary-                   ; ArbitrarySelect q2 <- TQ.arbitrary-                   ; f <- fg-                   ; pure (f q1 q2)-                   })+    ,+    map (\fg size1 size2 -> fg <*> arbitrarySelectArr size1 <*> arbitrarySelect size2)     genSelectArrMapper2-    ++-    map (\fg -> do { ArbitrarySelect q1 <- TQ.arbitrary-                   ; ArbitrarySelect q2 <- TQ.arbitrary-                   ; f <- fg-                   ; pure (f q1 q2)-                   })+    ,+    map (\fg size1 size2 -> fg <*> arbitrarySelect size1 <*> arbitrarySelect size2)     genSelectMapper2+    ]  arbitrarySelectArrRecurse0 :: [TQ.Gen ArbitrarySelectArr] arbitrarySelectArrRecurse0 =-  (fmap . fmap) ArbitrarySelectArr $-     map (fmap ignoreArguments) genSelect-  ++ genSelectArr+  arbitraryG ArbitrarySelectArr+    [+    map (fmap ignoreArguments) genSelect+    ,+    genSelectArr+    ]   where ignoreArguments = P.lmap (const ()) -arbitrarySelectArrRecurse1 :: [TQ.Gen ArbitrarySelectArr]+arbitrarySelectArrRecurse1 :: [Int -> TQ.Gen ArbitrarySelectArr] arbitrarySelectArrRecurse1 =-    (fmap . fmap) ArbitrarySelectArr $-    map (\fg -> do { ArbitrarySelectArr q <- TQ.arbitrary-                   ; f <- fg-                   ; pure (O.laterally f q) })-        genSelectMapper-    ++-    map (\fg -> do { ArbitrarySelectArr q <- TQ.arbitrary-                   ; f <- fg-                   ; pure (f q) })+  arbitraryG (fmap ArbitrarySelectArr)+    [+    map (\fg size -> fg <*> arbitrarySelectArr size)+        ((fmap . fmap) O.laterally genSelectMapper)+    ,+    map (\fg size -> fg <*> arbitrarySelectArr size)         genSelectArrMapper-    ++-    map (\fg -> do { ArbitrarySelectArr q <- TQ.arbitrary-                   ; f <- fg-                   ; pure (fmap (Choices . pure . Right) (f q)) })-        genSelectArrMaybeMapper-    ++-    map (\fg -> do { ArbitraryKleisli q <- TQ.arbitrary-                   ; f <- fg-                   ; pure (f q) })+    ,+    map (\fg size -> fg <*> arbitrarySelectArr size)+        ((fmap . fmap . fmap . fmap) (Choices . pure . Right) genSelectArrMaybeMapper)+    ,+    map (\fg size -> fg <*> arbitraryKleisli size)         [ pure O.lateral ]+    ] -arbitrarySelectArrRecurse2 :: [TQ.Gen ArbitrarySelectArr]+arbitrarySelectArrRecurse2 :: [Int -> Int -> TQ.Gen ArbitrarySelectArr] arbitrarySelectArrRecurse2 =-    (fmap . fmap) ArbitrarySelectArr $-    map (\fg -> do { ArbitrarySelectArr q1 <- TQ.arbitrary-                   ; ArbitrarySelectArr q2 <- TQ.arbitrary-                   ; f <- fg-                   ; pure (O.bilaterally f q1 q2) })-        genSelectMapper2-    ++-    (-    map (\fg -> do { ArbitrarySelectArr q1 <- TQ.arbitrary-                   ; ArbitrarySelectArr q2 <- TQ.arbitrary-                   ; f <- fg-                   ; pure (f q1 q2)-                   }) $+  arbitraryG ((fmap . fmap) ArbitrarySelectArr)+    [+    map (\fg size1 size2 -> fg <*> arbitrarySelectArr size1 <*> arbitrarySelectArr size2)+        ((fmap . fmap) O.bilaterally genSelectMapper2)+    ,+    map (\fg size1 size2 -> fg <*> arbitrarySelectArr size1 <*> arbitrarySelectArr size2) $     genSelectArrPoly     ++     genSelectArrMapper2-    )+    ]  arbitraryKleisliRecurse0 :: [TQ.Gen ArbitraryKleisli] arbitraryKleisliRecurse0 =-  (fmap . fmap) (ArbitraryKleisli . const) genSelect-  ++ [ pure (ArbitraryKleisli pure) ]+  arbitraryG ArbitraryKleisli+  [+  (fmap . fmap) const genSelect+  ,+  [ pure pure ]+  ] -arbitraryKleisliRecurse1 :: [TQ.Gen ArbitraryKleisli]+arbitraryKleisliRecurse1 :: [Int -> TQ.Gen ArbitraryKleisli] arbitraryKleisliRecurse1 =-  map (\fg -> do { ArbitrarySelectArr q <- TQ.arbitrary-                 ; f <- fg-                 ; return (ArbitraryKleisli (f q)) })+  arbitraryG (fmap ArbitraryKleisli)+  [+  map (\fg size -> fg <*> arbitrarySelectArr size)   [ pure O.viaLateral ]+  ,+  -- Ideally we would move this into arbitraryKleisliRecurse2 and+  -- generate the select mapper, but we don'th ave+  -- arbitrarySelectMapper yet.+  map (\fg size -> fg <*> arbitraryKleisli size)+     (map (fmap (.)) genSelectMapper)+  ] -arbitraryKleisliRecurse2 :: [TQ.Gen ArbitraryKleisli]+arbitraryKleisliRecurse2 :: [Int -> Int -> TQ.Gen ArbitraryKleisli] arbitraryKleisliRecurse2 =-  map (\fg -> do { ArbitraryKleisli q1 <- TQ.arbitrary-                 ; ArbitraryKleisli q2 <- TQ.arbitrary-                 ; f <- fg-                 ; return (ArbitraryKleisli (f q1 q2)) })+  arbitraryG ((fmap . fmap) ArbitraryKleisli)+  [+  map (\fg size1 size2 -> fg <*> arbitraryKleisli size1 <*> arbitraryKleisli size2)   [ pure (<=<) , pure (liftA2 (liftA2 appendChoices)) ]+  ] +arbitrarySelectMaybeRecurse0 :: [TQ.Gen ArbitrarySelectMaybe]+arbitrarySelectMaybeRecurse0 =+  arbitraryG ArbitrarySelectMaybe+  [ (fmap . fmap . fmap) (const (O.nothingFieldsExplicit nullspecFields)) genSelect+  , (fmap . fmap . fmap) O.justFields genSelect+  ]++arbitrarySelectMaybeRecurse1 :: [Int -> TQ.Gen ArbitrarySelectMaybe]+arbitrarySelectMaybeRecurse1 =+      (fmap . fmap . fmap) ArbitrarySelectMaybe $+      map (\fg size -> fg <*> arbitrarySelect size)+      genSelectArrMaybeMapper++arbitrarySelectMaybeRecurse2 :: [Int -> Int -> TQ.Gen ArbitrarySelectMaybe]+arbitrarySelectMaybeRecurse2 =+      (fmap . fmap . fmap . fmap) ArbitrarySelectMaybe $+      [ \size1 size2 -> do+          qm <- arbitrarySelectMaybe size1+          q <- arbitrarySelectArrMaybe size2+          return (q <<< qm)+      ]++arbitrarySelectArrMaybeRecurse0 :: [TQ.Gen ArbitrarySelectArrMaybe]+arbitrarySelectArrMaybeRecurse0 =+    arbitraryG ArbitrarySelectArrMaybe+    [ fmap (\fg -> fg <*> TQ.arbitrary)+    [ pure (Arrow.arr . fmap . unArbitraryFunction) ]+    ]++arbitrarySelectArrMaybeRecurse1 :: [Int -> TQ.Gen ArbitrarySelectArrMaybe]+arbitrarySelectArrMaybeRecurse1 =+      arbitraryG (fmap ArbitrarySelectArrMaybe)+      [+      map (\fg size -> fg <*> arbitrarySelectMaybe size)+      [ pure (P.lmap (const ())) ]+      , map (\fg size -> fg <*> arbitrarySelectArr size)+      [ pure traverse' ]+      ]+    where traverse' = O.traverseMaybeFieldsExplicit unpackFields unpackFields++ genSelect :: [TQ.Gen (O.Select Fields)] genSelect =     [ do@@ -380,10 +472,10 @@     [ do         return (O.distinctExplicit distinctFields)     , do-        l                <- TQ.choose (0, 100)+        ArbitraryPositiveInt l <- TQ.arbitrary         return (O.limit l)     , do-        l                <- TQ.choose (0, 100)+        ArbitraryPositiveInt l <- TQ.arbitrary         return (O.offset l)     , do         o                <- TQ.arbitrary@@ -433,6 +525,8 @@ genSelectArrMaybeMapper =   [ do       return (OJ.optionalExplicit unpackFields)+  , do+      return (fmap fieldsToMaybeFields)   ]  genSelectArrPoly :: [TQ.Gen (O.SelectArr a Fields

@@ -17,6 +17,7 @@  import qualified Opaleye as O import qualified Opaleye.Join as OJ+import qualified Opaleye.Exists as OE  import qualified Database.PostgreSQL.Simple as PGS import           Control.Applicative (Applicative, pure, (<$>), (<*>))@@ -401,14 +402,14 @@       -> Connection       -> IO TQ.Property limit (ArbitraryPositiveInt l) (ArbitrarySelect q) o = do-  let q' = O.limit l (O.orderBy (arbitraryOrder o) q)+  let limited = O.limit l (O.orderBy (arbitraryOrder o) q) -  unSelectDenotations (denotation q') (denotation q) $ \one' two' -> do-      let remainder = MultiSet.fromList two'+  unSelectDenotations (denotation limited) (denotation q) $ \limited' unlimited' -> do+      let remainder = MultiSet.fromList unlimited'                       `MultiSet.difference`-                      MultiSet.fromList one'+                      MultiSet.fromList limited'           maxChosen :: Maybe Haskells-          maxChosen = maximumBy (arbitraryOrdering o) one'+          maxChosen = maximumBy (arbitraryOrdering o) limited'           minRemain :: Maybe Haskells           minRemain = minimumBy (arbitraryOrdering o) (MultiSet.toList remainder)           cond :: Maybe Bool@@ -416,7 +417,7 @@           condBool :: Bool           condBool = Maybe.fromMaybe True cond -      return ((length one' === min l (length two'))+      return ((length limited' === min l (length unlimited'))               .&&. condBool)  offset :: ArbitraryPositiveInt -> ArbitrarySelect -> Connection@@ -499,6 +500,14 @@   compareDenotation (O.lateral f) (lateralDenotation (denotation . f'))   where f' = f . fieldsOfHaskells +exists :: ArbitrarySelect -> Connection -> IO TQ.Property+exists = compareDenotationNoSort' (existsQ OE.exists) (existsQ existsList)+  where existsList l = [not (null l)]+        existsQ existsf q = do+          exists_ <- existsf q+          pure (Choices [Left (CBool exists_)])++ {- TODO    * Nullability@@ -572,6 +581,7 @@   test1 maybeFieldsToSelect   test2 traverseMaybeFields   test2 lateral+  test1 exists  -- } @@ -580,13 +590,10 @@ nub :: Ord a => [a] -> [a] nub = Set.toList . Set.fromList --- Replace this with `isSuccess` when the following issue is fixed------     https://github.com/nick8325/quickcheck/issues/220 errorIfNotSuccess :: TQ.Result -> IO ()-errorIfNotSuccess r = case r of-  TQ.Success {} -> return ()-  _             -> error "Failed"+errorIfNotSuccess r = if TQ.isSuccess r+                      then return ()+                      else error "Failed"  restrictFirstBoolDenotation :: SelectArrDenotation Haskells Haskells restrictFirstBoolDenotation = proc hs -> do

@@ -483,33 +483,22 @@             , (4, 100, "b")             ] --- FIXME: the unsafeCoerceField is currently needed because the type--- changes required for aggregation are not currently dealt with by--- Opaleye.-aggregateCoerceFIXME :: SelectArr (Field O.SqlInt4) (Field O.SqlInt8)-aggregateCoerceFIXME = Arr.arr aggregateCoerceFIXME'--aggregateCoerceFIXME' :: Field a -> Field O.SqlInt8-aggregateCoerceFIXME' = O.unsafeCoerceField- testAggregate :: Test-testAggregate = it "" $ (Arr.second aggregateCoerceFIXME-                        <<< O.aggregate (PP.p2 (O.groupBy, O.sum))-                                           table1Q)+testAggregate = it "" $ O.aggregate (PP.p2 (O.groupBy, O.sumInt4))+                                           table1Q                       `selectShouldReturnSorted` [ (1, 400) :: (Int, Int64)                                                  , (2, 300) ]  testAggregate0 :: Test-testAggregate0 = it "" $ (Arr.second aggregateCoerceFIXME-                        <<< O.aggregate (PP.p2 (O.sum, O.sum))+testAggregate0 = it "" $    O.aggregate (PP.p2 (O.sum, O.sumInt4))                                         (O.keepWhen (const (O.sqlBool False))-                                         <<< table1Q))+                                         <<< table1Q)                          `selectShouldReturnSorted` ([] :: [(Int, Int64)])  testAggregateFunction :: Test-testAggregateFunction = it "" $ (Arr.second aggregateCoerceFIXME-                        <<< O.aggregate (PP.p2 (O.groupBy, O.sum))-                                        (fmap (\(x, y) -> (x + 1, y)) table1Q))+testAggregateFunction = it "" $+                            O.aggregate (PP.p2 (O.groupBy, O.sumInt4))+                                        (fmap (\(x, y) -> (x + 1, y)) table1Q)                       `selectShouldReturnSorted` [ (2, 400) :: (Int, Int64)                                                  , (3, 300) ] @@ -518,8 +507,8 @@     q `selectShouldReturnSorted` [ (1, 1200) :: (Int, Int64), (2, 300)]   where q = O.aggregate (PP.p2 (O.groupBy, countsum)) table1Q         countsum = P.dimap (\x -> (x,x))-                           (\(x, y) -> aggregateCoerceFIXME' x * y)-                           (PP.p2 (O.sum, O.count))+                           (\(x, y) -> x * y)+                           (PP.p2 (O.sumInt4, O.count))  testStringArrayAggregate :: Test testStringArrayAggregate = it "" $@@ -527,6 +516,47 @@                                    minimum (map snd table6data))]   where q = O.aggregate (PP.p2 (O.arrayAgg, O.min)) table6Q +testStringJsonAggregate :: Test+testStringJsonAggregate =+  it "" $+    testH+      q+      ( \((res : _) :: [Json.Value]) ->+          Just res `shouldBe` r+      )+  where+    r = Json.decode "[{\"summary\": \"xy\", \"details\": \"a\"}, {\"summary\": \"z\", \"details\": \"a\"}, {\"summary\": \"more text\", \"details\": \"a\"}]"+    q = O.aggregate O.jsonAgg $ do+      (firstCol, secondCol) <- O.selectTable table6+      return+        . O.jsonBuildObject+        $ O.jsonBuildObjectField "summary" firstCol+          <> O.jsonBuildObjectField "details" secondCol++testStringJsonAggregateWithJoin :: Test+testStringJsonAggregateWithJoin =+  it "" $+    testH+      q+      ( \((res : _) :: [Json.Value]) ->+          Just res `shouldBe` r+      )+  where+    r = Json.decode "[{\"id\" : 1, \"name\" : 100, \"blog_post\" : {\"summary\" : 1, \"details\" : 100}}, {\"id\" : 1, \"name\" : 100, \"blog_post\" : {\"summary\" : 1, \"details\" : 100}}, {\"id\" : 1, \"name\" : 200, \"blog_post\" : {\"summary\" : 1, \"details\" : 100}}]"+    q = O.aggregate O.jsonAgg $ do+      (firstCol, secondCol) <- O.selectTable table1+      (firstCol2, secondCol2) <- O.selectTable table2+      O.viaLateral O.restrict (firstCol .== firstCol2)+      let blog_post =+            O.jsonBuildObject $+              O.jsonBuildObjectField "summary" firstCol2+                <> O.jsonBuildObjectField "details" secondCol2+      return+        . O.jsonBuildObject+        $ O.jsonBuildObjectField "id" firstCol+          <> O.jsonBuildObjectField "name" secondCol+          <> O.jsonBuildObjectField "blog_post" blog_post+ testStringAggregate :: Test testStringAggregate = it "" $ q `selectShouldReturnSorted` expected   where q = O.aggregate (PP.p2 ((O.stringAgg . O.sqlString) "_", O.groupBy))@@ -638,8 +668,7 @@ testDistinctAndAggregate :: Test testDistinctAndAggregate = it "" $ q `selectShouldReturnSorted` expectedResult   where q = O.distinct table1Q-            &&& (Arr.second aggregateCoerceFIXME-                 <<< O.aggregate (PP.p2 (O.groupBy, O.sum)) table1Q)+            &&& O.aggregate (PP.p2 (O.groupBy, O.sumInt4)) table1Q         expectedResult = A.liftA2 (,) (L.nub table1data)                                       [(1 :: Int, 400 :: Int64), (2, 300)] @@ -959,6 +988,30 @@                   `O.arrayAppend` O.sqlArray O.sqlInt4 [1,2,3])         (`shouldBe` ([[5,6,7,1,2,3]] :: [[Int]])) +testArrayPosition :: Test+testArrayPosition = do+  it "determines array position (SqlInt4)" $+    testH (A.pure (O.arrayPosition (O.sqlArray O.sqlInt4 [5,6,7]) 5))+          (`shouldBe` [Just (1 :: Int)])+  it "determines array position (NULL) (SqlInt4)" $+    testH (A.pure (O.arrayPosition (O.sqlArray O.sqlInt4 [5,6,7]) 999))+          (`shouldBe` [Nothing :: Maybe Int])+  it "determines array position (SqlInt8)" $+    testH (A.pure (O.arrayPosition (O.sqlArray O.sqlInt8 [5,6,7]) 5))+          (`shouldBe` [Just (1 :: Int)])+  it "determines array position (NULL) (SqlInt8)" $+    testH (A.pure (O.arrayPosition (O.sqlArray O.sqlInt8 [5,6,7]) 999))+          (`shouldBe` [Nothing :: Maybe Int])++testSqlElem :: Test+testSqlElem = do+  it "checks presence of the element (SqlInt4)" $+    testH (A.pure (O.sqlElem 5 (O.sqlArray O.sqlInt4 [5,6,7])))+          (`shouldBe` [True])+  it "checks absence of the element (SqlInt4)" $+    testH (A.pure (O.sqlElem 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)@@ -1259,6 +1312,8 @@         testAggregateFunction         testAggregateProfunctor         testStringArrayAggregate+        testStringJsonAggregate+        testStringJsonAggregateWithJoin         testStringAggregate         testOverwriteAggregateOrdered         testMultipleAggregateOrdered@@ -1295,6 +1350,8 @@         testArrayIndexOOB         testSingletonArray         testArrayAppend+        testArrayPosition+        testSqlElem       describe "joins" $ do         testLeftJoin         testLeftJoinNullable

@@ -1,6 +1,6 @@ name:            opaleye-copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2020 Tom Ellis-version:         0.7.1.0+copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2021 Tom Ellis+version:         0.7.2.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@@ -13,11 +13,11 @@ maintainer:      Purely Agile category:        Database build-type:      Simple-cabal-version:   >= 1.18+cabal-version:   1.18 extra-doc-files: README.md                  CHANGELOG.md                  *.md-tested-with:     GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2+tested-with:     GHC==8.10, GHC==8.8, GHC==8.6, GHC==8.4, GHC==8.2, GHC==8.0  source-repository head   type:     git@@ -29,14 +29,14 @@   build-depends:       aeson               >= 0.6     && < 1.6     , base                >= 4.9     && < 5-    , base16-bytestring   >= 0.1.1.6 && < 0.2+    , base16-bytestring   >= 0.1.1.6 && < 1.1     , case-insensitive    >= 1.2     && < 1.3     , bytestring          >= 0.10    && < 0.11     , contravariant       >= 1.2     && < 1.6-    , postgresql-simple   >= 0.5.3   && < 0.7+    , postgresql-simple   >= 0.6     && < 0.7     , pretty              >= 1.1.1.0 && < 1.2     , product-profunctors >= 0.8.0.0 && < 0.12-    , profunctors         >= 4.0     && < 5.6+    , profunctors         >= 4.0     && < 5.7     , scientific          >= 0.3     && < 0.4     , semigroups          >= 0.13    && < 0.20     , text                >= 0.11    && < 1.3@@ -53,6 +53,7 @@                    Opaleye.Constant,                    Opaleye.Distinct,                    Opaleye.Experimental.Enum,+                   Opaleye.Exists,                    Opaleye.Field,                    Opaleye.FunctionalJoin,                    Opaleye.Join,@@ -83,6 +84,7 @@                    Opaleye.Internal.Helpers,                    Opaleye.Internal.Inferrable,                    Opaleye.Internal.Join,+                   Opaleye.Internal.JSONBuildObjectFields,                    Opaleye.Internal.Label,                    Opaleye.Internal.Lateral,                    Opaleye.Internal.Map,

@@ -25,6 +25,7 @@        , boolOr        , boolAnd        , arrayAgg+       , jsonAgg        , stringAgg        -- * Counting rows        , countRows@@ -75,6 +76,8 @@ result of an aggregation.  -}+-- See 'Opaleye.Internal.Sql.aggregate' for details of how aggregating+-- by an empty query with no group by is handled. aggregate :: Aggregator a b -> S.Select a -> S.Select b aggregate agg q = Q.productQueryArr (A.aggregateU agg . Q.runSimpleQueryArr q) @@ -142,6 +145,9 @@  arrayAgg :: Aggregator (C.Column a) (C.Column (T.SqlArray a)) arrayAgg = A.makeAggr HPQ.AggrArr++jsonAgg :: Aggregator (C.Column a) (C.Column T.SqlJson)+jsonAgg = A.makeAggr HPQ.JsonArr  stringAgg :: C.Column T.SqlText           -> Aggregator (C.Column T.SqlText) (C.Column T.SqlText)

@@ -0,0 +1,21 @@+module Opaleye.Exists (exists) where++import           Opaleye.Field (Field)+import           Opaleye.Internal.Column (Column (Column))+import           Opaleye.Internal.QueryArr (runSimpleQueryArr, productQueryArr)+import           Opaleye.Internal.PackMap (run, extractAttr)+import           Opaleye.Internal.PrimQuery (PrimQuery' (Exists))+import           Opaleye.Internal.Tag (next)+import           Opaleye.Select (Select)+import           Opaleye.SqlTypes (SqlBool)++-- | True if any rows are returned by the given query, false otherwise.+--+-- This operation is equivalent to Postgres's @EXISTS@ operator.+exists :: Select a -> Select (Field SqlBool)+exists q = productQueryArr (f . runSimpleQueryArr q)+  where+    f (_, query, tag) = (Column result, Exists binding query, tag')+      where+        (result, [(binding, ())]) = run (extractAttr "exists" tag ())+        tag' = next tag

@@ -1,20 +1,106 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+ module Opaleye.Experimental.Enum   (-    fromFieldToFieldsEnum+    enumMapper,+    EnumMapper,+    enumFromField,+    enumToFields,+    fromFieldToFieldsEnum,   ) where  import           Opaleye.Column (Column) import qualified Opaleye as O+import qualified Opaleye.Internal.Inferrable as I import qualified Opaleye.Internal.RunQuery as RQ  import           Data.ByteString.Char8 (unpack)+import qualified Data.Profunctor.Product.Default as D -fromFieldToFieldsEnum :: String-                      -> (String -> Maybe haskellSum)-                      -> (haskellSum -> String)-                      -> (RQ.FromField sqlEnum haskellSum,-                          O.ToFields haskellSum (Column sqlEnum))-fromFieldToFieldsEnum type_ from to_ = (fromFieldEnum, toFieldsEnum)+data EnumMapper sqlEnum haskellSum = EnumMapper {+    enumFromField :: RQ.FromField sqlEnum haskellSum+  , enumToFields :: O.ToFields haskellSum (Column sqlEnum)+  }++-- | Create a mapping between a Postgres @ENUM@ type and a Haskell+-- type.  Also works for @DOMAIN@ types. For example, if you have the+-- following @ENUM@+--+-- @+-- CREATE TYPE public.mpaa_rating AS ENUM (+--    \'G\',+--    \'PG\',+--    \'PG-13\',+--    \'R\',+--    \'NC-17\'+-- );+-- @+--+-- then you can define data types to represent the enum on the SQL+-- side and Haskell side respectively+--+-- @+-- data SqlRating+-- data Rating = G | PG | PG13 | R | NC17 deriving Show+-- @+--+-- and functions to map between them+--+-- @+-- toSqlRatingString :: Rating -> String+-- toSqlRatingString r = case r of+--     G    -> \"G\"+--     PG   -> \"PG\"+--     PG13 -> \"PG-13\"+--     R    -> \"R\"+--     NC17 -> \"NC-17\"+--+-- fromSqlRatingString :: String -> Maybe Rating+-- fromSqlRatingString s = case s of+--     \"G\"     -> Just G+--     \"PG\"    -> Just PG+--     \"PG-13\" -> Just PG13+--     \"R\"     -> Just R+--     \"NC-17\" -> Just NC17+--     _       -> Nothing+-- @+--+-- Then you can use the mappings as follows+--+-- @+-- import qualified Opaleye as O+-- import qualified Data.Profunctor.Product.Default as D+--+-- sqlRatingMapper :: EnumMapper SqlRating Rating+-- sqlRatingMapper = enumMapper "mpaa_rating" fromSqlRatingString toSqlRatingString+--+-- instance O.DefaultFromField SqlRating Rating where+--   defaultFromField = enumFromField sqlRatingMapper+--+-- instance rating ~ Rating+--   => D.Default (Inferrable O.FromFields) (O.Column SqlRating) rating where+--   def = Inferrable D.def+--+-- instance D.Default O.ToFields Rating (O.Column SqlRating) where+--   def = enumToFields sqlRatingMapper+-- @+enumMapper :: String+           -- ^ The name of the @ENUM@ type+           -> (String -> Maybe haskellSum)+           -- ^ A function which converts from the string+           -- representation of the ENUM field+           -> (haskellSum -> String)+           -- ^ A function which converts to the string representation+           -- of the ENUM field+           -> EnumMapper sqlEnum haskellSum+           -- ^ The @sqlEnum@ type variable is phantom. To protect+           -- yourself against type mismatches you should set it to+           -- the Haskell type that you use to represent the @ENUM@.+enumMapper type_ from to_ = EnumMapper {+    enumFromField = fromFieldEnum+  , enumToFields = toFieldsEnum+  }    where      toFieldsEnum = O.toToFields (O.unsafeCast type_ . O.sqlString . to_)      fromFieldEnum = flip fmap RQ.unsafeFromFieldRaw $ \(_, mdata) -> case mdata of@@ -22,3 +108,12 @@        Just s -> case from (unpack s) of          Just r -> r          Nothing -> error ("Unexpected: " ++ unpack s)++-- | Use 'enumMapper' instead.  Will be deprecated in 0.8.+fromFieldToFieldsEnum :: String+                      -> (String -> Maybe haskellSum)+                      -> (haskellSum -> String)+                      -> (RQ.FromField sqlEnum haskellSum,+                          O.ToFields haskellSum (Column sqlEnum))+fromFieldToFieldsEnum type_ from to_ = (enumFromField e, enumToFields e)+  where e = enumMapper type_ from to_

@@ -78,7 +78,8 @@  data AggrOp     = AggrCount | AggrSum | AggrAvg | AggrMin | AggrMax                 | AggrStdDev | AggrStdDevP | AggrVar | AggrVarP-                | AggrBoolOr | AggrBoolAnd | AggrArr | AggrStringAggr PrimExpr+                | AggrBoolOr | AggrBoolAnd | AggrArr | JsonArr+                | AggrStringAggr PrimExpr                 | AggrOther String                 deriving (Show,Read) 

@@ -227,6 +227,7 @@ showAggrOp AggrBoolAnd        = "BOOL_AND" showAggrOp AggrBoolOr         = "BOOL_OR" showAggrOp AggrArr            = "ARRAY_AGG"+showAggrOp JsonArr            = "JSON_AGG" showAggrOp (AggrStringAggr _) = "STRING_AGG" showAggrOp (AggrOther s)      = s 

@@ -9,6 +9,7 @@                                      ppUpdate,                                      ppDelete,                                      ppInsert,+                                     ppValues_,                                      ppSqlExpr,                                      ppWhere,                                      ppGroupBy,@@ -79,9 +80,9 @@ ppSqlDistinct Sql.SqlDistinct = text "DISTINCT" ppSqlDistinct Sql.SqlNotDistinct = empty -ppAs :: Maybe String -> Doc -> Doc-ppAs Nothing      expr = expr-ppAs (Just alias) expr = expr <+> hsep [text "as", doubleQuotes (text alias)]+ppAs :: Doc -> Maybe String -> Doc+ppAs expr Nothing      = expr+ppAs expr (Just alias) = expr <+> hsep [text "as", doubleQuotes (text alias)]   ppUpdate :: SqlUpdate -> Doc@@ -106,9 +107,11 @@ ppInsert (SqlInsert table names values onConflict)     = text "INSERT INTO" <+> ppTable table       <+> parens (commaV ppColumn names)-      $$ text "VALUES" <+> commaV (parens . commaV ppSqlExpr)-                                  (NEL.toList values)+      $$ ppValues_ (NEL.toList values)       <+> ppConflictStatement onConflict++ppValues_ :: [[SqlExpr]] -> Doc+ppValues_ v = text "VALUES" $$ commaV (parens . commaH ppSqlExpr) v  -- If we wanted to make the SQL slightly more readable this would be -- one easy place to do it.  Currently we wrap all column references

@@ -0,0 +1,39 @@+module Opaleye.Internal.JSONBuildObjectFields+  ( JSONBuildObjectFields,+    jsonBuildObjectField,+    jsonBuildObject,+  )+where++import Opaleye.Internal.Column (Column (Column))+import Opaleye.Internal.HaskellDB.PrimQuery (Literal (StringLit), PrimExpr (ConstExpr, FunExpr))+import Opaleye.Internal.PGTypesExternal (SqlJson)+import Data.Semigroup++-- | Combine @JSONBuildObjectFields@ using @('<>')@+newtype JSONBuildObjectFields+  = JSONBuildObjectFields [(String, PrimExpr)]++instance Semigroup JSONBuildObjectFields where+  (<>)+    (JSONBuildObjectFields a)+    (JSONBuildObjectFields b) =+      JSONBuildObjectFields $ a <> b++instance Monoid JSONBuildObjectFields where+  mempty = JSONBuildObjectFields mempty+  mappend = (<>)++jsonBuildObjectField :: String+                     -- ^ Field name+                     -> Column a+                     -- ^ Field value+                     -> JSONBuildObjectFields+jsonBuildObjectField f (Column v) = JSONBuildObjectFields [(f, v)]++-- | Create an 'SqlJson' object from a collection of fields+jsonBuildObject :: JSONBuildObjectFields -> Column SqlJson+jsonBuildObject (JSONBuildObjectFields jbofs) = Column $ FunExpr "json_build_object" args+  where+    args = concatMap mapLabelsToPrimExpr jbofs+    mapLabelsToPrimExpr (label, expr) = [ConstExpr $ StringLit label, expr]

@@ -10,7 +10,7 @@ import qualified Data.List.NonEmpty as NEL import           Data.Semigroup ((<>)) -import           Control.Applicative ((<$>), (<*>), pure)+import           Control.Applicative ((<$>), (<*>), liftA2, pure) import           Control.Arrow (first)  optimize :: PQ.PrimQuery' a -> PQ.PrimQuery' a@@ -48,7 +48,8 @@   , PQ.distinctOnOrderBy = \mDistinctOns -> fmap . PQ.DistinctOnOrderBy mDistinctOns   , PQ.limit     = fmap . PQ.Limit   , PQ.join      = \jt pe pes1 pes2 pq1 pq2 -> PQ.Join jt pe pes1 pes2 <$> pq1 <*> pq2-  , PQ.existsf   = \b pq1 pq2 -> PQ.Exists b <$> pq1 <*> pq2+  , PQ.semijoin  = liftA2 . PQ.Semijoin+  , PQ.exists    = fmap . PQ.Exists   , PQ.values    = return .: PQ.Values   , PQ.binary    = \case       -- Some unfortunate duplication here

@@ -238,6 +238,16 @@ data SqlText data SqlTime data SqlTimestamp+-- | Be careful if you use Haskell's `Time.ZonedTime` with+-- @SqlTimestamptz@. A Postgres @timestamptz@ does not actually+-- contain any time zone.  It is just a UTC time that is automatically+-- converted to or from local time on certain occasions, according to+-- the [timezone setting of the+-- server](https://www.postgresql.org/docs/9.1/runtime-config-client.html#GUC-TIMEZONE).+-- Therefore, although when you roundtrip an input 'Time.ZonedTime' to+-- obtain an output 'Time.ZonedTime' they each refer to the same+-- instant in time, the time zone attached to the output will not+-- necessarily the same as the time zone attached to the input. data SqlTimestamptz data SqlUuid data SqlCitext

@@ -21,6 +21,8 @@  data JoinType = LeftJoin | RightJoin | FullJoin deriving Show +data SemijoinType = Semi | Anti deriving Show+ data TableIdentifier = TableIdentifier   { tiSchemaName :: Maybe String   , tiTableName  :: String@@ -55,6 +57,8 @@                   | Empty     a                   | BaseTable TableIdentifier (Bindings HPQ.PrimExpr)                   | Product   (NEL.NonEmpty (Lateral, PrimQuery' a)) [HPQ.PrimExpr]+                  -- | The subqueries to take the product of and the+                  --   restrictions to apply                   | Aggregate (Bindings (Maybe (HPQ.AggrOp,                                                 [HPQ.OrderExpr],                                                 HPQ.AggrDistinct),@@ -76,7 +80,8 @@                               (Bindings HPQ.PrimExpr)                               (PrimQuery' a)                               (PrimQuery' a)-                  | Exists    Bool (PrimQuery' a) (PrimQuery' a)+                  | Semijoin  SemijoinType (PrimQuery' a) (PrimQuery' a)+                  | Exists    Symbol (PrimQuery' a)                   | Values    [Symbol] (NEL.NonEmpty [HPQ.PrimExpr])                   | Binary    BinOp                               (PrimQuery' a, PrimQuery' a)@@ -117,7 +122,8 @@                       -> p                       -> p                       -> p-  , existsf           :: Bool -> p -> p -> p+  , semijoin          :: SemijoinType -> p -> p -> p+  , exists            :: Symbol -> p -> p   , values            :: [Symbol] -> NEL.NonEmpty [HPQ.PrimExpr] -> p   , binary            :: BinOp                       -> (p, p)@@ -140,11 +146,12 @@   , distinctOnOrderBy = DistinctOnOrderBy   , limit             = Limit   , join              = Join+  , semijoin          = Semijoin   , values            = Values   , binary            = Binary   , label             = Label   , relExpr           = RelExpr-  , existsf           = Exists+  , exists            = Exists   , rebind            = Rebind   , forUpdate         = ForUpdate   }@@ -160,11 +167,12 @@           DistinctOnOrderBy dxs oxs q -> distinctOnOrderBy f dxs oxs (self q)           Limit op q                  -> limit             f op (self q)           Join j cond pe1 pe2 q1 q2   -> join              f j cond pe1 pe2 (self q1) (self q2)+          Semijoin j q1 q2            -> semijoin          f j (self q1) (self q2)           Values ss pes               -> values            f ss pes           Binary binop (q1, q2)       -> binary            f binop (self q1, self q2)           Label l pq                  -> label             f l (self pq)           RelExpr pe syms             -> relExpr           f pe syms-          Exists b q1 q2              -> existsf           f b (self q1) (self q2)+          Exists s q                  -> exists            f s (self q)           Rebind star pes q           -> rebind            f star pes (self q)           ForUpdate q                 -> forUpdate         f (self q)         fix g = let x = g x in x@@ -174,12 +182,6 @@  restrict :: HPQ.PrimExpr -> PrimQuery -> PrimQuery restrict cond primQ = Product (return (pure primQ)) [cond]--exists :: PrimQuery -> PrimQuery -> PrimQuery-exists = Exists True--notExists :: PrimQuery -> PrimQuery -> PrimQuery-notExists = Exists False  isUnit :: PrimQuery' a -> Bool isUnit Unit = True

@@ -9,16 +9,18 @@                                               Table,                                               RelExpr,                                               SelectJoin,+                                              SelectSemijoin,                                               SelectValues,                                               SelectBinary,                                               SelectLabel,                                               SelectExists),-                                       From, Join, Values, Binary, Label, Exists)+                                       From, Join, Semijoin, Values, Binary, Label, Exists)  import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import qualified Opaleye.Internal.HaskellDB.Sql as HSql import qualified Opaleye.Internal.HaskellDB.Sql.Print as HPrint+import           Opaleye.Internal.HaskellDB.Sql.Print (ppAs) import qualified Opaleye.Internal.Optimize as Op import qualified Opaleye.Internal.Tag as T @@ -31,14 +33,15 @@ type TableAlias = String  ppSql :: Select -> Doc-ppSql (SelectFrom s)   = ppSelectFrom s-ppSql (Table table)    = HPrint.ppTable table-ppSql (RelExpr expr)   = HPrint.ppSqlExpr expr-ppSql (SelectJoin j)   = ppSelectJoin j-ppSql (SelectValues v) = ppSelectValues v-ppSql (SelectBinary v) = ppSelectBinary v-ppSql (SelectLabel v)  = ppSelectLabel v-ppSql (SelectExists v) = ppSelectExists v+ppSql (SelectFrom s)     = ppSelectFrom s+ppSql (Table table)      = HPrint.ppTable table+ppSql (RelExpr expr)     = HPrint.ppSqlExpr expr+ppSql (SelectJoin j)     = ppSelectJoin j+ppSql (SelectSemijoin j) = ppSelectSemijoin j+ppSql (SelectValues v)   = ppSelectValues v+ppSql (SelectBinary v)   = ppSelectBinary v+ppSql (SelectLabel v)    = ppSelectLabel v+ppSql (SelectExists v)   = ppSelectExists v  ppDistinctOn :: Maybe (NEL.NonEmpty HSql.SqlExpr) -> Doc ppDistinctOn = maybe mempty $ \nel ->@@ -68,6 +71,16 @@                  $$  HPrint.ppSqlExpr (Sql.jCond j)   where (s1, s2) = Sql.jTables j +ppSelectSemijoin :: Semijoin -> Doc+ppSelectSemijoin v =+  text "SELECT *"+  $$  text "FROM"+  $$  ppTable (tableAlias 1 (Sql.sjTable v))+  $$  case Sql.sjType v of+        Sql.Semi -> text "WHERE EXISTS"+        Sql.Anti -> text "WHERE NOT EXISTS"+  $$ parens (ppSql (Sql.sjCriteria v))+ ppSelectValues :: Values -> Doc ppSelectValues v = text "SELECT"                    <+> ppAttrs (Sql.vAttrs v)@@ -91,14 +104,9 @@                    . ST.pack  ppSelectExists :: Exists -> Doc-ppSelectExists v =-  text "SELECT *"-  $$ text "FROM"-  $$ ppTable (tableAlias 1 (Sql.existsTable v))-  $$ case Sql.existsBool v of-       True -> text "WHERE EXISTS"-       False -> text "WHERE NOT EXISTS"-  $$ parens (ppSql (Sql.existsCriteria v))+ppSelectExists e =+  text "SELECT EXISTS"+  <+> ppTable (Sql.sqlSymbol (Sql.existsBinding e), Sql.existsTable e)  ppJoinType :: Sql.JoinType -> Doc ppJoinType Sql.LeftJoin = text "LEFT OUTER JOIN"@@ -113,7 +121,7 @@  -- This is pretty much just nameAs from HaskellDB nameAs :: (HSql.SqlExpr, Maybe HSql.SqlColumn) -> Doc-nameAs (expr, name) = HPrint.ppAs (fmap unColumn name) (HPrint.ppSqlExpr expr)+nameAs (expr, name) = HPrint.ppSqlExpr expr `ppAs` fmap unColumn name   where unColumn (HSql.SqlColumn s) = s  ppTables :: [(Sql.Lateral, Select)] -> Doc@@ -131,15 +139,18 @@  -- TODO: duplication with ppSql ppTable :: (TableAlias, Select) -> Doc-ppTable (alias, select) = HPrint.ppAs (Just alias) $ case select of+ppTable (alias, select) = case select of   Table table           -> HPrint.ppTable table   RelExpr expr          -> HPrint.ppSqlExpr expr   SelectFrom selectFrom -> parens (ppSelectFrom selectFrom)   SelectJoin slj        -> parens (ppSelectJoin slj)+  SelectSemijoin slj    -> parens (ppSelectSemijoin slj)   SelectValues slv      -> parens (ppSelectValues slv)   SelectBinary slb      -> parens (ppSelectBinary slb)   SelectLabel sll       -> parens (ppSelectLabel sll)   SelectExists saj      -> parens (ppSelectExists saj)+  `ppAs`+  Just alias  ppGroupBy :: Maybe (NEL.NonEmpty HSql.SqlExpr) -> Doc ppGroupBy Nothing   = empty@@ -158,10 +169,7 @@ ppFor (Just Sql.Update) = text "FOR UPDATE"  ppValues :: [[HSql.SqlExpr]] -> Doc-ppValues v = HPrint.ppAs (Just "V") (parens (text "VALUES" $$ HPrint.commaV ppValuesRow v))--ppValuesRow :: [HSql.SqlExpr] -> Doc-ppValuesRow = parens . HPrint.commaH HPrint.ppSqlExpr+ppValues v = parens (HPrint.ppValues_ v) `ppAs` Just "V"  ppBinOp :: Sql.BinOp -> Doc ppBinOp o = text $ case o of

@@ -25,6 +25,7 @@             | RelExpr HSql.SqlExpr             -- ^ A relation-valued expression             | SelectJoin Join+            | SelectSemijoin Semijoin             | SelectValues Values             | SelectBinary Binary             | SelectLabel Label@@ -57,6 +58,12 @@   }                 deriving Show +data Semijoin = Semijoin+  { sjType     :: SemijoinType+  , sjTable    :: Select+  , sjCriteria :: Select+  } deriving Show+ data Values = Values {   vAttrs  :: SelectAttrs,   vValues :: [[HSql.SqlExpr]]@@ -69,6 +76,7 @@ } deriving Show  data JoinType = LeftJoin | RightJoin | FullJoin deriving Show+data SemijoinType = Semi | Anti deriving Show data BinOp = Except | ExceptAll | Union | UnionAll | Intersect | IntersectAll deriving Show data Lateral = Lateral | NonLateral deriving Show data LockStrength = Update deriving Show@@ -81,9 +89,8 @@ data Returning a = Returning a (NEL.NonEmpty HSql.SqlExpr)  data Exists = Exists-  { existsBool :: Bool+  { existsBinding :: Symbol   , existsTable :: Select-  , existsCriteria :: Select   } deriving Show  sqlQueryGenerator :: PQ.PrimQueryFold' V.Void Select@@ -96,17 +103,18 @@   , PQ.distinctOnOrderBy = distinctOnOrderBy   , PQ.limit             = limit_   , PQ.join              = join+  , PQ.semijoin          = semijoin   , PQ.values            = values   , PQ.binary            = binary   , PQ.label             = label   , PQ.relExpr           = relExpr-  , PQ.existsf           = exists+  , PQ.exists            = exists   , PQ.rebind            = rebind   , PQ.forUpdate         = forUpdate   } -exists :: Bool -> Select -> Select -> Select-exists b q1 q2 = SelectExists (Exists b q1 q2)+exists :: Symbol -> Select -> Select+exists binding table = SelectExists (Exists binding table)  sql :: ([HPQ.PrimExpr], PQ.PrimQuery' V.Void, T.Tag) -> Select sql (pes, pq, t) = SelectFrom $ newSelect { attrs = SelectAttrs (ensureColumns (makeAttrs pes))@@ -226,6 +234,10 @@           , tables = oneTable s           } +semijoin :: PQ.SemijoinType -> Select -> Select -> Select+semijoin t q1 q2 = SelectSemijoin (Semijoin (semijoinType t) q1 q2)++ -- Postgres seems to name columns of VALUES clauses "column1", -- "column2", ... . I'm not sure to what extent it is customisable or -- how robust it is to rely on this@@ -247,6 +259,10 @@ joinType PQ.RightJoin = RightJoin joinType PQ.FullJoin = FullJoin +semijoinType :: PQ.SemijoinType -> SemijoinType+semijoinType PQ.Semi = Semi+semijoinType PQ.Anti = Anti+ binOp :: PQ.BinOp -> BinOp binOp o = case o of   PQ.Except       -> Except@@ -272,9 +288,11 @@ sqlExpr :: HPQ.PrimExpr -> HSql.SqlExpr sqlExpr = SG.sqlExpr SD.defaultSqlGenerator +sqlSymbol :: Symbol -> String+sqlSymbol (Symbol sym t) = T.tagWith t sym+ sqlBinding :: (Symbol, HPQ.PrimExpr) -> (HSql.SqlExpr, Maybe HSql.SqlColumn)-sqlBinding (Symbol sym t, pe) =-  (sqlExpr pe, Just (HSql.SqlColumn (T.tagWith t sym)))+sqlBinding (s, pe) = (sqlExpr pe, Just (HSql.SqlColumn (sqlSymbol s)))  ensureColumns :: [(HSql.SqlExpr, Maybe a)]              -> NEL.NonEmpty (HSql.SqlExpr, Maybe a)

@@ -3,19 +3,122 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeSynonymInstances #-} --- | Operators on 'Column's.  Please note that numeric 'Column' types--- are instances of 'Num', so you can use '*', '/', '+', '-' on them.+-- We can probably disable ConstraintKinds and TypeSynonymInstances+-- when we move to Sql... instead of PG.. -module Opaleye.Operators where+module Opaleye.Operators+  (+  -- * Restriction operators+    where_+  , restrict+  , restrictExists+  , restrictNotExists+  -- * Numerical operators+  -- | Numeric 'Column' / 'F.Field' types are instances of 'Num'+  -- and 'Fractional', so you can use the standard Haskell numerical+  -- operators (e.g.. '*', '/', '+', '-') on them and you can create+  -- them with numerical literals such as @3.14 :: 'F.Field' 'T.SqlFloat8'@.+  , (+)+  , (-)+  , (*)+  , (/)+  , fromInteger+  , abs+  , negate+  , signum+  -- * Equality operators+  , (.==)+  , (./=)+  , (.===)+  , (./==)+  -- * Comparison operators+  , (.>)+  , (.<)+  , (.<=)+  , (.>=)+  -- * Numerical operators+  , quot_+  , rem_+  -- * Conditional operators+  , case_+  , ifThenElse+  , ifThenElseMany+  -- * Logical operators+  , (.||)+  , (.&&)+  , not+  , ors+  -- * Text operators+  , (.++)+  , lower+  , upper+  , like+  , ilike+  , charLength+  , sqlLength+  -- * Containment operators+  , in_+  , inSelect+  -- * JSON operators+  , SqlIsJson+  , PGIsJson+  , SqlJsonIndex+  , PGJsonIndex+  , (.->)+  , (.->>)+  , (.#>)+  , (.#>>)+  , (.@>)+  , (.<@)+  , (.?)+  , (.?|)+  , (.?&)+  , JBOF.jsonBuildObject+  , JBOF.jsonBuildObjectField+  , JBOF.JSONBuildObjectFields+  -- * SqlArray operators+  , emptyArray+  , arrayAppend+  , arrayPrepend+  , arrayRemove+  , arrayRemoveNulls+  , singletonArray+  , index+  , arrayPosition+  , sqlElem+  -- * Range operators+  , overlap+  , liesWithin+  , upperBound+  , lowerBound+  , (.<<)+  , (.>>)+  , (.&<)+  , (.&>)+  , (.-|-)+  -- * Other operators+  , timestamptzAtTimeZone+  , dateOfTimestamp+  , now+  -- * Deprecated+  , exists+  , notExists+  , inQuery+  , keepWhen+  ) +  where+ import qualified Control.Arrow as A import qualified Data.Foldable as F import qualified Data.List.NonEmpty as NEL-+import           Prelude hiding (not)+import qualified Opaleye.Exists as E import qualified Opaleye.Field as F import           Opaleye.Internal.Column (Column(Column), unsafeCase_,                                           unsafeIfThenElse, unsafeGt) import qualified Opaleye.Internal.Column as C+import qualified Opaleye.Internal.JSONBuildObjectFields as JBOF import           Opaleye.Internal.QueryArr (SelectArr(QueryArr),                                             Query, QueryArr, runSimpleQueryArr) import qualified Opaleye.Internal.PrimQuery as PQ@@ -27,18 +130,11 @@ import qualified Opaleye.SqlTypes as T  import qualified Opaleye.Column   as Column-import qualified Opaleye.Distinct as Distinct-import qualified Opaleye.Join as Join  import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ  import qualified Data.Profunctor.Product.Default as D --- ^ We can probably disable ConstraintKinds and TypeSynonymInstances--- when we move to Sql... instead of PG..---- * Restriction operators- {-| Keep only the rows of a query satisfying a given condition, using an SQL @WHERE@ clause.  It is equivalent to the Haskell function @@ -60,17 +156,15 @@ {-| Add a @WHERE EXISTS@ clause to the current query. -} restrictExists :: S.SelectArr a b -> S.SelectArr a () restrictExists criteria = QueryArr f where-  f (a, primQ, t0) = ((), PQ.exists primQ existsQ, t1) where+  f (a, primQ, t0) = ((), PQ.Semijoin PQ.Semi primQ existsQ, t1) where     (_, existsQ, t1) = runSimpleQueryArr criteria (a, t0)  {-| Add a @WHERE NOT EXISTS@ clause to the current query. -} restrictNotExists :: S.SelectArr a b -> S.SelectArr a () restrictNotExists criteria = QueryArr f where-  f (a, primQ, t0) = ((), PQ.notExists primQ existsQ, t1) where+  f (a, primQ, t0) = ((), PQ.Semijoin PQ.Anti primQ existsQ, t1) where     (_, existsQ, t1) = runSimpleQueryArr criteria (a, t0) --- * Equality operators- infix 4 .== (.==) :: Column a -> Column a -> F.Field T.SqlBool (.==) = C.binOp (HPQ.:==)@@ -93,8 +187,6 @@ (./==) :: D.Default O.EqPP fields fields => fields -> fields -> F.Field T.SqlBool (./==) = Opaleye.Operators.not .: (O..==) --- * Comparison operators- infix 4 .> (.>) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool (.>) = unsafeGt@@ -111,8 +203,6 @@ (.>=) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool (.>=) = C.binOp (HPQ.:>=) --- * Numerical operators- -- | Integral division, named after 'Prelude.quot'.  It maps to the -- @/@ operator in Postgres. quot_ :: C.SqlIntegral a => Column a -> Column a -> Column a@@ -124,8 +214,6 @@ rem_ :: C.SqlIntegral a => Column a -> Column a -> Column a rem_ = C.binOp HPQ.OpMod --- * Conditional operators- -- | Select the first case for which the condition is true. case_ :: [(F.Field T.SqlBool, Column a)] -> Column a -> Column a case_ = unsafeCase_@@ -144,8 +232,6 @@                -> fields ifThenElseMany = O.ifExplict D.def --- * Logical operators- infixr 2 .||  -- | Boolean or@@ -166,8 +252,6 @@ ors :: F.Foldable f => f (F.Field T.SqlBool) -> F.Field T.SqlBool ors = F.foldl' (.||) (T.sqlBool False) --- * Text operators- -- | Concatenate 'F.Field' 'T.SqlText' (.++) :: F.Field T.SqlText -> F.Field T.SqlText -> F.Field T.SqlText (.++) = C.binOp (HPQ.:||)@@ -197,8 +281,6 @@ sqlLength :: C.PGString a => F.Field a -> F.Field T.SqlInt4 sqlLength  (Column e) = Column (HPQ.FunExpr "length" [e]) --- * Containment operators- -- | 'in_' is designed to be used in prefix form. -- -- 'in_' @validProducts@ @product@ checks whether @product@ is a valid@@ -212,34 +294,10 @@ -- | True if the first argument occurs amongst the rows of the second, -- false otherwise. ----- This operation is equivalent to Postgres's @IN@ operator but, for--- expediency, is currently implemented using a @LEFT JOIN@.  Please--- file a bug if this causes any issues in practice.+-- This operation is equivalent to Postgres's @IN@ operator. inSelect :: D.Default O.EqPP fields fields          => fields -> S.Select fields -> S.Select (F.Field T.SqlBool)-inSelect c q = qj'-  where -- Remove every row that isn't equal to c-        -- Replace the ones that are with '1'-        q' = A.arr (const 1)-             A.<<< keepWhen (c .===)-             A.<<< q--        -- Left join with a query that has a single row-        -- We either get a single row with '1'-        -- or a single row with 'NULL'-        qj :: Query (F.Field T.SqlInt4, Column (C.Nullable T.SqlInt4))-        qj = Join.leftJoin (A.arr (const 1))-                           (Distinct.distinct q')-                           (uncurry (.==))--        -- Check whether it is 'NULL'-        qj' :: Query (F.Field T.SqlBool)-        qj' = A.arr (Opaleye.Operators.not-                     . Column.isNull-                     . snd)-              A.<<< qj---- * JSON operators+inSelect c q = E.exists (keepWhen (c .===) A.<<< q)  -- | Class of Postgres types that represent json values. -- Used to overload functions and operators that work on both 'T.SqlJson' and 'T.SqlJsonb'.@@ -325,8 +383,6 @@       -> F.Field T.SqlBool (.?&) = C.binOp (HPQ.:?&) --- * SqlArray operators- emptyArray :: T.IsSqlType a => Column (T.SqlArray a) emptyArray = T.sqlArray id [] @@ -352,8 +408,21 @@ index :: (C.SqlIntegral n) => Column (T.SqlArray a) -> Column n -> Column (C.Nullable a) index (Column a) (Column b) = Column (HPQ.ArrayIndex a b) --- * Range operators+-- | Postgres's @array_position@+arrayPosition :: F.Field (T.SqlArray a) -- ^ Haystack+              -> F.Field a -- ^ Needle+              -> F.Field (Column.Nullable T.SqlInt4)+arrayPosition (Column fs) (Column f') =+  C.Column (HPQ.FunExpr "array_position" [fs , f']) +-- | 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.+sqlElem :: F.Field a -- ^ Needle+        -> F.Field (T.SqlArray a) -- ^ Haystack+        -> F.Field T.SqlBool+sqlElem f fs = (O.not . F.isNull . arrayPosition fs) f+ overlap :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool overlap = C.binOp (HPQ.:&&) @@ -388,8 +457,6 @@ (.-|-) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool (.-|-) = C.binOp (HPQ.:-|-) --- * Other operators- timestamptzAtTimeZone :: F.Field T.SqlTimestamptz                       -> F.Field T.SqlText                       -> F.Field T.SqlTimestamp@@ -398,8 +465,6 @@ dateOfTimestamp :: F.Field T.SqlTimestamp -> F.Field T.SqlDate dateOfTimestamp (Column e) = Column (HPQ.FunExpr "date" [e]) --- * Deprecated- {-# DEPRECATED exists "Identical to 'restrictExists'.  Will be removed in version 0.8." #-} exists :: QueryArr a b -> QueryArr a () exists = restrictExists@@ -430,3 +495,6 @@ keepWhen p = proc a -> do   restrict  -< p a   A.returnA -< a++now :: Column T.SqlTimestamptz+now = Column $ HPQ.FunExpr "now" []

@@ -2,29 +2,84 @@ -- those types.  To create fields you may find it more convenient to use -- "Opaleye.ToFields" instead. -module Opaleye.SqlTypes (module Opaleye.SqlTypes,-                         P.IsSqlType,-                         P.IsRangeType,-                         SqlBool,-                         SqlDate,-                         SqlFloat4,-                         SqlFloat8,-                         SqlInt8,-                         SqlInt4,-                         SqlInt2,-                         SqlNumeric,-                         SqlText,-                         SqlTime,-                         SqlTimestamp,-                         SqlTimestamptz,-                         SqlUuid,-                         SqlCitext,-                         SqlArray,-                         SqlBytea,-                         SqlJson,-                         SqlJsonb,-                         SqlRange,-                        ) where+module Opaleye.SqlTypes (+  -- * Numeric+  -- ** Creating values+  sqlInt4,+  sqlDouble,+  sqlInt8,+  sqlNumeric,+  -- ** Types+  SqlInt4,+  SqlFloat8,+  SqlNumeric,+  SqlInt8,+  SqlInt2,+  SqlFloat4,+  -- * Date and time+  -- ** Creating values+  sqlDay,+  sqlUTCTime,+  sqlLocalTime,+  sqlZonedTime,+  sqlTimeOfDay,+  -- ** Types+  SqlDate,+  SqlTime,+  SqlTimestamp,+  SqlTimestamptz,+  -- * JSON+  -- ** Creating values+  sqlJSON,+  sqlStrictJSON,+  sqlLazyJSON,+  sqlValueJSON,+  -- ** Types+  SqlJson,+  -- * JSONB+  -- ** Creating values+  sqlJSONB,+  sqlStrictJSONB,+  sqlLazyJSONB,+  sqlValueJSONB,+  -- ** Types+  SqlJsonb,+  -- * Text+  -- ** Creating values+  sqlString,+  sqlStrictText,+  sqlLazyText,+  sqlCiStrictText,+  sqlCiLazyText,+  -- ** Types+  SqlText,+  SqlCitext,+  -- * Array+  -- ** Creating values+  sqlArray,+  -- ** Types+  SqlArray,+  -- * Range+  -- ** Creating values+  sqlRange,+  -- ** Types+  SqlRange,+  P.IsRangeType,+  -- * Other+  -- ** Creating values+  sqlBool,+  sqlUUID,+  sqlLazyByteString,+  sqlStrictByteString,+  -- ** Types+  SqlBool,+  SqlUuid,+  SqlBytea,+  -- * @IsSqlType@+  P.IsSqlType,+  -- * Entire module+  module Opaleye.SqlTypes,+  ) where  import qualified Opaleye.Field   as F import qualified Opaleye.Internal.PGTypesExternal as P