opaleye 0.9.7.0 → 0.10.0.0

raw patch · 24 files changed

+163/−366 lines, 24 filesdep ~postgresql-simplePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: postgresql-simple

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• Test/QuickCheck.hs +2/−2
• Test/Test.hs +38/−19
• opaleye.cabal +1/−2
• src/Opaleye/Adaptors.hs +0/−1
• src/Opaleye/Column.hs +3/−5
• src/Opaleye/Experimental/Enum.hs +0/−10
• src/Opaleye/Field.hs +1/−1
• src/Opaleye/FunctionalJoin.hs +2/−83
• src/Opaleye/Internal/HaskellDB/Sql.hs +2/−0
• src/Opaleye/Internal/Operators.hs +27/−41
• src/Opaleye/Internal/PackMap.hs +17/−0
• src/Opaleye/Internal/PrimQuery.hs +2/−2
• src/Opaleye/Internal/Print.hs +29/−16
• src/Opaleye/Internal/RunQuery.hs +0/−12
• src/Opaleye/Internal/RunQueryExternal.hs +1/−3
• src/Opaleye/Internal/Sql.hs +10/−8
• src/Opaleye/Internal/TableMaker.hs +0/−69
• src/Opaleye/Internal/Values.hs +0/−41
• src/Opaleye/Label.hs +1/−1
• src/Opaleye/Manipulation.hs +6/−6
• src/Opaleye/Operators.hs +4/−8
• src/Opaleye/Order.hs +2/−2
• src/Opaleye/Values.hs +0/−34

@@ -1,3 +1,18 @@+## 0.10.0.0++* Changed `relationValuedExpr` to work in more cases.  (This is a+  breaking change to an internal function.)++* Removed the following, which were all previously deprecated:++  `valuesSafe`, `valuesSafeExplicit`, `valuesUnsafe`,+  `valuesUnsafeExplicit`, `ValuesspecSafe`, `fieldQueryRunnerColumn`,+  `fieldParserQueryRunnerColumn`, `queryRunner`, `joinF`, `leftJoinF`,+  `rightJoinF`, `fromFieldToFieldsEnum`, `keepWhen`++  See their documentation in the 0.9 series to learn about their+  replacements.+ ## 0.9.7.0  * Added `filterWhere` (thanks to Shane O'Brien)

@@ -444,14 +444,14 @@  values :: ArbitraryHaskellsList -> Connection -> IO TQ.Property values (ArbitraryHaskellsList l) =-  compareNoSort (denotation (fmap fieldsList (O.valuesSafe (fmap O.toFields l))))+  compareNoSort (denotation (fmap fieldsList (O.values (fmap O.toFields l))))                 (pureList (fmap fieldsList l))  -- We test values entries of length two in values, and values entries -- of length zero here.  Ideally we would find some way to merge them. valuesEmpty :: [()] -> Connection -> IO TQ.Property valuesEmpty l =-  compareNoSort (denotationExplicit D.def (O.valuesSafe l))+  compareNoSort (denotationExplicit D.def (O.values l))                 (pureList l)  aggregate :: ArbitrarySelect -> Connection -> IO TQ.Property

@@ -13,6 +13,7 @@ import           Control.Monad                    (guard) import qualified Data.Aeson                       as Json import qualified Data.Function                    as F+import           Data.Int (Int32) import qualified Data.List                        as L import           Data.Monoid                      ((<>)) import qualified Data.Ord                         as Ord@@ -30,8 +31,11 @@ import           Opaleye                          (Field, FieldNullable, Select,                                                    SelectArr, (.==), (.>)) import qualified Opaleye                          as O-import qualified Opaleye.Field                    as  F+import qualified Opaleye.Field                    as F import qualified Opaleye.Internal.Aggregate       as IA+import qualified Opaleye.Internal.Column          as O (unColumn)+import qualified Opaleye.Internal.HaskellDB.PrimQuery as O (PrimExpr (..))+import qualified Opaleye.Internal.Operators       as O (relationValuedExpr) import           Opaleye.Internal.RunQuery        (DefaultFromField) import           Opaleye.Internal.MaybeFields     as OM import           Opaleye.Internal.Locking         as OL@@ -508,8 +512,10 @@  testAggregate0 :: Test testAggregate0 = it "" $    O.aggregate (PP.p2 (O.sum, O.sumInt4))-                                        (O.keepWhen (const (O.sqlBool False))-                                         <<< table1Q)+                                        (proc () -> do+                                            r <- table1Q -< ()+                                            O.restrict -< O.sqlBool False+                                            Arr.returnA -< r)                          `selectShouldReturnSorted` ([] :: [(Int, Int64)])  testAggregateFunction :: Test@@ -644,7 +650,10 @@  testCountRows0 :: Test testCountRows0 = it "" $ q `selectShouldReturnSorted` [0 :: Int64]-  where q        = O.countRows (O.keepWhen (const (O.sqlBool False)) <<< table7Q)+  where q        = O.countRows (proc () -> do+                                   r <- table7Q -< ()+                                   O.restrict -< O.sqlBool False+                                   Arr.returnA -< r)  testCountRows3 :: Test testCountRows3 = it "" $ q `selectShouldReturnSorted` [3 :: Int64]@@ -765,20 +774,6 @@                    , ((1, 50), ((Just 1, Just 100), (Just 1, Just 50)))                    , ((1, 50), ((Just 1, Just 200), (Just 1, Just 50))) ] -testLeftJoinF :: Test-testLeftJoinF = it "" $ testH q (`shouldBe` expected)-  where q = O.leftJoinF (,)-                        (\x -> (x, (-1, -2)))-                        (\l r -> fst l .== fst r)-                        table1Q-                        table3Q--        expected :: [((Int, Int), (Int, Int))]-        expected = [ ((1, 100), (1, 50))-                   , ((1, 100), (1, 50))-                   , ((1, 200), (1, 50))-                   , ((2, 300), (-1, -2)) ]- testThreeWayProduct :: Test testThreeWayProduct = it "" $ testH q (`shouldBe` expected)   where q = A.liftA3 (,,) table1Q table2Q table3Q@@ -1415,6 +1410,29 @@                         (realToFrac (Time.ctTime c :: Time.NominalDiffTime) :: Time.DiffTime)                           + Time.timeOfDayToTime t +testUnnest :: Test+testUnnest = do+  it "unnest" $ testH query (`shouldBe` expectation)+  where query :: Select (Field O.SqlInt4, Field O.SqlText)+        query = O.relationValuedExpr (const expr)+          where+            expr = O.FunExpr "unnest" [O.unColumn as', O.unColumn bs']+              where+                as' :: Field (O.SqlArray O.SqlInt4)+                as' = O.toFields as+                bs' :: Field (O.SqlArray O.SqlText)+                bs' = O.toFields bs++        as :: [Int32]+        as = [1, 2, 3]++        bs :: [T.Text]+        bs = ["a", "b", "c"]++        expectation :: [(Int32, T.Text)]+        expectation = zipWith (,) as bs++ main :: IO () main = do   let envVarName = "POSTGRES_CONNSTRING"@@ -1531,7 +1549,6 @@         testLeftJoin         testLeftJoinNullable         testThreeWayProduct-        testLeftJoinF       describe "json" $ jsonTests table8Q       describe "jsonb" $ do         jsonTests table9Q@@ -1580,3 +1597,5 @@       describe "with" $ do         testWithRecursive         testWith+      describe "relation valued exprs" $ do+        testUnnest

@@ -1,6 +1,6 @@ name:            opaleye copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2023 Tom Ellis-version:         0.9.7.0+version:         0.10.0.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@@ -99,7 +99,6 @@                    Opaleye.Internal.RunQueryExternal,                    Opaleye.Internal.Sql,                    Opaleye.Internal.Table,-                   Opaleye.Internal.TableMaker,                    Opaleye.Internal.Tag,                    Opaleye.Internal.TypeFamilies,                    Opaleye.Internal.Unpackspec,

@@ -63,7 +63,6 @@     Updater,     -- * Valuesspec     Valuesspec,-    ValuesspecSafe,     valuesspecField,     valuesspecMaybeFields,     -- * WithNulls

@@ -1,13 +1,11 @@ {-# OPTIONS_GHC -fno-warn-duplicate-exports #-}--- | Do not use.  Will be deprecated in version 0.10.  Use--- "Opaleye.Field" instead.------ Functions for working directly with 'Column's.+-- | Functions for working directly with 'Column's. -- -- Please note that numeric 'Column' types are instances of 'Num', so -- you can use '*', '/', '+', '-' on them. -module Opaleye.Column (-- * 'Column'+module Opaleye.Column {-# DEPRECATED "Use \"Opaleye.Field\" instead.  Will be removed in version 0.11." #-}+                      (-- * 'Column'                        Column,                        -- * Working with @NULL@                        Nullable,

@@ -8,7 +8,6 @@     enumMapperWithSchema,     enumFromField,     enumToFields,-    fromFieldToFieldsEnum,   ) where  import           Opaleye.Field (Field)@@ -139,12 +138,3 @@        Just s -> case from (unpack s) of          Just r -> r          Nothing -> error ("Unexpected: " ++ unpack s)--{-# DEPRECATED fromFieldToFieldsEnum "Use 'enumMapper' instead.  Will be removed in 0.10." #-}-fromFieldToFieldsEnum :: String-                      -> (String -> Maybe haskellSum)-                      -> (haskellSum -> String)-                      -> (RQ.FromField sqlEnum haskellSum,-                          O.ToFields haskellSum (Field sqlEnum))-fromFieldToFieldsEnum type_ from to_ = (enumFromField e, enumToFields e)-  where e = enumMapper type_ from to_

@@ -10,7 +10,7 @@ -- SqlType@, and if you see @'C.Column' ('C.Nullable' SqlType)@ then -- you can understand it as @'FieldNullable' SqlType@. ----- 'C.Column' will be fully deprecated in version 0.10.+-- 'C.Column' will be removed in version 0.11.  {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-}

@@ -1,5 +1,5 @@--- | Alternative APIs to inner, left, right, and full outer joins.--- See "Opaleye.Join" for details on the best way to do joins in+-- | Full outer joins.+-- See "Opaleye.Join" for details on the best way to do other joins in -- Opaleye.  {-# LANGUAGE FlexibleContexts      #-}@@ -8,10 +8,6 @@ module Opaleye.FunctionalJoin (   -- * Full outer join   fullJoinF,-  -- ** Deprecated-  joinF,-  leftJoinF,-  rightJoinF,   ) where  import           Control.Applicative             ((<$>), (<*>))@@ -29,83 +25,6 @@ import qualified Opaleye.Select                  as S import qualified Opaleye.SqlTypes                as T import qualified Opaleye.Operators               as O--{-# DEPRECATED joinF "Use 'Opaleye.Operators.where_' and @do@ notation instead.  Will be removed in 0.10." #-}-joinF :: (fieldsL -> fieldsR -> fieldsResult)-      -- ^ Calculate result fields from input fields-      -> (fieldsL -> fieldsR -> F.Field T.SqlBool)-      -- ^ Condition on which to join-      -> S.Select fieldsL-      -- ^ Left query-      -> S.Select fieldsR-      -- ^ Right query-      -> S.Select fieldsResult-joinF f cond l r =-  fmap (uncurry f) (O.keepWhen (uncurry cond) <<< ((,) <$> l <*> r))--{-# DEPRECATED leftJoinF "Use 'Opaleye.Join.optional' instead.  Will be removed in 0.10." #-}-leftJoinF :: (D.Default IO.IfPP fieldsResult fieldsResult,-              D.Default IU.Unpackspec fieldsL fieldsL,-              D.Default IU.Unpackspec fieldsR fieldsR)-          => (fieldsL -> fieldsR -> fieldsResult)-          -- ^ Calculate result row from input rows for rows in the-          -- right query satisfying the join condition-          -> (fieldsL -> fieldsResult)-          -- ^ Calculate result row from input row when there are /no/-          -- rows in the right query satisfying the join condition-          -> (fieldsL -> fieldsR -> F.Field T.SqlBool)-          -- ^ Condition on which to join-          -> S.Select fieldsL-          -- ^ Left query-          -> S.Select fieldsR-          -- ^ Right query-          -> S.Select fieldsResult-leftJoinF f fL cond l r = fmap ret j-  where a1 = fmap (\x -> (x, T.sqlBool True))-        j  = J.leftJoinExplicit D.def-                                D.def-                                (PP.p2 (IJ.NullMaker id, nullmakerBool))-                                l-                                (a1 r)-                                (\(l', (r', _)) -> cond l' r')--        ret (lr, (rr, rc)) = O.ifThenElseMany (C.isNull rc) (fL lr) (f lr rr)--        nullmakerBool :: IJ.NullMaker (F.Field T.SqlBool)-                                      (F.FieldNullable T.SqlBool)-        nullmakerBool = D.def--{-# DEPRECATED rightJoinF "Use 'Opaleye.Join.optional' instead.  Will be removed in 0.10." #-}-rightJoinF :: (D.Default IO.IfPP fieldsResult fieldsResult,-               D.Default IU.Unpackspec fieldsL fieldsL,-               D.Default IU.Unpackspec fieldsR fieldsR)-           => (fieldsL -> fieldsR -> fieldsResult)-           -- ^ Calculate result row from input rows for rows in the-           -- left query satisfying the join condition-           -> (fieldsR -> fieldsResult)-           -- ^ Calculate result row from input row when there are /no/-           -- rows in the left query satisfying the join condition-           -> (fieldsL -> fieldsR -> F.Field T.SqlBool)-           -- ^ Condition on which to join-           -> S.Select fieldsL-           -- ^ Left query-           -> S.Select fieldsR-           -- ^ Right query-           -> S.Select fieldsResult-rightJoinF f fR cond l r = fmap ret j-  where a1 = fmap (\x -> (x, T.sqlBool True))-        j  = J.rightJoinExplicit D.def-                                 D.def-                                 (PP.p2 (IJ.NullMaker id, nullmakerBool))-                                 (a1 l)-                                 r-                                 (\((l', _), r') -> cond l' r')--        ret ((lr, lc), rr) = O.ifThenElseMany (C.isNull lc) (fR rr) (f lr rr)--        nullmakerBool :: IJ.NullMaker (F.Field T.SqlBool)-                                      (F.FieldNullable T.SqlBool)-        nullmakerBool = D.def  fullJoinF :: (D.Default IO.IfPP fieldsResult fieldsResult,               D.Default IU.Unpackspec fieldsL fieldsL,

@@ -72,6 +72,8 @@ -- | Data type for SQL DELETE statements. data SqlDelete  = SqlDelete SqlTable [SqlExpr] +{-# DEPRECATED DoNothing "Use 'doNothing' instead.  @DoNothing@ will be removed in version 0.11" #-}+-- It won't be removed, it will just be made internal data OnConflict = DoNothing                 -- ^ @ON CONFLICT DO NOTHING@ 

@@ -6,21 +6,21 @@  module Opaleye.Internal.Operators where +import Control.Applicative (liftA2)+ import           Opaleye.Internal.Column (Field_(Column)) import qualified Opaleye.Internal.Column as C+import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import qualified Opaleye.Internal.QueryArr as QA-import qualified Opaleye.Internal.Table as Table-import qualified Opaleye.Internal.TableMaker as TM import qualified Opaleye.Internal.Tag as Tag-import qualified Opaleye.Internal.Unpackspec as U import qualified Opaleye.Internal.PGTypesExternal as T import qualified Opaleye.Field as F import           Opaleye.Field (Field) import qualified Opaleye.Select as S -import           Data.Profunctor (Profunctor, dimap, lmap, rmap)+import           Data.Profunctor (Profunctor, dimap) import           Data.Profunctor.Product (ProductProfunctor, empty, (***!)) import qualified Data.Profunctor.Product.Default as D @@ -77,43 +77,32 @@   def = IfPP C.unsafeIfThenElse  --- This seems to be the only place we use ViewColumnMaker now.-data RelExprMaker a b =-  forall c. RelExprMaker {-      relExprVCM :: TM.ViewColumnMaker a c-    , relExprCM  :: U.Unpackspec c b-    }+newtype RelExprPP a b = RelExprPP (Tag.Tag -> PM.PM [HPQ.Symbol] b) -relExprColumn :: RelExprMaker String (Field_ n a)-relExprColumn = RelExprMaker TM.tableColumn U.unpackspecField -instance D.Default RelExprMaker String (Field_ n a) where+runRelExprPP :: RelExprPP a b -> Tag.Tag -> (b, [HPQ.Symbol])+runRelExprPP (RelExprPP m) = PM.run . m+++instance D.Default RelExprPP (Field_ n a) (Field_ n a) where   def = relExprColumn -runRelExprMaker :: RelExprMaker strings columns-                -> Tag.Tag-                -> strings-                -> (columns, [(HPQ.Symbol, HPQ.PrimExpr)])-runRelExprMaker rem_ tag =-  case rem_ of RelExprMaker vcm cm -> Table.runColumnMaker cm tag-                                    . TM.runViewColumnMaker vcm -relationValuedExprExplicit :: RelExprMaker strings columns-                           -> strings+relExprColumn :: RelExprPP (Field_ n a) (Field_ n a)+relExprColumn = RelExprPP $ fmap Column . PM.extract "relExpr"+++relationValuedExprExplicit :: RelExprPP columns columns                            -> (a -> HPQ.PrimExpr)                            -> QA.QueryArr a columns-relationValuedExprExplicit rem_ strings pe =+relationValuedExprExplicit relExprPP pe =   QA.productQueryArr' $ do-    tag <- Tag.fresh-    pure $ \a ->-      let (primExprs, projcols) = runRelExprMaker rem_ tag strings-          primQ :: PQ.PrimQuery-          primQ = PQ.RelExpr (pe a) projcols-      in (primExprs, primQ)+    (columns, symbols) <- runRelExprPP relExprPP <$> Tag.fresh+    pure $ \a -> (columns, PQ.RelExpr (pe a) symbols) -relationValuedExpr :: D.Default RelExprMaker strings columns-                   => strings-                   -> (a -> HPQ.PrimExpr)++relationValuedExpr :: D.Default RelExprPP columns columns+                   => (a -> HPQ.PrimExpr)                    -> QA.QueryArr a columns relationValuedExpr = relationValuedExprExplicit D.def @@ -127,16 +116,13 @@   EqPP f ***! EqPP f' = EqPP (\a a' ->                                f (fst a) (fst a') .&& f' (snd a) (snd a')) -instance Profunctor RelExprMaker where-  dimap f g (RelExprMaker a b) = RelExprMaker (lmap f a) (rmap g b)+instance Profunctor RelExprPP where+  dimap _ f (RelExprPP m) = RelExprPP (fmap (fmap f) m) -instance ProductProfunctor RelExprMaker where-  empty = RelExprMaker empty empty-  f ***! g = case f of RelExprMaker vcmf cmf ->-                        case g of RelExprMaker vcmg cmg ->-                                    h vcmf vcmg cmf cmg-    where h vcmg vcmf cmg cmf = RelExprMaker (vcmg ***! vcmf)-                                             (cmg  ***! cmf)+instance ProductProfunctor RelExprPP where+  empty = RelExprPP (pure (pure ()))+  RelExprPP f ***! RelExprPP g =+    RelExprPP $ liftA2 (liftA2 (,)) f g  instance Profunctor IfPP where   dimap f g (IfPP h) = IfPP (\b a a' -> g (h b (f a) (f a')))

@@ -1,4 +1,5 @@ {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TupleSections #-}  module Opaleye.Internal.PackMap where @@ -7,6 +8,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ  import           Control.Applicative (Applicative, pure, (<*>), liftA2)+import           Control.Arrow (first, second) import qualified Control.Monad.Trans.State as State import           Data.Profunctor (Profunctor, dimap, rmap) import           Data.Profunctor.Product (ProductProfunctor)@@ -109,6 +111,21 @@             -> primExpr             -> PM [(HPQ.Symbol, primExpr)] HPQ.PrimExpr extractAttr s = extractAttrPE (const (s ++))++isoState ::+  Functor m =>+  (s1 -> s2) ->+  (s2 -> s1) ->+  State.StateT s1 m a ->+  State.StateT s2 m a+isoState to from =+  State.StateT . ((fmap . second) to .) . (. from) . State.runStateT++extract :: String -> T.Tag -> PM [HPQ.Symbol] HPQ.PrimExpr+extract s t = isoState to from (extractAttr s t ())+  where+    to = (first . fmap) fst+    from = (first . fmap) (\x -> (x, ()))  -- } 

@@ -151,7 +151,7 @@                   | Binary    BinOp                               (PrimQuery' a, PrimQuery' a)                   | Label     String (PrimQuery' a)-                  | RelExpr   HPQ.PrimExpr (Bindings HPQ.PrimExpr)+                  | RelExpr   HPQ.PrimExpr [Symbol]                   | Rebind    Bool                               (Bindings HPQ.PrimExpr)                               (PrimQuery' a)@@ -194,7 +194,7 @@                       -> (p, p)                       -> p'   , label             :: String -> p -> p'-  , relExpr           :: HPQ.PrimExpr -> Bindings HPQ.PrimExpr -> p'+  , relExpr           :: HPQ.PrimExpr -> [Symbol] -> p'     -- ^ A relation-valued expression   , rebind            :: Bool -> Bindings HPQ.PrimExpr -> p -> p'   , forUpdate         :: p -> p'

@@ -26,13 +26,21 @@ import qualified Opaleye.Internal.Tag as T  import           Text.PrettyPrint.HughesPJ (Doc, ($$), (<+>), text, empty,-                                            parens)+                                            parens, doubleQuotes) import qualified Data.Char import qualified Data.List.NonEmpty as NEL import qualified Data.Text          as ST -type TableAlias = String+data TableAlias = TableAlias String (Maybe [HSql.SqlColumn]) +ppTableAlias :: TableAlias -> Doc+ppTableAlias (TableAlias table columns) =+  text "AS" <+>+  doubleQuotes (text table) <+>+  foldMap (parens . HPrint.commaH (doubleQuotes . unColumn)) columns+    where+      unColumn (HSql.SqlColumn col) = text col+ ppSql :: Select -> Doc ppSql (SelectFrom s)     = ppSelectFrom s ppSql (Table table)      = HPrint.ppTable table@@ -66,18 +74,20 @@ ppSelectJoin :: Join -> Doc ppSelectJoin j = text "SELECT *"                  $$  text "FROM"-                 $$  ppTable_tableAlias (1, s1)+                 $$  ppTable_tableAlias (1, alias s1)                  $$  ppJoinType (Sql.jJoinType j)-                 $$  ppTable_tableAlias (2, s2)+                 $$  ppTable_tableAlias (2, alias s2)                  $$  text "ON"                  $$  HPrint.ppSqlExpr (Sql.jCond j)-  where (s1, s2) = Sql.jTables j+  where+    (s1, s2) = Sql.jTables j+    alias (a, b) = (a, b, Nothing)  ppSelectSemijoin :: Semijoin -> Doc ppSelectSemijoin v =   text "SELECT *"   $$  text "FROM"-  $$  ppTable (tableAlias 1 (Sql.sjTable v))+  $$  ppTable (tableAlias 1 (Sql.sjTable v) Nothing)   $$  case Sql.sjType v of         Sql.Semi -> text "WHERE EXISTS"         Sql.Anti -> text "WHERE NOT EXISTS"@@ -108,7 +118,9 @@ ppSelectExists :: Exists -> Doc ppSelectExists e =   text "SELECT EXISTS"-  <+> ppTable (Sql.sqlSymbol (Sql.existsBinding e), Sql.existsTable e)+  <+> ppTable (alias, Sql.existsTable e)+  where+    alias = TableAlias (Sql.sqlSymbol (Sql.existsBinding e)) Nothing  ppRecursive :: Sql.Recursive -> Doc ppRecursive Sql.Recursive = text "RECURSIVE"@@ -140,19 +152,21 @@ nameAs (expr, name) = HPrint.ppSqlExpr expr `ppAs` fmap unColumn name   where unColumn (HSql.SqlColumn s) = s -ppTables :: [(Sql.Lateral, Select)] -> Doc+ppTables :: [(Sql.Lateral, Select, Maybe [HSql.SqlColumn])] -> Doc ppTables [] = empty ppTables ts = text "FROM" <+> HPrint.commaV ppTable_tableAlias (zip [1..] ts) -ppTable_tableAlias :: (Int, (Sql.Lateral, Select)) -> Doc-ppTable_tableAlias (i, (lat, select)) =-  lateral lat $ ppTable (tableAlias i select)+ppTable_tableAlias :: (Int, (Sql.Lateral, Select, Maybe [HSql.SqlColumn])) -> Doc+ppTable_tableAlias (i, (lat, select, columns)) =+  lateral lat $ ppTable (tableAlias i select columns)   where lateral = \case           Sql.NonLateral -> id           Sql.Lateral -> (text "LATERAL" $$) -tableAlias :: Int -> Select -> (TableAlias, Select)-tableAlias i select = ("T" ++ show i, select)+tableAlias :: Int -> Select -> Maybe [HSql.SqlColumn] -> (TableAlias, Select)+tableAlias i select columns = (alias, select)+  where+    alias = TableAlias ("T" ++ show i) columns  -- TODO: duplication with ppSql ppTable :: (TableAlias, Select) -> Doc@@ -167,8 +181,7 @@   SelectLabel sll       -> parens (ppSelectLabel sll)   SelectExists saj      -> parens (ppSelectExists saj)   SelectWith w          -> parens (ppWith w)-  `ppAs`-  Just alias+  <+> ppTableAlias alias  ppGroupBy :: Maybe (NEL.NonEmpty HSql.SqlExpr) -> Doc ppGroupBy Nothing   = empty@@ -187,7 +200,7 @@ ppFor (Just Sql.Update) = text "FOR UPDATE"  ppValues :: [[HSql.SqlExpr]] -> Doc-ppValues v = parens (HPrint.ppValues_ v) `ppAs` Just "V"+ppValues v = parens (HPrint.ppValues_ v) <+> ppTableAlias (TableAlias "V" Nothing)  ppBinOp :: Sql.BinOp -> Doc ppBinOp o = text $ case o of

@@ -111,17 +111,9 @@               -- SqlInt4)' has no columns when it is Nothing and one               -- column when it is Just. -{-# DEPRECATED fieldQueryRunnerColumn "Will be removed in version 0.10.  Use fromPGSFromField instead." #-}-fieldQueryRunnerColumn :: PGS.FromField haskell => FromField pgType haskell-fieldQueryRunnerColumn = fromPGSFromField- fromPGSFromField :: PGS.FromField haskell => FromField pgType haskell fromPGSFromField = fromPGSFieldParser fromField -{-# DEPRECATED fieldParserQueryRunnerColumn " Will be removed in version 0.10.  Use fromPGSFieldParser instead." #-}-fieldParserQueryRunnerColumn :: FieldParser haskell -> FromField pgType haskell-fieldParserQueryRunnerColumn = fromPGSFieldParser- fromPGSFieldParser :: FieldParser haskell -> FromField pgType haskell fromPGSFieldParser = FromField @@ -130,10 +122,6 @@  fieldParserFromFields :: FieldParser haskells -> FromFields (Field_ n a) haskells fieldParserFromFields fp = FromFields (P.rmap (const ()) U.unpackspecField) (const (fieldWith fp)) (const 1)--{-# DEPRECATED queryRunner "Use fromFields instead.  Will be removed in version 0.10." #-}-queryRunner :: FromField a b -> FromFields (Field a) b-queryRunner = fromFields  fromFieldsNullable :: FromField a b -> FromFields (FieldNullable a) (Maybe b) fromFieldsNullable (FromField fp) = fieldParserFromFields (optionalField fp)

@@ -8,9 +8,7 @@                          IRQ.Cursor,                          IRQ.FromFields,                          IRQ.FromField,-                         -- * Creating new 'FromField's-                         IRQ.fieldQueryRunnerColumn,-                         IRQ.fieldParserQueryRunnerColumn) where+                 ) where  import           Control.Applicative (pure, (<$>)) import qualified Database.PostgreSQL.Simple as PGS

@@ -42,7 +42,7 @@  data From = From {   attrs      :: SelectAttrs,-  tables     :: [(Lateral, Select)],+  tables     :: [(Lateral, Select, Maybe [HSql.SqlColumn])],   criteria   :: [HSql.SqlExpr],   groupBy    :: Maybe (NEL.NonEmpty HSql.SqlExpr),   orderBy    :: [(HSql.SqlExpr, HSql.SqlOrder)],@@ -142,8 +142,8 @@ empty :: V.Void -> select empty = V.absurd -oneTable :: t -> [(Lateral, t)]-oneTable t = [(NonLateral, t)]+oneTable :: t -> [(Lateral, t, Maybe a)]+oneTable t = [(NonLateral, t, Nothing)]  baseTable :: PQ.TableIdentifier -> [(Symbol, HPQ.PrimExpr)] -> Select baseTable ti columns = SelectFrom $@@ -154,7 +154,7 @@ product ss pes = SelectFrom $     newSelect { tables = NEL.toList ss'               , criteria = map sqlExpr pes }-  where ss' = flip fmap ss $ Arr.first $ \case+  where ss' = flip fmap ss $ (\f (a, b) -> (f a, b, Nothing)) $ \case           PQ.Lateral    -> Lateral           PQ.NonLateral -> NonLateral @@ -328,11 +328,13 @@ label l s = SelectLabel (Label l s)  -- Very similar to 'baseTable'-relExpr :: HPQ.PrimExpr -> [(Symbol, HPQ.PrimExpr)] -> Select+relExpr :: HPQ.PrimExpr -> [Symbol] -> Select relExpr pe columns = SelectFrom $-    newSelect { attrs = SelectAttrs (ensureColumns (map sqlBinding columns))-              , tables = oneTable (RelExpr (sqlExpr pe))+    newSelect { attrs = Star+              , tables = [(NonLateral, RelExpr (sqlExpr pe), Just columns')]               }+  where+    columns' = HSql.SqlColumn . sqlSymbol <$> columns  rebind :: Bool -> [(Symbol, HPQ.PrimExpr)] -> Select -> Select rebind star pes select = SelectFrom newSelect@@ -345,6 +347,6 @@  forUpdate :: Select -> Select forUpdate s = SelectFrom newSelect {-    tables = [(NonLateral, s)]+    tables = [(NonLateral, s, Nothing)]   , for = Just Update   }

@@ -1,69 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}--module Opaleye.Internal.TableMaker where--import qualified Opaleye.Internal.Column as IC-import qualified Opaleye.Internal.PackMap as PM-import qualified Opaleye.Internal.Unpackspec as U--import           Data.Profunctor (Profunctor, dimap)-import           Data.Profunctor.Product (ProductProfunctor)-import qualified Data.Profunctor.Product as PP-import           Data.Profunctor.Product.Default (Default, def)--import           Control.Applicative (Applicative, pure, (<*>))--import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ----- If we switch to a more lens-like approach to PackMap this should be--- the equivalent of a Setter-newtype ViewColumnMaker strings columns =-  ViewColumnMaker (PM.PackMap () () strings columns)--runViewColumnMaker :: ViewColumnMaker strings tablecolumns ->-                       strings -> tablecolumns-runViewColumnMaker (ViewColumnMaker f) = PM.overPM f id--{-# DEPRECATED ColumnMaker "Use Unpackspec instead" #-}-type ColumnMaker = U.Unpackspec--{-# DEPRECATED runColumnMaker "Use runUnpackspec instead" #-}-runColumnMaker :: Applicative f-                  => ColumnMaker tablecolumns columns-                  -> (HPQ.PrimExpr -> f HPQ.PrimExpr)-                  -> tablecolumns -> f columns-runColumnMaker = U.runUnpackspec---- There's surely a way of simplifying this implementation-tableColumn :: ViewColumnMaker String (IC.Field_ n a)-tableColumn = ViewColumnMaker-              (PM.PackMap (\f s -> fmap (const (mkColumn s)) (f ())))-  where mkColumn = IC.Column . HPQ.BaseTableAttrExpr--instance Default ViewColumnMaker String (IC.Field_ n a) where-  def = tableColumn--{-# DEPRECATED column "Use unpackspecColumn instead" #-}-column :: ColumnMaker (IC.Field_ n a) (IC.Field_ n a)-column = U.unpackspecField---- {---- Boilerplate instance definitions.  Theoretically, these are derivable.--instance Functor (ViewColumnMaker a) where-  fmap f (ViewColumnMaker g) = ViewColumnMaker (fmap f g)--instance Applicative (ViewColumnMaker a) where-  pure = ViewColumnMaker . pure-  ViewColumnMaker f <*> ViewColumnMaker x = ViewColumnMaker (f <*> x)--instance Profunctor ViewColumnMaker where-  dimap f g (ViewColumnMaker q) = ViewColumnMaker (dimap f g q)--instance ProductProfunctor ViewColumnMaker where-  purePP = pure-  (****) = (<*>)----}

@@ -218,49 +218,8 @@  -- } -{-# DEPRECATED valuesU "Will be removed in 0.10" #-}-valuesU :: U.Unpackspec columns columns'-        -> ValuesspecUnsafe columns columns'-        -> [columns]-        -> ((), T.Tag) -> (columns', PQ.PrimQuery)-valuesU unpack valuesspec rows ((), t) = (newColumns, primQ')-  where runRow row = valuesRow-           where (_, valuesRow) =-                   PM.run (U.runUnpackspec unpack extractValuesEntry row)--        (newColumns, valuesPEs_nulls) =-          PM.run (runValuesspec valuesspec (extractValuesField t))--        valuesPEs = map fst valuesPEs_nulls--        values :: [[HPQ.PrimExpr]]-        values = map runRow rows--        primQ' = case NEL.nonEmpty values of-          Nothing      -> PQ.Empty ()-          Just values' -> PQ.Values valuesPEs values'--{-# DEPRECATED extractValuesEntry "Will be removed in 0.10" #-}-extractValuesEntry :: HPQ.PrimExpr -> PM.PM [HPQ.PrimExpr] HPQ.PrimExpr-extractValuesEntry pe = do-  PM.write pe-  return pe--{-# DEPRECATED extractValuesField "Will be removed in 0.10" #-}-extractValuesField :: T.Tag -> primExpr-                   -> PM.PM [(HPQ.Symbol, primExpr)] HPQ.PrimExpr-extractValuesField = PM.extractAttr "values"--{-# DEPRECATED runValuesspec "Will be removed in 0.10" #-}-runValuesspec :: Applicative f => ValuesspecUnsafe columns columns'-              -> (() -> f HPQ.PrimExpr) -> f columns'-runValuesspec (Valuesspec v) f = PM.traversePM v f ()- newtype ValuesspecUnsafe columns columns' =   Valuesspec (PM.PackMap () HPQ.PrimExpr () columns')  instance Default ValuesspecUnsafe (Field_ n a) (Field_ n a) where   def = Valuesspec (PM.iso id Column)--{-# DEPRECATED ValuesspecSafe "Use Valuesspec instead.  Will be removed in version 0.10." #-}-type ValuesspecSafe = Valuesspec

@@ -17,7 +17,7 @@ label' l = Q.selectArr f where   f = pure (\() -> ((), PQ.aLabel l)) --- | Will be deprecated in version 0.10.  Use 'label\'' instead.+{-# DEPRECATED label "Will be removed in version 0.11.  Use 'label\'' instead." #-} label :: String -> S.SelectArr a b -> S.SelectArr a b label l s = proc a -> do   b <- s -< a

@@ -50,8 +50,8 @@                              runDelete_,                              -- ** @DoNothing@                              -- | Use 'doNothing' instead.-                             -- @DoNothing@ will be deprecated in-                             -- version 0.10.+                             -- @DoNothing@ will be removed in+                             -- version 0.11.                              HSql.OnConflict(HSql.DoNothing),                              ) where @@ -97,7 +97,7 @@             \c t r -> MI.runInsertManyReturningExplicit qr c t r f onConflict_     in insert conn table_ rows_ --- | Use 'runInsert' instead.  Will be deprecated in 0.10.+{-# DEPRECATED runInsert_ "Use 'runInsert' instead.  Will be removed in 0.11." #-} runInsert_ :: PGS.Connection            -> Insert haskells            -> IO haskells@@ -119,7 +119,7 @@           MI.ReturningExplicit qr f ->             runUpdateReturningExplicit qr conn table_ updateWith_ where_ f --- | Use 'runUpdate' instead.  Will be deprecated in 0.10.+{-# DEPRECATED runUpdate_ "Use 'runUpdate' instead.  Will be removed in 0.11." #-} runUpdate_ :: PGS.Connection            -> Update haskells            -> IO haskells@@ -140,7 +140,7 @@           MI.ReturningExplicit qr f ->             MI.runDeleteReturningExplicit qr conn table_ where_ f --- | Use 'runDelete' instead.  Will be deprecated in 0.10.+{-# DEPRECATED runDelete_ "Use 'runDelete' instead.  Will be removed in 0.11." #-} runDelete_ :: PGS.Connection            -> Delete haskells            -> IO haskells@@ -158,7 +158,7 @@    --    --     * 'iOnConflict' @=@ 'Nothing' means omit @ON CONFLICT@ statement    ---   --     * 'iOnConflict' @=@ 'Just' 'HSql.DoNothing' means @ON CONFLICT DO+   --     * 'iOnConflict' @=@ 'Just' 'HSql.doNothing' means @ON CONFLICT DO    --        NOTHING@    } 

@@ -105,7 +105,6 @@   , addInterval   , minusInterval   -- * Deprecated-  , keepWhen   )    where@@ -300,7 +299,10 @@ -- 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 = E.exists (keepWhen (c .===) A.<<< q)+inSelect c q = E.exists $ proc () -> do+  r <- q -< ()+  restrict -< c .=== r+  A.returnA -< r  -- | Class of Postgres types that represent json values. -- Used to overload functions and operators that work on both 'T.SqlJson' and 'T.SqlJsonb'.@@ -486,12 +488,6 @@  minusInterval :: IntervalNum from to => F.Field from -> F.Field T.SqlInterval -> F.Field to minusInterval = C.binOp (HPQ.:-)--{-# DEPRECATED keepWhen "Use 'where_' or 'restrict' instead.  Will be removed in version 0.10." #-}-keepWhen :: (a -> F.Field T.SqlBool) -> S.SelectArr a a-keepWhen p = proc a -> do-  restrict  -< p a-  A.returnA -< a  -- | Current date and time (start of current transaction) now :: F.Field T.SqlTimestamptz

@@ -143,14 +143,14 @@  -- * Distinct on --- | Use 'distinctOn' instead.  Will be deprecated in 0.10.+{-# DEPRECATED distinctOnCorrect "Use 'distinctOn' instead.  Will be removed in 0.11." #-} distinctOnCorrect :: D.Default U.Unpackspec b b                   => (a -> b)                   -> S.Select a                   -> S.Select a distinctOnCorrect = distinctOnExplicit D.def --- | Use 'distinctOnBy' instead.  Will be deprecated in 0.10.+{-# DEPRECATED distinctOnByCorrect "Use 'distinctOnBy' instead.  Will be removed in 0.11." #-} distinctOnByCorrect :: D.Default U.Unpackspec b b                     => (a -> b)                     -> O.Order a

@@ -7,38 +7,14 @@   -- * Adaptors   V.Valuesspec,   V.valuesspecField,-  -- * Deprecated versions-  valuesSafe,-  valuesSafeExplicit,-  valuesUnsafe,-  valuesUnsafeExplicit,-  V.ValuesspecSafe,   ) where -import qualified Opaleye.Internal.QueryArr as Q-import qualified Opaleye.Internal.Tag as Tag import qualified Opaleye.Internal.Values as V-import qualified Opaleye.Internal.Unpackspec as U import qualified Opaleye.Select              as S  import qualified Data.List.NonEmpty as NEL import           Data.Profunctor.Product.Default (Default, def) -{-# DEPRECATED valuesUnsafe "Use 'values' instead.  Will be removed in 0.10." #-}-valuesUnsafe :: (Default V.ValuesspecUnsafe fields fields,-                 Default U.Unpackspec fields fields) =>-                [fields] -> S.Select fields-valuesUnsafe = valuesUnsafeExplicit def def--{-# DEPRECATED valuesUnsafeExplicit "Use 'values' instead.  Will be removed in 0.10." #-}-valuesUnsafeExplicit :: U.Unpackspec fields fields'-                     -> V.ValuesspecUnsafe fields fields'-                     -> [fields] -> S.Select fields'-valuesUnsafeExplicit unpack valuesspec fields =-  Q.productQueryArr $ do-  t <- Tag.fresh-  pure (V.valuesU unpack valuesspec fields ((), t))- -- | 'values' implements Postgres's @VALUES@ construct and allows you -- to create a @SELECT@ that consists of the given rows. --@@ -63,13 +39,3 @@ valuesExplicit (V.ValuesspecSafe nullspec rowspec) fields = case NEL.nonEmpty fields of   Nothing -> V.emptySelectExplicit nullspec   Just rows -> V.nonEmptyValues rowspec rows--{-# DEPRECATED valuesSafe "Use 'values' instead.  Will be removed in 0.10." #-}-valuesSafe :: Default V.Valuesspec fields fields-           => [fields] -> S.Select fields-valuesSafe = values--{-# DEPRECATED valuesSafeExplicit "Use 'values' instead.  Will be removed in 0.10." #-}-valuesSafeExplicit :: V.Valuesspec fields fields'-                   -> [fields] -> S.Select fields'-valuesSafeExplicit = valuesExplicit