opaleye 0.5.4.0 → 0.6.0.0

raw patch · 24 files changed

+486/−286 lines, 24 filesdep −attoparsecdep ~aesondep ~product-profunctorsPVP ok

version bump matches the API change (PVP)

Dependencies removed: attoparsec

Dependency ranges changed: aeson, product-profunctors

API changes (from Hackage documentation)

Files

• CHANGELOG.md +38/−0
• Doc/Tutorial/TutorialAdvanced.lhs +3/−3
• Doc/Tutorial/TutorialBasic.lhs +25/−25
• Doc/Tutorial/TutorialBasicMonomorphic.lhs +46/−26
• Doc/Tutorial/TutorialBasicTypeFamilies.lhs +15/−30
• Doc/Tutorial/TutorialManipulation.lhs +18/−18
• opaleye.cabal +2/−4
• src/Opaleye/Column.hs +1/−2
• src/Opaleye/Internal/Binary.hs +3/−3
• src/Opaleye/Internal/Column.hs +2/−6
• src/Opaleye/Internal/Manipulation.hs +39/−0
• src/Opaleye/Internal/Operators.hs +5/−5
• src/Opaleye/Internal/PackMap.hs +7/−9
• src/Opaleye/Internal/RunQuery.hs +16/−1
• src/Opaleye/Internal/Table.hs +90/−32
• src/Opaleye/Internal/TableMaker.hs +9/−25
• src/Opaleye/Internal/Unpackspec.hs +6/−7
• src/Opaleye/Internal/Values.hs +1/−1
• src/Opaleye/Manipulation.hs +77/−38
• src/Opaleye/Operators.hs +19/−8
• src/Opaleye/PGTypes.hs +7/−6
• src/Opaleye/RunQuery.hs +2/−3
• src/Opaleye/Sql.hs +3/−2
• src/Opaleye/Table.hs +52/−32

@@ -1,3 +1,41 @@+## 0.6.0.0++* Added `runUpdateEasy`++* Deprecated++  * `Show` instance of `Column a`+  * `Manipulation.arrange...`+  * `showPGType`+  * `literalColumn`+  * `unsafePgFormatTime`+  * `prepareQuery`+  * `formatAndShowSQL`++* Removed++  * `unsafeCoerce`++* Added `TableColumn` and `tableColumn` which selects `optional` or+  `required` based on write type.++* Added `TableColumns` as synonym for `TableProperties`.+  `TableProperties` will be deprecated in version 0.7.++* Added `table` as synonym for `Table`.  `Table` will be deprecated in+  version 0.7.++* Added `tableWithSchema` as synonym for `TableWithSchema`.  `Table`+  will be deprecated in version 0.7.++* Replaced `ColumnMaker` with `Unpackspec`, which is identical to it.++* Added `Profunctor` instance for `Table`++* Added `restrictExists` and `restrictNotExists` as synonyms for+  `exists` and `notExists`.  The latter will be deprecated in version+  0.7.+ ## 0.5.4.0  * Added cursor interface (`Cursor` and friends)

@@ -6,7 +6,7 @@ > > import           Opaleye.QueryArr (Query) > import           Opaleye.Column (Column)-> import           Opaleye.Table (Table(Table), required, queryTable)+> import           Opaleye.Table (Table, table, tableColumn, queryTable) > import           Opaleye.PGTypes (PGText, PGInt4) > import qualified Opaleye.Aggregate as A > import           Opaleye.Aggregate (Aggregator, aggregate)@@ -40,8 +40,8 @@  > personTable :: Table (Column PGText, Column PGInt4) >                      (Column PGText, Column PGInt4)-> personTable = Table "personTable" (p2 ( required "name"->                                       , required "child_age" ))+> personTable = table "personTable" (p2 ( tableColumn "name"+>                                       , tableColumn "child_age" ))  > rangeOfChildrensAges :: Query (Column PGText, Column PGInt4) > rangeOfChildrensAges = aggregate (p2 (A.groupBy, range)) (queryTable personTable)

@@ -9,7 +9,7 @@ > import           Prelude hiding (sum) > > import           Opaleye (Column, Nullable, matchNullable, isNull,->                          Table(Table), required, queryTable,+>                          Table, table, tableColumn, queryTable, >                          Query, QueryArr, restrict, (.==), (.<=), (.&&), (.<), >                          (.===), >                          (.++), ifThenElse, pgString, aggregate, groupBy,@@ -61,13 +61,13 @@  > personTable :: Table (Column PGText, Column PGInt4, Column PGText) >                      (Column PGText, Column PGInt4, Column PGText)-> personTable = Table "personTable" (p3 ( required "name"->                                       , required "age"->                                       , required "address" ))+> personTable = table "personTable" (p3 ( tableColumn "name"+>                                       , tableColumn "age"+>                                       , tableColumn "address" ))  By default, the table `"personTable"` is looked up in PostgreSQL's default `"public"` schema. If we wanted to specify a different schema we-could have used the `TableWithSchema` constructor instead of `Table`.+could have used the `tableWithSchema` function instead of `table`.  To query a table we use `queryTable`. @@ -138,13 +138,13 @@ things out by hand here.  If you want to avoid Template Haskell see [Data.Profunctor.Product.TH](https://hackage.haskell.org/package/product-profunctors-0.6.3.1/docs/Data-Profunctor-Product-TH.html). -Then we can use 'Table' to make a table on our record type in exactly+Then we can use 'table' to make a table on our record type in exactly the same way as before.  > birthdayTable :: Table BirthdayColumn BirthdayColumn-> birthdayTable = Table "birthdayTable"->                        (pBirthday Birthday { bdName = required "name"->                                            , bdDay  = required "birthday" })+> birthdayTable = table "birthdayTable"+>                        (pBirthday Birthday { bdName = tableColumn "name"+>                                            , bdDay  = tableColumn "birthday" }) > > birthdayQuery :: Query BirthdayColumn > birthdayQuery = queryTable birthdayTable@@ -382,8 +382,8 @@  > employeeTable :: Table (Column PGText, Column (Nullable PGText)) >                        (Column PGText, Column (Nullable PGText))-> employeeTable = Table "employeeTable" (p2 ( required "name"->                                           , required "boss" ))+> employeeTable = table "employeeTable" (p2 ( tableColumn "name"+>                                           , tableColumn "boss" ))  We can write a query that returns as string indicating for each employee whether they have a boss.@@ -584,12 +584,12 @@ >                              (Column PGInt4) (Column PGFloat8)) >                      (Widget (Column PGText) (Column PGText) (Column PGText) >                              (Column PGInt4) (Column PGFloat8))-> widgetTable = Table "widgetTable"->                      (pWidget Widget { style    = required "style"->                                      , color    = required "color"->                                      , location = required "location"->                                      , quantity = required "quantity"->                                      , radius   = required "radius" })+> widgetTable = table "widgetTable"+>                      (pWidget Widget { style    = tableColumn "style"+>                                      , color    = tableColumn "color"+>                                      , location = tableColumn "location"+>                                      , quantity = tableColumn "quantity"+>                                      , radius   = tableColumn "radius" })   Say we want to group by the style and color of widgets, calculating@@ -752,10 +752,10 @@ >                                      (Column PGInt4) > > badWarehouseTable :: Table BadWarehouseColumn BadWarehouseColumn-> badWarehouseTable = Table "warehouse_table"->         (pWarehouse Warehouse { wId       = required "id"->                               , wLocation = required "location"->                               , wNumGoods = required "num_goods" })+> badWarehouseTable = table "warehouse_table"+>         (pWarehouse Warehouse { wId       = tableColumn "id"+>                               , wLocation = tableColumn "location"+>                               , wNumGoods = tableColumn "num_goods" })  but that would expose us to the following sorts of errors, where we can meaninglessly relate the warehouse ID with the quantity of goods@@ -776,10 +776,10 @@ >                                       (Column PGInt4) > > goodWarehouseTable :: Table GoodWarehouseColumn GoodWarehouseColumn-> goodWarehouseTable = Table "warehouse_table"->         (pWarehouse Warehouse { wId       = pWarehouseId (WarehouseId (required "id"))->                               , wLocation = required "location"->                               , wNumGoods = required "num_goods" })+> goodWarehouseTable = table "warehouse_table"+>         (pWarehouse Warehouse { wId       = pWarehouseId (WarehouseId (tableColumn "id"))+>                               , wLocation = tableColumn "location"+>                               , wNumGoods = tableColumn "num_goods" })  Now the comparison will not pass the type checker 

@@ -1,14 +1,14 @@ > {-# LANGUAGE FlexibleContexts #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE MultiParamTypeClasses #-}-> {-# LANGUAGE UndecidableInstances #-} > > module TutorialBasicMonomorphic where > > import           Prelude hiding (sum) > > import           Opaleye (Column, Nullable,->                          Table(Table), required, queryTable,+>                          Table, table, queryTable,+>                          tableColumn, >                          Query, (.==), >                          aggregate, groupBy, >                          count, avg, sum, leftJoin, runQuery,@@ -17,14 +17,13 @@ > > import qualified Opaleye                 as O >-> import           Control.Applicative     ((<$>), (<*>))+> import           Control.Applicative     (Applicative, (<$>), (<*>)) > > import qualified Data.Profunctor         as P > import           Data.Profunctor.Product (p3) > import           Data.Profunctor.Product.Default (Default) > import qualified Data.Profunctor.Product.Default as D > import           Data.Time.Calendar (Day)-> import qualified Opaleye.Internal.TableMaker > import qualified Opaleye.Internal.Join > > import qualified Database.PostgreSQL.Simple as PGS@@ -64,13 +63,19 @@  > personTable :: Table (Column PGText, Column PGInt4, Column PGText) >                      (Column PGText, Column PGInt4, Column PGText)-> personTable = Table "personTable" (p3 ( required "name"->                                       , required "age"->                                       , required "address" ))+> personTable = table "personTable" (p3 ( tableColumn "name"+>                                       , tableColumn "age"+>                                       , tableColumn "address" )) +> personTable' :: Table (Column PGText, Column PGInt4, Column PGText)+>                       (Column PGText, Column PGInt4, Column PGText)+> personTable' = table "personTable" (p3 ( tableColumn "name"+>                                        , tableColumn "age"+>                                        , tableColumn "address" ))+ By default, the table `"personTable"` is looked up in PostgreSQL's default `"public"` schema. If we wanted to specify a different schema we-could have used the `TableWithSchema` constructor instead of `Table`.+could have used the `tableWithSchema` constructor instead of `table`.  To query a table we use `queryTable`. @@ -132,21 +137,29 @@ > > data Birthday = Birthday { bdName :: String, bdDay :: Day } >-> instance Default Unpackspec BirthdayColumn BirthdayColumn where->   def = BirthdayColumn <$> P.lmap bdNameColumn D.def->                        <*> P.lmap bdDayColumn  D.def+> birthdayColumnDef ::+>   (Applicative (p BirthdayColumn),+>    P.Profunctor p,+>    Default p (Column PGText) (Column PGText),+>    Default p (Column PGDate) (Column PGDate)) =>+>   p BirthdayColumn BirthdayColumn+> birthdayColumnDef = BirthdayColumn <$> P.lmap bdNameColumn D.def+>                                    <*> P.lmap bdDayColumn  D.def >-> instance Default Opaleye.Internal.TableMaker.ColumnMaker BirthdayColumn BirthdayColumn where->   def = BirthdayColumn <$> P.lmap bdNameColumn D.def->                        <*> P.lmap bdDayColumn  D.def+> instance Default Unpackspec BirthdayColumn BirthdayColumn where+>   def = birthdayColumnDef -Then we can use 'Table' to make a table on our record type in exactly+Naturally this is all derivable using `Generic` or Template Haskell,+but no one's bothered to implement that yet.  Would you like to?++Then we can use 'table' to make a table on our record type in exactly the same way as before.  > birthdayTable :: Table BirthdayColumn BirthdayColumn-> birthdayTable = Table "birthdayTable"->                        (BirthdayColumn <$> P.lmap bdNameColumn (required "name")->                                        <*> P.lmap bdDayColumn  (required "birthday"))+> birthdayTable =+>   table "birthdayTable"+>   (BirthdayColumn <$> P.lmap bdNameColumn (tableColumn "name")+>                   <*> P.lmap bdDayColumn  (tableColumn "birthday")) > > birthdayQuery :: Query BirthdayColumn > birthdayQuery = queryTable birthdayTable@@ -186,7 +199,7 @@ >                                  , radius   :: Column PGFloat8 >                                  } >-> instance Default Opaleye.Internal.TableMaker.ColumnMaker WidgetColumn WidgetColumn where+> instance Default Unpackspec WidgetColumn WidgetColumn where >   def = WidgetColumn <$> P.lmap style    D.def >                      <*> P.lmap color    D.def >                      <*> P.lmap location D.def@@ -197,12 +210,12 @@ strings, but in practice they might have been a different data type.  > widgetTable :: Table WidgetColumn WidgetColumn-> widgetTable = Table "widgetTable"->                      (WidgetColumn <$> P.lmap style    (required "style")->                                    <*> P.lmap color    (required "color")->                                    <*> P.lmap location (required "location")->                                    <*> P.lmap quantity (required "quantity")->                                    <*> P.lmap radius   (required "radius"))+> widgetTable = table "widgetTable"+>                      (WidgetColumn <$> P.lmap style    (tableColumn "style")+>                                    <*> P.lmap color    (tableColumn "color")+>                                    <*> P.lmap location (tableColumn "location")+>                                    <*> P.lmap quantity (tableColumn "quantity")+>                                    <*> P.lmap radius   (tableColumn "radius"))   Say we want to group by the style and color of widgets, calculating@@ -284,13 +297,17 @@ >   def = BirthdayColumnNullable <$> P.lmap bdNameColumn D.def >                                <*> P.lmap bdDayColumn  D.def +Again, this is all derivable using `Generic` or Template Haskell, if+someone would take the time to implement it.+ A left join is expressed by specifying the two tables to join and the join condition.  > personBirthdayLeftJoin :: Query ((Column PGText, Column PGInt4, Column PGText), >                                  BirthdayColumnNullable) > personBirthdayLeftJoin = leftJoin personQuery birthdayQuery eqName->     where eqName ((name, _, _), birthdayRow) = name .== bdNameColumn birthdayRow+>     where eqName ((name, _, _), birthdayRow) =+>             name .== bdNameColumn birthdayRow  The generated SQL is @@ -373,6 +390,9 @@ >                  -> Query BirthdayColumn >                  -> IO [Birthday] > runBirthdayQuery = runQuery++Again, this is derivable using `Generic` or Template Haskell, if+someone would take the time to implement it.  Conclusion ==========

@@ -12,12 +12,11 @@ > import           Prelude hiding (sum) > > import           Opaleye (Column, Nullable,->                          Table(Table), required, queryTable,+>                          Table, table, tableColumn, queryTable, >                          Query, (.==), aggregate, groupBy, >                          count, avg, sum, leftJoin, runQuery, >                          showSqlForPostgres, Unpackspec, >                          PGInt4, PGInt8, PGText, PGDate, PGFloat8)-> import qualified Opaleye as O > > import           Control.Applicative     ((<$>), (<*>), Applicative) >@@ -64,13 +63,13 @@  > personTable :: Table (Column PGText, Column PGInt4, Column PGText) >                      (Column PGText, Column PGInt4, Column PGText)-> personTable = Table "personTable" (p3 ( required "name"->                                       , required "age"->                                       , required "address" ))+> personTable = table "personTable" (p3 ( tableColumn "name"+>                                       , tableColumn "age"+>                                       , tableColumn "address" ))  By default, the table `"personTable"` is looked up in PostgreSQL's default `"public"` schema. If we wanted to specify a different schema we-could have used the `TableWithSchema` constructor instead of `Table`.+could have used the `tableWithSchema` constructor instead of `table`.  To query a table we use `queryTable`. @@ -156,20 +155,6 @@ > -- could even have a symbol field containing the table name and use > -- https://hackage.haskell.org/package/base-4.8.2.0/docs/GHC-TypeLits.html#v:symbolVal > ->-> -- { If you use Tableable you don't even have to specify required or optional->      -> class Tableable a b | a -> b where->   tableField :: String -> O.TableProperties a b->-> instance Tableable (Column a) (Column a) where->   tableField = required->-> instance Tableable (Maybe (Column a)) (Column a) where->   tableField = O.optional->-> -- }-> > data Birthday f = Birthday { bdName :: TableField f String PGText NN Req >                            , bdDay  :: TableField f Day    PGDate NN Req >                            }@@ -182,13 +167,13 @@ >   def = Birthday <$> P.lmap bdName D.def >                  <*> P.lmap bdDay  D.def -Then we can use 'Table' to make a table on our record type in exactly+Then we can use 'table' to make a table on our record type in exactly the same way as before.  > birthdayTable :: Table (Birthday W) (Birthday O)-> birthdayTable = Table "birthdayTable"->                        (Birthday <$> P.lmap bdName (required "name")->                                  <*> P.lmap bdDay  (required "birthday"))+> birthdayTable = table "birthdayTable"+>                        (Birthday <$> P.lmap bdName (tableColumn "name")+>                                  <*> P.lmap bdDay  (tableColumn "birthday")) > > birthdayQuery :: Query (Birthday O) > birthdayQuery = queryTable birthdayTable@@ -245,12 +230,12 @@ strings, but in practice they might have been a different data type.  > widgetTable :: Table (Widget O) (Widget O)-> widgetTable = Table "widgetTable"->                      (Widget <$> P.lmap style    (required "style")->                              <*> P.lmap color    (required "color")->                              <*> P.lmap location (required "location")->                              <*> P.lmap quantity (required "quantity")->                              <*> P.lmap radius   (required "radius"))+> widgetTable = table "widgetTable"+>                      (Widget <$> P.lmap style    (tableColumn "style")+>                              <*> P.lmap color    (tableColumn "color")+>                              <*> P.lmap location (tableColumn "location")+>                              <*> P.lmap quantity (tableColumn "quantity")+>                              <*> P.lmap radius   (tableColumn "radius"))   Say we want to group by the style and color of widgets, calculating

@@ -2,8 +2,8 @@ > > import           Prelude hiding (sum) >-> import           Opaleye (Column, Table(Table),->                           required, optional, (.==), (.<),+> import           Opaleye (Column, Table, table,+>                           tableColumn, (.==), (.<), >                           arrangeDeleteSql, arrangeInsertManySql, >                           arrangeUpdateSql, arrangeInsertManyReturningSql, >                           PGInt4, PGFloat8)@@ -25,25 +25,25 @@ "id" column (assumed to be an auto-incrementing field) and two double-valued required fields.  The `Table` type constructor has two type arguments.  The first one is the type of writes to the table, and-the second is the type of reads from the table.  Notice that the "id"-column was defined as optional (for writes) so in the type of writes-it is wrapped in a Maybe.  That means we don't necessarily need to+the second is the type of reads from the table.  The "id"+column is defined as optional (for writes) because its write type is+`Maybe (Column PGInt4)`.  That means we don't necessarily need to specify it when writing to the table.  The database will automatically fill in a value for us. -> table :: Table+> myTable :: Table >     (Maybe (Column PGInt4), Column PGFloat8, Column PGFloat8, Column P.PGText) >     (Column PGInt4, Column PGFloat8, Column PGFloat8, Column P.PGText)-> table = Table "tablename" (p4 ( optional "id"->                               , required "x"->                               , required "y"->                               , required "s" ))+> myTable = table "tablename" (p4 ( tableColumn "id"+>                                 , tableColumn "x"+>                                 , tableColumn "y"+>                                 , tableColumn "s" ))  To perform a delete we provide an expression from our read type to `Column Bool`.  All rows for which the expression is true are deleted.  > delete :: String-> delete = arrangeDeleteSql table (\(_, x, y, _) -> x .< y)+> delete = arrangeDeleteSql myTable (\(_, x, y, _) -> x .< y)  ghci> putStrLn delete DELETE FROM tablename@@ -58,7 +58,7 @@ P.PGText` from a `String`.  > insertNothing :: String-> insertNothing = arrangeInsertManySql table (return (Nothing, 2, 3, P.pgString "Hello"))+> insertNothing = arrangeInsertManySql myTable (return (Nothing, 2, 3, P.pgString "Hello"))  ghci> putStrLn insertNothing INSERT INTO "tablename" ("id",@@ -76,7 +76,7 @@  > insertNonLiteral :: Double -> String > insertNonLiteral i =->   arrangeInsertManySql table (return (Nothing, 2, C.constant i, P.pgString "Hello"))+>   arrangeInsertManySql myTable (return (Nothing, 2, C.constant i, P.pgString "Hello"))  ghci> putStrLn $ insertNonLiteral 12.0 INSERT INTO "tablename" ("id",@@ -92,7 +92,7 @@ If we really want to specify an optional column we can use `Just`.  > insertJust :: String-> insertJust = arrangeInsertManySql table (return (Just 1, 2, 3, P.pgString "Hello"))+> insertJust = arrangeInsertManySql myTable (return (Just 1, 2, 3, P.pgString "Hello"))  ghci> putStrLn insertJust INSERT INTO "tablename" ("id",@@ -111,8 +111,8 @@ according to the update function.  > update :: String-> update = arrangeUpdateSql table (\(_, x, y, s) -> (Nothing, x + y, x - y, s))->                                 (\(id_, _, _, _) -> id_ .== 5)+> update = arrangeUpdateSql myTable (\(_, x, y, s) -> (Nothing, x + y, x - y, s))+>                                   (\(id_, _, _, _) -> id_ .== 5)  ghci> putStrLn update SET "id" = DEFAULT,@@ -129,8 +129,8 @@  > insertReturning :: String > insertReturning =->   arrangeInsertManyReturningSql def' table (return (Nothing, 4, 5, P.pgString "Bye"))->                                            (\(id_, _, _, _) -> id_)+>   arrangeInsertManyReturningSql def' myTable (return (Nothing, 4, 5, P.pgString "Bye"))+>                                              (\(id_, _, _, _) -> id_) >   -- TODO: vv This is too messy >   where def' :: U.Unpackspec (Column a) (Column a) >         def' = def

@@ -1,6 +1,6 @@ name:            opaleye copyright:       Copyright (c) 2014-2017 Purely Agile Limited-version:         0.5.4.0+version:         0.6.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@@ -28,10 +28,7 @@   default-language: Haskell2010   hs-source-dirs: src   build-depends:-      -- attoparsec can be removed once postgresql-simple patch in-      -- Internal.RunQuery is merged upstream       aeson               >= 0.6     && < 1.3-    , attoparsec          >= 0.10.3  && < 0.14     , base                >= 4.6     && < 5     , base16-bytestring   >= 0.1.1.6 && < 0.2     , case-insensitive    >= 1.2     && < 1.3@@ -73,6 +70,7 @@                    Opaleye.Internal.Helpers,                    Opaleye.Internal.Join,                    Opaleye.Internal.Label,+                   Opaleye.Internal.Manipulation,                    Opaleye.Internal.Order,                    Opaleye.Internal.Operators,                    Opaleye.Internal.Optimize,

@@ -16,13 +16,12 @@                        maybeToNullable,                        -- * Unsafe operations                        unsafeCast,-                       unsafeCoerce,                        unsafeCoerceColumn,                        unsafeCompositeField,                        -- * Entire module                        module Opaleye.Column)  where -import           Opaleye.Internal.Column (Column, Nullable, unsafeCoerce, unsafeCoerceColumn,+import           Opaleye.Internal.Column (Column, Nullable, unsafeCoerceColumn,                                           unsafeCast, unsafeCompositeField) import qualified Opaleye.Internal.Column as C import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ

@@ -2,7 +2,7 @@  module Opaleye.Internal.Binary where -import           Opaleye.Internal.Column (Column(Column))+import           Opaleye.Internal.Column (Column(Column), unColumn) import qualified Opaleye.Internal.Tag as T import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.QueryArr as Q@@ -33,8 +33,8 @@ runBinaryspec (Binaryspec b) = PM.traversePM b  binaryspecColumn :: Binaryspec (Column a) (Column a)-binaryspecColumn = Binaryspec (PM.PackMap (\f (Column e, Column e')-                                           -> fmap Column (f (e, e'))))+binaryspecColumn = Binaryspec (PM.iso (mapBoth unColumn) Column)+  where mapBoth f (s, t) = (f s, f t)  sameTypeBinOpHelper :: PQ.BinOp -> Binaryspec columns columns'                     -> Q.Query columns -> Q.Query columns -> Q.Query columns'

@@ -8,8 +8,8 @@ -- @PGInt4@ is an @int4@ column and a 'Column' @PGText@ is a @text@ -- column. ----- Do not use the 'Show' instance of 'Column'.  It will be deprecated--- in version 0.6.+-- Do not use the 'Show' instance of 'Column'.  It is considered+-- deprecated and will be removed in version 0.7. newtype Column pgType = Column HPQ.PrimExpr deriving Show  -- | Only used within a 'Column', to indicate that it can be @NULL@.@@ -19,10 +19,6 @@  unColumn :: Column a -> HPQ.PrimExpr unColumn (Column e) = e--{-# DEPRECATED unsafeCoerce "Will be removed in version 0.6.  Use unsafeCoerceColumn instead." #-}-unsafeCoerce :: Column a -> Column b-unsafeCoerce = unsafeCoerceColumn  -- | Treat a 'Column' as though it were of a different type.  If such -- a treatment is not valid then Postgres may fail with an error at

@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Opaleye.Internal.Manipulation where++import qualified Control.Applicative as A++import           Opaleye.Internal.Column (Column)+import           Data.Profunctor                 (Profunctor, dimap)+import qualified Data.Profunctor.Product         as PP+import qualified Data.Profunctor.Product.Default as D++newtype Updater a b = Updater (a -> b)++-- { Boilerplate instances++instance Functor (Updater a) where+  fmap f (Updater g) = Updater (fmap f g)++instance A.Applicative (Updater a) where+  pure = Updater . A.pure+  Updater f <*> Updater x = Updater (f A.<*> x)++instance Profunctor Updater where+  dimap f g (Updater h) = Updater (dimap f g h)++instance PP.ProductProfunctor Updater where+  empty  = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++--++instance D.Default Updater (Column a) (Column a) where+  def = Updater id++instance D.Default Updater (Column a) (Maybe (Column a)) where+  def = Updater Just+

@@ -9,9 +9,10 @@ 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.TableMaker as TM 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.PGTypes as T  import           Data.Profunctor (Profunctor, dimap, lmap, rmap)@@ -29,8 +30,7 @@ (.&&) :: Column T.PGBool -> Column T.PGBool -> Column T.PGBool (.&&) = C.binOp HPQ.OpAnd --- Probably should be newtype-data EqPP a b = EqPP (a -> a -> Column T.PGBool)+newtype EqPP a b = EqPP (a -> a -> Column T.PGBool)  eqExplicit :: EqPP columns a -> columns -> columns -> Column T.PGBool eqExplicit (EqPP f) = f@@ -56,11 +56,11 @@ data RelExprMaker a b =   forall c. RelExprMaker {       relExprVCM :: TM.ViewColumnMaker a c-    , relExprCM  :: TM.ColumnMaker c b+    , relExprCM  :: U.Unpackspec c b     }  relExprColumn :: RelExprMaker String (Column a)-relExprColumn = RelExprMaker TM.tableColumn TM.column+relExprColumn = RelExprMaker TM.tableColumn U.unpackspecColumn  instance D.Default RelExprMaker String (Column a) where   def = relExprColumn

@@ -40,7 +40,7 @@ -- 'ProductProfunctor') in @s@ and @t@.  It is unclear at this point -- whether we want the same @Traversal@ laws to hold or not.  Our use -- cases may be much more general.-data PackMap a b s t = PackMap (forall f. Applicative f => (a -> f b) -> s -> f t)+newtype PackMap a b s t = PackMap (forall f. Applicative f => (a -> f b) -> s -> f t)  -- | Replaces the targeted occurences of @a@ in @s@ with @b@ (changing -- the @s@ to a @t@ in the process).  This can be done via an@@ -114,6 +114,11 @@                -> f (Either b b') eitherFunction f g = fmap (either (fmap Left) (fmap Right)) (f PP.+++! g) +-- | Like 'Control.Lens.Iso.iso'.  In practice it won't actually be+-- used as an isomorphism, but it seems to be appropriate anyway.+iso :: (s -> a) -> (b -> t) -> PackMap a b s t+iso h g = PackMap (dimap h (fmap g))+ -- {  -- Boilerplate instance definitions.  There's no choice here apart@@ -134,13 +139,6 @@   (***!) = PP.defaultProfunctorProduct  instance PP.SumProfunctor (PackMap a b) where-  f +++! g =-    PackMap (\x ->-               case f of-                 PackMap f' ->-                   case g of-                     PackMap g' ->-                       eitherFunction (f' x)-                                      (g' x))+  PackMap f +++! PackMap g = PackMap (\x -> eitherFunction (f x) (g x))  -- }

@@ -36,7 +36,7 @@ import           Data.UUID (UUID) import           GHC.Int (Int32, Int64) --- { Only needed for annoying postgresql-simple patch below+-- { Only needed for postgresql-simple FieldParsers  import           Control.Applicative ((<$>)) import           Database.PostgreSQL.Simple.FromField@@ -52,6 +52,9 @@ -- @haskellType@.  For example a value of type 'QueryRunnerColumn' -- 'T.PGText' 'String' encodes how to turn a 'T.PGText' result from the -- database into a Haskell 'String'.+--+-- \"'QueryRunnerColumn' @pgType@ @haskellType@\" corresponds to+-- postgresql-simple's \"'FieldParser' @haskellType@\".  -- This is *not* a Product Profunctor because it is the only way I -- know of to get the instance generation to work for non-Nullable and@@ -71,6 +74,11 @@ --   into Haskell values (@haskells@).  Most likely you will never need --   to create on of these or handle one directly.  It will be provided --   for you by the 'D.Default' 'QueryRunner' instance.+--+-- \"'QueryRunner' @columns@ @haskells@\" corresponds to+-- postgresql-simple's \"'RowParser' @haskells@\".  \"'Default'+-- 'QueryRunner' @columns@ @haskells@\" corresponds to+-- postgresql-simple's \"@FromRow@ @haskells@\". data QueryRunner columns haskells =   QueryRunner (U.Unpackspec columns ())               (columns -> RowParser haskells)@@ -128,6 +136,9 @@ -- the default way to turn a @pgType@ result from the database into a -- Haskell value of type @haskellType@. --+-- \"'QueryRunnerColumnDefault' @pgType@ @haskellType@\" corresponds+-- to postgresql-simple's \"'FromField' @haskellType@\".+-- -- Creating an instance of 'QueryRunnerColumnDefault' for your own types is -- necessary for retrieving those types from the database. --@@ -265,6 +276,10 @@  -- typenames, not type Oids are used in order to avoid creating -- a dependency on 'Database.PostgreSQL.LibPQ'+--+-- Eventually we want to move this to postgresql-simple+--+--     https://github.com/tomjaguarpaw/haskell-opaleye/issues/329 jsonFieldTypeParser :: SBS.ByteString -> FieldParser String jsonFieldTypeParser jsonTypeName field mData = do     ti <- typeInfo field

@@ -1,11 +1,13 @@+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE Rank2Types #-}  module Opaleye.Internal.Table where -import           Opaleye.Internal.Column (Column, unColumn)-import qualified Opaleye.Internal.TableMaker as TM+import           Opaleye.Internal.Column (Column(Column), unColumn) import qualified Opaleye.Internal.Tag as Tag+import qualified Opaleye.Internal.Unpackspec as U import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.PackMap as PM @@ -38,34 +40,61 @@ --                              (Column PGInt4) (Column PGFloat8)) --                      (Widget (Column PGText) (Column PGText) (Column PGText) --                              (Column PGInt4) (Column PGFloat8))--- widgetTable = Table \"widgetTable\"---                      (pWidget Widget { wid      = optional \"id\"---                                      , color    = required \"color\"---                                      , location = required \"location\"---                                      , quantity = required \"quantity\"---                                      , radius   = required \"radius\" })+-- widgetTable = table \"widgetTable\"+--                      (pWidget Widget { wid      = tableColumn \"id\"+--                                      , color    = tableColumn \"color\"+--                                      , location = tableColumn \"location\"+--                                      , quantity = tableColumn \"quantity\"+--                                      , radius   = tableColumn \"radius\" }) -- @+--+-- The constructors of Table are internal only and will be+-- deprecated in version 0.7. data Table writerColumns viewColumns-  = Table String (TableProperties writerColumns viewColumns)-    -- ^ Uses the default schema name (@\"public\"@).-  | TableWithSchema String String (TableProperties writerColumns viewColumns)-    -- ^ Schema name (@\"public\"@ by default in PostgreSQL), table name,-    --   table properties.+  = Table String (TableColumns writerColumns viewColumns)+    -- ^ For unqualified table names. Do not use the constructor.  It+    -- is internal and will be deprecated in version 0.7.+  | TableWithSchema String String (TableColumns writerColumns viewColumns)+    -- ^ Schema name, table name, table properties.  Do not use the+    -- constructor.  It is internal and will be deprecated in version 0.7. -tableIdentifier :: Table writerColumns viewColumns -> PQ.TableIdentifier+tableIdentifier :: Table writeColumns viewColumns -> PQ.TableIdentifier tableIdentifier (Table t _) = PQ.TableIdentifier Nothing t tableIdentifier (TableWithSchema s t _) = PQ.TableIdentifier (Just s) t -tableProperties :: Table writerColumns viewColumns -> TableProperties writerColumns viewColumns-tableProperties (Table _ p) = p-tableProperties (TableWithSchema _ _ p) = p+tableColumns :: Table writeColumns viewColumns -> TableColumns writeColumns viewColumns+tableColumns (Table _ p) = p+tableColumns (TableWithSchema _ _ p) = p -data TableProperties writerColumns viewColumns = TableProperties-   { tablePropertiesWriter :: Writer writerColumns viewColumns+-- | Use 'tableColumns' instead.  Will be deprecated soon.+tableProperties :: Table writeColumns viewColumns -> TableColumns writeColumns viewColumns+tableProperties = tableColumns++-- | Use 'TableColumns' instead. 'TableProperties' will be deprecated+-- in version 0.7.+data TableProperties writeColumns viewColumns = TableProperties+   { tablePropertiesWriter :: Writer writeColumns viewColumns    , tablePropertiesView   :: View viewColumns } +-- | The new name for 'TableColumns' which will replace+-- 'TableColumn' in version 0.7.+type TableColumns = TableProperties++tableColumnsWriter :: TableColumns writeColumns viewColumns+                   -> Writer writeColumns viewColumns+tableColumnsWriter = tablePropertiesWriter++tableColumnsView :: TableColumns writeColumns viewColumns+                 -> View viewColumns+tableColumnsView = tablePropertiesView++-- | Internal only.  Do not use.  'View' will be deprecated in version+-- 0.7. data View columns = View columns +-- | Internal only.  Do not use.  'Writer' will be deprecated in+-- version 0.7.+ -- There's no reason the second parameter should exist except that we -- use ProductProfunctors more than ProductContravariants so it makes -- things easier if we make it one of the former.@@ -79,21 +108,47 @@   Writer (forall f. Functor f =>           PM.PackMap (f HPQ.PrimExpr, String) () (f columns) ()) -queryTable :: TM.ColumnMaker viewColumns columns-            -> Table writerColumns viewColumns+-- | 'required' is for columns which are not 'optional'.  You must+-- provide them on writes.+required :: String -> TableColumns (Column a) (Column a)+required columnName = TableProperties+  (requiredW columnName)+  (View (Column (HPQ.BaseTableAttrExpr columnName)))++-- | 'optional' is for columns that you can omit on writes, such as+--  columns which have defaults or which are SERIAL.+optional :: String -> TableColumns (Maybe (Column a)) (Column a)+optional columnName = TableProperties+  (optionalW columnName)+  (View (Column (HPQ.BaseTableAttrExpr columnName)))++class TableColumn a b | a -> b where+    -- | Create either a 'required' or 'optional' column depending on+    -- the write type.  It's generally more convenient to use this+    -- than 'required' or 'optional'.+    tableColumn :: String -> TableColumns a (Column b)++instance TableColumn (Column a) a where+    tableColumn = required++instance TableColumn (Maybe (Column a)) a where+    tableColumn = optional++queryTable :: U.Unpackspec viewColumns columns+            -> Table writeColumns viewColumns             -> Tag.Tag             -> (columns, PQ.PrimQuery) queryTable cm table tag = (primExprs, primQ) where-  View tableCols = tablePropertiesView (tableProperties table)+  View tableCols = tableColumnsView (tableColumns table)   (primExprs, projcols) = runColumnMaker cm tag tableCols   primQ :: PQ.PrimQuery   primQ = PQ.BaseTable (tableIdentifier table) projcols -runColumnMaker :: TM.ColumnMaker tablecolumns columns+runColumnMaker :: U.Unpackspec tablecolumns columns                   -> Tag.Tag                   -> tablecolumns                   -> (columns, [(HPQ.Symbol, HPQ.PrimExpr)])-runColumnMaker cm tag tableCols = PM.run (TM.runColumnMaker cm f tableCols) where+runColumnMaker cm tag tableCols = PM.run (U.runUnpackspec cm f tableCols) where   f = PM.extractAttrPE mkName tag   -- The non-AttrExpr PrimExprs are not created by 'makeView' or a   -- 'ViewColumnMaker' so could only arise from an fmap (if we@@ -127,15 +182,14 @@     where mempty' = [] `NEL.cons` mempty'   Zip xs `mappend` Zip ys = Zip (NEL.zipWith (++) xs ys) -required :: String -> Writer (Column a) (Column a)-required columnName =-  Writer (PM.PackMap (\f columns -> f (fmap unColumn columns, columnName)))+requiredW :: String -> Writer (Column a) (Column a)+requiredW columnName =+  Writer (PM.iso (flip (,) columnName . fmap unColumn) id) -optional :: String -> Writer (Maybe (Column a)) (Column a)-optional columnName =-  Writer (PM.PackMap (\f columns -> f (fmap maybeUnColumn columns, columnName)))-  where maybeUnColumn Nothing = HPQ.DefaultInsertExpr-        maybeUnColumn (Just column) = unColumn column+optionalW :: String -> Writer (Maybe (Column a)) (Column a)+optionalW columnName =+  Writer (PM.iso (flip (,) columnName . fmap maybeUnColumn) id)+  where maybeUnColumn = maybe HPQ.DefaultInsertExpr unColumn  -- { @@ -173,5 +227,9 @@ instance Functor (Table a) where   fmap f (Table t tp) = Table t (fmap f tp)   fmap f (TableWithSchema s t tp) = TableWithSchema s t (fmap f tp)++instance Profunctor Table where+  dimap f g (Table t tp) = Table t (dimap f g tp)+  dimap f g (TableWithSchema s t tp) = TableWithSchema s t (dimap f g tp)  -- }

@@ -5,6 +5,7 @@ import qualified Opaleye.Column as C 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, empty, (***!))@@ -21,18 +22,19 @@ newtype ViewColumnMaker strings columns =   ViewColumnMaker (PM.PackMap () () strings columns) -newtype ColumnMaker columns columns' =-  ColumnMaker (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr columns 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 (ColumnMaker f) = PM.traversePM f+runColumnMaker = U.runUnpackspec  -- There's surely a way of simplifying this implementation tableColumn :: ViewColumnMaker String (C.Column a)@@ -40,16 +42,12 @@               (PM.PackMap (\f s -> fmap (const (mkColumn s)) (f ())))   where mkColumn = IC.Column . HPQ.BaseTableAttrExpr -column :: ColumnMaker (C.Column a) (C.Column a)-column = ColumnMaker-         (PM.PackMap (\f (IC.Column s)-                      -> fmap IC.Column (f s)))- instance Default ViewColumnMaker String (C.Column a) where   def = tableColumn -instance Default ColumnMaker (C.Column a) (C.Column a) where-  def = column+{-# DEPRECATED column "Use unpackspecColumn instead" #-}+column :: ColumnMaker (C.Column a) (C.Column a)+column = U.unpackspecColumn  -- { @@ -66,20 +64,6 @@   dimap f g (ViewColumnMaker q) = ViewColumnMaker (dimap f g q)  instance ProductProfunctor ViewColumnMaker where-  empty = PP.defaultEmpty-  (***!) = PP.defaultProfunctorProduct--instance Functor (ColumnMaker a) where-  fmap f (ColumnMaker g) = ColumnMaker (fmap f g)--instance Applicative (ColumnMaker a) where-  pure = ColumnMaker . pure-  ColumnMaker f <*> ColumnMaker x = ColumnMaker (f <*> x)--instance Profunctor ColumnMaker where-  dimap f g (ColumnMaker q) = ColumnMaker (dimap f g q)--instance ProductProfunctor ColumnMaker where   empty = PP.defaultEmpty   (***!) = PP.defaultProfunctorProduct 

@@ -28,17 +28,16 @@   -- the @makeAdaptorAndInstance@ splice from   -- @Data.Profunctor.Product.TH@ has been run).   ---  -- You can create 'Unpackspec's by hand using 'unpackspecColumn' and-  -- the 'Profunctor', 'ProductProfunctor' and 'SumProfunctor'-  -- operations.  However, in practice users should almost never need-  -- to create or manipulate them.  Typically they will be created-  -- automatically by the 'D.Default' instance.+  -- Users should almost never need to create or manipulate+  -- `Unpackspec`s.  Typically they will be created automatically by+  -- the 'D.Default' instance.  If you really need to you can create+  -- 'Unpackspec's by hand using 'unpackspecColumn' and the+  -- 'Profunctor', 'ProductProfunctor' and 'SumProfunctor' operations.   Unpackspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr columns columns')  -- | Target the single 'HPQ.PrimExpr' inside a 'C.Column' unpackspecColumn :: Unpackspec (C.Column a) (C.Column a)-unpackspecColumn = Unpackspec-                   (PM.PackMap (\f (IC.Column pe) -> fmap IC.Column (f pe)))+unpackspecColumn = Unpackspec (PM.iso IC.unColumn IC.Column)  -- | Modify all the targeted 'HPQ.PrimExpr's runUnpackspec :: Applicative f

@@ -60,7 +60,7 @@ runValuesspec (Valuesspec v) f = PM.traversePM v f ()  instance Default Valuesspec (Column a) (Column a) where-  def = Valuesspec (PM.PackMap (\f () -> fmap Column (f ())))+  def = Valuesspec (PM.iso id Column)  -- { 

@@ -1,4 +1,6 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}  -- | Inserts, updates and deletes --@@ -30,6 +32,7 @@ import qualified Opaleye.Internal.Table as TI import           Opaleye.Internal.Column (Column(Column)) import           Opaleye.Internal.Helpers ((.:), (.:.), (.::), (.::.))+import           Opaleye.Internal.Manipulation (Updater(Updater)) import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.Unpackspec as U import           Opaleye.PGTypes (PGBool)@@ -84,6 +87,28 @@  -- | Update rows in a table. --+-- (N.B. 'runUpdateEasy''s \"returning\" counterpart+-- \"@runUpdateEasyReturning@\" hasn't been implemented.  File an+-- issue if you want it!)+runUpdateEasy :: D.Default Updater columnsR columnsW+              => PGS.Connection+              -> T.Table columnsW columnsR+              -- ^ Table to update+              -> (columnsR -> columnsR)+              -- ^ Update function to apply to chosen rows+              -> (columnsR -> Column PGBool)+              -- ^ Predicate function @f@ to choose which rows to update.+              -- 'runUpdate' will update rows for which @f@ returns @TRUE@+              -- and leave unchanged rows for which @f@ returns @FALSE@.+              -> IO Int64+              -- ^ The number of rows updated+runUpdateEasy conn table u = runUpdate conn table (u' . u)+  where Updater u' = D.def++-- | Update rows in a table.  You'll probably find it more convenient+-- to use 'runUpdateEasy' (although 'runUpdate' provides more+-- fine-grained control if you need it).+-- -- Be careful: providing 'Nothing' to a column created by @optional@ -- updates the column to its default value.  Many users have been -- confused by this because they assume it means that the column is to@@ -177,7 +202,7 @@                         (arrangeInsertManyReturningSql u t columns' r))   where IRQ.QueryRunner u _ _ = qr         parser = IRQ.prepareRowParser qr (r v)-        TI.Table _ (TI.TableProperties _ (TI.View v)) = t+        TI.View v = TI.tableColumnsView (TI.tableColumns t)         -- This method of getting hold of the return type feels a bit         -- suspect.  I haven't checked it for validity. @@ -197,14 +222,15 @@                  (fromString (arrangeUpdateReturningSql u t update cond r))   where IRQ.QueryRunner u _ _ = qr         parser = IRQ.prepareRowParser qr (r v)-        TI.Table _ (TI.TableProperties _ (TI.View v)) = t+        TI.View v = TI.tableColumnsView (TI.tableColumns t)  -- * Deprecated versions  -- | Returns the number of rows inserted------ This will be deprecated in version 0.6.  Use 'runInsertMany'--- instead.++{-# DEPRECATED runInsert+    "'runInsert' will be removed in version 0.7. \+    \Use 'runInsertMany' instead." #-} runInsert :: PGS.Connection -> T.Table columns columns' -> columns -> IO Int64 runInsert conn = PGS.execute_ conn . fromString .: arrangeInsertSql @@ -212,9 +238,10 @@ -- compiler will have trouble inferring types.  It is strongly -- recommended that you provide full type signatures when using -- @runInsertReturning@.------ This will be deprecated in version 0.6.  Use--- 'runInsertManyReturning' instead.++{-# DEPRECATED runInsertReturning+    "'runInsertReturning' will be removed in version 0.7. \+    \Use 'runInsertManyReturning' instead." #-} runInsertReturning :: (D.Default RQ.QueryRunner columnsReturned haskells)                    => PGS.Connection                    -> T.Table columnsW columnsR@@ -223,33 +250,38 @@                    -> IO [haskells] runInsertReturning = runInsertReturningExplicit D.def --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeInsert+    "You probably want 'runInsertMany' instead. \+    \Will be removed in version 0.7." #-} arrangeInsert :: T.Table columns a -> columns -> HSql.SqlInsert arrangeInsert t c = arrangeInsertMany t (return c) --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeInsertSql+    "You probably want 'runInsertMany' instead. \+    \Will be removed in version 0.7." #-} arrangeInsertSql :: T.Table columns a -> columns -> String arrangeInsertSql = show . HPrint.ppInsert .: arrangeInsert --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeInsertMany+    "You probably want 'runInsertMany' instead. \+    \Will be removed in version 0.7." #-} arrangeInsertMany :: T.Table columns a -> NEL.NonEmpty columns -> HSql.SqlInsert arrangeInsertMany table columns = insert-  where writer = TI.tablePropertiesWriter (TI.tableProperties table)+  where writer = TI.tableColumnsWriter (TI.tableColumns table)         (columnExprs, columnNames) = TI.runWriter' writer columns         insert = SG.sqlInsert SD.defaultSqlGenerator                       (PQ.tiToSqlTable (TI.tableIdentifier table))                       columnNames columnExprs --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeInsertManySql+    "You probably want 'runInsertMany' instead. \+    \Will be removed in version 0.7." #-} arrangeInsertManySql :: T.Table columns a -> NEL.NonEmpty columns -> String arrangeInsertManySql = show . HPrint.ppInsert .: arrangeInsertMany --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeUpdate+    "You probably want 'runUpdate' instead. \+    \Will be removed in version 0.7." #-} arrangeUpdate :: T.Table columnsW columnsR               -> (columnsR -> columnsW) -> (columnsR -> Column PGBool)               -> HSql.SqlUpdate@@ -257,32 +289,36 @@   SG.sqlUpdate SD.defaultSqlGenerator                (PQ.tiToSqlTable (TI.tableIdentifier table))                [condExpr] (update' tableCols)-  where TI.TableProperties writer (TI.View tableCols) = TI.tableProperties table+  where TI.TableProperties writer (TI.View tableCols) = TI.tableColumns table         update' = map (\(x, y) -> (y, x)) . TI.runWriter writer . update         Column condExpr = cond tableCols --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeUpdateSql+    "You probably want 'runUpdate' instead. \+    \Will be removed in version 0.7." #-} arrangeUpdateSql :: T.Table columnsW columnsR               -> (columnsR -> columnsW) -> (columnsR -> Column PGBool)               -> String arrangeUpdateSql = show . HPrint.ppUpdate .:. arrangeUpdate --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeDelete+    "You probably want 'runDelete' instead. \+    \Will be removed in version 0.7." #-} arrangeDelete :: T.Table a columnsR -> (columnsR -> Column PGBool) -> HSql.SqlDelete arrangeDelete table cond =   SG.sqlDelete SD.defaultSqlGenerator (PQ.tiToSqlTable (TI.tableIdentifier table)) [condExpr]   where Column condExpr = cond tableCols-        TI.View tableCols = TI.tablePropertiesView (TI.tableProperties table)+        TI.View tableCols = TI.tableColumnsView (TI.tableColumns table) --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeDeleteSql+    "You probably want 'runDelete' instead. \+    \Will be removed in version 0.7." #-} arrangeDeleteSql :: T.Table a columnsR -> (columnsR -> Column PGBool) -> String arrangeDeleteSql = show . HPrint.ppDelete .: arrangeDelete --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeInsertManyReturning+    "You probably want 'runInsertMany' instead. \+    \Will be removed in version 0.7." #-} arrangeInsertManyReturning :: U.Unpackspec columnsReturned ignored                            -> T.Table columnsW columnsR                            -> NEL.NonEmpty columnsW@@ -291,12 +327,13 @@ arrangeInsertManyReturning unpackspec table columns returningf =   Sql.Returning insert returningSEs   where insert = arrangeInsertMany table columns-        TI.View columnsR = TI.tablePropertiesView (TI.tableProperties table)+        TI.View columnsR = TI.tableColumnsView (TI.tableColumns table)         returningPEs = U.collectPEs unpackspec (returningf columnsR)         returningSEs = Sql.ensureColumnsGen id (map Sql.sqlExpr returningPEs) --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeInsertManyReturningSql+    "You probably want 'runInsertManyReturning' instead. \+    \Will be removed in version 0.7." #-} arrangeInsertManyReturningSql :: U.Unpackspec columnsReturned ignored                               -> T.Table columnsW columnsR                               -> NEL.NonEmpty columnsW@@ -305,8 +342,9 @@ arrangeInsertManyReturningSql =   show . Print.ppInsertReturning .:: arrangeInsertManyReturning --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeUpdateReturning+    "You probably want 'runUpdateReturning' instead. \+    \Will be removed in version 0.7." #-} arrangeUpdateReturning :: U.Unpackspec columnsReturned ignored                        -> T.Table columnsW columnsR                        -> (columnsR -> columnsW)@@ -316,12 +354,13 @@ arrangeUpdateReturning unpackspec table updatef cond returningf =   Sql.Returning update returningSEs   where update = arrangeUpdate table updatef cond-        TI.View columnsR = TI.tablePropertiesView (TI.tableProperties table)+        TI.View columnsR = TI.tableColumnsView (TI.tableColumns table)         returningPEs = U.collectPEs unpackspec (returningf columnsR)         returningSEs = Sql.ensureColumnsGen id (map Sql.sqlExpr returningPEs) --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED arrangeUpdateReturningSql+    "You probably want 'runUpdateReturning' instead. \+    \Will be removed in version 0.7." #-} arrangeUpdateReturningSql :: U.Unpackspec columnsReturned ignored                           -> T.Table columnsW columnsR                           -> (columnsR -> columnsW)

@@ -37,15 +37,15 @@ restrict = QueryArr f where   f (Column predicate, primQ, t0) = ((), PQ.restrict predicate primQ, t0) -{-| Add a @WHERE EXSITS@ clause to the current query. -}-exists :: QueryArr a b -> QueryArr a ()-exists criteria = QueryArr f where+{-| Add a @WHERE EXISTS@ clause to the current query. -}+restrictExists :: QueryArr a b -> QueryArr a ()+restrictExists criteria = QueryArr f where   f (a, primQ, t0) = ((), PQ.exists primQ existsQ, t1) where     (_, existsQ, t1) = runSimpleQueryArr criteria (a, t0) -{-| Add a @WHERE EXSITS@ clause to the current query. -}-notExists :: QueryArr a b -> QueryArr a ()-notExists criteria = QueryArr f where+{-| Add a @WHERE NOT EXISTS@ clause to the current query. -}+restrictNotExists :: QueryArr a b -> QueryArr a ()+restrictNotExists criteria = QueryArr f where   f (a, primQ, t0) = ((), PQ.notExists primQ existsQ, t1) where     (_, existsQ, t1) = runSimpleQueryArr criteria (a, t0) @@ -317,8 +317,9 @@                       -> Column T.PGTimestamp timestamptzAtTimeZone = C.binOp HPQ.OpAtTimeZone --- | Do not use.  Will be deprecated in version 0.6.  Use--- 'C.unsafeCast' instead.+{-# DEPRECATED doubleOfInt+    "Use 'C.unsafeCast' instead. \+    \Will be removed in version 0.7." #-} doubleOfInt :: Column T.PGInt4 -> Column T.PGFloat8 doubleOfInt (Column e) = Column (HPQ.CastExpr "float8" e) @@ -344,3 +345,13 @@ infix 4 .-|- (.-|-) :: Column (T.PGRange a) -> Column (T.PGRange a) -> Column T.PGBool (.-|-) = C.binOp (HPQ.:-|-)++-- * Deprecated++-- | Identical to 'restrictExists'.  Will be deprecated in version 0.7.+exists :: QueryArr a b -> QueryArr a ()+exists = restrictExists++-- | Identical to 'restrictNoExists'.  Will be deprecated in version 0.7.+notExists :: QueryArr a b -> QueryArr a ()+notExists = restrictNotExists

@@ -149,9 +149,10 @@         oneEl R.NegInfinity   = HPQ.NegInfinity         oneEl R.PosInfinity   = HPQ.PosInfinity +{-# DEPRECATED showPGType+    "Use 'showSqlType' instead. 'showSqlType' will be deprecated \+    \in version 0.7." #-} class IsSqlType pgType where-  -- | 'showSqlType' will be deprecated in version 0.6.  Use-  -- 'showSqlType' instead.   showPGType :: proxy pgType -> String   showPGType  = showSqlType @@ -246,12 +247,12 @@  literalColumn :: HPQ.Literal -> Column a literalColumn = IPT.literalColumn-{-# WARNING literalColumn-    "'literalColumn' has been moved to Opaleye.Internal.PGTypes and will be deprecated in version 0.6"+{-# DEPRECATED literalColumn+    "'literalColumn' has been moved to Opaleye.Internal.PGTypes and will be removed in version 0.7."   #-}  unsafePgFormatTime :: Time.FormatTime t => HPQ.Name -> String -> t -> Column c unsafePgFormatTime = IPT.unsafePgFormatTime-{-# WARNING unsafePgFormatTime-    "'unsafePgFormatTime' has been moved to Opaleye.Internal.PGTypes and will be deprecated in version 0.6"+{-# DEPRECATED unsafePgFormatTime+    "'unsafePgFormatTime' has been moved to Opaleye.Internal.PGTypes and will be removed in version 0.7."   #-}

@@ -6,7 +6,7 @@                          QueryRunner,                          IRQ.QueryRunnerColumn,                          IRQ.QueryRunnerColumnDefault (..),-                         -- * Creating now 'QueryRunnerColumn's+                         -- * Creating new 'QueryRunnerColumn's                          IRQ.fieldQueryRunnerColumn,                          IRQ.fieldParserQueryRunnerColumn) where @@ -157,8 +157,7 @@  -- * Deprecated functions --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED prepareQuery "Will be removed in version 0.7" #-} prepareQuery :: QueryRunner columns haskells -> Query columns -> (Maybe PGS.Query, FR.RowParser haskells) prepareQuery qr@(QueryRunner u _ _) q = (sql, parser)   where sql :: Maybe PGS.Query

@@ -77,8 +77,9 @@ showSqlForPostgresUnoptExplicit :: U.Unpackspec columns b -> Q.Query columns -> Maybe String showSqlForPostgresUnoptExplicit = showSqlUnoptExplicit --- | For internal use only.  Do not use.  Will be deprecated in--- version 0.6.+{-# DEPRECATED formatAndShowSQL+    "You probably want 'showSqlExplicit' or 'showSqlUnoptExplicit' instead. \+    \Will be removed in version 0.7." #-} formatAndShowSQL :: ([HPQ.PrimExpr], PQ.PrimQuery' a, T.Tag) -> Maybe String formatAndShowSQL = fmap (show . Pr.ppSql . Sql.sql) . traverse2Of3 Op.removeEmpty   where -- Just a lens

@@ -1,5 +1,8 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} + {- |   Columns can be required or optional and, independently, nullable or@@ -9,7 +12,7 @@  'required' and gives rise to a   @- TableProperties (Column PGInt4) (Column PGInt4)+ TableColumns (Column PGInt4) (Column PGInt4)  @   The leftmost argument is the type of writes. When you insert or@@ -20,7 +23,7 @@  to a   @- TableProperties (Column (Nullable PGInt4)) (Column (Nullable PGInt4))+ TableColumns (Column (Nullable PGInt4)) (Column (Nullable PGInt4))  @   When you insert or update into this column you must give it a @Column@@ -28,25 +31,29 @@  @toNullable :: Column a -> Column (Nullable a)@, or with @null ::  Column (Nullable a)@. - An optional non-nullable @PGInt4@ is created with optional and gives+ An optional non-nullable @PGInt4@ is created with 'optional' and gives  rise to a   @- TableProperties (Maybe (Column PGInt4)) (Column PGInt4)+ TableColumns (Maybe (Column PGInt4)) (Column PGInt4)  @ + Optional columns are those that can be omitted on writes, such as+ those that have @DEFAULT@s or those that are @SERIAL@.  When you insert or update into this column you must give it a @Maybe  (Column PGInt4)@. If you provide @Nothing@ then the column will be  omitted from the query and the default value will be used. Otherwise  you have to provide a @Just@ containing a @Column PGInt4@. - An optional non-nullable @PGInt4@ is created with optional and gives+ An optional nullable @PGInt4@ is created with 'optional' and gives  rise to a   @- TableProperties (Maybe (Column (Nullable PGInt4))) (Column PGInt4)+ TableColumns (Maybe (Column (Nullable PGInt4))) (Column (Nullable PGInt4))  @ + Optional columns are those that can be omitted on writes, such as+ those that have @DEFAULT@s or those that are @SERIAL@.  When you insert or update into this column you must give it a @Maybe  (Column (Nullable PGInt4))@. If you provide @Nothing@ then the default  value will be used. Otherwise you have to provide a @Just@ containing@@ -54,59 +61,72 @@  -} -module Opaleye.Table (module Opaleye.Table,+module Opaleye.Table (-- * Creating tables+                      table,+                      tableWithSchema,+                      T.Table,+                      T.tableColumn,+                      T.optional,+                      T.required,+                      -- * Querying tables+                      queryTable,                       -- * Other+                      TableColumns,+                      -- * Deprecated                       View,                       Writer,                       T.Table(T.Table, T.TableWithSchema),-                      TableProperties) where+                      -- * Module reexport+                      module Opaleye.Table) where -import           Opaleye.Internal.Column (Column(Column)) import qualified Opaleye.Internal.QueryArr as Q import qualified Opaleye.Internal.Table as T-import           Opaleye.Internal.Table (View(View), Table, Writer,-                                         TableProperties)-import qualified Opaleye.Internal.TableMaker as TM+import           Opaleye.Internal.Table (View, Table, Writer,+                                         TableColumns)+ import qualified Opaleye.Internal.Tag as Tag+import qualified Opaleye.Internal.Unpackspec as U  import qualified Data.Profunctor.Product.Default as D -import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ- -- | Example type specialization: -- -- @--- queryTable :: Table w (Column a, Column b) -> Query (Column a, Column b)+-- queryTable :: Table w (Column a, Column b)+--            -> Query (Column a, Column b) -- @ -- -- Assuming the @makeAdaptorAndInstance@ splice has been run for the -- product type @Foo@: -- -- @--- queryTable :: Table w (Foo (Column a) (Column b) (Column c)) -> Query (Foo (Column a) (Column b) (Column c))+-- queryTable :: Table w (Foo (Column a) (Column b) (Column c))+--            -> Query (Foo (Column a) (Column b) (Column c)) -- @-queryTable :: D.Default TM.ColumnMaker columns columns =>+queryTable :: D.Default U.Unpackspec columns columns =>               Table a columns -> Q.Query columns queryTable = queryTableExplicit D.def --- | 'required' is for columns which are not 'optional'.  You must--- provide them on writes.-required :: String -> TableProperties (Column a) (Column a)-required columnName = T.TableProperties-  (T.required columnName)-  (View (Column (HPQ.BaseTableAttrExpr columnName)))+-- | Create a table with unqualified names.+table :: String+      -- ^ Table name+      -> TableColumns writeColumns viewColumns+      -> Table writeColumns viewColumns+table = T.Table --- | 'optional' is for columns that you can omit on writes, such as---  columns which have defaults or which are SERIAL.-optional :: String -> TableProperties (Maybe (Column a)) (Column a)-optional columnName = T.TableProperties-  (T.optional columnName)-  (View (Column (HPQ.BaseTableAttrExpr columnName)))+-- | Create a table.+tableWithSchema :: String+                -- ^ Schema name+                -> String+                -- ^ Table name+                -> TableColumns writeColumns viewColumns+                -> Table writeColumns viewColumns+tableWithSchema = T.TableWithSchema  -- * Explicit versions -queryTableExplicit :: TM.ColumnMaker tablecolumns columns ->+queryTableExplicit :: U.Unpackspec tablecolumns columns ->                      Table a tablecolumns -> Q.Query columns-queryTableExplicit cm table = Q.simpleQueryArr f where+queryTableExplicit cm table' = Q.simpleQueryArr f where   f ((), t0) = (retwires, primQ, Tag.next t0) where-    (retwires, primQ) = T.queryTable cm table t0+    (retwires, primQ) = T.queryTable cm table' t0