opaleye 0.4.1.0 → 0.4.2.0

raw patch · 21 files changed

+324/−139 lines, 21 filesdep +aesondep ~basedep ~contravariantdep ~product-profunctorsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: aeson

Dependency ranges changed: base, contravariant, product-profunctors, profunctors, semigroups, time, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Doc/Tutorial/TutorialBasic.lhs +4/−0
• README.md +7/−2
• Test/Test.hs +5/−5
• opaleye.cabal +6/−4
• src/Opaleye/Constant.hs +7/−0
• src/Opaleye/Internal/Column.hs +2/−3
• src/Opaleye/Internal/HaskellDB/Sql.hs +4/−1
• src/Opaleye/Internal/HaskellDB/Sql/Default.hs +8/−8
• src/Opaleye/Internal/HaskellDB/Sql/Generate.hs +3/−3
• src/Opaleye/Internal/HaskellDB/Sql/Print.hs +7/−3
• src/Opaleye/Internal/Operators.hs +42/−0
• src/Opaleye/Internal/PrimQuery.hs +14/−3
• src/Opaleye/Internal/RunQuery.hs +7/−0
• src/Opaleye/Internal/Sql.hs +3/−5
• src/Opaleye/Internal/Table.hs +21/−7
• src/Opaleye/Manipulation.hs +127/−85
• src/Opaleye/Operators.hs +41/−9
• src/Opaleye/Order.hs +1/−0
• src/Opaleye/PGTypes.hs +7/−0
• src/Opaleye/Table.hs +1/−1

@@ -1,3 +1,10 @@+## 0.4.2.0++* Added `.===` and `./==` for comparison of product types+* Added `keepWhen` as an alternative to `restrict`+* Added `constant` conversion to and from Aeson+* Added `pgValueJSON` and `pgValueJSONB`+ ## 0.4.1.0  * Added `Opaleye.Constant` for lifting constant values

@@ -64,6 +64,10 @@ >                                       , required "age" >                                       , required "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`.+ To query a table we use `queryTable`.  (Here and in a few other places in Opaleye there is some typeclass

@@ -20,12 +20,17 @@ composable at a very fine level of granularity, promoting code reuse and high levels of abstraction. +## Getting Opaleye++* Github: https://github.com/tomjaguarpaw/haskell-opaleye+* Hackage: https://hackage.haskell.org/package/opaleye+ ## Tutorials  Please get started with Opaleye by referring to these two tutorials -* [Basic tutorial](Doc/Tutorial/TutorialBasic.lhs)-* [Manipulation tutorial](Doc/Tutorial/TutorialManipulation.lhs)+* [Basic tutorial](https://github.com/tomjaguarpaw/haskell-opaleye/blob/master/Doc/Tutorial/TutorialBasic.lhs)+* [Manipulation tutorial](https://github.com/tomjaguarpaw/haskell-opaleye/blob/master/Doc/Tutorial/TutorialManipulation.lhs)  # Contact 

@@ -137,7 +137,7 @@  table5 :: O.Table (Maybe (Column O.PGInt4), Maybe (Column  O.PGInt4))                   (Column O.PGInt4, Column O.PGInt4)-table5 = O.Table "table5" (PP.p2 (O.optional "column1", O.optional "column2"))+table5 = O.TableWithSchema "public" "table5" (PP.p2 (O.optional "column1", O.optional "column2"))  table6 :: O.Table (Column O.PGText, Column O.PGText) (Column O.PGText, Column O.PGText) table6 = O.Table "table6" (PP.p2 (O.required "column1", O.required "column2"))@@ -209,8 +209,8 @@ -- table names are treated as lower case unless the name is quoted! dropAndCreateTable :: String -> (String, [String]) -> PGS.Query dropAndCreateTable columnType (t, cols) = String.fromString drop_-  where drop_ = "DROP TABLE IF EXISTS \"" ++ t ++ "\";"-                ++ "CREATE TABLE \"" ++ t ++ "\""+  where drop_ = "DROP TABLE IF EXISTS \"public\".\"" ++ t ++ "\";"+                ++ "CREATE TABLE \"public\".\"" ++ t ++ "\""                 ++ " (" ++ commas cols ++ ");"         integer c = ("\"" ++ c ++ "\"" ++ " " ++ columnType)         commas = L.intercalate "," . map integer@@ -225,8 +225,8 @@ -- table names are treated as lower case unless the name is quoted! dropAndCreateTableSerial :: (String, [String]) -> PGS.Query dropAndCreateTableSerial (t, cols) = String.fromString drop_-  where drop_ = "DROP TABLE IF EXISTS \"" ++ t ++ "\";"-                ++ "CREATE TABLE \"" ++ t ++ "\""+  where drop_ = "DROP TABLE IF EXISTS \"public\".\"" ++ t ++ "\";"+                ++ "CREATE TABLE \"public\".\"" ++ t ++ "\""                 ++ " (" ++ commas cols ++ ");"         integer c = ("\"" ++ c ++ "\"" ++ " SERIAL")         commas = L.intercalate "," . map integer

@@ -1,6 +1,6 @@ name:            opaleye copyright:       Copyright (c) 2014-2015 Purely Agile Limited-version:         0.4.1.0+version:         0.4.2.0 synopsis:        An SQL-generating DSL targeting PostgreSQL description:     An SQL-generating DSL targeting PostgreSQL.  Allows                  Postgres queries to be written within Haskell in a@@ -27,17 +27,18 @@   build-depends:       -- attoparsec can be removed once postgresql-simple patch in       -- Internal.RunQuery is merged upstream-      attoparsec          >= 0.10.3  && < 0.14+      aeson               >= 0.6     && < 0.11+    , attoparsec          >= 0.10.3  && < 0.14     , base                >= 4       && < 5     , base16-bytestring   >= 0.1.1.6 && < 0.2     , case-insensitive    >= 1.2     && < 1.3     , bytestring          >= 0.10    && < 0.11     , contravariant       >= 1.2     && < 1.4-    , postgresql-simple   >= 0.4.8.0 && < 0.5+    , postgresql-simple   >= 0.4.8.0 && < 0.6     , pretty              >= 1.1.1.0 && < 1.2     , product-profunctors >= 0.6.2   && < 0.7     , profunctors         >= 4.0     && < 5.2-    , semigroups          >= 0.13    && < 0.17+    , semigroups          >= 0.13    && < 0.18     , text                >= 0.11    && < 1.3     , transformers        >= 0.3     && < 0.5     , time                >= 1.4     && < 1.6@@ -67,6 +68,7 @@                    Opaleye.Internal.Helpers,                    Opaleye.Internal.Join,                    Opaleye.Internal.Order,+                   Opaleye.Internal.Operators,                    Opaleye.Internal.Optimize,                    Opaleye.Internal.PackMap,                    Opaleye.Internal.PGTypes,

@@ -6,6 +6,7 @@ import qualified Opaleye.Column                  as C import qualified Opaleye.PGTypes                 as T +import qualified Data.Aeson                      as Ae import qualified Data.CaseInsensitive            as CI import qualified Data.Int                        as Int import qualified Data.Text                       as ST@@ -89,11 +90,17 @@ instance D.Default Constant LBS.ByteString (Column T.PGJson) where   def = Constant T.pgLazyJSON +instance D.Default Constant Ae.Value (Column T.PGJson) where+  def = Constant T.pgValueJSON+ instance D.Default Constant SBS.ByteString (Column T.PGJsonb) where   def = Constant T.pgStrictJSONB  instance D.Default Constant LBS.ByteString (Column T.PGJsonb) where   def = Constant T.pgLazyJSONB++instance D.Default Constant Ae.Value (Column T.PGJsonb) where+  def = Constant T.pgValueJSONB  -- { Boilerplate instances 

@@ -2,9 +2,8 @@  import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ --- | The 'Num' and 'Fractional' instances for 'Column' 'a' are too--- general.  For example, they allow you to add two 'Column'--- 'String's.  This will be fixed in a subsequent release.+-- | Numeric 'Column' types are instances of 'Num', so you can use+-- '*', '/', '+', '-' on them. newtype Column a = Column HPQ.PrimExpr deriving Show  data Nullable a = Nullable

@@ -11,7 +11,10 @@ -- * SQL data type ----------------------------------------------------------- -newtype SqlTable = SqlTable String deriving Show+data SqlTable = SqlTable+  { sqlTableSchemaName :: Maybe String+  , sqlTableName       :: String+  } deriving Show  newtype SqlColumn = SqlColumn String deriving Show 

@@ -50,29 +50,29 @@   defaultSqlUpdate :: SqlGenerator-                 -> TableName  -- ^ Name of the table to update.+                 -> SqlTable   -- ^ Table to update                  -> [PrimExpr] -- ^ Conditions which must all be true for a row                                --   to be updated.                  -> Assoc -- ^ Update the data with this.                  -> SqlUpdate-defaultSqlUpdate gen name criteria assigns-        = SqlUpdate (SqlTable name) (toSqlAssoc gen assigns) (map (sqlExpr gen) criteria)+defaultSqlUpdate gen tbl criteria assigns+        = SqlUpdate tbl (toSqlAssoc gen assigns) (map (sqlExpr gen) criteria)   defaultSqlInsert :: SqlGenerator-                 -> TableName+                 -> SqlTable                  -> [Attribute]                  -> NEL.NonEmpty [PrimExpr]                  -> SqlInsert-defaultSqlInsert gen name attrs exprs =-  SqlInsert (SqlTable name) (map toSqlColumn attrs) ((fmap . map) (sqlExpr gen) exprs)+defaultSqlInsert gen tbl attrs exprs =+  SqlInsert tbl (map toSqlColumn attrs) ((fmap . map) (sqlExpr gen) exprs)  defaultSqlDelete :: SqlGenerator-                 -> TableName -- ^ Name of the table+                 -> SqlTable                  -> [PrimExpr] -- ^ Criteria which must all be true for a row                                --   to be deleted.                  -> SqlDelete-defaultSqlDelete gen name criteria = SqlDelete (SqlTable name) (map (sqlExpr gen) criteria)+defaultSqlDelete gen tbl criteria = SqlDelete tbl (map (sqlExpr gen) criteria)   defaultSqlExpr :: SqlGenerator -> PrimExpr -> SqlExpr

@@ -11,9 +11,9 @@  data SqlGenerator = SqlGenerator     {-     sqlUpdate      :: TableName -> [PrimExpr] -> Assoc -> SqlUpdate,-     sqlDelete      :: TableName -> [PrimExpr] -> SqlDelete,-     sqlInsert      :: TableName -> [Attribute] -> NEL.NonEmpty [PrimExpr] -> SqlInsert,+     sqlUpdate      :: SqlTable -> [PrimExpr] -> Assoc -> SqlUpdate,+     sqlDelete      :: SqlTable -> [PrimExpr] -> SqlDelete,+     sqlInsert      :: SqlTable -> [Attribute] -> NEL.NonEmpty [PrimExpr] -> SqlInsert,      sqlExpr        :: PrimExpr -> SqlExpr,      sqlLiteral     :: Literal -> String,      -- | Turn a string into a quoted string. Quote characters

@@ -104,10 +104,14 @@ ppColumn :: SqlColumn -> Doc ppColumn (SqlColumn s) = doubleQuotes (text s) --- Postgres treats upper case letters in table names as lower case,--- unless the name is quoted!+-- Postgres treats schema and table names as lower case unless quoted. ppTable :: SqlTable -> Doc-ppTable (SqlTable s) = doubleQuotes (text s)+ppTable st = case sqlTableSchemaName st of+    Just sn -> doubleQuotes (text sn) <> text "." <> tname+    Nothing -> tname+  where+    tname = doubleQuotes (text (sqlTableName st))+  ppSqlExpr :: SqlExpr -> Doc ppSqlExpr expr =

@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Opaleye.Internal.Operators where++import           Opaleye.Internal.Column (Column)+import qualified Opaleye.Internal.Column as C+import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ+import qualified Opaleye.PGTypes as T++import           Data.Profunctor (Profunctor, dimap)+import           Data.Profunctor.Product (ProductProfunctor, empty, (***!))+import qualified Data.Profunctor.Product.Default as D++infix 4 .==+(.==) :: forall columns. D.Default EqPP columns columns+      => columns -> columns -> Column T.PGBool+(.==) = eqExplicit (D.def :: EqPP columns columns)++infixr 3 .&&+(.&&) :: Column T.PGBool -> Column T.PGBool -> Column T.PGBool+(.&&) = C.binOp HPQ.OpAnd++data EqPP a b = EqPP (a -> a -> Column T.PGBool)++eqExplicit :: EqPP columns a -> columns -> columns -> Column T.PGBool+eqExplicit (EqPP f) = f++instance D.Default EqPP (Column a) (Column a) where+  def = EqPP C.unsafeEq++-- { Boilerplate instances++instance Profunctor EqPP where+  dimap f _ (EqPP h) = EqPP (\a a' -> h (f a) (f a'))++instance ProductProfunctor EqPP where+  empty = EqPP (\() () -> T.pgBool True)+  EqPP f ***! EqPP f' = EqPP (\a a' ->+                               f (fst a) (fst a') .&& f' (snd a) (snd a'))++-- }

@@ -3,6 +3,7 @@ import           Prelude hiding (product)  import qualified Data.List.NonEmpty as NEL+import qualified Opaleye.Internal.HaskellDB.Sql as HSql import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import           Opaleye.Internal.HaskellDB.PrimQuery (Symbol) @@ -12,13 +13,23 @@ data BinOp = Except | Union | UnionAll deriving Show data JoinType = LeftJoin deriving Show +data TableIdentifier = TableIdentifier+  { tiSchemaName :: Maybe String+  , tiTableName  :: String+  } deriving Show++tiToSqlTable :: TableIdentifier -> HSql.SqlTable+tiToSqlTable ti = HSql.SqlTable { HSql.sqlTableSchemaName = tiSchemaName ti+                                , HSql.sqlTableName = tiTableName ti }++ -- In the future it may make sense to introduce this datatype -- type Bindings a = [(Symbol, a)]  -- We use a 'NEL.NonEmpty' for Product because otherwise we'd have to check -- for emptiness explicity in the SQL generation phase. data PrimQuery = Unit-               | BaseTable String [(Symbol, HPQ.PrimExpr)]+               | BaseTable TableIdentifier [(Symbol, HPQ.PrimExpr)]                | Product (NEL.NonEmpty PrimQuery) [HPQ.PrimExpr]                | Aggregate [(Symbol, (Maybe HPQ.AggrOp, HPQ.PrimExpr))] PrimQuery                | Order [HPQ.OrderExpr] PrimQuery@@ -29,7 +40,7 @@                  deriving Show  type PrimQueryFold p = ( p-                       , String -> [(Symbol, HPQ.PrimExpr)] -> p+                       , TableIdentifier -> [(Symbol, HPQ.PrimExpr)] -> p                        , NEL.NonEmpty p -> [HPQ.PrimExpr] -> p                        , [(Symbol, (Maybe HPQ.AggrOp, HPQ.PrimExpr))] -> p -> p                        , [HPQ.OrderExpr] -> p -> p@@ -44,7 +55,7 @@                binary) = fix fold   where fold self primQ = case primQ of           Unit                       -> unit-          BaseTable n s              -> baseTable n s+          BaseTable ti syms          -> baseTable ti syms           Product pqs pes            -> product (fmap self pqs) pes           Aggregate aggrs pq         -> aggregate aggrs (self pq)           Order pes pq               -> order pes (self pq)

@@ -24,6 +24,7 @@ import           Data.Profunctor.Product (empty, (***!)) import qualified Data.Profunctor.Product.Default as D +import qualified Data.Aeson as Ae import qualified Data.CaseInsensitive as CI import qualified Data.Text as ST import qualified Data.Text.Lazy as LT@@ -173,9 +174,15 @@   queryRunnerColumnDefault =     QueryRunnerColumn (P.rmap (const ()) U.unpackspecColumn) jsonFieldParser +instance QueryRunnerColumnDefault T.PGJson Ae.Value where+  queryRunnerColumnDefault = fieldQueryRunnerColumn+ instance QueryRunnerColumnDefault T.PGJsonb String where   queryRunnerColumnDefault =     QueryRunnerColumn (P.rmap (const ()) U.unpackspecColumn) jsonbFieldParser++instance QueryRunnerColumnDefault T.PGJsonb Ae.Value where+  queryRunnerColumnDefault = fieldQueryRunnerColumn  -- No CI String instance since postgresql-simple doesn't define FromField (CI String) 

@@ -61,8 +61,6 @@ data JoinType = LeftJoin deriving Show data BinOp = Except | Union | UnionAll deriving Show -data TableName = String- data Returning a = Returning a (NEL.NonEmpty HSql.SqlExpr)  sqlQueryGenerator :: PQ.PrimQueryFold Select@@ -79,10 +77,10 @@ unit :: Select unit = SelectFrom newSelect { attrs  = SelectAttrs (ensureColumns []) } -baseTable :: String -> [(Symbol, HPQ.PrimExpr)] -> Select-baseTable name columns = SelectFrom $+baseTable :: PQ.TableIdentifier -> [(Symbol, HPQ.PrimExpr)] -> Select+baseTable ti columns = SelectFrom $     newSelect { attrs = SelectAttrs (ensureColumns (map sqlBinding columns))-              , tables = [Table (HSql.SqlTable name)] }+              , tables = [Table (HSql.SqlTable (PQ.tiSchemaName ti) (PQ.tiTableName ti))] }  product :: NEL.NonEmpty Select -> [HPQ.PrimExpr] -> Select product ss pes = SelectFrom $

@@ -45,12 +45,25 @@ --                                      , quantity = required \"quantity\" --                                      , radius   = required \"radius\" }) -- @-data Table writerColumns viewColumns =-  Table String (TableProperties writerColumns viewColumns)+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. -data TableProperties writerColumns viewColumns =-  TableProperties (Writer writerColumns viewColumns) (View viewColumns)+tableIdentifier :: Table writerColumns 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++data TableProperties writerColumns viewColumns = TableProperties+   { tablePropertiesWriter :: Writer writerColumns viewColumns+   , tablePropertiesView   :: View viewColumns }+ data View columns = View columns  -- There's no reason the second parameter should exist except that we@@ -71,10 +84,10 @@             -> Tag.Tag             -> (columns, PQ.PrimQuery) queryTable cm table tag = (primExprs, primQ) where-  (Table tableName (TableProperties _ (View tableCols))) = table+  View tableCols = tablePropertiesView (tableProperties table)   (primExprs, projcols) = runColumnMaker cm tag tableCols   primQ :: PQ.PrimQuery-  primQ = PQ.BaseTable tableName projcols+  primQ = PQ.BaseTable (tableIdentifier table) projcols  runColumnMaker :: TM.ColumnMaker tablecolumns columns                   -> Tag.Tag@@ -158,6 +171,7 @@   (***!) = PP.defaultProfunctorProduct  instance Functor (Table a) where-  fmap f (Table s tp) = Table s (fmap f tp)+  fmap f (Table t tp) = Table t (fmap f tp)+  fmap f (TableWithSchema s t tp) = TableWithSchema s t (fmap f tp)  -- }

@@ -11,6 +11,7 @@ import qualified Opaleye.Internal.Table as TI import           Opaleye.Internal.Column (Column(Column)) import           Opaleye.Internal.Helpers ((.:), (.:.), (.::), (.::.))+import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.Unpackspec as U import           Opaleye.PGTypes (PGBool) @@ -27,24 +28,9 @@ import           Data.String (fromString) import qualified Data.List.NonEmpty as NEL -arrangeInsert :: T.Table columns a -> columns -> HSql.SqlInsert-arrangeInsert t c = arrangeInsertMany t (return c)--arrangeInsertSql :: T.Table columns a -> columns -> String-arrangeInsertSql = show . HPrint.ppInsert .: arrangeInsert- runInsert :: PGS.Connection -> T.Table columns columns' -> columns -> IO Int64 runInsert conn = PGS.execute_ conn . fromString .: arrangeInsertSql -arrangeInsertMany :: T.Table columns a -> NEL.NonEmpty columns -> HSql.SqlInsert-arrangeInsertMany (T.Table tableName (TI.TableProperties writer _)) columns = insert-  where (columnExprs, columnNames) = TI.runWriter' writer columns-        insert = SG.sqlInsert SD.defaultSqlGenerator-                      tableName columnNames columnExprs--arrangeInsertManySql :: T.Table columns a -> NEL.NonEmpty columns -> String-arrangeInsertManySql = show . HPrint.ppInsert .: arrangeInsertMany- runInsertMany :: PGS.Connection               -> T.Table columns columns'               -> [columns]@@ -54,40 +40,140 @@   Nothing       -> return 0   Just columns' -> (PGS.execute_ conn . fromString .: arrangeInsertManySql) table columns' +-- | @runInsertReturning@'s use of the 'D.Default' typeclass means that the+-- compiler will have trouble inferring types.  It is strongly+-- recommended that you provide full type signatures when using+-- @runInsertReturning@.+runInsertReturning :: (D.Default RQ.QueryRunner returned haskells)+                      => PGS.Connection+                      -> T.Table columnsW columnsR+                      -> columnsW+                      -> (columnsR -> returned)+                      -> IO [haskells]+runInsertReturning = runInsertReturningExplicit D.def++-- | Where the predicate is true, update rows using the supplied+-- function.+runUpdate :: PGS.Connection -> T.Table columnsW columnsR+          -> (columnsR -> columnsW) -> (columnsR -> Column PGBool)+          -> IO Int64+runUpdate conn = PGS.execute_ conn . fromString .:. arrangeUpdateSql++-- | @runUpdateReturning@'s use of the 'D.Default' typeclass means+-- that the compiler will have trouble inferring types.  It is+-- strongly recommended that you provide full type signatures when+-- using @runInsertReturning@.+runUpdateReturning :: (D.Default RQ.QueryRunner returned haskells)+                      => PGS.Connection+                      -> T.Table columnsW columnsR+                      -> (columnsR -> columnsW)+                      -> (columnsR -> Column PGBool)+                      -> (columnsR -> returned)+                      -> IO [haskells]+runUpdateReturning = runUpdateReturningExplicit D.def++-- | Delete rows where the predicate is true.+runDelete :: PGS.Connection -> T.Table a columnsR -> (columnsR -> Column PGBool)+          -> IO Int64+runDelete conn = PGS.execute_ conn . fromString .: arrangeDeleteSql++-- | You probably don't need this, but can just use+-- 'runInsertReturning' instead.  You only need it if you want to run+-- an UPDATE RETURNING statement but need to be explicit about the+-- 'QueryRunner'.+runInsertReturningExplicit :: RQ.QueryRunner returned haskells+                            -> PGS.Connection+                            -> T.Table columnsW columnsR+                            -> columnsW+                            -> (columnsR -> returned)+                            -> IO [haskells]+runInsertReturningExplicit qr conn t w r = PGS.queryWith_ parser conn+                                             (fromString+                                             (arrangeInsertReturningSql u t w r))+  where IRQ.QueryRunner u _ _ = qr+        parser = IRQ.prepareRowParser qr (r v)+        TI.Table _ (TI.TableProperties _ (TI.View v)) = t+        -- This method of getting hold of the return type feels a bit+        -- suspect.  I haven't checked it for validity.++-- | You probably don't need this, but can just use+-- 'runUpdateReturning' instead.  You only need it if you want to run+-- an UPDATE RETURNING statement but need to be explicit about the+-- 'QueryRunner'.+runUpdateReturningExplicit :: RQ.QueryRunner returned haskells+                           -> PGS.Connection+                           -> T.Table columnsW columnsR+                           -> (columnsR -> columnsW)+                           -> (columnsR -> Column PGBool)+                           -> (columnsR -> returned)+                           -> IO [haskells]+runUpdateReturningExplicit qr conn t update cond r =+  PGS.queryWith_ parser conn+                 (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++-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release.+arrangeInsert :: T.Table columns a -> columns -> HSql.SqlInsert+arrangeInsert t c = arrangeInsertMany t (return c)++-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release.+arrangeInsertSql :: T.Table columns a -> columns -> String+arrangeInsertSql = show . HPrint.ppInsert .: arrangeInsert++-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release.+arrangeInsertMany :: T.Table columns a -> NEL.NonEmpty columns -> HSql.SqlInsert+arrangeInsertMany table columns = insert+  where writer = TI.tablePropertiesWriter (TI.tableProperties 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 removed in a+-- subsequent release.+arrangeInsertManySql :: T.Table columns a -> NEL.NonEmpty columns -> String+arrangeInsertManySql = show . HPrint.ppInsert .: arrangeInsertMany++-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release. arrangeUpdate :: T.Table columnsW columnsR               -> (columnsR -> columnsW) -> (columnsR -> Column PGBool)               -> HSql.SqlUpdate-arrangeUpdate (TI.Table tableName (TI.TableProperties writer (TI.View tableCols)))-              update cond =-  SG.sqlUpdate SD.defaultSqlGenerator tableName [condExpr] (update' tableCols)-  where update' = map (\(x, y) -> (y, x))-                   . TI.runWriter writer-                   . update+arrangeUpdate table update cond =+  SG.sqlUpdate SD.defaultSqlGenerator+               (PQ.tiToSqlTable (TI.tableIdentifier table))+               [condExpr] (update' tableCols)+  where TI.TableProperties writer (TI.View tableCols) = TI.tableProperties table+        update' = map (\(x, y) -> (y, x)) . TI.runWriter writer . update         Column condExpr = cond tableCols +-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release. arrangeUpdateSql :: T.Table columnsW columnsR               -> (columnsR -> columnsW) -> (columnsR -> Column PGBool)               -> String arrangeUpdateSql = show . HPrint.ppUpdate .:. arrangeUpdate -runUpdate :: PGS.Connection -> T.Table columnsW columnsR-          -> (columnsR -> columnsW) -> (columnsR -> Column PGBool)-          -> IO Int64-runUpdate conn = PGS.execute_ conn . fromString .:. arrangeUpdateSql-+-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release. arrangeDelete :: T.Table a columnsR -> (columnsR -> Column PGBool) -> HSql.SqlDelete-arrangeDelete (TI.Table tableName (TI.TableProperties _ (TI.View tableCols)))-              cond =-  SG.sqlDelete SD.defaultSqlGenerator tableName [condExpr]+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) +-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release. arrangeDeleteSql :: T.Table a columnsR -> (columnsR -> Column PGBool) -> String arrangeDeleteSql = show . HPrint.ppDelete .: arrangeDelete -runDelete :: PGS.Connection -> T.Table a columnsR -> (columnsR -> Column PGBool)-          -> IO Int64-runDelete conn = PGS.execute_ conn . fromString .: arrangeDeleteSql-+-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release. arrangeInsertReturning :: U.Unpackspec returned ignored                        -> T.Table columnsW columnsR                        -> columnsW@@ -96,10 +182,12 @@ arrangeInsertReturning unpackspec table columns returningf =   Sql.Returning insert returningSEs   where insert = arrangeInsert table columns-        TI.Table _ (TI.TableProperties _ (TI.View columnsR)) = table+        TI.View columnsR = TI.tablePropertiesView (TI.tableProperties table)         returningPEs = U.collectPEs unpackspec (returningf columnsR)         returningSEs = Sql.ensureColumnsGen id (map Sql.sqlExpr returningPEs) +-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release. arrangeInsertReturningSql :: U.Unpackspec returned ignored                           -> T.Table columnsW columnsR                           -> columnsW@@ -109,33 +197,8 @@                             . Print.ppInsertReturning                             .:: arrangeInsertReturning -runInsertReturningExplicit :: RQ.QueryRunner returned haskells-                            -> PGS.Connection-                            -> T.Table columnsW columnsR-                            -> columnsW-                            -> (columnsR -> returned)-                            -> IO [haskells]-runInsertReturningExplicit qr conn t w r = PGS.queryWith_ parser conn-                                             (fromString-                                             (arrangeInsertReturningSql u t w r))-  where IRQ.QueryRunner u _ _ = qr-        parser = IRQ.prepareRowParser qr (r v)-        TI.Table _ (TI.TableProperties _ (TI.View v)) = t-        -- This method of getting hold of the return type feels a bit-        -- suspect.  I haven't checked it for validity.---- | @runInsertReturning@'s use of the 'D.Default' typeclass means that the--- compiler will have trouble inferring types.  It is strongly--- recommended that you provide full type signatures when using--- @runInsertReturning@.-runInsertReturning :: (D.Default RQ.QueryRunner returned haskells)-                      => PGS.Connection-                      -> T.Table columnsW columnsR-                      -> columnsW-                      -> (columnsR -> returned)-                      -> IO [haskells]-runInsertReturning = runInsertReturningExplicit D.def-+-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release. arrangeUpdateReturning :: U.Unpackspec returned ignored                        -> T.Table columnsW columnsR                        -> (columnsR -> columnsW)@@ -145,10 +208,12 @@ arrangeUpdateReturning unpackspec table updatef cond returningf =   Sql.Returning update returningSEs   where update = arrangeUpdate table updatef cond-        TI.Table _ (TI.TableProperties _ (TI.View columnsR)) = table+        TI.View columnsR = TI.tablePropertiesView (TI.tableProperties table)         returningPEs = U.collectPEs unpackspec (returningf columnsR)         returningSEs = Sql.ensureColumnsGen id (map Sql.sqlExpr returningPEs) +-- | For internal use only.  Do not use.  Will be removed in a+-- subsequent release. arrangeUpdateReturningSql :: U.Unpackspec returned ignored                        -> T.Table columnsW columnsR                        -> (columnsR -> columnsW)@@ -158,26 +223,3 @@ arrangeUpdateReturningSql = show                             . Print.ppUpdateReturning                             .::. arrangeUpdateReturning--runUpdateReturningExplicit :: RQ.QueryRunner returned haskells-                           -> PGS.Connection-                           -> T.Table columnsW columnsR-                           -> (columnsR -> columnsW)-                           -> (columnsR -> Column PGBool)-                           -> (columnsR -> returned)-                           -> IO [haskells]-runUpdateReturningExplicit qr conn t update cond r =-  PGS.queryWith_ parser conn-                 (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--runUpdateReturning :: (D.Default RQ.QueryRunner returned haskells)-                      => PGS.Connection-                      -> T.Table columnsW columnsR-                      -> (columnsR -> columnsW)-                      -> (columnsR -> Column PGBool)-                      -> (columnsR -> returned)-                      -> IO [haskells]-runUpdateReturning = runUpdateReturningExplicit D.def

@@ -1,35 +1,70 @@-module Opaleye.Operators (module Opaleye.Operators) where+{-# LANGUAGE Arrows #-}+{-# LANGUAGE FlexibleContexts #-} +-- | Operators on 'Column's.  Numeric 'Column' types are instances of+-- 'Num', so you can use '*', '/', '+', '-' on them.++module Opaleye.Operators (module Opaleye.Operators,+                          (O..&&)) where++import qualified Control.Arrow as A import qualified Data.Foldable as F  import           Opaleye.Internal.Column (Column(Column), unsafeCase_,-                                          unsafeIfThenElse, unsafeGt, unsafeEq)+                                          unsafeIfThenElse, unsafeGt) import qualified Opaleye.Internal.Column as C import           Opaleye.Internal.QueryArr (QueryArr(QueryArr)) import qualified Opaleye.Internal.PrimQuery as PQ+import qualified Opaleye.Internal.Operators as O+import           Opaleye.Internal.Helpers   ((.:)) import qualified Opaleye.Order as Ord import qualified Opaleye.PGTypes as T  import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ +import qualified Data.Profunctor.Product.Default as D+ {-| Restrict query results to a particular condition.  Corresponds to-    the guard method of the MonadPlus class.--}+the guard method of the MonadPlus class.  You would typically use+'restrict' if you want to use 'A.Arrow' notation.  -} restrict :: QueryArr (Column T.PGBool) () restrict = QueryArr f where   f (Column predicate, primQ, t0) = ((), PQ.restrict predicate primQ, t0) +{-| Filter a 'QueryArr' to only those rows where the given condition+holds.  This is the 'QueryArr' equivalent of 'Prelude.filter' from the+'Prelude'.  You would typically use 'keepWhen' if you want to use a+"point free" style.-}+keepWhen :: (a -> Column T.PGBool) -> QueryArr a a+keepWhen p = proc a -> do+  restrict  -< p a+  A.returnA -< a+ doubleOfInt :: Column T.PGInt4 -> Column T.PGFloat8 doubleOfInt (Column e) = Column (HPQ.CastExpr "float8" e)  infix 4 .== (.==) :: Column a -> Column a -> Column T.PGBool-(.==) = unsafeEq+(.==) = C.binOp HPQ.OpEq  infix 4 ./= (./=) :: Column a -> Column a -> Column T.PGBool (./=) = C.binOp HPQ.OpNotEq +infix 4 .===+-- | A polymorphic equality operator that works for all types that you+-- have run `makeAdaptorAndInstance` on.  This may be unified with+-- `.==` in a future version.+(.===) :: D.Default O.EqPP columns columns => columns -> columns -> Column T.PGBool+(.===) = (O..==)++infix 4 ./==+-- | A polymorphic inequality operator that works for all types that+-- you have run `makeAdaptorAndInstance` on.  This may be unified with+-- `.==` in a future version.+(./==) :: D.Default O.EqPP columns columns => columns -> columns -> Column T.PGBool+(./==) = Opaleye.Operators.not .: (O..==)+ infix 4 .> (.>) :: Ord.PGOrd a => Column a -> Column a -> Column T.PGBool (.>) = unsafeGt@@ -52,10 +87,6 @@ ifThenElse :: Column T.PGBool -> Column a -> Column a -> Column a ifThenElse = unsafeIfThenElse -infixr 3 .&&-(.&&) :: Column T.PGBool -> Column T.PGBool -> Column T.PGBool-(.&&) = C.binOp HPQ.OpAnd- infixr 2 .|| (.||) :: Column T.PGBool -> Column T.PGBool -> Column T.PGBool (.||) = C.binOp HPQ.OpOr@@ -75,6 +106,7 @@ like :: Column T.PGText -> Column T.PGText -> Column T.PGBool like = C.binOp HPQ.OpLike +-- | True when any element of the container is true ors :: F.Foldable f => f (Column T.PGBool) -> Column T.PGBool ors = F.foldl' (.||) (T.pgBool False) 

@@ -80,3 +80,4 @@ instance PGOrd T.PGTimestamptz instance PGOrd T.PGTimestamp instance PGOrd T.PGCitext+instance PGOrd T.PGUuid

@@ -10,6 +10,7 @@ import qualified Opaleye.Internal.HaskellDB.Sql.Default as HSD (quote)  import qualified Data.CaseInsensitive as CI+import qualified Data.Aeson as Ae import qualified Data.Text as SText import qualified Data.Text.Lazy as LText import qualified Data.ByteString as SByteString@@ -127,6 +128,9 @@ pgLazyJSON :: LByteString.ByteString -> Column PGJson pgLazyJSON = pgJSON . IPT.lazyDecodeUtf8 +pgValueJSON :: Ae.ToJSON a => a -> Column PGJson+pgValueJSON = pgLazyJSON . Ae.encode+ -- The jsonb data type was introduced in PostgreSQL version 9.4 -- JSONB values must be SQL string quoted --@@ -140,3 +144,6 @@  pgLazyJSONB :: LByteString.ByteString -> Column PGJsonb pgLazyJSONB = pgJSONB . IPT.lazyDecodeUtf8++pgValueJSONB :: Ae.ToJSON a => a -> Column PGJsonb+pgValueJSONB = pgLazyJSONB . Ae.encode

@@ -3,7 +3,7 @@ module Opaleye.Table (module Opaleye.Table,                       View,                       Writer,-                      Table(Table),+                      Table(Table, TableWithSchema),                       TableProperties) where  import           Opaleye.Internal.Column (Column(Column))