diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,11 @@
+## 0.9.3.0
+
+* Add `with` and `withRecursive` (thanks to Erik Hesselink and Shane
+  O'Brien).
+
+* Add `Default ToFields` and `DefaultFromField` instances for
+  postgresql-simple's `Aeson` (thanks to Bas Van Dijk).
+
 ## 0.9.2.0
 
 * Added `nullableToMaybeFields` and `maybeFieldsToNullable`
diff --git a/Test/Opaleye/Test/Arbitrary.hs b/Test/Opaleye/Test/Arbitrary.hs
--- a/Test/Opaleye/Test/Arbitrary.hs
+++ b/Test/Opaleye/Test/Arbitrary.hs
@@ -448,13 +448,13 @@
         TQ.oneof [
             do
             ArbitraryHaskellsList l <- TQ.arbitrary
-            return (fmap fieldsList (O.valuesSafe (fmap O.toFields l)))
+            return (fmap fieldsList (O.values (fmap O.toFields l)))
           , -- We test empty lists of values separately, because we
             -- used to not support them
             do
               s <- TQ.choose (0, 5)
               l <- TQ.vectorOf s (pure ())
-              return (fmap (const emptyChoices) (O.valuesSafe l))
+              return (fmap (const emptyChoices) (O.values l))
           ]
     ]
 
@@ -518,10 +518,10 @@
       return (arbitraryBinary binaryOperation)
   ]
   where arbitraryBinary binaryOperation q1 q2 =
-          (fmap fieldsList
+           fmap fieldsList
             (binaryOperation
               (fmap listFields q1)
-              (fmap listFields q2)))
+              (fmap listFields q2))
 
 genSelectArrMapper :: [TQ.Gen (O.SelectArr a Fields -> O.SelectArr a Fields)]
 genSelectArrMapper =
diff --git a/Test/Test.hs b/Test/Test.hs
--- a/Test/Test.hs
+++ b/Test/Test.hs
@@ -10,6 +10,7 @@
 import qualified Control.Applicative              as A
 import           Control.Arrow                    ((&&&), (***), (<<<), (>>>))
 import qualified Control.Arrow                    as Arr
+import           Control.Monad                    (guard)
 import qualified Data.Aeson                       as Json
 import qualified Data.Function                    as F
 import qualified Data.List                        as L
@@ -818,6 +819,24 @@
 testTableFunctor = it "" $ testH (O.selectTable table1F) (result `shouldBe`)
   where result = fmap (\(col1, col2) -> (col1 + col2, col1 - col2)) table1data
 
+recursive = O.withRecursive table1Q $ \(n, x) -> do
+          O.where_ (n O..< 5)
+          pure (n + 1, x + 1)
+
+testWithRecursive :: Test
+testWithRecursive = it "with recursive" $ testH recursive (`shouldBe` expected)
+  where expected = withRecursive [] table1data $ \(n, x) -> do
+          guard (n < 5)
+          pure (n + 1, x + 1)
+        withRecursive r s f =
+          let r' = s ++ (r >>= f)
+          in if r' == r then r else withRecursive r' s f
+
+testWith :: Test
+testWith = it "with" $ testH with (`shouldBe` expected)
+  where with = O.with table1Q $ \t -> (,) <$> t <*> table2Q
+        expected = (,) <$> table1data <*> table2data
+
 -- TODO: This is getting too complicated
 testUpdate :: Test
 testUpdate = it "" $ \conn -> do
@@ -1283,7 +1302,7 @@
   it "MaybeFields equality" $ testH query2 (`shouldBe` [True])
   where nothing_ = OM.nothingFields :: MaybeFields ()
         query :: Select (MaybeFields (Field O.SqlInt4))
-        query = O.distinct (O.valuesSafe [ fmap (const 0) nothing_
+        query = O.distinct (O.values [ fmap (const 0) nothing_
                                          , fmap (const 1) nothing_ ])
         query2 :: Select (Field O.SqlBool)
         query2 = pure ((fmap (const (0 :: Field O.SqlInt4)) nothing_)
@@ -1558,3 +1577,6 @@
         testAddIntervalFromTimestampToTimestamp
         testAddIntervalFromTimestamptzToTimestamptz
         testAddIntervalFromTimeToTime
+      describe "with" $ do
+        testWithRecursive
+        testWith
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-2022 Tom Ellis
-version:         0.9.2.0
+version:         0.9.3.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
@@ -26,7 +26,7 @@
   default-language: Haskell2010
   hs-source-dirs: src
   build-depends:
-      aeson               >= 0.6     && < 2.1
+      aeson               >= 0.6     && < 2.2
     , base                >= 4.9     && < 4.17
     , base16-bytestring   >= 0.1.1.6 && < 1.1
     , case-insensitive    >= 1.2     && < 1.3
@@ -69,6 +69,7 @@
                    Opaleye.ToFields,
                    Opaleye.TypeFamilies,
                    Opaleye.Values,
+                   Opaleye.With,
                    Opaleye.Internal.Aggregate,
                    Opaleye.Internal.Binary,
                    Opaleye.Internal.Constant,
diff --git a/src/Opaleye.hs b/src/Opaleye.hs
--- a/src/Opaleye.hs
+++ b/src/Opaleye.hs
@@ -36,6 +36,7 @@
                , module Opaleye.Table
                , module Opaleye.ToFields
                , module Opaleye.Values
+               , module Opaleye.With
                ) where
 
 import Opaleye.Adaptors
@@ -61,3 +62,4 @@
 import Opaleye.Table
 import Opaleye.ToFields
 import Opaleye.Values
+import Opaleye.With
diff --git a/src/Opaleye/Aggregate.hs b/src/Opaleye/Aggregate.hs
--- a/src/Opaleye/Aggregate.hs
+++ b/src/Opaleye/Aggregate.hs
@@ -82,7 +82,7 @@
 -- 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' $ \() -> do
+aggregate agg q = Q.productQueryArr $ do
   (a, pq) <- Q.runSimpleQueryArr' q ()
   t <- Tag.fresh
   pure (A.aggregateU agg (a, pq, t))
diff --git a/src/Opaleye/Exists.hs b/src/Opaleye/Exists.hs
--- a/src/Opaleye/Exists.hs
+++ b/src/Opaleye/Exists.hs
@@ -2,7 +2,7 @@
 
 import           Opaleye.Field (Field)
 import           Opaleye.Internal.Column (Field_(Column))
-import           Opaleye.Internal.QueryArr (productQueryArr', runSimpleQueryArr')
+import           Opaleye.Internal.QueryArr (productQueryArr, runSimpleQueryArr')
 import           Opaleye.Internal.PackMap (run, extractAttr)
 import           Opaleye.Internal.PrimQuery (PrimQuery' (Exists))
 import           Opaleye.Internal.Tag (fresh)
@@ -13,7 +13,7 @@
 --
 -- This operation is equivalent to Postgres's @EXISTS@ operator.
 exists :: Select a -> Select (Field SqlBool)
-exists q = productQueryArr' $ \() -> do
+exists q = productQueryArr $ do
   (_, query) <- runSimpleQueryArr' q ()
   tag <- fresh
   let (result, [(binding, ())]) = run (extractAttr "exists" tag ())
diff --git a/src/Opaleye/Internal/Aggregate.hs b/src/Opaleye/Internal/Aggregate.hs
--- a/src/Opaleye/Internal/Aggregate.hs
+++ b/src/Opaleye/Internal/Aggregate.hs
@@ -46,30 +46,33 @@
 -- `Opaleye.Aggregate.arrayAgg` and `Opaleye.Aggregate.stringAgg`.
 --
 -- You can either apply it to an aggregation of multiple columns, in
--- which case it will apply to all aggregation functions in there, or you
--- can apply it to a single column, and then compose the aggregations
--- afterwards. Examples:
+-- which case it will apply to all aggregation functions in there
 --
--- > x :: Aggregator (Column a, Column b) (Column (PGArray a), Column (PGArray a))
--- > x = (,) <$> orderAggregate (asc snd) (lmap fst arrayAggGrouped)
--- >         <*> orderAggregate (desc snd) (lmap fst arrayAggGrouped)
+-- Example:
 --
+-- > x :: Aggregator (Column a, Column b) (Column (PGArray a), Column (PGArray b))
+-- > x = orderAggregate (asc snd) $ p2 (arrayAgg, arrayAgg)
+--
 -- This will generate:
 --
 -- @
--- SELECT array_agg(a ORDER BY b ASC), array_agg(a ORDER BY b DESC)
+-- SELECT array_agg(a ORDER BY b ASC), array_agg(b ORDER BY b ASC)
 -- FROM (SELECT a, b FROM ...)
 -- @
 --
--- Or:
+-- Or you can apply it to a single column, and then compose the aggregations
+-- afterwards.
 --
--- > x :: Aggregator (Column a, Column b) (Column (PGArray a), Column (PGArray b))
--- > x = orderAggregate (asc snd) $ p2 (arrayAggGrouped, arrayAggGrouped)
+-- Example:
 --
+-- > x :: Aggregator (Column a, Column b) (Column (PGArray a), Column (PGArray a))
+-- > x = (,) <$> orderAggregate (asc snd) (lmap fst arrayAgg)
+-- >         <*> orderAggregate (desc snd) (lmap fst arrayAgg)
+--
 -- This will generate:
 --
 -- @
--- SELECT array_agg(a ORDER BY b ASC), array_agg(b ORDER BY b ASC)
+-- SELECT array_agg(a ORDER BY b ASC), array_agg(a ORDER BY b DESC)
 -- FROM (SELECT a, b FROM ...)
 -- @
 
diff --git a/src/Opaleye/Internal/Binary.hs b/src/Opaleye/Internal/Binary.hs
--- a/src/Opaleye/Internal/Binary.hs
+++ b/src/Opaleye/Internal/Binary.hs
@@ -40,7 +40,7 @@
 
 sameTypeBinOpHelper :: PQ.BinOp -> Binaryspec columns columns'
                     -> Q.Query columns -> Q.Query columns -> Q.Query columns'
-sameTypeBinOpHelper binop binaryspec q1 q2 = Q.productQueryArr' $ \() -> do
+sameTypeBinOpHelper binop binaryspec q1 q2 = Q.productQueryArr $ do
   (columns1, primQuery1) <- Q.runSimpleQueryArr' q1 ()
   (columns2, primQuery2) <- Q.runSimpleQueryArr' q2 ()
 
diff --git a/src/Opaleye/Internal/Constant.hs b/src/Opaleye/Internal/Constant.hs
--- a/src/Opaleye/Internal/Constant.hs
+++ b/src/Opaleye/Internal/Constant.hs
@@ -29,6 +29,7 @@
 import           Data.Functor                    ((<$>))
 
 import qualified Database.PostgreSQL.Simple.Range as R
+import           Database.PostgreSQL.Simple.Newtypes ( Aeson, getAeson )
 
 toFields :: D.Default ToFields haskells fields
          => haskells -> fields
@@ -134,11 +135,17 @@
 instance D.Default ToFields LBS.ByteString (Field T.SqlJsonb) where
   def = toToFields T.sqlLazyJSONB
 
+instance (Ae.ToJSON a) => D.Default ToFields (Aeson a) (Field T.SqlJson) where
+  def = toToFields $ T.sqlValueJSON . getAeson
+
 instance D.Default ToFields Ae.Value (Field T.SqlJsonb) where
   def = toToFields T.sqlValueJSONB
 
 instance D.Default ToFields haskell (F.Field_ n sql) => D.Default ToFields (Maybe haskell) (Maybe (F.Field_ n sql)) where
   def = toToFields (toFields <$>)
+
+instance (Ae.ToJSON a) => D.Default ToFields (Aeson a) (F.Field T.SqlJsonb) where
+  def = toToFields $ T.sqlValueJSONB . getAeson
 
 instance (D.Default ToFields a (F.Field_ n b), T.IsSqlType b)
          => D.Default ToFields [a] (F.Field (T.SqlArray_ n b)) where
diff --git a/src/Opaleye/Internal/Join.hs b/src/Opaleye/Internal/Join.hs
--- a/src/Opaleye/Internal/Join.hs
+++ b/src/Opaleye/Internal/Join.hs
@@ -48,7 +48,7 @@
              -> ((columnsA, columnsB) -> Field T.PGBool)
              -> Q.Query (returnedColumnsA, returnedColumnsB)
 joinExplicit uA uB returnColumnsA returnColumnsB joinType
-             qA qB cond = Q.productQueryArr' $ \() -> do
+             qA qB cond = Q.productQueryArr $ do
   (columnsA, primQueryA) <- Q.runSimpleQueryArr' qA ()
   (columnsB, primQueryB) <- Q.runSimpleQueryArr' qB ()
 
diff --git a/src/Opaleye/Internal/Locking.hs b/src/Opaleye/Internal/Locking.hs
--- a/src/Opaleye/Internal/Locking.hs
+++ b/src/Opaleye/Internal/Locking.hs
@@ -21,6 +21,6 @@
 -- enforce those restrictions through its type system so it's very
 -- easy to create queries that fail at run time using this operation.
 forUpdate :: Q.Select a -> Q.Select a
-forUpdate s = Q.productQueryArr' $ \() -> do
+forUpdate s = Q.productQueryArr $ do
   (a, query) <- Q.runSimpleQueryArr' s ()
   pure (a, PQ.ForUpdate query)
diff --git a/src/Opaleye/Internal/Optimize.hs b/src/Opaleye/Internal/Optimize.hs
--- a/src/Opaleye/Internal/Optimize.hs
+++ b/src/Opaleye/Internal/Optimize.hs
@@ -14,17 +14,19 @@
 import           Control.Arrow (first)
 
 optimize :: PQ.PrimQuery' a -> PQ.PrimQuery' a
-optimize = mergeProduct . removeUnit
+optimize = PQ.foldPrimQuery (noSingletonProduct
+                             `PQ.composePrimQueryFold` mergeProduct
+                             `PQ.composePrimQueryFold` removeUnit)
 
-removeUnit :: PQ.PrimQuery' a -> PQ.PrimQuery' a
-removeUnit = PQ.foldPrimQuery PQ.primQueryFoldDefault { PQ.product   = product }
+removeUnit :: PQ.PrimQueryFoldP a (PQ.PrimQuery' a) (PQ.PrimQuery' a)
+removeUnit = PQ.primQueryFoldDefault { PQ.product   = product }
   where product pqs = PQ.Product pqs'
           where pqs' = case NEL.nonEmpty (NEL.filter (not . PQ.isUnit . snd) pqs) of
                          Nothing -> return (pure PQ.Unit)
                          Just xs -> xs
 
-mergeProduct :: PQ.PrimQuery' a -> PQ.PrimQuery' a
-mergeProduct = PQ.foldPrimQuery PQ.primQueryFoldDefault { PQ.product   = product }
+mergeProduct :: PQ.PrimQueryFoldP a (PQ.PrimQuery' a) (PQ.PrimQuery' a)
+mergeProduct = PQ.primQueryFoldDefault { PQ.product   = product }
   where product pqs pes = PQ.Product pqs' (pes ++ pes')
           where pqs' = pqs >>= queries
                 queries (lat, PQ.Product qs _) = fmap (first (lat <>)) qs
@@ -33,6 +35,12 @@
                 conds (_lat, PQ.Product _ cs) = cs
                 conds _ = []
 
+noSingletonProduct :: PQ.PrimQueryFoldP a (PQ.PrimQuery' a) (PQ.PrimQuery' a)
+noSingletonProduct = PQ.primQueryFoldDefault { PQ.product = product }
+  where product pqs conds = case (NEL.uncons pqs, conds) of
+          (((PQ.NonLateral, x), Nothing), []) -> x
+          _ -> PQ.Product pqs conds
+
 removeEmpty :: PQ.PrimQuery' a -> Maybe (PQ.PrimQuery' b)
 removeEmpty = PQ.foldPrimQuery PQ.PrimQueryFold {
     PQ.unit      = return PQ.Unit
@@ -64,6 +72,7 @@
   , PQ.relExpr   = return .: PQ.RelExpr
   , PQ.rebind    = \b -> fmap . PQ.Rebind b
   , PQ.forUpdate = fmap PQ.ForUpdate
+  , PQ.with      = \recursive name cols -> liftA2 (PQ.With recursive name cols)
   }
   where -- If only the first argument is Just, do n1 on it
         -- If only the second argument is Just, do n2 on it
diff --git a/src/Opaleye/Internal/PrimQuery.hs b/src/Opaleye/Internal/PrimQuery.hs
--- a/src/Opaleye/Internal/PrimQuery.hs
+++ b/src/Opaleye/Internal/PrimQuery.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Opaleye.Internal.PrimQuery where
 
 import           Prelude hiding (product)
@@ -45,6 +47,9 @@
   mappend = (<>)
   mempty = NonLateral
 
+data Recursive = NonRecursive | Recursive
+  deriving Show
+
 aLeftJoin :: HPQ.PrimExpr -> PrimQuery -> PrimQueryArr
 aLeftJoin cond primQuery' = PrimQueryArr $ \lat primQueryL ->
   Join LeftJoin cond (NonLateral, primQueryL) (lat, primQuery')
@@ -157,42 +162,46 @@
                   -- ForUpdate in the future
                   --
                   -- https://www.postgresql.org/docs/current/sql-select.html#SQL-FOR-UPDATE-SHARE
+                  | With Recursive Symbol [Symbol] (PrimQuery' a) (PrimQuery' a)
                  deriving Show
 
 type PrimQuery = PrimQuery' ()
-type PrimQueryFold = PrimQueryFold' ()
+type PrimQueryFold p = PrimQueryFold' () p
 
-data PrimQueryFold' a p = PrimQueryFold
-  { unit              :: p
-  , empty             :: a -> p
-  , baseTable         :: TableIdentifier -> Bindings HPQ.PrimExpr -> p
-  , product           :: NEL.NonEmpty (Lateral, p) -> [HPQ.PrimExpr] -> p
+type PrimQueryFold' a p = PrimQueryFoldP a p p
+
+data PrimQueryFoldP a p p' = PrimQueryFold
+  { unit              :: p'
+  , empty             :: a -> p'
+  , baseTable         :: TableIdentifier -> Bindings HPQ.PrimExpr -> p'
+  , product           :: NEL.NonEmpty (Lateral, p) -> [HPQ.PrimExpr] -> p'
   , aggregate         :: Bindings (Maybe
                              (HPQ.AggrOp, [HPQ.OrderExpr], HPQ.AggrDistinct),
                                    HPQ.Symbol)
                       -> p
-                      -> p
+                      -> p'
   , distinctOnOrderBy :: Maybe (NEL.NonEmpty HPQ.PrimExpr)
                       -> [HPQ.OrderExpr]
                       -> p
-                      -> p
-  , limit             :: LimitOp -> p -> p
+                      -> p'
+  , limit             :: LimitOp -> p -> p'
   , join              :: JoinType
                       -> HPQ.PrimExpr
                       -> (Lateral, p)
                       -> (Lateral, p)
-                      -> p
-  , semijoin          :: SemijoinType -> p -> p -> p
-  , exists            :: Symbol -> p -> p
-  , values            :: [Symbol] -> NEL.NonEmpty [HPQ.PrimExpr] -> p
+                      -> p'
+  , semijoin          :: SemijoinType -> p -> p -> p'
+  , exists            :: Symbol -> p -> p'
+  , values            :: [Symbol] -> NEL.NonEmpty [HPQ.PrimExpr] -> p'
   , binary            :: BinOp
                       -> (p, p)
-                      -> p
-  , label             :: String -> p -> p
-  , relExpr           :: HPQ.PrimExpr -> Bindings HPQ.PrimExpr -> p
+                      -> p'
+  , label             :: String -> p -> p'
+  , relExpr           :: HPQ.PrimExpr -> Bindings HPQ.PrimExpr -> p'
     -- ^ A relation-valued expression
-  , rebind            :: Bool -> Bindings HPQ.PrimExpr -> p -> p
-  , forUpdate         :: p -> p
+  , rebind            :: Bool -> Bindings HPQ.PrimExpr -> p -> p'
+  , forUpdate         :: p -> p'
+  , with              :: Recursive -> Symbol -> [Symbol] -> p -> p -> p'
   }
 
 
@@ -214,28 +223,69 @@
   , exists            = Exists
   , rebind            = Rebind
   , forUpdate         = ForUpdate
+  , with              = With
   }
 
+dimapPrimQueryFold :: (q -> p)
+                   -> (p' -> q')
+                   -> PrimQueryFoldP a p p'
+                   -> PrimQueryFoldP a q q'
+dimapPrimQueryFold self g f = PrimQueryFold
+  { unit = g (unit f)
+  , empty = g . empty f
+  , baseTable = \ti bs -> g (baseTable f ti bs)
+  , product = \ps conds -> g (product f ((fmap . fmap) self ps) conds)
+  , aggregate = \b p -> g (aggregate f b (self p))
+  , distinctOnOrderBy = \m os p -> g (distinctOnOrderBy f m os (self p))
+  , limit = \l p -> g (limit f l (self p))
+  , join = \j pe lp lp' -> g (join f j pe (fmap self lp) (fmap self lp'))
+  , semijoin = \j p1 p2 -> g (semijoin f j (self p1) (self p2))
+  , exists = \s p -> g (exists f s (self p))
+  , values = \ss nel -> g (values f ss nel)
+  , binary = \bo (p1, p2) -> g (binary f bo (self p1, self p2))
+  , label = \l p -> g (label f l (self p))
+  , relExpr = \pe bs -> g (relExpr f pe bs)
+  , rebind = \s bs p -> g (rebind f s bs (self p))
+  , forUpdate = \p -> g (forUpdate f (self p))
+  , with = \r s ss p1 p2 -> g (with f r s ss (self p1) (self p2))
+  }
+
+applyPrimQueryFoldF ::
+  PrimQueryFoldP a (PrimQuery' a) p -> PrimQuery' a -> p
+applyPrimQueryFoldF f = \case
+  Unit -> unit f
+  Empty a -> empty f a
+  BaseTable ti syms -> baseTable f ti syms
+  Product qs pes -> product f qs pes
+  Aggregate aggrs q -> aggregate f aggrs q
+  DistinctOnOrderBy dxs oxs q -> distinctOnOrderBy f dxs oxs q
+  Limit op q -> limit f op q
+  Join j cond q1 q2 -> join f j cond q1 q2
+  Semijoin j q1 q2 -> semijoin f j q1 q2
+  Values ss pes -> values f ss pes
+  Binary binop (q1, q2) -> binary f binop (q1, q2)
+  Label l pq -> label f l pq
+  RelExpr pe syms -> relExpr f pe syms
+  Exists s q -> exists f s q
+  Rebind star pes q -> rebind f star pes q
+  ForUpdate q -> forUpdate f q
+  With recursive name cols a b -> with f recursive name cols a b
+
+primQueryFoldF ::
+  PrimQueryFoldP a p p' -> (PrimQuery' a -> p) -> PrimQuery' a -> p'
+primQueryFoldF g self = applyPrimQueryFoldF (dimapPrimQueryFold self id g)
+
 foldPrimQuery :: PrimQueryFold' a p -> PrimQuery' a -> p
-foldPrimQuery f = fix fold
-  where fold self primQ = case primQ of
-          Unit                        -> unit              f
-          Empty a                     -> empty             f a
-          BaseTable ti syms           -> baseTable         f ti syms
-          Product qs pes              -> product           f (fmap (fmap self) qs) pes
-          Aggregate aggrs q           -> aggregate         f aggrs (self q)
-          DistinctOnOrderBy dxs oxs q -> distinctOnOrderBy f dxs oxs (self q)
-          Limit op q                  -> limit             f op (self q)
-          Join j cond q1 q2           -> join              f j cond (fmap self q1) (fmap 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 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
+foldPrimQuery f = fix (primQueryFoldF f)
+  where fix g = let x = g x in x
+
+-- Would be nice to show that this is associative
+composePrimQueryFold ::
+  PrimQueryFoldP a (PrimQuery' a) q ->
+  PrimQueryFoldP a p (PrimQuery' a) ->
+  PrimQueryFoldP a p q
+composePrimQueryFold = fmapPrimQueryFold . applyPrimQueryFoldF
+  where fmapPrimQueryFold = dimapPrimQueryFold id
 
 times :: Lateral -> PrimQuery -> PrimQuery -> PrimQuery
 times lat q q' = Product (pure q NEL.:| [(lat, q')]) []
diff --git a/src/Opaleye/Internal/Print.hs b/src/Opaleye/Internal/Print.hs
--- a/src/Opaleye/Internal/Print.hs
+++ b/src/Opaleye/Internal/Print.hs
@@ -13,8 +13,9 @@
                                               SelectValues,
                                               SelectBinary,
                                               SelectLabel,
-                                              SelectExists),
-                                       From, Join, Semijoin, Values, Binary, Label, Exists)
+                                              SelectExists,
+                                              SelectWith),
+                                       From, Join, Semijoin, Values, Binary, Label, Exists, With)
 
 import qualified Opaleye.Internal.PrimQuery as PQ
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
@@ -42,6 +43,7 @@
 ppSql (SelectBinary v)   = ppSelectBinary v
 ppSql (SelectLabel v)    = ppSelectLabel v
 ppSql (SelectExists v)   = ppSelectExists v
+ppSql (SelectWith r)     = ppWith r
 
 ppDistinctOn :: Maybe (NEL.NonEmpty HSql.SqlExpr) -> Doc
 ppDistinctOn = maybe mempty $ \nel ->
@@ -108,6 +110,20 @@
   text "SELECT EXISTS"
   <+> ppTable (Sql.sqlSymbol (Sql.existsBinding e), Sql.existsTable e)
 
+ppRecursive :: Sql.Recursive -> Doc
+ppRecursive Sql.Recursive = text "RECURSIVE"
+ppRecursive Sql.NonRecursive = mempty
+
+ppWith :: With -> Doc
+ppWith w
+  =  text "WITH" <+> ppRecursive (Sql.wRecursive w)
+  <+> HPrint.ppTable (Sql.wTable w)
+  <+> parens (HPrint.commaV unColumn (Sql.wCols w))
+  <+> text "AS"
+  $$ parens (ppSql (Sql.wWith w))
+  $$ ppSql (Sql.wSelect w)
+  where unColumn (HSql.SqlColumn col) = text col
+
 ppJoinType :: Sql.JoinType -> Doc
 ppJoinType Sql.LeftJoin = text "LEFT OUTER JOIN"
 ppJoinType Sql.RightJoin = text "RIGHT OUTER JOIN"
@@ -150,6 +166,7 @@
   SelectBinary slb      -> parens (ppSelectBinary slb)
   SelectLabel sll       -> parens (ppSelectLabel sll)
   SelectExists saj      -> parens (ppSelectExists saj)
+  SelectWith w          -> parens (ppWith w)
   `ppAs`
   Just alias
 
diff --git a/src/Opaleye/Internal/QueryArr.hs b/src/Opaleye/Internal/QueryArr.hs
--- a/src/Opaleye/Internal/QueryArr.hs
+++ b/src/Opaleye/Internal/QueryArr.hs
@@ -33,6 +33,9 @@
 type QueryArr = SelectArr
 type Query = SelectArr ()
 
+productQueryArr :: State Tag (a, PQ.PrimQuery) -> Query a
+productQueryArr f = productQueryArr' (\() -> f)
+
 productQueryArr' :: (a -> State Tag (b, PQ.PrimQuery)) -> QueryArr a b
 productQueryArr' f = QueryArr $ \a -> do
   (b, pq) <- f a
@@ -52,11 +55,6 @@
 runStateQueryArr (QueryArr f) a tag =
   let ((b, pq), tag') = runState (f a) tag
   in (b, pq, tag')
-
-stateQueryArr :: (a -> Tag -> (b, PQ.PrimQueryArr, Tag)) -> QueryArr a b
-stateQueryArr f = QueryArr $ \a -> state $ \tag ->
-  let (b, pq, tag') = f a tag
-  in ((b, pq), tag')
 
 runSimpleQueryArrStart :: QueryArr a b -> a -> (b, PQ.PrimQuery, Tag)
 runSimpleQueryArrStart q a =
diff --git a/src/Opaleye/Internal/RunQuery.hs b/src/Opaleye/Internal/RunQuery.hs
--- a/src/Opaleye/Internal/RunQuery.hs
+++ b/src/Opaleye/Internal/RunQuery.hs
@@ -17,6 +17,7 @@
   (FieldParser, fromField, pgArrayFieldParser, optionalField)
 import           Database.PostgreSQL.Simple.FromRow (fromRow, fieldWith)
 import           Database.PostgreSQL.Simple.Types (fromPGArray, Only(..))
+import           Database.PostgreSQL.Simple.Newtypes ( Aeson )
 
 import           Opaleye.Internal.Column (Field_, Field, FieldNullable,
                                           Nullability(Nullable, NonNullable))
@@ -276,6 +277,9 @@
 instance DefaultFromField T.SqlJson Ae.Value where
   defaultFromField = fromPGSFromField
 
+instance (Ae.FromJSON a, Typeable a) => DefaultFromField T.SqlJson (Aeson a) where
+  defaultFromField = fromPGSFromField
+
 instance DefaultFromField T.SqlJsonb String where
   defaultFromField = fromPGSFieldParser jsonbFieldParser
 
@@ -292,6 +296,9 @@
   defaultFromField = fromPGSFieldParser jsonbFieldLazyByteParser
 
 instance DefaultFromField T.SqlJsonb Ae.Value where
+  defaultFromField = fromPGSFromField
+
+instance (Ae.FromJSON a, Typeable a) => DefaultFromField T.SqlJsonb (Aeson a) where
   defaultFromField = fromPGSFromField
 
 -- No CI String instance since postgresql-simple doesn't define FromField (CI String)
diff --git a/src/Opaleye/Internal/Sql.hs b/src/Opaleye/Internal/Sql.hs
--- a/src/Opaleye/Internal/Sql.hs
+++ b/src/Opaleye/Internal/Sql.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Opaleye.Internal.Sql where
 
@@ -30,6 +31,7 @@
             | SelectBinary Binary
             | SelectLabel Label
             | SelectExists Exists
+            | SelectWith With
             deriving Show
 
 data SelectAttrs =
@@ -80,7 +82,16 @@
 data BinOp = Except | ExceptAll | Union | UnionAll | Intersect | IntersectAll deriving Show
 data Lateral = Lateral | NonLateral deriving Show
 data LockStrength = Update deriving Show
+data Recursive = NonRecursive | Recursive deriving Show
+data With = With {
+  wTable     :: HSql.SqlTable, -- The name of the result, i.e. WITH <name> AS
+  wCols      :: [HSql.SqlColumn],
+  wRecursive :: Recursive,
+  wWith      :: Select,
+  wSelect    :: Select
+} deriving Show
 
+
 data Label = Label {
   lLabel  :: String,
   lSelect :: Select
@@ -111,6 +122,7 @@
   , PQ.exists            = exists
   , PQ.rebind            = rebind
   , PQ.forUpdate         = forUpdate
+  , PQ.with              = with
   }
 
 exists :: Symbol -> Select -> Select
@@ -248,6 +260,15 @@
   bSelect1 = select1,
   bSelect2 = select2
   }
+
+with :: PQ.Recursive -> Symbol -> [Symbol]-> Select -> Select -> Select
+with recursive name cols wWith wSelect = SelectWith $ With {..}
+  where
+   wTable = HSql.SqlTable Nothing (sqlSymbol name)
+   wRecursive = case recursive of
+     PQ.NonRecursive -> NonRecursive
+     PQ.Recursive -> Recursive
+   wCols = map (HSql.SqlColumn . sqlSymbol) cols
 
 joinType :: PQ.JoinType -> JoinType
 joinType PQ.LeftJoin = LeftJoin
diff --git a/src/Opaleye/Internal/Table.hs b/src/Opaleye/Internal/Table.hs
--- a/src/Opaleye/Internal/Table.hs
+++ b/src/Opaleye/Internal/Table.hs
@@ -39,7 +39,7 @@
 --
 -- widgetTable :: Table (Widget (Maybe (Field SqlInt4)) (Field SqlText) (Field SqlText)
 --                              (Field SqlInt4) (Field SqlFloat8))
---                      (Widget (Field SqlText) (Field SqlText) (Field SqlText)
+--                      (Widget (Field SqlInt4) (Field SqlText) (Field SqlText)
 --                              (Field SqlInt4) (Field SqlFloat8))
 -- widgetTable = table \"widgetTable\"
 --                      (pWidget Widget { wid      = tableField \"id\"
diff --git a/src/Opaleye/Order.hs b/src/Opaleye/Order.hs
--- a/src/Opaleye/Order.hs
+++ b/src/Opaleye/Order.hs
@@ -57,7 +57,7 @@
 -}
 orderBy :: O.Order a -> S.Select a -> S.Select a
 orderBy os q =
-  Q.productQueryArr' $ \() -> do
+  Q.productQueryArr $ do
     a_pq <- Q.runSimpleQueryArr' q ()
     pure (O.orderByU os a_pq)
 
@@ -116,7 +116,7 @@
 @
 -}
 limit :: Int -> S.Select a -> S.Select a
-limit n a = Q.productQueryArr' $ \() -> do
+limit n a = Q.productQueryArr $ do
   a_pq <- Q.runSimpleQueryArr' a ()
   pure (O.limit' n a_pq)
 
@@ -128,7 +128,7 @@
 'offset' with 'limit'.
 -}
 offset :: Int -> S.Select a -> S.Select a
-offset n a = Q.productQueryArr' $ \() -> do
+offset n a = Q.productQueryArr $ do
   a_pq <- Q.runSimpleQueryArr' a ()
   pure (O.offset' n a_pq)
 
@@ -190,7 +190,7 @@
                    -> (a -> b)
                    -> S.Select a
                    -> S.Select a
-distinctOnExplicit unpack proj q = Q.productQueryArr' $ \() -> do
+distinctOnExplicit unpack proj q = Q.productQueryArr $ do
   a_pq <- Q.runSimpleQueryArr' q ()
   pure (O.distinctOn unpack proj a_pq)
 
@@ -199,6 +199,6 @@
                      -> O.Order a
                      -> S.Select a
                      -> S.Select a
-distinctOnByExplicit unpack proj ord q = Q.productQueryArr' $ \() -> do
+distinctOnByExplicit unpack proj ord q = Q.productQueryArr $ do
   a_pq <- Q.runSimpleQueryArr' q ()
   pure (O.distinctOnBy unpack proj ord a_pq)
diff --git a/src/Opaleye/Table.hs b/src/Opaleye/Table.hs
--- a/src/Opaleye/Table.hs
+++ b/src/Opaleye/Table.hs
@@ -132,7 +132,7 @@
                     -> Table a tablefields
                     -- ^
                     -> S.Select fields
-selectTableExplicit cm table' = Q.productQueryArr' $ \() -> do
+selectTableExplicit cm table' = Q.productQueryArr $ do
   t0 <- Tag.fresh
   let (retwires, primQ) = T.queryTable cm table' t0
   pure (retwires, primQ)
diff --git a/src/Opaleye/Values.hs b/src/Opaleye/Values.hs
--- a/src/Opaleye/Values.hs
+++ b/src/Opaleye/Values.hs
@@ -34,7 +34,7 @@
                      -> V.ValuesspecUnsafe fields fields'
                      -> [fields] -> S.Select fields'
 valuesUnsafeExplicit unpack valuesspec fields =
-  Q.productQueryArr' $ \() -> do
+  Q.productQueryArr $ do
   t <- Tag.fresh
   pure (V.valuesU unpack valuesspec fields ((), t))
 
@@ -60,7 +60,7 @@
 valuesExplicit :: V.Valuesspec fields fields'
                -> [fields] -> S.Select fields'
 valuesExplicit valuesspec fields =
-  Q.productQueryArr' $ \() -> do
+  Q.productQueryArr $ do
     t <- Tag.fresh
     pure (V.valuesUSafe valuesspec fields ((), t))
 
diff --git a/src/Opaleye/With.hs b/src/Opaleye/With.hs
new file mode 100644
--- /dev/null
+++ b/src/Opaleye/With.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Opaleye.With
+  ( with,
+    withRecursive,
+
+    -- * Explicit versions
+    withExplicit,
+    withRecursiveExplicit,
+  )
+where
+
+import Control.Monad.Trans.State.Strict (State)
+import Data.Profunctor.Product.Default (Default, def)
+import Opaleye.Binary (unionAllExplicit)
+import Opaleye.Internal.Binary (Binaryspec (..))
+import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
+import Opaleye.Internal.PackMap (PackMap (..))
+import qualified Opaleye.Internal.PackMap as PM
+import qualified Opaleye.Internal.PrimQuery as PQ
+import Opaleye.Internal.QueryArr (Select, productQueryArr, runSimpleQueryArr')
+import qualified Opaleye.Internal.Sql as Sql
+import qualified Opaleye.Internal.Tag as Tag
+import Opaleye.Internal.Unpackspec (Unpackspec (..), runUnpackspec)
+
+with :: Default Unpackspec a a => Select a -> (Select a -> Select b) -> Select b
+with = withExplicit def
+
+-- | @withRecursive s f@ is the smallest set of rows @r@ such that
+--
+-- @
+-- r == s \`'unionAll'\` (r >>= f)
+-- @
+withRecursive :: Default Binaryspec a a => Select a -> (a -> Select a) -> Select a
+withRecursive = withRecursiveExplicit def
+
+withExplicit :: Unpackspec a a -> Select a -> (Select a -> Select b) -> Select b
+withExplicit unpackspec rhsSelect bodySelect = productQueryArr $ do
+  withG unpackspec PQ.NonRecursive (\_ -> rhsSelect) bodySelect
+
+withRecursiveExplicit :: Binaryspec a a -> Select a -> (a -> Select a) -> Select a
+withRecursiveExplicit binaryspec base recursive = productQueryArr $ do
+  let bodySelect selectCte = selectCte
+  let rhsSelect selectCte = unionAllExplicit binaryspec base (selectCte >>= recursive)
+
+  withG unpackspec PQ.Recursive rhsSelect bodySelect
+  where
+    unpackspec = binaryspecToUnpackspec binaryspec
+
+withG ::
+  Unpackspec a a ->
+  PQ.Recursive ->
+  (Select a -> Select a) ->
+  (Select a -> Select b) ->
+  State Tag.Tag (b, PQ.PrimQuery)
+withG unpackspec recursive rhsSelect bodySelect = do
+  (selectCte, withCte) <- freshCte unpackspec
+
+  let rhsSelect' = rhsSelect selectCte
+  let bodySelect' = bodySelect selectCte
+
+  (_, rhsQ) <- runSimpleQueryArr' rhsSelect' ()
+  bodyQ <- runSimpleQueryArr' bodySelect' ()
+
+  pure (withCte recursive rhsQ bodyQ)
+
+freshCte ::
+  Unpackspec a a ->
+  State
+    Tag.Tag
+    ( Select a,
+      PQ.Recursive -> PQ.PrimQuery -> (b, PQ.PrimQuery) -> (b, PQ.PrimQuery)
+    )
+freshCte unpackspec = do
+  cteName <- HPQ.Symbol "cte" <$> Tag.fresh
+
+  -- TODO: Make a function that explicitly ignores its argument
+  (cteColumns, cteBindings) <- do
+    startTag <- Tag.fresh
+    pure $
+      PM.run $
+        runUnpackspec unpackspec (PM.extractAttr "cte" startTag) (error "freshCte")
+
+  let selectCte = productQueryArr $ do
+        tag <- Tag.fresh
+        let (renamedCte, renameCte) =
+              PM.run $
+                runUnpackspec unpackspec (PM.extractAttr "cte_renamed" tag) cteColumns
+
+        pure (renamedCte, PQ.BaseTable (PQ.TableIdentifier Nothing (Sql.sqlSymbol cteName)) renameCte)
+
+  pure
+    ( selectCte,
+      \recursive withQ (withedCols, withedQ) ->
+        (withedCols, PQ.With recursive cteName (map fst cteBindings) withQ withedQ)
+    )
+
+binaryspecToUnpackspec :: Binaryspec a a -> Unpackspec a a
+binaryspecToUnpackspec (Binaryspec (PackMap spec)) =
+  Unpackspec $ PackMap $ \f a -> spec (\(pe, _) -> f pe) (a, a)