opaleye 0.10.3.1 → 0.10.4.0
raw patch · 21 files changed
+120/−96 lines, 21 filesdep +uuid-typesdep −uuiddep ~basedep ~text
Dependencies added: uuid-types
Dependencies removed: uuid
Dependency ranges changed: base, text
Files
- CHANGELOG.md +8/−0
- Doc/Tutorial/DefaultExplanation.lhs +1/−1
- Doc/Tutorial/TutorialBasic.lhs +22/−22
- Doc/Tutorial/TutorialBasicMonomorphic.lhs +14/−31
- opaleye.cabal +5/−6
- src/Opaleye/Binary.hs +1/−1
- src/Opaleye/Distinct.hs +1/−1
- src/Opaleye/Internal/Constant.hs +1/−1
- src/Opaleye/Internal/Inferrable.hs +1/−1
- src/Opaleye/Internal/Manipulation.hs +3/−0
- src/Opaleye/Internal/PGTypesExternal.hs +1/−1
- src/Opaleye/Internal/RunQuery.hs +1/−1
- src/Opaleye/Internal/Table.hs +14/−11
- src/Opaleye/Internal/Unpackspec.hs +1/−1
- src/Opaleye/Join.hs +20/−7
- src/Opaleye/Operators.hs +20/−6
- src/Opaleye/RunSelect.hs +1/−1
- src/Opaleye/Sql.hs +1/−1
- src/Opaleye/SqlTypes.hs +1/−1
- src/Opaleye/Table.hs +2/−1
- src/Opaleye/Values.hs +1/−1
CHANGELOG.md view
@@ -1,3 +1,11 @@+## 0.10.4.0++* Added `instance Default Updater (Field_ n a) ()`++* Added `omitOnWriteTableField`++* Added `inMany` and removed `Functor` constraint from `in_`.+ ## 0.10.3.1 * Improve Haddock
Doc/Tutorial/DefaultExplanation.lhs view
@@ -119,7 +119,7 @@ Binaryspec (T a1 ... an) (T a1 ... an) (This requires the `Default` instance for `T` as generated by-`Data.Profunctor.Product.TH.makeAdaptorAndInstance`, or an equivalent+`Data.Profunctor.Product.TH.makeAdaptorAndInstanceInferrable`, or an equivalent instance defined by hand). It means we don't have to explicitly specify the `Binaryspec` value.
Doc/Tutorial/TutorialBasic.lhs view
@@ -2,23 +2,27 @@ > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE TemplateHaskell #-}+> {-# LANGUAGE TypeFamilies #-}+> {-# LANGUAGE TypeOperators #-}+> {-# LANGUAGE UndecidableInstances #-} > > module TutorialBasic where > > import Prelude hiding (sum) > > import Opaleye (Field, FieldNullable, matchNullable, isNull,+> MaybeFields, > Table, table, tableField, selectTable, > Select, (.==), (.<=), (.&&), (.<), > (.===), > (.++), ifThenElse, sqlString, aggregate, groupBy,-> count, avg, sum, leftJoin, runSelect,+> count, avg, sum, optional, runSelect, > showSql, where_, Unpackspec, > SqlInt4, SqlInt8, SqlText, SqlDate, SqlFloat8, SqlBool) > > import Data.Profunctor.Product (p2, p3) > import Data.Profunctor.Product.Default (Default)-> import Data.Profunctor.Product.TH (makeAdaptorAndInstance)+> import Data.Profunctor.Product.TH (makeAdaptorAndInstanceInferrable) > import Data.Time.Calendar (Day) > > import qualified Database.PostgreSQL.Simple as PGS@@ -129,7 +133,7 @@ have instances defined for them. The instances are derivable with Template Haskell. -> $(makeAdaptorAndInstance "pBirthday" ''Birthday')+> $(makeAdaptorAndInstanceInferrable "pBirthday" ''Birthday') You don't have to use Template Haskell, but it just saves us writing things out by hand here. If you want to avoid Template Haskell see@@ -568,7 +572,7 @@ > , quantity :: d > , radius :: e } >-> $(makeAdaptorAndInstance "pWidget" ''Widget)+> $(makeAdaptorAndInstanceInferrable "pWidget" ''Widget) For the purposes of this example the style, color and location will be strings, but in practice they might have been a different data type.@@ -643,23 +647,19 @@ Outer join ========== -Opaleye supports left joins.--Because left joins can change non-nullable fields into nullable-fields we have to make sure the type of the output supports-nullability. We introduce the following type synonym for this-purpose, which is just a notational convenience.--> type FieldNullableBirthday = Birthday' (FieldNullable SqlText)-> (FieldNullable SqlDate)--A left join is expressed by specifying the two tables to join and the-join condition.+Opaleye supports left/right and full outer joins. A left or right+join is expressed by using `optional`. For full outer joins see+`Opaleye.Join`. > personBirthdayLeftJoin :: Select ((Field SqlText, Field SqlInt4, Field SqlText),-> FieldNullableBirthday)-> personBirthdayLeftJoin = leftJoin personSelect birthdaySelect eqName-> where eqName ((name, _, _), birthdayRow) = name .== bdName birthdayRow+> MaybeFields BirthdayField)+> personBirthdayLeftJoin = do+> personRow@(name, _, _) <- personSelect+> mBirthdayRow <- optional $ do+> birthdayRow <- birthdaySelect+> where_ (name .== bdName birthdayRow)+> pure birthdayRow+> pure (personRow, mBirthdayRow) The generated SQL is @@ -734,7 +734,7 @@ > , wLocation :: b > , wNumGoods :: c } >-> $(makeAdaptorAndInstance "pWarehouse" ''Warehouse')+> $(makeAdaptorAndInstanceInferrable "pWarehouse" ''Warehouse') We could represent the integer ID in Opaleye as a `SqlInt4` @@ -758,7 +758,7 @@ On the other hand we can make a newtype for the warehouse ID > newtype WarehouseId' a = WarehouseId a-> $(makeAdaptorAndInstance "pWarehouseId" ''WarehouseId')+> $(makeAdaptorAndInstanceInferrable "pWarehouseId" ''WarehouseId') > > type WarehouseIdField = WarehouseId' (Field SqlInt4) >@@ -824,7 +824,7 @@ > runEmployeesSelect = runSelect Newtypes are taken care of automatically by the typeclass instance-that was generated by `makeAdaptorAndInstance`. A `WarehouseId'+that was generated by `makeAdaptorAndInstanceInferrable`. A `WarehouseId' (Field SqlInt4)` becomes a `WarehouseId' Int` when the select is run. We could run the select `selectTable goodWarehouseTable` like this.
Doc/Tutorial/TutorialBasicMonomorphic.lhs view
@@ -8,11 +8,12 @@ > > import Opaleye (Field, FieldNullable, > Table, table, tableWithSchema, selectTable,+> MaybeFields, > tableField, > Select, (.==), > aggregate, groupBy,-> count, avg, sum, leftJoin, runSelect,-> showSql, Unpackspec,+> count, avg, sum, optional, runSelect,+> showSql, where_, Unpackspec, > SqlInt4, SqlInt8, SqlText, SqlDate, SqlFloat8) > > import qualified Opaleye as O@@ -276,38 +277,20 @@ Outer join ========== -Opaleye supports left joins. (Full outer joins and right joins are-left to be added as a simple starter project for a new Opaleye-contributor!)+Opaleye supports left/right and full outer joins. A left or right+join is expressed by using `optional`. For full outer joins see+`Opaleye.Join`. -Because left joins can change non-nullable fields into nullable-fields we have to make sure the type of the output supports-nullability. We introduce the following type synonym for this-purpose, which is just a notational convenience. -> data BirthdayFieldNullable =-> BirthdayFieldNullable { bdNameFieldNullable :: FieldNullable SqlText-> , bdDayFieldNullable :: FieldNullable SqlDate }->-> instance Default O.Unpackspec BirthdayFieldNullable BirthdayFieldNullable where-> def = BirthdayFieldNullable <$> P.lmap bdNameFieldNullable D.def-> <*> P.lmap bdDayFieldNullable D.def->-> instance Default Opaleye.Internal.Join.NullMaker BirthdayField BirthdayFieldNullable where-> def = BirthdayFieldNullable <$> P.lmap bdNameField D.def-> <*> P.lmap bdDayField 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 :: Select ((Field SqlText, Field SqlInt4, Field SqlText),-> BirthdayFieldNullable)-> personBirthdayLeftJoin = leftJoin personSelect birthdaySelect eqName-> where eqName ((name, _, _), birthdayRow) =-> name .== bdNameField birthdayRow+> MaybeFields BirthdayField)+> personBirthdayLeftJoin = do+> personRow@(name, _, _) <- personSelect+> mBirthdayRow <- optional $ do+> birthdayRow <- birthdaySelect+> where_ (name .== bdNameField birthdayRow)+> pure birthdayRow+> pure (personRow, mBirthdayRow) The generated SQL is
opaleye.cabal view
@@ -1,6 +1,6 @@ name: opaleye copyright: Copyright (c) 2014-2018 Purely Agile Limited; 2019-2024 Tom Ellis-version: 0.10.3.1+version: 0.10.4.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@@ -16,7 +16,7 @@ extra-doc-files: README.md CHANGELOG.md *.md-tested-with: GHC==9.8, GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8+tested-with: GHC==9.10, GHC==9.8, GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8 source-repository head type: git@@ -33,7 +33,7 @@ , base >= 4.9 && < 4.21 , base16-bytestring >= 0.1.1.6 && < 1.1 , case-insensitive >= 1.2 && < 1.3- , bytestring >= 0.10 && < 0.12+ , bytestring >= 0.10 && < 0.13 , contravariant >= 1.2 && < 1.6 , postgresql-simple >= 0.6 && < 0.8 , pretty >= 1.1.1.0 && < 1.2@@ -45,7 +45,7 @@ , transformers >= 0.3 && < 0.7 , time-compat >= 1.9.5 && < 1.12 , time-locale-compat >= 0.1 && < 0.2- , uuid >= 1.3 && < 1.4+ , uuid-types >= 1.0.6 && < 1.1 , void >= 0.4 && < 0.8 exposed-modules: Opaleye, Opaleye.Adaptors,@@ -139,9 +139,8 @@ product-profunctors, QuickCheck, semigroups,- text >= 0.11 && < 2.1,+ text >= 0.11 && < 2.2, time-compat,- uuid, transformers, hspec, hspec-discover,
src/Opaleye/Binary.hs view
@@ -10,7 +10,7 @@ -- -> S.Select (Field a, Field b) -- @ ----- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@:+-- Assuming the @makeAdaptorAndInstanceInferrable@ splice has been run for the product type @Foo@: -- -- @ -- unionAll :: S.Select (Foo (Field a) (Field b) (Field c))
src/Opaleye/Distinct.hs view
@@ -28,7 +28,7 @@ -- distinct :: Select (Field a, Field b) -> Select (Field a, Field b) -- @ ----- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@:+-- Assuming the @makeAdaptorAndInstanceInferrable@ splice has been run for the product type @Foo@: -- -- @ -- distinct :: Select (Foo (Field a) (Field b) (Field c)) -> Select (Foo (Field a) (Field b) (Field c))
src/Opaleye/Internal/Constant.hs view
@@ -17,7 +17,7 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.Scientific as Sci import qualified Data.Time.Compat as Time-import qualified Data.UUID as UUID+import qualified Data.UUID.Types as UUID import qualified Data.Profunctor.Product as PP import Data.Profunctor.Product (empty, (***!), (+++!))
src/Opaleye/Internal/Inferrable.hs view
@@ -22,7 +22,7 @@ import qualified Data.Text as ST import qualified Data.Time.Compat as Time import Data.Typeable (Typeable)-import Data.UUID (UUID)+import Data.UUID.Types (UUID) import qualified Database.PostgreSQL.Simple.Range as R import GHC.Int (Int32, Int64)
src/Opaleye/Internal/Manipulation.hs view
@@ -125,6 +125,9 @@ instance D.Default Updater (Field_ n a) (Maybe (Field_ n a)) where def = Updater Just +instance D.Default Updater (Field_ n a) () where+ def = Updater (const ())+ arrangeDeleteReturning :: U.Unpackspec columnsReturned ignored -> T.Table columnsW columnsR -> (columnsR -> Field SqlBool)
src/Opaleye/Internal/PGTypesExternal.hs view
@@ -24,7 +24,7 @@ import qualified Data.ByteString.Lazy as LByteString import Data.Scientific as Sci import qualified Data.Time.Compat as Time-import qualified Data.UUID as UUID+import qualified Data.UUID.Types as UUID import Data.Int (Int64)
src/Opaleye/Internal/RunQuery.hs view
@@ -44,7 +44,7 @@ import qualified Data.Time.Compat as Time import qualified Data.Scientific as Sci import qualified Data.String as String-import Data.UUID (UUID)+import Data.UUID.Types (UUID) import GHC.Int (Int32, Int64) -- { Only needed for postgresql-simple FieldParsers
src/Opaleye/Internal/Table.hs view
@@ -31,7 +31,7 @@ -- , quantity :: d -- , radius :: e } ----- \$('Data.Profunctor.Product.TH.makeAdaptorAndInstance' \"pWidget\" ''Widget)+-- \$('Data.Profunctor.Product.TH.makeAdaptorAndInstanceInferrable' \"pWidget\" ''Widget) -- -- widgetTable :: Table (Widget (Maybe (Field SqlInt4)) (Field SqlText) (Field SqlText) -- (Field SqlInt4) (Field SqlFloat8))@@ -87,16 +87,18 @@ Writer (forall f. Functor f => PM.PackMap (f HPQ.PrimExpr, String) () (f columns) ()) +coerceWriterOutput :: Writer columns dummy -> Writer columns dummy'+coerceWriterOutput (Writer w) = Writer w+ -- | 'requiredTableField' is for fields which are not optional. You -- must provide them on writes. requiredTableField :: String -> TableFields (Field_ n a) (Field_ n a)-requiredTableField columnName = TableFields- (requiredW columnName)- (View (Column (HPQ.BaseTableAttrExpr columnName)))-+requiredTableField = lmap Just . optionalTableField --- | 'optionalTableField' is for fields that you can omit on writes, such as--- fields which have defaults or which are SERIAL.+-- | 'optionalTableField' is for fields that you can omit on writes,+-- such as fields which have defaults or which are SERIAL. Setting+-- the write value to @Nothing@ uses SQL @DEFAULT@ in the generated+-- update. optionalTableField :: String -> TableFields (Maybe (Field_ n a)) (Field_ n a) optionalTableField columnName = TableFields (optionalW columnName)@@ -110,6 +112,11 @@ readOnlyTableField :: String -> TableFields () (Field_ n a) readOnlyTableField = lmap (const Nothing) . optionalTableField +omitOnWriteTableField :: String -> TableFields () (Field_ n a)+omitOnWriteTableField columnName = TableFields+ (coerceWriterOutput (pure ()))+ (View (Column (HPQ.BaseTableAttrExpr columnName)))+ -- | You should not define your own instances of -- 'InferrableTableField'. class InferrableTableField w n r@@ -183,10 +190,6 @@ mempty = Zip mempty' where mempty' = [] `NEL.cons` mempty' mappend = (<>)--requiredW :: String -> Writer (Field_ n a) (Field_ n a)-requiredW columnName =- Writer (PM.iso (flip (,) columnName . fmap unColumn) id) optionalW :: String -> Writer (Maybe (Field_ n a)) (Field_ n a) optionalW columnName =
src/Opaleye/Internal/Unpackspec.hs view
@@ -24,7 +24,7 @@ -- 'Default' instance of type @Foo (Field a) (Field b) (Field c)@ -- will allow you to manipulate or extract the three 'HPQ.PrimExpr's -- contained therein (for a user-defined product type @Foo@, assuming- -- the @makeAdaptorAndInstance@ splice from+ -- the @makeAdaptorAndInstanceInferrable@ splice from -- @Data.Profunctor.Product.TH@ has been run). -- -- Users should almost never need to create or manipulate
src/Opaleye/Join.hs view
@@ -138,19 +138,32 @@ -- -> Select ((Field a, Field b), (FieldNullable c, FieldNullable d)) -- @ --- | We suggest you use 'optionalRestrict' instead. Instead of writing+-- | We suggest you use 'optional' instead. Instead of writing -- \"@'Opaleye.Join.leftJoin' qL qR cond@\" you can write -- -- @+-- do+-- fieldsL <- qL+-- maybeFieldsR \<- 'optional' $ do+-- fieldsR <- qR+-- cond (fieldsL, fieldsR)+-- pure fieldsR+-- pure (fieldsL, maybeFieldsR)+-- @+--+-- Typically everything except the 'optional' block can be inlined in+-- surrounding @do@ notation. In such cases, readability and+-- maintainability increase dramatically.+--+-- Alternatively, if you have a reason to avoid @LATERAL@ joins you+-- can use 'optionalRestrict' and arrow notation.+--+-- @ -- proc () -> do -- fieldsL <- qL -< () -- maybeFieldsR \<- 'optionalRestrict' qR -\< 'Prelude.curry' cond fieldsL -- 'Control.Arrow.returnA' -< (fieldsL, maybeFieldsR) -- @------ Typically everything except the 'optionalRestrict' line can be--- inlined in surrounding arrow notation. In such cases, readability--- and maintainability increase dramatically. leftJoin :: (D.Default U.Unpackspec fieldsL fieldsL, D.Default U.Unpackspec fieldsR fieldsR, D.Default J.NullMaker fieldsR nullableFieldsR)@@ -160,7 +173,7 @@ -> S.Select (fieldsL, nullableFieldsR) -- ^ Left join leftJoin = leftJoinExplicit D.def D.def D.def --- | We suggest you don't use this. 'optionalRestrict' is probably+-- | We suggest you don't use this. 'optional' or 'optionalRestrict' are probably -- better for your use case. 'Opaleye.Join.leftJoinA' is the same as -- 'optionalRestrict' except without the return type wrapped in -- 'Opaleye.Internal.MaybeFields.MaybeFields'.@@ -174,7 +187,7 @@ -- result comes out leftJoinA = leftJoinAExplict D.def D.def --- | We suggest you use 'optionalRestrict' instead. See 'leftJoin'+-- | We suggest you use 'optional' or 'optionalRestrict' instead. See 'leftJoin' -- for more details. rightJoin :: (D.Default U.Unpackspec fieldsL fieldsL, D.Default U.Unpackspec fieldsR fieldsR,
src/Opaleye/Operators.hs view
@@ -58,6 +58,7 @@ , sqlLength -- * Containment operators , in_+ , inMany , inSelect -- * JSON operators , SqlIsJson@@ -187,14 +188,14 @@ infix 4 .=== -- | A polymorphic equality operator that works for all types that you--- have run `makeAdaptorAndInstance` on. This may be unified with+-- have run `makeAdaptorAndInstanceInferrable` on. This may be unified with -- `.==` in a future version. (.===) :: D.Default O.EqPP fields fields => fields -> fields -> F.Field T.SqlBool (.===) = (O..==) infix 4 ./== -- | A polymorphic inequality operator that works for all types that--- you have run `makeAdaptorAndInstance` on. This may be unified with+-- you have run `makeAdaptorAndInstanceInferrable` on. This may be unified with -- `./=` in a future version. (./==) :: D.Default O.EqPP fields fields => fields -> fields -> F.Field T.SqlBool (./==) = Opaleye.Operators.not .: (O..==)@@ -289,13 +290,26 @@ -- | 'in_' is designed to be used in prefix form. ----- 'in_' @validProducts@ @product@ checks whether @product@ is a valid--- product. 'in_' @validProducts@ is a function which checks whether--- a product is a valid product.-in_ :: (Functor f, F.Foldable f) => f (Field a) -> Field a -> F.Field T.SqlBool+-- 'in_' @validUsers@ @user@ checks whether @user@ is a valid user.+-- 'in_' @validUsers@ is a function which checks whether a user is a+-- valid user.+in_ :: (F.Foldable f) => f (Field a) -> Field a -> F.Field T.SqlBool in_ fcas (Column a) = case NEL.nonEmpty (F.toList fcas) of Nothing -> T.sqlBool False Just xs -> Column $ HPQ.BinExpr HPQ.OpIn a (HPQ.ListExpr (fmap C.unColumn xs))++-- | @inMany@ is a generalization of 'in_' to values with multiple+-- fields. It is designed to be used in prefix form.+--+-- @inMany validUsers user@ checks whether @user@ is a valid user.+-- @inMany validUsers@ is a function which checks whether a user is a+-- valid user.+inMany ::+ (F.Foldable f, D.Default O.EqPP fields fields) =>+ f fields ->+ fields ->+ F.Field T.SqlBool+inMany xs x = ors (fmap (.=== x) (F.toList xs)) -- | True if the first argument occurs amongst the rows of the second, -- false otherwise.
src/Opaleye/RunSelect.hs view
@@ -158,7 +158,7 @@ -- runSelectI :: 'S.Select' ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlInt4', 'Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlText') -> IO [(Int, String)] -- @ ----- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@:+-- Assuming the @makeAdaptorAndInstanceInferrable@ splice has been run for the product type @Foo@: -- -- @ -- runSelectI :: 'S.Select' (Foo ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlInt4') ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlText') ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlBool')
src/Opaleye/Sql.hs view
@@ -30,7 +30,7 @@ -- showSql :: Select (Field a, Field b) -> Maybe String -- @ ----- Assuming the @makeAdaptorAndInstance@ splice has been run for the+-- Assuming the @makeAdaptorAndInstanceInferrable@ splice has been run for the -- product type @Foo@: -- -- @
src/Opaleye/SqlTypes.hs view
@@ -130,7 +130,7 @@ import qualified Data.Text as SText import qualified Data.Text.Lazy as LText import qualified Data.Time.Compat as Time-import qualified Data.UUID as UUID+import qualified Data.UUID.Types as UUID import qualified Database.PostgreSQL.Simple.Range as R
src/Opaleye/Table.hs view
@@ -63,6 +63,7 @@ T.tableField, T.optionalTableField, T.requiredTableField,+ T.omitOnWriteTableField, T.InferrableTableField, -- * Selecting from tables selectTable,@@ -92,7 +93,7 @@ -- -> Select (Field a, Field b) -- @ ----- Assuming the @makeAdaptorAndInstance@ splice has been run for the+-- Assuming the @makeAdaptorAndInstanceInferrable@ splice has been run for the -- product type @Foo@: -- -- @
src/Opaleye/Values.hs view
@@ -22,7 +22,7 @@ -- values :: [(Field a, Field b)] -> Select (Field a, Field b) -- @ ----- Assuming the @makeAdaptorAndInstance@ splice has been run for the+-- Assuming the @makeAdaptorAndInstanceInferrable@ splice has been run for the -- product type @Foo@: -- -- @