diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,25 @@ +## 0.9.0.0 + +The switch from `Column` to `Field` is complete. This is a small yet +pervasive change. To update your code please change all usages of +`Column` as follows: + +* `Column` of a non-nullable type: to `Field` +* `Column` of a nullable type: to `FieldNullable` +* `Column` of a nullability-polymorphic type: to `Field_ n` + +For example + +* `Column SqlText` -> `Field SqlText` +* `Column (Nullable SqlInt4)` -> `FieldNullable SqlInt4` +* `Column a` -> `Field_ n a` + +This is the only change that has been made in this version, in order +to ease user transition. + +* See also + + ## 0.8.1.0 * Cosmetic and re-export changes only. diff --git a/Test/Test.hs b/Test/Test.hs --- a/Test/Test.hs +++ b/Test/Test.hs @@ -88,7 +88,7 @@ -} -required :: String -> O.TableFields (O.Column a) (O.Column a) +required :: String -> O.TableFields (O.Field a) (O.Field a) required = O.requiredTableField twoIntTable :: String diff --git a/opaleye.cabal b/opaleye.cabal --- a/opaleye.cabal +++ b/opaleye.cabal @@ -1,6 +1,6 @@ name: opaleye copyright: Copyright (c) 2014-2018 Purely Agile Limited; 2019-2022 Tom Ellis -version: 0.8.1.0 +version: 0.9.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 @@ -107,7 +107,7 @@ Opaleye.Internal.HaskellDB.Sql.Default, Opaleye.Internal.HaskellDB.Sql.Generate, Opaleye.Internal.HaskellDB.Sql.Print - ghc-options: -Wall -Wcompat + ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors test-suite test default-language: Haskell2010 diff --git a/src/Opaleye.hs b/src/Opaleye.hs --- a/src/Opaleye.hs +++ b/src/Opaleye.hs @@ -1,3 +1,5 @@ +-- {-# OPTIONS_HADDOCK ignore-exports #-} + -- | An SQL-generating DSL targeting PostgreSQL. Allows Postgres -- queries to be written within Haskell in a typesafe and composable -- fashion. @@ -40,14 +42,10 @@ import Opaleye.Aggregate import Opaleye.Binary import Opaleye.Column + hiding (null, + isNull) import Opaleye.Distinct import Opaleye.Field - hiding (null, - isNull, - matchNullable, - fromNullable, - toNullable, - maybeToNullable) import Opaleye.FunctionalJoin import Opaleye.Join import Opaleye.Label diff --git a/src/Opaleye/Aggregate.hs b/src/Opaleye/Aggregate.hs --- a/src/Opaleye/Aggregate.hs +++ b/src/Opaleye/Aggregate.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DataKinds #-} + -- | Perform aggregation on 'S.Select's. To aggregate a 'S.Select' you -- should construct an 'Aggregator' encoding how you want the -- aggregation to proceed, then call 'aggregate' on it. The @@ -42,7 +44,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import qualified Opaleye.Internal.PackMap as PM -import qualified Opaleye.Column as C +import qualified Opaleye.Field as F import qualified Opaleye.Order as Ord import qualified Opaleye.Select as S import qualified Opaleye.SqlTypes as T @@ -99,7 +101,7 @@ A.Aggregator (PM.PackMap (\f c -> pm (f . P.first' (fmap (\(a,b,_) -> (a,b,HPQ.AggrDistinct)))) c)) -- | Group the aggregation by equality on the input to 'groupBy'. -groupBy :: Aggregator (C.Column a) (C.Column a) +groupBy :: Aggregator (F.Field_ n a) (F.Field_ n a) groupBy = A.makeAggr' Nothing -- | Sum all rows in a group. @@ -107,46 +109,48 @@ -- WARNING! The type of this operation is wrong and will crash at -- runtime when the argument is 'T.SqlInt4' or 'T.SqlInt8'. For those -- use 'sumInt4' or 'sumInt8' instead. -sum :: Aggregator (C.Column a) (C.Column a) +sum :: Aggregator (F.Field a) (F.Field a) sum = A.makeAggr HPQ.AggrSum -sumInt4 :: Aggregator (C.Column T.SqlInt4) (C.Column T.SqlInt8) -sumInt4 = fmap C.unsafeCoerceColumn Opaleye.Aggregate.sum +sumInt4 :: Aggregator (F.Field T.SqlInt4) (F.Field T.SqlInt8) +sumInt4 = fmap F.unsafeCoerceField Opaleye.Aggregate.sum -sumInt8 :: Aggregator (C.Column T.SqlInt8) (C.Column T.SqlNumeric) -sumInt8 = fmap C.unsafeCoerceColumn Opaleye.Aggregate.sum +sumInt8 :: Aggregator (F.Field T.SqlInt8) (F.Field T.SqlNumeric) +sumInt8 = fmap F.unsafeCoerceField Opaleye.Aggregate.sum -- | Count the number of non-null rows in a group. -count :: Aggregator (C.Column a) (C.Column T.SqlInt8) +count :: Aggregator (F.Field a) (F.Field T.SqlInt8) count = A.makeAggr HPQ.AggrCount -- | Count the number of rows in a group. This 'Aggregator' is named -- @countStar@ after SQL's @COUNT(*)@ aggregation function. -countStar :: Aggregator a (C.Column T.SqlInt8) -countStar = lmap (const (0 :: C.Column T.SqlInt4)) count +countStar :: Aggregator a (F.Field T.SqlInt8) +countStar = lmap (const (0 :: F.Field T.SqlInt4)) count -- | Average of a group -avg :: Aggregator (C.Column T.SqlFloat8) (C.Column T.SqlFloat8) +avg :: Aggregator (F.Field T.SqlFloat8) (F.Field T.SqlFloat8) avg = A.makeAggr HPQ.AggrAvg -- | Maximum of a group -max :: Ord.SqlOrd a => Aggregator (C.Column a) (C.Column a) +max :: Ord.SqlOrd a => Aggregator (F.Field a) (F.Field a) max = A.makeAggr HPQ.AggrMax -- | Maximum of a group -min :: Ord.SqlOrd a => Aggregator (C.Column a) (C.Column a) +min :: Ord.SqlOrd a => Aggregator (F.Field a) (F.Field a) min = A.makeAggr HPQ.AggrMin -boolOr :: Aggregator (C.Column T.SqlBool) (C.Column T.SqlBool) +boolOr :: Aggregator (F.Field T.SqlBool) (F.Field T.SqlBool) boolOr = A.makeAggr HPQ.AggrBoolOr -boolAnd :: Aggregator (C.Column T.SqlBool) (C.Column T.SqlBool) +boolAnd :: Aggregator (F.Field T.SqlBool) (F.Field T.SqlBool) boolAnd = A.makeAggr HPQ.AggrBoolAnd -arrayAgg :: Aggregator (C.Column a) (C.Column (T.SqlArray a)) +arrayAgg :: Aggregator (F.Field a) (F.Field (T.SqlArray a)) arrayAgg = A.makeAggr HPQ.AggrArr {-| +FIXME: no longer supports nulls + Aggregates values, including nulls, as a JSON array An example usage: @@ -166,11 +170,11 @@ @"[{\\"summary\\" : \\"xy\\", \\"details\\" : \\"a\\"}, {\\"summary\\" : \\"z\\", \\"details\\" : \\"a\\"}, {\\"summary\\" : \\"more text\\", \\"details\\" : \\"a\\"}]"@ -} -jsonAgg :: Aggregator (C.Column a) (C.Column T.SqlJson) +jsonAgg :: Aggregator (F.Field a) (F.Field T.SqlJson) jsonAgg = A.makeAggr HPQ.JsonArr -stringAgg :: C.Column T.SqlText - -> Aggregator (C.Column T.SqlText) (C.Column T.SqlText) +stringAgg :: F.Field T.SqlText + -> Aggregator (F.Field T.SqlText) (F.Field T.SqlText) stringAgg = A.makeAggr' . Just . HPQ.AggrStringAggr . IC.unColumn -- | Count the number of rows in a query. This is different from @@ -183,13 +187,13 @@ -- changing the AST though, so I'm not too keen. -- -- See https://github.com/tomjaguarpaw/haskell-opaleye/issues/162 -countRows :: S.Select a -> S.Select (C.Column T.SqlInt8) -countRows = fmap (C.fromNullable 0) +countRows :: S.Select a -> S.Select (F.Field T.SqlInt8) +countRows = fmap (F.fromNullable 0) . fmap snd . (\q -> J.leftJoin (pure ()) (aggregate count q) (const (T.sqlBool True))) - . fmap (const (0 :: C.Column T.SqlInt4)) + . fmap (const (0 :: F.Field T.SqlInt4)) --- ^^ The count aggregator requires an input of type -- 'Column a' rather than 'a' (I'm not sure if there's a -- good reason for this). To deal with that restriction diff --git a/src/Opaleye/Binary.hs b/src/Opaleye/Binary.hs --- a/src/Opaleye/Binary.hs +++ b/src/Opaleye/Binary.hs @@ -114,6 +114,6 @@ exceptExplicit = B.sameTypeBinOpHelper PQ.Except binaryspecField :: (B.Binaryspec - (Opaleye.Internal.Column.Column a) - (Opaleye.Internal.Column.Column a)) + (Opaleye.Internal.Column.Field_ n a) + (Opaleye.Internal.Column.Field_ n a)) binaryspecField = B.binaryspecColumn diff --git a/src/Opaleye/Column.hs b/src/Opaleye/Column.hs --- a/src/Opaleye/Column.hs +++ b/src/Opaleye/Column.hs @@ -1,14 +1,11 @@ {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} --- | Do not use. Will be deprecated in version 0.9. Use +-- | Do not use. Will be deprecated in version 0.10. Use -- "Opaleye.Field" instead. -- -- Functions for working directly with 'Column's. -- -- Please note that numeric 'Column' types are instances of 'Num', so -- you can use '*', '/', '+', '-' on them. --- --- 'Column' will be renamed to 'Opaleye.Field.Field_' in version 0.9, --- so you might want to use the latter as much as you can. module Opaleye.Column (-- * 'Column' Column, @@ -16,10 +13,6 @@ Nullable, null, isNull, - matchNullable, - fromNullable, - toNullable, - maybeToNullable, -- * Unsafe operations unsafeCast, unsafeCoerceColumn, @@ -29,6 +22,7 @@ import Opaleye.Internal.Column (Column, Nullable, unsafeCoerceColumn, unsafeCast, unsafeCompositeField) +import qualified Opaleye.Field as F import qualified Opaleye.Internal.Column as C import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import qualified Opaleye.Internal.PGTypesExternal as T @@ -36,40 +30,11 @@ -- | A NULL of any type null :: Column (Nullable a) -null = C.Column (HPQ.ConstExpr HPQ.NullLit) +null = F.null -- | @TRUE@ if the value of the column is @NULL@, @FALSE@ otherwise. isNull :: Column (Nullable a) -> Column T.PGBool isNull = C.unOp HPQ.OpIsNull - --- | If the @Column (Nullable a)@ is NULL then return the @Column b@ --- otherwise map the underlying @Column a@ using the provided --- function. --- --- The Opaleye equivalent of 'Data.Maybe.maybe'. -matchNullable :: Column b -> (Column a -> Column b) -> Column (Nullable a) - -> Column b -matchNullable replacement f x = C.unsafeIfThenElse (isNull x) replacement - (f (unsafeCoerceColumn x)) - --- | If the @Column (Nullable a)@ is NULL then return the provided --- @Column a@ otherwise return the underlying @Column a@. --- --- The Opaleye equivalent of 'Data.Maybe.fromMaybe' and very similar --- to PostgreSQL's @COALESCE@. -fromNullable :: Column a -> Column (Nullable a) -> Column a -fromNullable = flip matchNullable id - --- | Treat a column as though it were nullable. This is always safe. --- --- The Opaleye equivalent of 'Data.Maybe.Just'. -toNullable :: Column a -> Column (Nullable a) -toNullable = unsafeCoerceColumn - --- | If the argument is 'Data.Maybe.Nothing' return NULL otherwise return the --- provided value coerced to a nullable type. -maybeToNullable :: Maybe (Column a) -> Column (Nullable a) -maybeToNullable = maybe null toNullable joinNullable :: Column (Nullable (Nullable a)) -> Column (Nullable a) joinNullable = unsafeCoerceColumn diff --git a/src/Opaleye/Exists.hs b/src/Opaleye/Exists.hs --- a/src/Opaleye/Exists.hs +++ b/src/Opaleye/Exists.hs @@ -1,7 +1,7 @@ module Opaleye.Exists (exists) where import Opaleye.Field (Field) -import Opaleye.Internal.Column (Column (Column)) +import Opaleye.Internal.Column (Field_(Column)) import Opaleye.Internal.QueryArr (runSimpleQueryArr, productQueryArr) import Opaleye.Internal.PackMap (run, extractAttr) import Opaleye.Internal.PrimQuery (PrimQuery' (Exists)) diff --git a/src/Opaleye/Experimental/Enum.hs b/src/Opaleye/Experimental/Enum.hs --- a/src/Opaleye/Experimental/Enum.hs +++ b/src/Opaleye/Experimental/Enum.hs @@ -11,7 +11,7 @@ fromFieldToFieldsEnum, ) where -import Opaleye.Column (Column) +import Opaleye.Field (Field) import qualified Opaleye as O import qualified Opaleye.Internal.RunQuery as RQ @@ -21,7 +21,7 @@ data EnumMapper sqlEnum haskellSum = EnumMapper { enumFromField :: RQ.FromField sqlEnum haskellSum - , enumToFields :: O.ToFields haskellSum (Column sqlEnum) + , enumToFields :: O.ToFields haskellSum (Field sqlEnum) } -- | Create a mapping between a Postgres @ENUM@ type and a Haskell @@ -83,7 +83,7 @@ -- => D.Default (Inferrable O.FromField) SqlRating rating where -- def = Inferrable D.def -- --- instance D.Default O.ToFields Rating (O.Column SqlRating) where +-- instance D.Default O.ToFields Rating (O.Field SqlRating) where -- def = enumToFields sqlRatingMapper -- @ enumMapper :: String @@ -140,11 +140,11 @@ Just r -> r Nothing -> error ("Unexpected: " ++ unpack s) -{-# DEPRECATED fromFieldToFieldsEnum "Use 'enumMapper' instead. Will be removed in 0.9." #-} +{-# DEPRECATED fromFieldToFieldsEnum "Use 'enumMapper' instead. Will be removed in 0.10." #-} fromFieldToFieldsEnum :: String -> (String -> Maybe haskellSum) -> (haskellSum -> String) -> (RQ.FromField sqlEnum haskellSum, - O.ToFields haskellSum (Column sqlEnum)) + O.ToFields haskellSum (Field sqlEnum)) fromFieldToFieldsEnum type_ from to_ = (enumFromField e, enumToFields e) where e = enumMapper type_ from to_ diff --git a/src/Opaleye/Field.hs b/src/Opaleye/Field.hs --- a/src/Opaleye/Field.hs +++ b/src/Opaleye/Field.hs @@ -10,7 +10,7 @@ -- SqlType@, and if you see @'C.Column' ('C.Nullable' SqlType)@ then -- you can understand it as @'FieldNullable' SqlType@. -- --- 'C.Column' will be fully deprecated in version 0.9. +-- 'C.Column' will be fully deprecated in version 0.10. {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} @@ -33,33 +33,23 @@ maybeToNullable, ) where -import qualified Opaleye.Column as C -import qualified Opaleye.Internal.PGTypesExternal as T - --- | The name @Column@ will be replaced by @Field@ in version 0.9. --- The @Field_@, @Field@ and @FieldNullable@ types exist to help --- smooth the transition. We recommend that you use @Field_@, @Field@ --- or @FieldNullable@ instead of @Column@ everywhere that it is --- sufficient. -type family Field_ (a :: Nullability) b - -data Nullability = NonNullable | Nullable - -type instance Field_ 'NonNullable a = C.Column a -type instance Field_ 'Nullable a = C.Column (C.Nullable a) +import Prelude hiding (null) -type FieldNullable a = Field_ 'Nullable a -type Field a = Field_ 'NonNullable a +import Opaleye.Internal.Column + (Field_(Column), FieldNullable, Field, Nullability(NonNullable, Nullable)) +import qualified Opaleye.Internal.Column as C +import qualified Opaleye.Internal.PGTypesExternal as T +import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ -- FIXME Put Nullspec (or sqltype?) constraint on this -- | A NULL of any type null :: FieldNullable a -null = C.null +null = Column (HPQ.ConstExpr HPQ.NullLit) -- | @TRUE@ if the value of the field is @NULL@, @FALSE@ otherwise. isNull :: FieldNullable a -> Field T.PGBool -isNull = C.isNull +isNull = C.unOp HPQ.OpIsNull -- | If the @Field 'Nullable a@ is NULL then return the @Field -- 'NonNullable b@ otherwise map the underlying @Field 'Nullable a@ @@ -73,7 +63,8 @@ -> FieldNullable a -- ^ -> Field b -matchNullable = C.matchNullable +matchNullable replacement f x = C.unsafeIfThenElse (isNull x) replacement + (f (unsafeCoerceField x)) -- | If the @FieldNullable a@ is NULL then return the provided -- @Field a@ otherwise return the underlying @Field @@ -86,7 +77,7 @@ -> FieldNullable a -- ^ -> Field a -fromNullable = C.fromNullable +fromNullable = flip matchNullable id -- | Treat a field as though it were nullable. This is always safe. -- @@ -98,7 +89,7 @@ -- provided value coerced to a nullable type. maybeToNullable :: Maybe (Field a) -> FieldNullable a -maybeToNullable = C.maybeToNullable +maybeToNullable = maybe null toNullable -unsafeCoerceField :: C.Column a -> C.Column b +unsafeCoerceField :: Field_ n a -> Field_ n' b unsafeCoerceField = C.unsafeCoerceColumn diff --git a/src/Opaleye/FunctionalJoin.hs b/src/Opaleye/FunctionalJoin.hs --- a/src/Opaleye/FunctionalJoin.hs +++ b/src/Opaleye/FunctionalJoin.hs @@ -30,7 +30,7 @@ import qualified Opaleye.SqlTypes as T import qualified Opaleye.Operators as O -{-# DEPRECATED joinF "Use 'Opaleye.Operators.where_' and @do@ notation instead. Will be removed in 0.9." #-} +{-# DEPRECATED joinF "Use 'Opaleye.Operators.where_' and @do@ notation instead. Will be removed in 0.10." #-} joinF :: (fieldsL -> fieldsR -> fieldsResult) -- ^ Calculate result fields from input fields -> (fieldsL -> fieldsR -> F.Field T.SqlBool) @@ -43,7 +43,7 @@ joinF f cond l r = fmap (uncurry f) (O.keepWhen (uncurry cond) <<< ((,) <$> l <*> r)) -{-# DEPRECATED leftJoinF "Use 'Opaleye.Join.optional' instead. Will be removed in 0.9." #-} +{-# DEPRECATED leftJoinF "Use 'Opaleye.Join.optional' instead. Will be removed in 0.10." #-} leftJoinF :: (D.Default IO.IfPP fieldsResult fieldsResult, D.Default IU.Unpackspec fieldsL fieldsL, D.Default IU.Unpackspec fieldsR fieldsR) @@ -75,7 +75,7 @@ (F.FieldNullable T.SqlBool) nullmakerBool = D.def -{-# DEPRECATED rightJoinF "Use 'Opaleye.Join.optional' instead. Will be removed in 0.9." #-} +{-# DEPRECATED rightJoinF "Use 'Opaleye.Join.optional' instead. Will be removed in 0.10." #-} rightJoinF :: (D.Default IO.IfPP fieldsResult fieldsResult, D.Default IU.Unpackspec fieldsL fieldsL, D.Default IU.Unpackspec fieldsR fieldsR) diff --git a/src/Opaleye/Internal/Aggregate.hs b/src/Opaleye/Internal/Aggregate.hs --- a/src/Opaleye/Internal/Aggregate.hs +++ b/src/Opaleye/Internal/Aggregate.hs @@ -33,11 +33,11 @@ HPQ.PrimExpr a b) -makeAggr' :: Maybe HPQ.AggrOp -> Aggregator (C.Column a) (C.Column b) +makeAggr' :: Maybe HPQ.AggrOp -> Aggregator (C.Field_ n a) (C.Field_ n' b) makeAggr' mAggrOp = Aggregator (PM.PackMap (\f (C.Column e) -> fmap C.Column (f (fmap (, [], HPQ.AggrAll) mAggrOp, e)))) -makeAggr :: HPQ.AggrOp -> Aggregator (C.Column a) (C.Column b) +makeAggr :: HPQ.AggrOp -> Aggregator (C.Field_ n a) (C.Field_ n' b) makeAggr = makeAggr' . Just -- | Order the values within each aggregation in `Aggregator` using diff --git a/src/Opaleye/Internal/Binary.hs b/src/Opaleye/Internal/Binary.hs --- a/src/Opaleye/Internal/Binary.hs +++ b/src/Opaleye/Internal/Binary.hs @@ -1,8 +1,10 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-} module Opaleye.Internal.Binary where -import Opaleye.Internal.Column (Column(Column), unColumn) +import Opaleye.Internal.Column (Field_(Column), unColumn) import qualified Opaleye.Internal.Tag as T import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.QueryArr as Q @@ -23,16 +25,16 @@ HPQ.PrimExpr extractBinaryFields = PM.extractAttr "binary" -newtype Binaryspec columns columns' = +newtype Binaryspec fields fields' = Binaryspec (PM.PackMap (HPQ.PrimExpr, HPQ.PrimExpr) HPQ.PrimExpr - (columns, columns) columns') + (fields, fields) fields') runBinaryspec :: Applicative f => Binaryspec columns columns' -> ((HPQ.PrimExpr, HPQ.PrimExpr) -> f HPQ.PrimExpr) -> (columns, columns) -> f columns' runBinaryspec (Binaryspec b) = PM.traversePM b -binaryspecColumn :: Binaryspec (Column a) (Column a) +binaryspecColumn :: Binaryspec (Field_ n a) (Field_ n a) binaryspecColumn = Binaryspec (PM.iso (mapBoth unColumn) Column) where mapBoth f (s, t) = (f s, f t) @@ -52,7 +54,7 @@ , PQ.Rebind False (map (fmap snd) pes) primQuery2 ) -instance Default Binaryspec (Column a) (Column a) where +instance Default Binaryspec (Field_ n a) (Field_ n a) where def = binaryspecColumn -- { diff --git a/src/Opaleye/Internal/Column.hs b/src/Opaleye/Internal/Column.hs --- a/src/Opaleye/Internal/Column.hs +++ b/src/Opaleye/Internal/Column.hs @@ -1,4 +1,9 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} module Opaleye.Internal.Column where @@ -6,73 +11,82 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ --- | A column of a @Query@, of type @pgType@. For example 'Column' --- @SqlInt4@ is an @int4@ column and a 'Column' @SqlText@ is a @text@ +data Nullability = NonNullable | Nullable + +-- | A field of a @Select@, of type @sqlType@. For example a @Field +-- SqlInt4@ is an @int4@ column and a @Field SqlText@ is a @text@ -- column. --- --- The name @Column@ will be replaced by @Field@ in version 0.9. --- There already exists a @Field@ type family to help smooth the --- transition. We recommend that you use @Field_@, @Field@ or --- @FieldNullable@ instead of @Column@ everywhere that it is --- sufficient. -newtype Column pgType = Column HPQ.PrimExpr +newtype Field_ (n :: Nullability) sqlType = Column HPQ.PrimExpr +type Field = Field_ NonNullable +type FieldNullable = Field_ 'Nullable + -- | Only used within a 'Column', to indicate that it can be @NULL@. -- For example, a 'Column' ('Nullable' @SqlText@) can be @NULL@ but a -- 'Column' @SqlText@ cannot. -data Nullable a = Nullable +data Nullable a = Nullable_ -unColumn :: Column a -> HPQ.PrimExpr +-- | Do not use. Use 'Field' instead. Will be removed in a later +-- version. +type family Column a where + Column (Nullable a) = FieldNullable a + Column a = Field a + +unColumn :: Field_ n a -> HPQ.PrimExpr unColumn (Column e) = e -- | 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 -- SQL run time. -unsafeCoerceColumn :: Column a -> Column b +unsafeCoerceColumn :: Field_ n a -> Field_ n' b unsafeCoerceColumn (Column e) = Column e -- | Cast a column to any other type. Implements Postgres's @::@ or -- @CAST( ... AS ... )@ operations. This is safe for some -- conversions, such as uuid to text. -unsafeCast :: String -> Column a -> Column b +unsafeCast :: String -> Field_ n' a -> Field_ n' b unsafeCast = mapColumn . HPQ.CastExpr where - mapColumn :: (HPQ.PrimExpr -> HPQ.PrimExpr) -> Column c -> Column a + mapColumn :: (HPQ.PrimExpr -> HPQ.PrimExpr) -> Field_ n c -> Field_ n' a mapColumn primExpr c = Column (primExpr (unColumn c)) -unsafeCompositeField :: Column a -> String -> Column b +unsafeCompositeField :: Field_ n a -> String -> Field_ n' b unsafeCompositeField (Column e) fieldName = Column (HPQ.CompositeExpr e fieldName) -binOp :: HPQ.BinOp -> Column a -> Column b -> Column c +unsafeFromNullable :: Field_ n a + -> Field_ n' a +unsafeFromNullable (Column e) = Column e + +binOp :: HPQ.BinOp -> Field_ n a -> Field_ n' b -> Field_ n'' c binOp op (Column e) (Column e') = Column (HPQ.BinExpr op e e') -unOp :: HPQ.UnOp -> Column a -> Column b +unOp :: HPQ.UnOp -> Field_ n a -> Field_ n' b unOp op (Column e) = Column (HPQ.UnExpr op e) -- For import order reasons we can't make the argument type SqlBool -unsafeCase_ :: [(Column pgBool, Column a)] -> Column a -> Column a +unsafeCase_ :: [(Field_ n pgBool, Field_ n' a)] -> Field_ n' a -> Field_ n' a unsafeCase_ alts (Column otherwise_) = Column (HPQ.CaseExpr (unColumns alts) otherwise_) where unColumns = map (\(Column e, Column e') -> (e, e')) -unsafeIfThenElse :: Column pgBool -> Column a -> Column a -> Column a +unsafeIfThenElse :: Field_ n' pgBool -> Field_ n a -> Field_ n a -> Field_ n a unsafeIfThenElse cond t f = unsafeCase_ [(cond, t)] f -unsafeGt :: Column a -> Column a -> Column pgBool +unsafeGt :: Field_ n a -> Field_ n a -> Field_ n' pgBool unsafeGt = binOp (HPQ.:>) -unsafeEq :: Column a -> Column a -> Column pgBool +unsafeEq :: Field_ n a -> Field_ n a -> Field_ n' pgBool unsafeEq = binOp (HPQ.:==) class SqlNum a where - pgFromInteger :: Integer -> Column a + pgFromInteger :: Integer -> Field a pgFromInteger = sqlFromInteger - sqlFromInteger :: Integer -> Column a + sqlFromInteger :: Integer -> Field a type PGNum = SqlNum -instance SqlNum a => Num (Column a) where +instance SqlNum a => Num (Field a) where fromInteger = pgFromInteger (*) = binOp (HPQ.:*) (+) = binOp (HPQ.:+) @@ -86,14 +100,14 @@ signum c = unsafeCase_ [(c `unsafeGt` 0, 1), (c `unsafeEq` 0, 0)] (-1) class SqlFractional a where - pgFromRational :: Rational -> Column a + pgFromRational :: Rational -> Field a pgFromRational = sqlFromRational - sqlFromRational :: Rational -> Column a + sqlFromRational :: Rational -> Field a type PGFractional = SqlFractional -instance (SqlNum a, SqlFractional a) => Fractional (Column a) where +instance (SqlNum a, SqlFractional a) => Fractional (Field a) where fromRational = sqlFromRational (/) = binOp (HPQ.:/) @@ -103,12 +117,12 @@ type PGIntegral = SqlIntegral class SqlString a where - pgFromString :: String -> Column a + pgFromString :: String -> Field a pgFromString = sqlFromString - sqlFromString :: String -> Column a + sqlFromString :: String -> Field a type PGString = SqlString -instance SqlString a => IsString (Column a) where +instance SqlString a => IsString (Field a) where fromString = sqlFromString diff --git a/src/Opaleye/Internal/Constant.hs b/src/Opaleye/Internal/Constant.hs --- a/src/Opaleye/Internal/Constant.hs +++ b/src/Opaleye/Internal/Constant.hs @@ -1,9 +1,12 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE DataKinds #-} module Opaleye.Internal.Constant where -import Opaleye.Column (Column) -import qualified Opaleye.Column as C +import Opaleye.Field (Field) +import qualified Opaleye.Field as F import qualified Opaleye.SqlTypes as T import qualified Data.Aeson as Ae @@ -36,127 +39,127 @@ newtype ToFields haskells fields = ToFields { constantExplicit :: haskells -> fields } -instance D.Default ToFields haskell (Column sql) - => D.Default ToFields (Maybe haskell) (Column (C.Nullable sql)) where - def = ToFields (C.maybeToNullable . fmap f) +instance D.Default ToFields haskell (F.Field sql) + => D.Default ToFields (Maybe haskell) (F.FieldNullable sql) where + def = ToFields (F.maybeToNullable . fmap f) where ToFields f = D.def toToFields :: (haskells -> fields) -> ToFields haskells fields toToFields = ToFields -instance D.Default ToFields (Column a) (Column a) where +instance D.Default ToFields (Field a) (Field a) where def = toToFields id -instance D.Default ToFields String (Column T.SqlText) where +instance D.Default ToFields String (Field T.SqlText) where def = toToFields T.sqlString -instance D.Default ToFields LBS.ByteString (Column T.SqlBytea) where +instance D.Default ToFields LBS.ByteString (Field T.SqlBytea) where def = toToFields T.sqlLazyByteString -instance D.Default ToFields SBS.ByteString (Column T.SqlBytea) where +instance D.Default ToFields SBS.ByteString (Field T.SqlBytea) where def = toToFields T.sqlStrictByteString -instance D.Default ToFields ST.Text (Column T.SqlText) where +instance D.Default ToFields ST.Text (Field T.SqlText) where def = toToFields T.sqlStrictText -instance D.Default ToFields LT.Text (Column T.SqlText) where +instance D.Default ToFields LT.Text (Field T.SqlText) where def = toToFields T.sqlLazyText -instance D.Default ToFields String (Column T.SqlVarcharN) where +instance D.Default ToFields String (Field T.SqlVarcharN) where def = toToFields T.sqlStringVarcharN -instance D.Default ToFields ST.Text (Column T.SqlVarcharN) where +instance D.Default ToFields ST.Text (Field T.SqlVarcharN) where def = toToFields T.sqlStrictTextVarcharN -instance D.Default ToFields LT.Text (Column T.SqlVarcharN) where +instance D.Default ToFields LT.Text (Field T.SqlVarcharN) where def = toToFields T.sqlLazyTextVarcharN -instance D.Default ToFields Sci.Scientific (Column T.SqlNumeric) where +instance D.Default ToFields Sci.Scientific (Field T.SqlNumeric) where def = toToFields T.sqlNumeric -instance D.Default ToFields Int (Column T.SqlInt4) where +instance D.Default ToFields Int (Field T.SqlInt4) where def = toToFields T.sqlInt4 -instance D.Default ToFields Int.Int32 (Column T.SqlInt4) where +instance D.Default ToFields Int.Int32 (Field T.SqlInt4) where def = toToFields $ T.sqlInt4 . fromIntegral -instance D.Default ToFields Int.Int64 (Column T.SqlInt8) where +instance D.Default ToFields Int.Int64 (Field T.SqlInt8) where def = toToFields T.sqlInt8 -instance D.Default ToFields Double (Column T.SqlFloat8) where +instance D.Default ToFields Double (Field T.SqlFloat8) where def = toToFields T.sqlDouble -instance D.Default ToFields Bool (Column T.SqlBool) where +instance D.Default ToFields Bool (Field T.SqlBool) where def = toToFields T.sqlBool -instance D.Default ToFields UUID.UUID (Column T.SqlUuid) where +instance D.Default ToFields UUID.UUID (Field T.SqlUuid) where def = toToFields T.sqlUUID -instance D.Default ToFields Time.Day (Column T.SqlDate) where +instance D.Default ToFields Time.Day (Field T.SqlDate) where def = toToFields T.sqlDay -instance D.Default ToFields Time.UTCTime (Column T.SqlTimestamptz) where +instance D.Default ToFields Time.UTCTime (Field T.SqlTimestamptz) where def = toToFields T.sqlUTCTime -instance D.Default ToFields Time.LocalTime (Column T.SqlTimestamp) where +instance D.Default ToFields Time.LocalTime (Field T.SqlTimestamp) where def = toToFields T.sqlLocalTime -instance D.Default ToFields Time.ZonedTime (Column T.SqlTimestamptz) where +instance D.Default ToFields Time.ZonedTime (Field T.SqlTimestamptz) where def = toToFields T.sqlZonedTime -instance D.Default ToFields Time.TimeOfDay (Column T.SqlTime) where +instance D.Default ToFields Time.TimeOfDay (Field T.SqlTime) where def = toToFields T.sqlTimeOfDay -instance D.Default ToFields Time.CalendarDiffTime (Column T.SqlInterval) where +instance D.Default ToFields Time.CalendarDiffTime (Field T.SqlInterval) where def = toToFields T.sqlInterval -instance D.Default ToFields (CI.CI ST.Text) (Column T.SqlCitext) where +instance D.Default ToFields (CI.CI ST.Text) (Field T.SqlCitext) where def = toToFields T.sqlCiStrictText -instance D.Default ToFields (CI.CI LT.Text) (Column T.SqlCitext) where +instance D.Default ToFields (CI.CI LT.Text) (Field T.SqlCitext) where def = toToFields T.sqlCiLazyText -instance D.Default ToFields SBS.ByteString (Column T.SqlJson) where +instance D.Default ToFields SBS.ByteString (Field T.SqlJson) where def = toToFields T.sqlStrictJSON -instance D.Default ToFields LBS.ByteString (Column T.SqlJson) where +instance D.Default ToFields LBS.ByteString (Field T.SqlJson) where def = toToFields T.sqlLazyJSON -instance D.Default ToFields Ae.Value (Column T.SqlJson) where +instance D.Default ToFields Ae.Value (Field T.SqlJson) where def = toToFields T.sqlValueJSON -instance D.Default ToFields SBS.ByteString (Column T.SqlJsonb) where +instance D.Default ToFields SBS.ByteString (Field T.SqlJsonb) where def = toToFields T.sqlStrictJSONB -instance D.Default ToFields LBS.ByteString (Column T.SqlJsonb) where +instance D.Default ToFields LBS.ByteString (Field T.SqlJsonb) where def = toToFields T.sqlLazyJSONB -instance D.Default ToFields Ae.Value (Column T.SqlJsonb) where +instance D.Default ToFields Ae.Value (Field T.SqlJsonb) where def = toToFields T.sqlValueJSONB -instance D.Default ToFields haskell (Column sql) => D.Default ToFields (Maybe haskell) (Maybe (Column sql)) where +instance D.Default ToFields haskell (F.Field_ n sql) => D.Default ToFields (Maybe haskell) (Maybe (F.Field_ n sql)) where def = toToFields (toFields <$>) -instance (D.Default ToFields a (Column b), T.IsSqlType b) - => D.Default ToFields [a] (Column (T.SqlArray b)) where +instance (D.Default ToFields a (F.Field_ n b), T.IsSqlType b) + => D.Default ToFields [a] (F.Field (T.SqlArray_ n b)) where def = toToFields (T.sqlArray (constantExplicit D.def)) -instance D.Default ToFields (R.PGRange Int.Int) (Column (T.SqlRange T.SqlInt4)) where +instance D.Default ToFields (R.PGRange Int.Int) (F.Field (T.SqlRange T.SqlInt4)) where def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlInt4 a b -instance D.Default ToFields (R.PGRange Int.Int64) (Column (T.SqlRange T.SqlInt8)) where +instance D.Default ToFields (R.PGRange Int.Int64) (F.Field (T.SqlRange T.SqlInt8)) where def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlInt8 a b -instance D.Default ToFields (R.PGRange Sci.Scientific) (Column (T.SqlRange T.SqlNumeric)) where +instance D.Default ToFields (R.PGRange Sci.Scientific) (F.Field (T.SqlRange T.SqlNumeric)) where def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlNumeric a b -instance D.Default ToFields (R.PGRange Time.LocalTime) (Column (T.SqlRange T.SqlTimestamp)) where +instance D.Default ToFields (R.PGRange Time.LocalTime) (F.Field (T.SqlRange T.SqlTimestamp)) where def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlLocalTime a b -instance D.Default ToFields (R.PGRange Time.UTCTime) (Column (T.SqlRange T.SqlTimestamptz)) where +instance D.Default ToFields (R.PGRange Time.UTCTime) (F.Field (T.SqlRange T.SqlTimestamptz)) where def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlUTCTime a b -instance D.Default ToFields (R.PGRange Time.Day) (Column (T.SqlRange T.SqlDate)) where +instance D.Default ToFields (R.PGRange Time.Day) (F.Field (T.SqlRange T.SqlDate)) where def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlDay a b -- { Boilerplate instances diff --git a/src/Opaleye/Internal/Distinct.hs b/src/Opaleye/Internal/Distinct.hs --- a/src/Opaleye/Internal/Distinct.hs +++ b/src/Opaleye/Internal/Distinct.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -5,7 +7,7 @@ import qualified Opaleye.Internal.MaybeFields as M import Opaleye.Select (Select) -import Opaleye.Column (Column) +import Opaleye.Field (Field_) import Opaleye.Aggregate (Aggregator, groupBy, aggregate) import Control.Applicative (Applicative, pure, (<*>)) @@ -24,10 +26,10 @@ newtype Distinctspec a b = Distinctspec (Aggregator a b) -instance Default Distinctspec (Column a) (Column a) where +instance Default Distinctspec (Field_ n a) (Field_ n a) where def = Distinctspec groupBy -distinctspecField :: Distinctspec (Column a) (Column a) +distinctspecField :: Distinctspec (Field_ n a) (Field_ n a) distinctspecField = def distinctspecMaybeFields :: M.WithNulls Distinctspec a b diff --git a/src/Opaleye/Internal/Inferrable.hs b/src/Opaleye/Internal/Inferrable.hs --- a/src/Opaleye/Internal/Inferrable.hs +++ b/src/Opaleye/Internal/Inferrable.hs @@ -3,10 +3,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DataKinds #-} module Opaleye.Internal.Inferrable where -import qualified Opaleye.Column as C +import qualified Opaleye.Field as F import Opaleye.Internal.RunQuery (FromField, FromFields) import qualified Opaleye.Internal.RunQuery as RQ import qualified Opaleye.SqlTypes as T @@ -34,16 +35,15 @@ -- FromFields --- OVERLAPPABLE is pretty grim, but it will go away when we switch to Field -instance {-# OVERLAPPABLE #-} +instance D.Default (Inferrable FromField) a b - => D.Default (Inferrable FromFields) (C.Column a) b where + => D.Default (Inferrable FromFields) (F.Field a) b where def = Inferrable (RQ.fromFields (runInferrable D.def)) instance (D.Default (Inferrable FromField) a b, Maybe b ~ maybe_b) - => D.Default (Inferrable FromFields) (C.Column (C.Nullable a)) maybe_b where - def = Inferrable (RQ.fromFields (RQ.fromFieldNullable (runInferrable D.def))) + => D.Default (Inferrable FromFields) (F.FieldNullable a) maybe_b where + def = Inferrable (RQ.fromFieldsNullable (runInferrable D.def)) -- FromField @@ -63,6 +63,10 @@ => D.Default (Inferrable FromField) (T.SqlArray f) hs where def = Inferrable (RQ.fromFieldArray (runInferrable D.def)) +instance (Typeable h, D.Default (Inferrable FromField) f h, hs ~ [Maybe h]) + => D.Default (Inferrable FromField) (T.SqlArray_ F.Nullable f) hs where + def = Inferrable (RQ.fromFieldArrayNullable (runInferrable D.def)) + instance double ~ Double => D.Default (Inferrable FromField) T.SqlFloat8 double where def = Inferrable D.def @@ -145,107 +149,107 @@ (runInferrable D.def)))) -} -instance C.Column a ~ columnA - => D.Default (Inferrable ToFields) (C.Column a) columnA where +instance F.Field a ~ fieldA + => D.Default (Inferrable ToFields) (F.Field a) fieldA where def = Inferrable D.def -instance C.Column T.SqlText ~ cSqlText +instance F.Field T.SqlText ~ cSqlText => D.Default (Inferrable ToFields) String cSqlText where def = Inferrable D.def -instance C.Column T.SqlBytea ~ cSqlBytea +instance F.Field T.SqlBytea ~ cSqlBytea => D.Default (Inferrable ToFields) LBS.ByteString cSqlBytea where def = Inferrable D.def -instance C.Column T.SqlBytea ~ cSqlBytea +instance F.Field T.SqlBytea ~ cSqlBytea => D.Default (Inferrable ToFields) SBS.ByteString cSqlBytea where def = Inferrable D.def -instance C.Column T.SqlText ~ cSqlText +instance F.Field T.SqlText ~ cSqlText => D.Default (Inferrable ToFields) ST.Text cSqlText where def = Inferrable D.def -instance C.Column T.SqlText ~ cSqlText +instance F.Field T.SqlText ~ cSqlText => D.Default (Inferrable ToFields) LT.Text cSqlText where def = Inferrable D.def -instance C.Column T.SqlNumeric ~ cSqlNumeric +instance F.Field T.SqlNumeric ~ cSqlNumeric => D.Default (Inferrable ToFields) Sci.Scientific cSqlNumeric where def = Inferrable D.def -instance C.Column T.SqlInt4 ~ cSqlInt4 +instance F.Field T.SqlInt4 ~ cSqlInt4 => D.Default (Inferrable ToFields) Int cSqlInt4 where def = Inferrable D.def -instance C.Column T.SqlInt4 ~ cSqlInt4 +instance F.Field T.SqlInt4 ~ cSqlInt4 => D.Default (Inferrable ToFields) Int32 cSqlInt4 where def = Inferrable D.def -instance C.Column T.SqlInt8 ~ cSqlInt8 +instance F.Field T.SqlInt8 ~ cSqlInt8 => D.Default (Inferrable ToFields) Int64 cSqlInt8 where def = Inferrable D.def -instance C.Column T.SqlFloat8 ~ cSqlFloat8 +instance F.Field T.SqlFloat8 ~ cSqlFloat8 => D.Default (Inferrable ToFields) Double cSqlFloat8 where def = Inferrable D.def -instance C.Column T.SqlBool ~ cSqlBool +instance F.Field T.SqlBool ~ cSqlBool => D.Default (Inferrable ToFields) Bool cSqlBool where def = Inferrable D.def -instance C.Column T.SqlUuid ~ cSqlUuid +instance F.Field T.SqlUuid ~ cSqlUuid => D.Default (Inferrable ToFields) UUID cSqlUuid where def = Inferrable D.def -instance C.Column T.SqlDate ~ cSqlDate +instance F.Field T.SqlDate ~ cSqlDate => D.Default (Inferrable ToFields) Time.Day cSqlDate where def = Inferrable D.def -instance C.Column T.SqlTimestamptz ~ cSqlTimestamptz +instance F.Field T.SqlTimestamptz ~ cSqlTimestamptz => D.Default (Inferrable ToFields) Time.UTCTime cSqlTimestamptz where def = Inferrable D.def -instance C.Column T.SqlTimestamptz ~ cSqlTimestamptz +instance F.Field T.SqlTimestamptz ~ cSqlTimestamptz => D.Default (Inferrable ToFields) Time.ZonedTime cSqlTimestamptz where def = Inferrable D.def -instance C.Column T.SqlTime ~ cSqlTime +instance F.Field T.SqlTime ~ cSqlTime => D.Default (Inferrable ToFields) Time.TimeOfDay cSqlTime where def = Inferrable D.def -instance C.Column T.SqlInterval ~ cSqlInterval +instance F.Field T.SqlInterval ~ cSqlInterval => D.Default (Inferrable ToFields) Time.CalendarDiffTime cSqlInterval where def = Inferrable D.def -instance C.Column T.SqlCitext ~ cSqlCitext +instance F.Field T.SqlCitext ~ cSqlCitext => D.Default (Inferrable ToFields) (CI.CI ST.Text) cSqlCitext where def = Inferrable D.def -instance C.Column T.SqlCitext ~ cSqlCitext +instance F.Field T.SqlCitext ~ cSqlCitext => D.Default (Inferrable ToFields) (CI.CI LT.Text) cSqlCitext where def = Inferrable D.def -instance C.Column (T.SqlRange T.SqlInt4) ~ cRangeInt4 +instance F.Field (T.SqlRange T.SqlInt4) ~ cRangeInt4 => D.Default (Inferrable ToFields) (R.PGRange Int) cRangeInt4 where def = Inferrable D.def -instance C.Column (T.SqlRange T.SqlInt8) ~ cRangeInt8 +instance F.Field (T.SqlRange T.SqlInt8) ~ cRangeInt8 => D.Default (Inferrable ToFields) (R.PGRange Int64) cRangeInt8 where def = Inferrable D.def -instance C.Column (T.SqlRange T.SqlNumeric) ~ cRangeScientific +instance F.Field (T.SqlRange T.SqlNumeric) ~ cRangeScientific => D.Default (Inferrable ToFields) (R.PGRange Sci.Scientific) cRangeScientific where def = Inferrable D.def -instance C.Column (T.SqlRange T.SqlTimestamp) ~ cRangeTimestamp +instance F.Field (T.SqlRange T.SqlTimestamp) ~ cRangeTimestamp => D.Default (Inferrable ToFields) (R.PGRange Time.LocalTime) cRangeTimestamp where def = Inferrable D.def -instance C.Column (T.SqlRange T.SqlTimestamptz) ~ cRangeTimestamptz +instance F.Field (T.SqlRange T.SqlTimestamptz) ~ cRangeTimestamptz => D.Default (Inferrable ToFields) (R.PGRange Time.UTCTime) cRangeTimestamptz where def = Inferrable D.def -instance C.Column (T.SqlRange T.SqlDate) ~ cRangeDate +instance F.Field (T.SqlRange T.SqlDate) ~ cRangeDate => D.Default (Inferrable ToFields) (R.PGRange Time.Day) cRangeDate where def = Inferrable D.def diff --git a/src/Opaleye/Internal/JSONBuildObjectFields.hs b/src/Opaleye/Internal/JSONBuildObjectFields.hs --- a/src/Opaleye/Internal/JSONBuildObjectFields.hs +++ b/src/Opaleye/Internal/JSONBuildObjectFields.hs @@ -5,7 +5,7 @@ ) where -import Opaleye.Internal.Column (Column (Column)) +import Opaleye.Internal.Column (Field_(Column)) import Opaleye.Field (Field) import Opaleye.Internal.HaskellDB.PrimQuery (Literal (StringLit), PrimExpr (ConstExpr, FunExpr)) import Opaleye.Internal.PGTypesExternal (SqlJson) @@ -25,10 +25,10 @@ mempty = JSONBuildObjectFields mempty mappend = (<>) --- | Given a label and a column, generates a pair for use with @jsonBuildObject@ +-- | Given a label and a field, generates a pair for use with @jsonBuildObject@ jsonBuildObjectField :: String -- ^ Field name - -> Column a + -> Field_ n a -- ^ Field value -> JSONBuildObjectFields jsonBuildObjectField f (Column v) = JSONBuildObjectFields [(f, v)] diff --git a/src/Opaleye/Internal/Join.hs b/src/Opaleye/Internal/Join.hs --- a/src/Opaleye/Internal/Join.hs +++ b/src/Opaleye/Internal/Join.hs @@ -8,7 +8,7 @@ import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.Tag as T import qualified Opaleye.Internal.Unpackspec as U -import Opaleye.Internal.Column (Column(Column), Nullable) +import Opaleye.Internal.Column (Field_(Column), FieldNullable) import qualified Opaleye.Internal.QueryArr as Q import qualified Opaleye.Internal.Operators as Op import qualified Opaleye.Internal.PrimQuery as PQ @@ -35,10 +35,10 @@ toNullable :: NullMaker a b -> a -> b toNullable (NullMaker f) = f -instance D.Default NullMaker (Column a) (Column (Nullable a)) where +instance D.Default NullMaker (Field a) (FieldNullable a) where def = NullMaker C.toNullable -instance D.Default NullMaker (Column (Nullable a)) (Column (Nullable a)) where +instance D.Default NullMaker (FieldNullable a) (FieldNullable a) where def = NullMaker id joinExplicit :: U.Unpackspec columnsA columnsA diff --git a/src/Opaleye/Internal/Manipulation.hs b/src/Opaleye/Internal/Manipulation.hs --- a/src/Opaleye/Internal/Manipulation.hs +++ b/src/Opaleye/Internal/Manipulation.hs @@ -7,8 +7,7 @@ import qualified Control.Applicative as A -import Opaleye.Internal.Column (Column(Column)) -import Opaleye.Field (Field) +import Opaleye.Internal.Column (Field_(Column), Field) import qualified Opaleye.Internal.HaskellDB.Sql as HSql import qualified Opaleye.Internal.HaskellDB.Sql.Default as SD import qualified Opaleye.Internal.HaskellDB.Sql.Generate as SG @@ -123,10 +122,10 @@ -- -instance D.Default Updater (Column a) (Column a) where +instance D.Default Updater (Field_ n a) (Field_ n a) where def = Updater id -instance D.Default Updater (Column a) (Maybe (Column a)) where +instance D.Default Updater (Field_ n a) (Maybe (Field_ n a)) where def = Updater Just arrangeDeleteReturning :: U.Unpackspec columnsReturned ignored @@ -185,47 +184,6 @@ where Column condExpr = cond tableCols TI.View tableCols = TI.tableColumnsView (TI.tableColumns t) -runInsert :: PGS.Connection -> T.Table fields fields' -> fields -> IO Int64 -runInsert conn = PGS.execute_ conn . fromString .: arrangeInsertSql - -runInsertReturning :: (D.Default RS.FromFields fieldsReturned haskells) - => PGS.Connection - -> T.Table fieldsW fieldsR - -> fieldsW - -> (fieldsR -> fieldsReturned) - -> IO [haskells] -runInsertReturning = runInsertReturningExplicit D.def - -runInsertReturningExplicit :: RS.FromFields columnsReturned haskells - -> PGS.Connection - -> T.Table columnsW columnsR - -> columnsW - -> (columnsR -> columnsReturned) - -> IO [haskells] -runInsertReturningExplicit qr conn t = - runInsertManyReturningExplicitI qr conn t . return - -runInsertManyReturningExplicitI :: RS.FromFields columnsReturned haskells - -> PGS.Connection - -> T.Table columnsW columnsR - -> [columnsW] - -> (columnsR -> columnsReturned) - -> IO [haskells] -runInsertManyReturningExplicitI qr conn t columns f = - runInsertManyReturningExplicit qr conn t columns f Nothing - -arrangeInsert :: T.Table columns a -> columns -> HSql.SqlInsert -arrangeInsert t c = arrangeInsertManyI t (return c) - -arrangeInsertSql :: T.Table columns a -> columns -> String -arrangeInsertSql = show . HPrint.ppInsert .: arrangeInsert - -arrangeInsertManyI :: T.Table columns a -> NEL.NonEmpty columns -> HSql.SqlInsert -arrangeInsertManyI t columns = arrangeInsertMany t columns Nothing - -arrangeInsertManySqlI :: T.Table columns a -> NEL.NonEmpty columns -> String -arrangeInsertManySqlI t c = arrangeInsertManySql t c Nothing - arrangeUpdate :: T.Table columnsW columnsR -> (columnsR -> columnsW) -> (columnsR -> Field SqlBool) -> HSql.SqlUpdate @@ -244,22 +202,6 @@ arrangeDeleteSql :: T.Table a columnsR -> (columnsR -> Field SqlBool) -> String arrangeDeleteSql = show . HPrint.ppDelete .: arrangeDelete - -arrangeInsertManyReturningI :: U.Unpackspec columnsReturned ignored - -> T.Table columnsW columnsR - -> NEL.NonEmpty columnsW - -> (columnsR -> columnsReturned) - -> Sql.Returning HSql.SqlInsert -arrangeInsertManyReturningI unpackspec t columns returningf = - arrangeInsertManyReturning unpackspec t columns returningf Nothing - -arrangeInsertManyReturningSqlI :: U.Unpackspec columnsReturned ignored - -> T.Table columnsW columnsR - -> NEL.NonEmpty columnsW - -> (columnsR -> columnsReturned) - -> String -arrangeInsertManyReturningSqlI u t c r = - arrangeInsertManyReturningSql u t c r Nothing arrangeUpdateReturning :: U.Unpackspec columnsReturned ignored -> T.Table columnsW columnsR diff --git a/src/Opaleye/Internal/MaybeFields.hs b/src/Opaleye/Internal/MaybeFields.hs --- a/src/Opaleye/Internal/MaybeFields.hs +++ b/src/Opaleye/Internal/MaybeFields.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Arrows #-} @@ -257,14 +259,14 @@ -- | This is only safe if @col@ is OK with having nulls passed through it -- when they claim to be non-null. withNullsField :: (IsSqlType a, P.Profunctor p) - => p (IC.Column a) (IC.Column a) - -> WithNulls p (IC.Column a) (IC.Column a) + => p (IC.Field_ n a) (IC.Field_ n a) + -> WithNulls p (IC.Field_ n a) (IC.Field_ n a) withNullsField col = result where result = WithNulls (P.lmap (\(MaybeFields b c) -> ifExplict PP.def b c nullC) col) nullC = IC.Column (V.nullPE (columnProxy result)) - columnProxy :: f (IC.Column sqlType) -> Maybe sqlType + columnProxy :: f (IC.Field_ n sqlType) -> Maybe sqlType columnProxy _ = Nothing binaryspecMaybeFields @@ -316,8 +318,8 @@ => PP.Default EqPP (MaybeFields a) (MaybeFields b) where def = eqPPMaybeFields PP.def -instance (P.Profunctor p, IsSqlType a, PP.Default p (IC.Column a) (IC.Column a)) - => PP.Default (WithNulls p) (IC.Column a) (IC.Column a) where +instance (P.Profunctor p, IsSqlType a, PP.Default p (IC.Field_ n a) (IC.Field_ n a)) + => PP.Default (WithNulls p) (IC.Field_ n a) (IC.Field_ n a) where def = withNullsField PP.def instance PP.Default (WithNulls B.Binaryspec) a b diff --git a/src/Opaleye/Internal/Operators.hs b/src/Opaleye/Internal/Operators.hs --- a/src/Opaleye/Internal/Operators.hs +++ b/src/Opaleye/Internal/Operators.hs @@ -1,10 +1,12 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} module Opaleye.Internal.Operators where -import Opaleye.Internal.Column (Column(Column)) +import Opaleye.Internal.Column (Field_(Column)) import qualified Opaleye.Internal.Column as C import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ @@ -49,13 +51,13 @@ newtype EqPP a b = EqPP (a -> a -> Field T.PGBool) -eqPPField :: EqPP (Column a) ignored +eqPPField :: EqPP (Field a) ignored eqPPField = EqPP C.unsafeEq eqExplicit :: EqPP columns a -> columns -> columns -> Field T.PGBool eqExplicit (EqPP f) = f -instance D.Default EqPP (Column a) (Column a) where +instance D.Default EqPP (Field a) (Field a) where def = eqPPField @@ -68,10 +70,10 @@ -> columns' ifExplict (IfPP f) = f -ifPPField :: IfPP (Column a) (Column a) +ifPPField :: IfPP (Field_ n a) (Field_ n a) ifPPField = D.def -instance D.Default IfPP (Column a) (Column a) where +instance D.Default IfPP (Field_ n a) (Field_ n a) where def = IfPP C.unsafeIfThenElse @@ -82,10 +84,10 @@ , relExprCM :: U.Unpackspec c b } -relExprColumn :: RelExprMaker String (Column a) +relExprColumn :: RelExprMaker String (Field_ n a) relExprColumn = RelExprMaker TM.tableColumn U.unpackspecField -instance D.Default RelExprMaker String (Column a) where +instance D.Default RelExprMaker String (Field_ n a) where def = relExprColumn runRelExprMaker :: RelExprMaker strings columns diff --git a/src/Opaleye/Internal/Order.hs b/src/Opaleye/Internal/Order.hs --- a/src/Opaleye/Internal/Order.hs +++ b/src/Opaleye/Internal/Order.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_HADDOCK not-home #-} + module Opaleye.Internal.Order where import Data.Function (on) @@ -8,7 +10,7 @@ import qualified Data.Profunctor as P import qualified Data.Semigroup as S import qualified Data.Void as Void -import qualified Opaleye.Column as C +import qualified Opaleye.Field as F import qualified Opaleye.Internal.Column as IC import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import qualified Opaleye.Internal.PrimQuery as PQ @@ -48,7 +50,7 @@ lose f = C.contramap f (Order Void.absurd) choose f (Order o) (Order o') = C.contramap f (Order (either o o')) -order :: HPQ.OrderOp -> (a -> C.Column b) -> Order a +order :: HPQ.OrderOp -> (a -> F.Field_ n b) -> Order a order op f = Order (fmap (\column -> [(op, IC.unColumn column)]) f) orderByU :: Order a -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag) @@ -78,14 +80,14 @@ oexprs = orderExprs cols ord -- | Order the results of a given query exactly, as determined by the given list --- of input columns. Note that this list does not have to contain an entry for +-- of input fields. Note that this list does not have to contain an entry for -- every result in your query: you may exactly order only a subset of results, -- if you wish. Rows that are not ordered according to the input list are -- returned /after/ the ordered results, in the usual order the database would -- return them (e.g. sorted by primary key). Exactly-ordered results always come -- first in a result set. Entries in the input list that are /not/ present in -- result of a query are ignored. -exact :: [IC.Column b] -> (a -> IC.Column b) -> Order a +exact :: [IC.Field_ n b] -> (a -> IC.Field_ n b) -> Order a exact xs k = maybe M.mempty go (NL.nonEmpty xs) where -- Create an equality AST node, between two columns, essentially -- stating "(column = value)" syntactically. diff --git a/src/Opaleye/Internal/PGTypes.hs b/src/Opaleye/Internal/PGTypes.hs --- a/src/Opaleye/Internal/PGTypes.hs +++ b/src/Opaleye/Internal/PGTypes.hs @@ -1,9 +1,10 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE ScopedTypeVariables #-} module Opaleye.Internal.PGTypes where -import Opaleye.Internal.Column (Column(Column)) -import qualified Opaleye.Internal.Column as C +import Opaleye.Internal.Column (Field, Field_(Column)) import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import Data.Proxy (Proxy(..)) @@ -15,16 +16,16 @@ import qualified Data.ByteString.Lazy as LByteString import qualified Data.Time.Format.ISO8601.Compat as Time -unsafePgFormatTime :: Time.ISO8601 t => HPQ.Name -> t -> Column c +unsafePgFormatTime :: Time.ISO8601 t => HPQ.Name -> t -> Field c unsafePgFormatTime typeName = castToType typeName . format where format = quote . Time.iso8601Show quote s = "'" ++ s ++ "'" -literalColumn :: forall a. IsSqlType a => HPQ.Literal -> Column a +literalColumn :: forall a. IsSqlType a => HPQ.Literal -> Field a literalColumn = Column . HPQ.CastExpr (showSqlType (Proxy :: Proxy a)) . HPQ.ConstExpr -castToType :: HPQ.Name -> String -> Column c +castToType :: HPQ.Name -> String -> Field_ n c castToType typeName = Column . HPQ.CastExpr typeName . HPQ.ConstExpr . HPQ.OtherLit @@ -38,6 +39,3 @@ showSqlType :: proxy sqlType -> String {-# MINIMAL showSqlType #-} - -instance IsSqlType a => IsSqlType (C.Nullable a) where - showSqlType _ = showSqlType (Proxy :: Proxy a) diff --git a/src/Opaleye/Internal/PGTypesExternal.hs b/src/Opaleye/Internal/PGTypesExternal.hs --- a/src/Opaleye/Internal/PGTypesExternal.hs +++ b/src/Opaleye/Internal/PGTypesExternal.hs @@ -1,10 +1,14 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} module Opaleye.Internal.PGTypesExternal (module Opaleye.Internal.PGTypesExternal, IsSqlType(..)) where -import Opaleye.Internal.Column (Column) +import Opaleye.Internal.Column (Field_, Field) import qualified Opaleye.Internal.Column as C import qualified Opaleye.Internal.PGTypes as IPT import Opaleye.Internal.PGTypes (IsSqlType(..)) @@ -57,73 +61,73 @@ -- * Creating SQL values -pgString :: String -> Column PGText +pgString :: String -> Field PGText pgString = IPT.literalColumn . HPQ.StringLit -pgLazyByteString :: LByteString.ByteString -> Column PGBytea +pgLazyByteString :: LByteString.ByteString -> Field PGBytea pgLazyByteString = IPT.literalColumn . HPQ.ByteStringLit . LByteString.toStrict -pgStrictByteString :: SByteString.ByteString -> Column PGBytea +pgStrictByteString :: SByteString.ByteString -> Field PGBytea pgStrictByteString = IPT.literalColumn . HPQ.ByteStringLit -pgStrictText :: SText.Text -> Column PGText +pgStrictText :: SText.Text -> Field PGText pgStrictText = IPT.literalColumn . HPQ.StringLit . SText.unpack -pgLazyText :: LText.Text -> Column PGText +pgLazyText :: LText.Text -> Field PGText pgLazyText = IPT.literalColumn . HPQ.StringLit . LText.unpack -sqlStringVarcharN :: String -> Column SqlVarcharN +sqlStringVarcharN :: String -> Field SqlVarcharN sqlStringVarcharN = IPT.literalColumn . HPQ.StringLit -sqlStrictTextVarcharN :: SText.Text -> Column SqlVarcharN +sqlStrictTextVarcharN :: SText.Text -> Field SqlVarcharN sqlStrictTextVarcharN = IPT.literalColumn . HPQ.StringLit . SText.unpack -sqlLazyTextVarcharN :: LText.Text -> Column SqlVarcharN +sqlLazyTextVarcharN :: LText.Text -> Field SqlVarcharN sqlLazyTextVarcharN = IPT.literalColumn . HPQ.StringLit . LText.unpack -pgNumeric :: Sci.Scientific -> Column PGNumeric +pgNumeric :: Sci.Scientific -> Field PGNumeric pgNumeric = IPT.literalColumn . HPQ.NumericLit -pgInt4 :: Int -> Column PGInt4 +pgInt4 :: Int -> Field PGInt4 pgInt4 = IPT.literalColumn . HPQ.IntegerLit . fromIntegral -pgInt8 :: Int64 -> Column PGInt8 +pgInt8 :: Int64 -> Field PGInt8 pgInt8 = IPT.literalColumn . HPQ.IntegerLit . fromIntegral -pgDouble :: Double -> Column PGFloat8 +pgDouble :: Double -> Field PGFloat8 pgDouble = IPT.literalColumn . HPQ.DoubleLit -pgBool :: Bool -> Column PGBool +pgBool :: Bool -> Field PGBool pgBool = IPT.literalColumn . HPQ.BoolLit -pgUUID :: UUID.UUID -> Column PGUuid +pgUUID :: UUID.UUID -> Field PGUuid pgUUID = IPT.literalColumn . HPQ.StringLit . UUID.toString -pgDay :: Time.Day -> Column PGDate +pgDay :: Time.Day -> Field PGDate pgDay = IPT.unsafePgFormatTime "date" -pgUTCTime :: Time.UTCTime -> Column PGTimestamptz +pgUTCTime :: Time.UTCTime -> Field PGTimestamptz pgUTCTime = IPT.unsafePgFormatTime "timestamptz" -pgLocalTime :: Time.LocalTime -> Column PGTimestamp +pgLocalTime :: Time.LocalTime -> Field PGTimestamp pgLocalTime = IPT.unsafePgFormatTime "timestamp" -pgZonedTime :: Time.ZonedTime -> Column PGTimestamptz +pgZonedTime :: Time.ZonedTime -> Field PGTimestamptz pgZonedTime = IPT.unsafePgFormatTime "timestamptz" -pgTimeOfDay :: Time.TimeOfDay -> Column PGTime +pgTimeOfDay :: Time.TimeOfDay -> Field PGTime pgTimeOfDay = IPT.unsafePgFormatTime "time" -- "We recommend not using the type time with time zone" -- http://www.postgresql.org/docs/8.3/static/datatype-datetime.html -sqlInterval :: Time.CalendarDiffTime -> Column PGInterval +sqlInterval :: Time.CalendarDiffTime -> Field PGInterval sqlInterval = IPT.unsafePgFormatTime "interval" -pgCiStrictText :: CI.CI SText.Text -> Column PGCitext +pgCiStrictText :: CI.CI SText.Text -> Field PGCitext pgCiStrictText = IPT.literalColumn . HPQ.StringLit . SText.unpack . CI.original -pgCiLazyText :: CI.CI LText.Text -> Column PGCitext +pgCiLazyText :: CI.CI LText.Text -> Field PGCitext pgCiLazyText = IPT.literalColumn . HPQ.StringLit . LText.unpack . CI.original -- No CI String instance since postgresql-simple doesn't define @@ -131,16 +135,16 @@ -- The json data type was introduced in PostgreSQL version 9.2 -- JSON values must be SQL string quoted -pgJSON :: String -> Column PGJson +pgJSON :: String -> Field PGJson pgJSON = IPT.castToType "json" . HSD.quote -pgStrictJSON :: SByteString.ByteString -> Column PGJson +pgStrictJSON :: SByteString.ByteString -> Field PGJson pgStrictJSON = pgJSON . IPT.strictDecodeUtf8 -pgLazyJSON :: LByteString.ByteString -> Column PGJson +pgLazyJSON :: LByteString.ByteString -> Field PGJson pgLazyJSON = pgJSON . IPT.lazyDecodeUtf8 -pgValueJSON :: Ae.ToJSON a => a -> Column PGJson +pgValueJSON :: Ae.ToJSON a => a -> Field PGJson pgValueJSON = pgLazyJSON . Ae.encode -- The jsonb data type was introduced in PostgreSQL version 9.4 @@ -148,29 +152,29 @@ -- -- TODO: We need to add literal JSON and JSONB types so we can say -- `castToTypeTyped JSONB` rather than `castToType "jsonb"`. -pgJSONB :: String -> Column PGJsonb +pgJSONB :: String -> Field PGJsonb pgJSONB = IPT.castToType "jsonb" . HSD.quote -pgStrictJSONB :: SByteString.ByteString -> Column PGJsonb +pgStrictJSONB :: SByteString.ByteString -> Field PGJsonb pgStrictJSONB = pgJSONB . IPT.strictDecodeUtf8 -pgLazyJSONB :: LByteString.ByteString -> Column PGJsonb +pgLazyJSONB :: LByteString.ByteString -> Field PGJsonb pgLazyJSONB = pgJSONB . IPT.lazyDecodeUtf8 -pgValueJSONB :: Ae.ToJSON a => a -> Column PGJsonb +pgValueJSONB :: Ae.ToJSON a => a -> Field PGJsonb pgValueJSONB = pgLazyJSONB . Ae.encode -pgArray :: forall a b. IsSqlType b - => (a -> C.Column b) -> [a] -> C.Column (PGArray b) +pgArray :: forall a b n. IsSqlType b + => (a -> Field_ n b) -> [a] -> Field (SqlArray_ n b) pgArray pgEl xs = C.unsafeCast arrayTy $ C.Column (HPQ.ArrayExpr (map oneEl xs)) where oneEl = C.unColumn . pgEl - arrayTy = showSqlType ([] :: [PGArray b]) + arrayTy = showSqlType ([] :: [SqlArray_ n b]) -pgRange :: forall a b. IsRangeType b - => (a -> C.Column b) -> R.RangeBound a -> R.RangeBound a - -> C.Column (PGRange b) +pgRange :: forall a b n n'. IsRangeType b + => (a -> Field_ n b) -> R.RangeBound a -> R.RangeBound a + -> Field_ n' (SqlRange b) pgRange pgEl start end = C.Column (HPQ.RangeExpr (showRangeType ([] :: [b])) (oneEl start) (oneEl end)) where oneEl (R.Inclusive a) = HPQ.Inclusive . C.unColumn $ pgEl a @@ -212,7 +216,7 @@ showSqlType _ = "citext" instance IsSqlType SqlBytea where showSqlType _ = "bytea" -instance IsSqlType a => IsSqlType (SqlArray a) where +instance IsSqlType a => IsSqlType (SqlArray_ n a) where showSqlType _ = showSqlType ([] :: [a]) ++ "[]" instance IsSqlType SqlJson where showSqlType _ = "json" @@ -277,7 +281,8 @@ data SqlTimestamptz data SqlUuid data SqlCitext -data SqlArray a +data SqlArray_ (n :: C.Nullability) a +type SqlArray = SqlArray_ C.NonNullable data SqlBytea data SqlJson data SqlJsonb diff --git a/src/Opaleye/Internal/PrimQuery.hs b/src/Opaleye/Internal/PrimQuery.hs --- a/src/Opaleye/Internal/PrimQuery.hs +++ b/src/Opaleye/Internal/PrimQuery.hs @@ -54,7 +54,7 @@ -- convenient to allow 'Empty', but it is hard to represent 'Empty' in -- SQL so we remove it in 'Optimize' and set 'a = Void'. data PrimQuery' a = Unit - -- Remove the Empty constructor in 0.9 + -- Remove the Empty constructor in 0.10 | Empty a | BaseTable TableIdentifier (Bindings HPQ.PrimExpr) | Product (NEL.NonEmpty (Lateral, PrimQuery' a)) [HPQ.PrimExpr] diff --git a/src/Opaleye/Internal/QueryArr.hs b/src/Opaleye/Internal/QueryArr.hs --- a/src/Opaleye/Internal/QueryArr.hs +++ b/src/Opaleye/Internal/QueryArr.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE Arrows #-} {-# LANGUAGE TypeSynonymInstances #-} diff --git a/src/Opaleye/Internal/RunQuery.hs b/src/Opaleye/Internal/RunQuery.hs --- a/src/Opaleye/Internal/RunQuery.hs +++ b/src/Opaleye/Internal/RunQuery.hs @@ -1,5 +1,8 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} module Opaleye.Internal.RunQuery where @@ -11,12 +14,12 @@ import Database.PostgreSQL.Simple.Internal (RowParser) import qualified Database.PostgreSQL.Simple.FromField as PGS import Database.PostgreSQL.Simple.FromField - (FieldParser, fromField, pgArrayFieldParser) + (FieldParser, fromField, pgArrayFieldParser, optionalField) import Database.PostgreSQL.Simple.FromRow (fromRow, fieldWith) import Database.PostgreSQL.Simple.Types (fromPGArray, Only(..)) -import Opaleye.Column (Column) -import Opaleye.Internal.Column (Nullable) +import Opaleye.Internal.Column (Field_, Field, FieldNullable, + Nullability(Nullable, NonNullable)) import qualified Opaleye.Internal.PackMap as PackMap import qualified Opaleye.Internal.QueryArr as Q import qualified Opaleye.Column as C @@ -74,12 +77,10 @@ -- FieldParser, so we have to have some type that we know contains -- just a FieldParser. --- Why isn't this a newtype? -data FromField sqlType haskellType = - FromField (U.Unpackspec (Column sqlType) ()) (FieldParser haskellType) +newtype FromField sqlType haskellType = FromField (FieldParser haskellType) instance Functor (FromField u) where - fmap f ~(FromField u fp) = FromField u ((fmap . fmap . fmap) f fp) + fmap f (FromField fp) = FromField ((fmap . fmap . fmap) f fp) -- | A 'FromFields' -- specifies how to convert Postgres values (@fields@) @@ -89,14 +90,14 @@ -- -- \"'FromFields' @fields@ @haskells@\" corresponds to -- postgresql-simple's \"'RowParser' @haskells@\". \"'Default' --- 'FromFields' @columns@ @haskells@\" corresponds to +-- 'FromFields' @fields@ @haskells@\" corresponds to -- postgresql-simple's \"@FromRow@ @haskells@\". -data FromFields columns haskells = - FromFields (U.Unpackspec columns ()) - (columns -> RowParser haskells) +data FromFields fields haskells = + FromFields (U.Unpackspec fields ()) + (fields -> RowParser haskells) -- We never actually look at the columns except to see -- its "type" in the case of a sum profunctor - (columns -> Int) + (fields -> Int) -- How many columns have we requested? If we -- asked for zero columns then the SQL generator will -- have to put a dummy 0 into the SELECT statement, @@ -110,58 +111,47 @@ -- SqlInt4)' has no columns when it is Nothing and one -- column when it is Just. -{-# DEPRECATED fieldQueryRunnerColumn "Will be removed in version 0.9. Use fromPGSFromField instead." #-} +{-# DEPRECATED fieldQueryRunnerColumn "Will be removed in version 0.10. Use fromPGSFromField instead." #-} fieldQueryRunnerColumn :: PGS.FromField haskell => FromField pgType haskell fieldQueryRunnerColumn = fromPGSFromField fromPGSFromField :: PGS.FromField haskell => FromField pgType haskell fromPGSFromField = fromPGSFieldParser fromField -{-# DEPRECATED fieldParserQueryRunnerColumn " Will be removed in version 0.9. Use fromPGSFieldParser instead." #-} +{-# DEPRECATED fieldParserQueryRunnerColumn " Will be removed in version 0.10. Use fromPGSFieldParser instead." #-} fieldParserQueryRunnerColumn :: FieldParser haskell -> FromField pgType haskell fieldParserQueryRunnerColumn = fromPGSFieldParser fromPGSFieldParser :: FieldParser haskell -> FromField pgType haskell -fromPGSFieldParser = FromField (P.rmap (const ()) U.unpackspecField) +fromPGSFieldParser = FromField -fromFields :: FromField a b -> FromFields (Column a) b -fromFields qrc = FromFields u (const (fieldWith fp)) (const 1) - where FromField u fp = qrc +fromFields :: FromField a b -> FromFields (Field a) b +fromFields (FromField fp) = fieldParserFromFields fp -{-# DEPRECATED queryRunner "Use fromFields instead. Will be removed in version 0.9." #-} -queryRunner :: FromField a b -> FromFields (Column a) b -queryRunner = fromFields +fieldParserFromFields :: FieldParser haskells -> FromFields (Field_ n a) haskells +fieldParserFromFields fp = FromFields (P.rmap (const ()) U.unpackspecField) (const (fieldWith fp)) (const 1) -fromFieldNullable :: FromField a b - -> FromField (Nullable a) (Maybe b) -fromFieldNullable qr = - FromField (P.lmap C.unsafeCoerceColumn u) (fromField' fp) - where FromField u fp = qr - fromField' :: FieldParser a -> FieldParser (Maybe a) - fromField' _ _ Nothing = pure Nothing - fromField' fp' f bs = fmap Just (fp' f bs) +{-# DEPRECATED queryRunner "Use fromFields instead. Will be removed in version 0.10." #-} +queryRunner :: FromField a b -> FromFields (Field a) b +queryRunner = fromFields -{-# DEPRECATED queryRunnerColumnNullable "Use fromFieldNullable instead. Will be deprecated in 0.9." #-} -queryRunnerColumnNullable :: FromField a b - -> FromField (Nullable a) (Maybe b) -queryRunnerColumnNullable = fromFieldNullable +fromFieldsNullable :: FromField a b -> FromFields (FieldNullable a) (Maybe b) +fromFieldsNullable (FromField fp) = fieldParserFromFields (optionalField fp) unsafeFromFieldRaw :: FromField a (PGS.Field, Maybe SBS.ByteString) unsafeFromFieldRaw = fromPGSFieldParser (\f mdata -> pure (f, mdata)) -unsafeAdjustFromField :: FromField field a -> FromField field' a -unsafeAdjustFromField (FromField u f) = FromField (P.lmap C.unsafeCoerceColumn u) f - -- { Instances for automatic derivation instance DefaultFromField a b => - DefaultFromField (Nullable a) (Maybe b) where - defaultFromField = fromFieldNullable defaultFromField + D.Default FromFields (Field a) b where + def = fromFields defaultFromField instance DefaultFromField a b => - D.Default FromFields (Column a) b where - def = fromFields defaultFromField + D.Default FromFields (FieldNullable a) (Maybe b) + where def = fromFieldsNullable defaultFromField + -- } -- { Instances that must be provided once for each type. Instances @@ -308,26 +298,27 @@ -- No CI String instance since postgresql-simple doesn't define FromField (CI String) instance (Typeable b, DefaultFromField a b) => - DefaultFromField (T.SqlArray a) [b] where + DefaultFromField (T.SqlArray_ NonNullable a) [b] where defaultFromField = fromFieldArray defaultFromField -fromFieldArray :: Typeable h => FromField f h -> FromField (T.SqlArray f) [h] -fromFieldArray q = - fmap fromPGArray (unsafeAdjustFromField (FromField c (pgArrayFieldParser f))) - where FromField c f = q +fromFieldArray :: Typeable h => FromField f h -> FromField (T.SqlArray_ NonNullable f) [h] +fromFieldArray (FromField f) = + fmap fromPGArray (FromField (pgArrayFieldParser f)) +fromFieldArrayNullable :: Typeable h => FromField f h -> FromField (T.SqlArray_ 'Nullable f) [Maybe h] +fromFieldArrayNullable (FromField f) = + fmap fromPGArray (FromField (pgArrayFieldParser (optionalField f))) + -- } instance (Typeable b, DefaultFromField a b) => - DefaultFromField (T.PGRange a) (PGSR.PGRange b) where + DefaultFromField (T.SqlRange a) (PGSR.PGRange b) where defaultFromField = fromFieldRange defaultFromField fromFieldRange :: Typeable b => FromField a b - -> FromField (T.PGRange a) (PGSR.PGRange b) -fromFieldRange off = - FromField (P.lmap C.unsafeCoerceColumn c) (PGSR.fromFieldRange pff) - where FromField c pff = off + -> FromField (T.SqlRange a) (PGSR.PGRange b) +fromFieldRange (FromField pff) = FromField (PGSR.fromFieldRange pff) -- Boilerplate instances @@ -425,6 +416,8 @@ -- SELECT statement, since we can't select zero -- columns. In that case we have to make sure we -- read a single Int. + -- + -- See: Opaleye.Internal.Sql -- | Cursor within a transaction. data Cursor haskells = EmptyCursor | Cursor (RowParser haskells) PGSC.Cursor diff --git a/src/Opaleye/Internal/RunQueryExternal.hs b/src/Opaleye/Internal/RunQueryExternal.hs --- a/src/Opaleye/Internal/RunQueryExternal.hs +++ b/src/Opaleye/Internal/RunQueryExternal.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE FlexibleContexts #-} module Opaleye.Internal.RunQueryExternal diff --git a/src/Opaleye/Internal/Sql.hs b/src/Opaleye/Internal/Sql.hs --- a/src/Opaleye/Internal/Sql.hs +++ b/src/Opaleye/Internal/Sql.hs @@ -175,9 +175,7 @@ --- "GROUP BY 0" means group by the zeroth column so we --- instead use an expression rather than a constant. handleEmpty :: [HSql.SqlExpr] -> NEL.NonEmpty HSql.SqlExpr - handleEmpty = - M.fromMaybe (return (SP.deliteral (HSql.ConstSqlExpr "0"))) - . NEL.nonEmpty + handleEmpty = ensureColumnsGen SP.deliteral aggrs = (map . Arr.second . Arr.second) HPQ.AttrExpr aggrs' diff --git a/src/Opaleye/Internal/Table.hs b/src/Opaleye/Internal/Table.hs --- a/src/Opaleye/Internal/Table.hs +++ b/src/Opaleye/Internal/Table.hs @@ -5,7 +5,7 @@ module Opaleye.Internal.Table where -import Opaleye.Internal.Column (Column(Column), unColumn) +import Opaleye.Internal.Column (Field_(Column), unColumn) import qualified Opaleye.Internal.Tag as Tag import qualified Opaleye.Internal.Unpackspec as U import qualified Opaleye.Internal.PrimQuery as PQ @@ -93,7 +93,7 @@ -- | 'requiredTableField' is for fields which are not optional. You -- must provide them on writes. -requiredTableField :: String -> TableFields (Column a) (Column a) +requiredTableField :: String -> TableFields (Field_ n a) (Field_ n a) requiredTableField columnName = TableFields (requiredW columnName) (View (Column (HPQ.BaseTableAttrExpr columnName))) @@ -101,29 +101,40 @@ -- | 'optionalTableField' is for fields that you can omit on writes, such as -- fields which have defaults or which are SERIAL. -optionalTableField :: String -> TableFields (Maybe (Column a)) (Column a) +optionalTableField :: String -> TableFields (Maybe (Field_ n a)) (Field_ n a) optionalTableField columnName = TableFields (optionalW columnName) (View (Column (HPQ.BaseTableAttrExpr columnName))) --- | 'readOnlyTableField' is for fields that you must omit on writes, such as --- SERIAL fields intended to auto-increment only. -readOnlyTableField :: String -> TableFields () (Column a) +-- | Don't use 'readOnlyTableField'. It will be formally deprecated +-- in a future version. It is broken for updates because it always +-- updates its field with @DEFAULT@ which is very unlikely to be what +-- you want! For more details see +-- . +readOnlyTableField :: String -> TableFields () (Field_ n a) readOnlyTableField = lmap (const Nothing) . optionalTableField --- TODO: Rename this TableField -class TableColumn writeType sqlType | writeType -> sqlType where +-- | You should not define your own instances of +-- 'InferrableTableField'. +class InferrableTableField w n r + | w -> n, w -> r where -- | Infer either a required ('requiredTableField') or optional -- ('optionalTableField') field depending on -- the write type. It's generally more convenient to use this -- than 'required' or 'optional' but you do have to provide a type -- signature instead. - tableField :: String -> TableFields writeType (Column sqlType) + tableField :: String -> TableFields w (Field_ n r) -instance TableColumn (Column a) a where +-- | Equivalent to defining the column with 'requiredTableField'. If +-- the write type is @Field_ n r@ then the read type is also @Field_ n +-- r@. +instance InferrableTableField (Field_ n r) n r where tableField = requiredTableField -instance TableColumn (Maybe (Column a)) a where +-- | Equivalaent to defining the column with 'optionalTableField'. If +-- the write type is @Maybe (Field_ n r)@ (i.e. @DEFAULT@ can be +-- written to it) then the write type is @Field_ n r@. +instance InferrableTableField (Maybe (Field_ n r)) n r where tableField = optionalTableField queryTable :: U.Unpackspec viewColumns columns @@ -177,11 +188,11 @@ where mempty' = [] `NEL.cons` mempty' mappend = (<>) -requiredW :: String -> Writer (Column a) (Column a) +requiredW :: String -> Writer (Field_ n a) (Field_ n a) requiredW columnName = Writer (PM.iso (flip (,) columnName . fmap unColumn) id) -optionalW :: String -> Writer (Maybe (Column a)) (Column a) +optionalW :: String -> Writer (Maybe (Field_ n a)) (Field_ n a) optionalW columnName = Writer (PM.iso (flip (,) columnName . fmap maybeUnColumn) id) where maybeUnColumn = maybe HPQ.DefaultInsertExpr unColumn diff --git a/src/Opaleye/Internal/TableMaker.hs b/src/Opaleye/Internal/TableMaker.hs --- a/src/Opaleye/Internal/TableMaker.hs +++ b/src/Opaleye/Internal/TableMaker.hs @@ -2,7 +2,6 @@ module Opaleye.Internal.TableMaker where -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 @@ -37,16 +36,16 @@ runColumnMaker = U.runUnpackspec -- There's surely a way of simplifying this implementation -tableColumn :: ViewColumnMaker String (C.Column a) +tableColumn :: ViewColumnMaker String (IC.Field_ n a) tableColumn = ViewColumnMaker (PM.PackMap (\f s -> fmap (const (mkColumn s)) (f ()))) where mkColumn = IC.Column . HPQ.BaseTableAttrExpr -instance Default ViewColumnMaker String (C.Column a) where +instance Default ViewColumnMaker String (IC.Field_ n a) where def = tableColumn {-# DEPRECATED column "Use unpackspecColumn instead" #-} -column :: ColumnMaker (C.Column a) (C.Column a) +column :: ColumnMaker (IC.Field_ n a) (IC.Field_ n a) column = U.unpackspecField -- { diff --git a/src/Opaleye/Internal/Unpackspec.hs b/src/Opaleye/Internal/Unpackspec.hs --- a/src/Opaleye/Internal/Unpackspec.hs +++ b/src/Opaleye/Internal/Unpackspec.hs @@ -1,10 +1,12 @@ +{-# OPTIONS_HADDOCK not-home #-} + {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module Opaleye.Internal.Unpackspec where import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.Column as IC -import qualified Opaleye.Column as C +import qualified Opaleye.Field as F import Control.Applicative (Applicative, pure, (<*>)) import Data.Profunctor (Profunctor, dimap) @@ -14,15 +16,15 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ -newtype Unpackspec columns columns' = - -- | An 'Unpackspec' @columns@ @columns'@ allows you to extract and +newtype Unpackspec fields fields' = + -- | An 'Unpackspec' @fields@ @fields'@ allows you to extract and -- modify a sequence of 'HPQ.PrimExpr's inside a value of type - -- @columns@. + -- @fields@. -- - -- For example, the 'Default' instance of type 'Unpackspec' @(Column - -- a, Column b)@ @(Column a, Column b)@ allows you to manipulate or - -- extract the two 'HPQ.PrimExpr's inside a @(Column a, Column b)@. The - -- 'Default' instance of type @Foo (Column a) (Column b) (Column c)@ + -- For example, the 'Default' instance of type 'Unpackspec' @(Field + -- a, Field b)@ @(Field a, Field b)@ allows you to manipulate or + -- extract the two 'HPQ.PrimExpr's inside a @(Field a, Field b)@. The + -- '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 @@ -31,12 +33,12 @@ -- 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 + -- 'Unpackspec's by hand using 'unpackspecField' and the -- 'Profunctor', 'ProductProfunctor' and 'SumProfunctor' operations. - Unpackspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr columns columns') + Unpackspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr fields fields') --- | Target the single 'HPQ.PrimExpr' inside a 'C.Column' -unpackspecField :: Unpackspec (C.Column a) (C.Column a) +-- | Target the single 'HPQ.PrimExpr' inside a 'F.Field n' +unpackspecField :: Unpackspec (F.Field_ n a) (F.Field_ n a) unpackspecField = Unpackspec (PM.iso IC.unColumn IC.Column) -- | Modify all the targeted 'HPQ.PrimExpr's @@ -51,7 +53,7 @@ collectPEs unpackspec = fst . runUnpackspec unpackspec f where f pe = ([pe], pe) -instance D.Default Unpackspec (C.Column a) (C.Column a) where +instance D.Default Unpackspec (F.Field_ n a) (F.Field_ n a) where def = unpackspecField -- { diff --git a/src/Opaleye/Internal/Values.hs b/src/Opaleye/Internal/Values.hs --- a/src/Opaleye/Internal/Values.hs +++ b/src/Opaleye/Internal/Values.hs @@ -2,7 +2,7 @@ module Opaleye.Internal.Values where -import Opaleye.Internal.Column (Column(Column)) +import Opaleye.Internal.Column (Field_(Column)) import qualified Opaleye.Internal.Unpackspec as U import qualified Opaleye.Internal.Tag as T import qualified Opaleye.Internal.PrimQuery as PQ @@ -63,7 +63,7 @@ -> (() -> f HPQ.PrimExpr) -> f columns' runValuesspec (Valuesspec v) f = PM.traversePM v f () -instance Default ValuesspecUnsafe (Column a) (Column a) where +instance Default ValuesspecUnsafe (Field_ n a) (Field_ n a) where def = Valuesspec (PM.iso id Column) valuesUSafe :: Valuesspec columns columns' @@ -98,11 +98,11 @@ primQ' = wrap (PQ.Values valuesPEs values) -data Valuesspec columns columns' = - ValuesspecSafe (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr () columns') - (U.Unpackspec columns columns') +data Valuesspec fields fields' = + ValuesspecSafe (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr () fields') + (U.Unpackspec fields fields') -{-# DEPRECATED ValuesspecSafe "Use Valuesspec instead. Will be removed in version 0.9." #-} +{-# DEPRECATED ValuesspecSafe "Use Valuesspec instead. Will be removed in version 0.10." #-} type ValuesspecSafe = Valuesspec runValuesspecSafe :: Applicative f @@ -112,18 +112,18 @@ runValuesspecSafe (ValuesspecSafe v _) f = PM.traversePM v f () valuesspecField :: Opaleye.SqlTypes.IsSqlType a - => Valuesspec (Column a) (Column a) + => Valuesspec (Field_ n a) (Field_ n a) valuesspecField = def instance Opaleye.Internal.PGTypes.IsSqlType a - => Default Valuesspec (Column a) (Column a) where + => Default Valuesspec (Field_ n a) (Field_ n a) where def = def_ where def_ = ValuesspecSafe (PM.PackMap (\f () -> fmap Column (f null_))) U.unpackspecField null_ = nullPE sqlType sqlType = columnProxy def_ - columnProxy :: f (Column sqlType) -> Maybe sqlType + columnProxy :: f (Field_ n sqlType) -> Maybe sqlType columnProxy _ = Nothing nullPE :: Opaleye.SqlTypes.IsSqlType a => proxy a -> HPQ.PrimExpr @@ -134,7 +134,7 @@ newtype Nullspec fields fields' = Nullspec (Valuesspec Void fields') nullspecField :: Opaleye.SqlTypes.IsSqlType b - => Nullspec a (Column b) + => Nullspec a (Field_ n b) nullspecField = Nullspec (lmap absurd valuesspecField) nullspecList :: Nullspec a [b] @@ -149,7 +149,7 @@ nullspecEitherRight = fmap Right instance Opaleye.SqlTypes.IsSqlType b - => Default Nullspec a (Column b) where + => Default Nullspec a (Field_ n b) where def = nullspecField -- | All fields @NULL@, even though technically the type may forbid diff --git a/src/Opaleye/Manipulation.hs b/src/Opaleye/Manipulation.hs --- a/src/Opaleye/Manipulation.hs +++ b/src/Opaleye/Manipulation.hs @@ -51,7 +51,7 @@ -- ** @DoNothing@ -- | Use 'doNothing' instead. -- @DoNothing@ will be deprecated in - -- version 0.9. + -- version 0.10. HSql.OnConflict(HSql.DoNothing), ) where @@ -61,7 +61,7 @@ import qualified Opaleye.Table as T import qualified Opaleye.Internal.Table as TI import Opaleye.Internal.Column (Column) -import Opaleye.Internal.Helpers ((.:), (.:.)) +import Opaleye.Internal.Helpers ((.:.)) import Opaleye.Internal.Inferrable (Inferrable, runInferrable) import Opaleye.Internal.Manipulation (Updater(Updater)) import qualified Opaleye.Internal.Manipulation as MI @@ -90,16 +90,14 @@ -- you provided when creating the 'Insert'. runInsert conn i = case i of Insert table_ rows_ returning_ onConflict_ -> - let insert = case (returning_, onConflict_) of - (MI.Count, Nothing) -> - runInsertMany - (MI.Count, Just HSql.DoNothing) -> - runInsertManyOnConflictDoNothing - (MI.ReturningExplicit qr f, oc) -> - \c t r -> MI.runInsertManyReturningExplicit qr c t r f oc + let insert = case returning_ of + MI.Count -> + runInsertMany' onConflict_ + MI.ReturningExplicit qr f -> + \c t r -> MI.runInsertManyReturningExplicit qr c t r f onConflict_ in insert conn table_ rows_ --- | Use 'runInsert' instead. Will be deprecated in 0.9. +-- | Use 'runInsert' instead. Will be deprecated in 0.10. runInsert_ :: PGS.Connection -> Insert haskells -> IO haskells @@ -121,7 +119,7 @@ MI.ReturningExplicit qr f -> runUpdateReturningExplicit qr conn table_ updateWith_ where_ f --- | Use 'runUpdate' instead. Will be deprecated in 0.9. +-- | Use 'runUpdate' instead. Will be deprecated in 0.10. runUpdate_ :: PGS.Connection -> Update haskells -> IO haskells @@ -142,7 +140,7 @@ MI.ReturningExplicit qr f -> MI.runDeleteReturningExplicit qr conn table_ where_ f --- | Use 'runDelete' instead. Will be deprecated in 0.9. +-- | Use 'runDelete' instead. Will be deprecated in 0.10. runDelete_ :: PGS.Connection -> Delete haskells -> IO haskells @@ -168,7 +166,7 @@ { uTable :: T.Table fieldsW fieldsR , uUpdateWith :: fieldsR -> fieldsW -- ^ Be careful: providing 'Nothing' to a field created by - -- 'Opaleye.Table.optionalTableFields' updates the field to its default + -- 'Opaleye.Table.optionalTableField' updates the field to its default -- value. Many users have been confused by this because they -- assume it means that the field is to be left unchanged. For an -- easier time wrap your update function in 'updateEasy'. @@ -176,7 +174,10 @@ , uReturning :: MI.Returning fieldsR haskells } --- | A convenient wrapper for writing your update function +-- | A convenient wrapper for writing your update function. +-- @updateEasy@ protects you from accidentally updating an +-- 'Opaleye.Table.optionalTableField' with @Nothing@ (i.e. SQL +-- @DEFAULT@). See 'uUpdateWith'. -- -- @uUpdateWith = updateEasy (\\... -> ...)@ updateEasy :: D.Default Updater fieldsR fieldsW @@ -231,34 +232,17 @@ -- * Deprecated versions --- | Insert rows into a table with @ON CONFLICT DO NOTHING@ -runInsertManyOnConflictDoNothing :: PGS.Connection - -- ^ - -> T.Table columns columns' - -- ^ Table to insert into - -> [columns] - -- ^ Rows to insert - -> IO Int64 - -- ^ Number of rows inserted -runInsertManyOnConflictDoNothing conn table_ columns = +runInsertMany' :: Maybe HSql.OnConflict + -> PGS.Connection + -> TI.Table columnsW columnsR + -> [columnsW] + -> IO Int64 +runInsertMany' oc conn t columns = case NEL.nonEmpty columns of -- Inserting the empty list is just the same as returning 0 Nothing -> return 0 Just columns' -> (PGS.execute_ conn . fromString .:. MI.arrangeInsertManySql) - table_ columns' (Just HSql.DoNothing) - -runInsertMany :: PGS.Connection - -- ^ - -> T.Table columns columns' - -- ^ Table to insert into - -> [columns] - -- ^ Rows to insert - -> IO Int64 - -- ^ Number of rows inserted -runInsertMany conn t columns = case NEL.nonEmpty columns of - -- Inserting the empty list is just the same as returning 0 - Nothing -> return 0 - Just columns' -> (PGS.execute_ conn . fromString .: MI.arrangeInsertManySqlI) t columns' + t columns' oc runUpdateReturningExplicit :: RS.FromFields columnsReturned haskells -> PGS.Connection diff --git a/src/Opaleye/Operators.hs b/src/Opaleye/Operators.hs --- a/src/Opaleye/Operators.hs +++ b/src/Opaleye/Operators.hs @@ -4,6 +4,7 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE DataKinds #-} -- We can probably disable ConstraintKinds and TypeSynonymInstances -- when we move to Sql... instead of PG.. @@ -110,13 +111,14 @@ where import qualified Control.Arrow as A -import qualified Data.Foldable as F +import qualified Data.Foldable as F hiding (null) import qualified Data.List.NonEmpty as NEL import Prelude hiding (not) import qualified Opaleye.Exists as E import qualified Opaleye.Field as F -import Opaleye.Field (Field, FieldNullable) -import Opaleye.Internal.Column (Column(Column), unsafeCase_, +import Opaleye.Internal.Column (Field_(Column), Field, FieldNullable, + Nullability(Nullable), + unsafeCase_, unsafeIfThenElse, unsafeGt) import qualified Opaleye.Internal.Column as C import qualified Opaleye.Internal.JSONBuildObjectFields as JBOF @@ -171,11 +173,11 @@ (_, existsQ, t1) = runSimpleQueryArr criteria (a, t0) infix 4 .== -(.==) :: Column a -> Column a -> F.Field T.SqlBool +(.==) :: Field a -> Field a -> F.Field T.SqlBool (.==) = C.binOp (HPQ.:==) infix 4 ./= -(./=) :: Column a -> Column a -> F.Field T.SqlBool +(./=) :: Field a -> Field a -> F.Field T.SqlBool (./=) = C.binOp (HPQ.:<>) infix 4 .=== @@ -193,40 +195,40 @@ (./==) = Opaleye.Operators.not .: (O..==) infix 4 .> -(.>) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool +(.>) :: Ord.SqlOrd a => Field a -> Field a -> F.Field T.SqlBool (.>) = unsafeGt infix 4 .< -(.<) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool +(.<) :: Ord.SqlOrd a => Field a -> Field a -> F.Field T.SqlBool (.<) = C.binOp (HPQ.:<) infix 4 .<= -(.<=) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool +(.<=) :: Ord.SqlOrd a => Field a -> Field a -> F.Field T.SqlBool (.<=) = C.binOp (HPQ.:<=) infix 4 .>= -(.>=) :: Ord.SqlOrd a => Column a -> Column a -> F.Field T.SqlBool +(.>=) :: Ord.SqlOrd a => Field a -> Field a -> F.Field T.SqlBool (.>=) = C.binOp (HPQ.:>=) -- | Integral division, named after 'Prelude.quot'. It maps to the -- @/@ operator in Postgres. -quot_ :: C.SqlIntegral a => Column a -> Column a -> Column a +quot_ :: C.SqlIntegral a => Field a -> Field a -> Field a quot_ = C.binOp (HPQ.:/) -- | The remainder of integral division, named after 'Prelude.rem'. -- It maps to 'MOD' ('%') in Postgres, confusingly described as -- "modulo (remainder)". -rem_ :: C.SqlIntegral a => Column a -> Column a -> Column a +rem_ :: C.SqlIntegral a => Field a -> Field a -> Field a rem_ = C.binOp HPQ.OpMod -- | Select the first case for which the condition is true. -case_ :: [(F.Field T.SqlBool, Column a)] -> Column a -> Column a +case_ :: [(F.Field T.SqlBool, Field_ n a)] -> Field_ n a -> Field_ n a case_ = unsafeCase_ -- | Monomorphic if\/then\/else. -- -- This may be replaced by 'ifThenElseMany' in a future version. -ifThenElse :: F.Field T.SqlBool -> Column a -> Column a -> Column a +ifThenElse :: F.Field T.SqlBool -> Field_ n a -> Field_ n a -> Field_ n a ifThenElse = unsafeIfThenElse -- | Polymorphic if\/then\/else. @@ -285,7 +287,7 @@ -- '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 (Column a) -> Column a -> F.Field T.SqlBool +in_ :: (Functor f, 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)) @@ -380,43 +382,43 @@ -> F.Field T.SqlBool (.?&) = C.binOp (HPQ.:?&) -emptyArray :: T.IsSqlType a => Column (T.SqlArray a) +emptyArray :: T.IsSqlType a => Field (T.SqlArray_ n a) emptyArray = T.sqlArray id [] -- | Append two 'T.SqlArray's -arrayAppend :: F.Field (T.SqlArray a) -> F.Field (T.SqlArray a) -> F.Field (T.SqlArray a) +arrayAppend :: F.Field (T.SqlArray_ n a) -> F.Field (T.SqlArray_ n a) -> F.Field (T.SqlArray_ n a) arrayAppend = C.binOp (HPQ.:||) -- | Prepend an element to a 'T.SqlArray' -arrayPrepend :: Column a -> Column (T.SqlArray a) -> Column (T.SqlArray a) +arrayPrepend :: Field_ n a -> Field (T.SqlArray_ n a) -> Field (T.SqlArray_ n a) arrayPrepend (Column e) (Column es) = Column (HPQ.FunExpr "array_prepend" [e, es]) -- | Remove all instances of an element from a 'T.SqlArray' -arrayRemove :: Column a -> Column (T.SqlArray a) -> Column (T.SqlArray a) +arrayRemove :: Field_ n a -> Field (T.SqlArray_ n a) -> Field (T.SqlArray_ n a) arrayRemove (Column e) (Column es) = Column (HPQ.FunExpr "array_remove" [es, e]) -- | Remove all 'NULL' values from a 'T.SqlArray' -arrayRemoveNulls :: Column (T.SqlArray (C.Nullable a)) -> Column (T.SqlArray a) -arrayRemoveNulls = Column.unsafeCoerceColumn . arrayRemove Column.null +arrayRemoveNulls :: Field (T.SqlArray_ Nullable a) -> Field (T.SqlArray a) +arrayRemoveNulls = Column.unsafeCoerceColumn . arrayRemove F.null -singletonArray :: T.IsSqlType a => Column a -> Column (T.SqlArray a) +singletonArray :: T.IsSqlType a => Field_ n a -> Field (T.SqlArray_ n a) singletonArray x = arrayPrepend x emptyArray -index :: (C.SqlIntegral n) => Column (T.SqlArray a) -> Column n -> Column (C.Nullable a) +index :: (C.SqlIntegral n) => Field (T.SqlArray_ n' a) -> Field n -> FieldNullable a index (Column a) (Column b) = Column (HPQ.ArrayIndex a b) -- | Postgres's @array_position@ -arrayPosition :: F.Field (T.SqlArray a) -- ^ Haystack - -> F.Field a -- ^ Needle - -> F.Field (Column.Nullable T.SqlInt4) +arrayPosition :: F.Field (T.SqlArray_ n a) -- ^ Haystack + -> F.Field_ n a -- ^ Needle + -> F.FieldNullable T.SqlInt4 arrayPosition (Column fs) (Column f') = C.Column (HPQ.FunExpr "array_position" [fs , f']) -- | Whether the element (needle) exists in the array (haystack). -- N.B. this is implemented hackily using @array_position@. If you -- need it to be implemented using @= any@ then please open an issue. -sqlElem :: F.Field a -- ^ Needle - -> F.Field (T.SqlArray a) -- ^ Haystack +sqlElem :: F.Field_ n a -- ^ Needle + -> F.Field (T.SqlArray_ n a) -- ^ Haystack -> F.Field T.SqlBool sqlElem f fs = (O.not . F.isNull . arrayPosition fs) f @@ -483,7 +485,7 @@ minusInterval :: IntervalNum from to => F.Field from -> F.Field T.SqlInterval -> F.Field to minusInterval = C.binOp (HPQ.:-) -{-# DEPRECATED keepWhen "Use 'where_' or 'restrict' instead. Will be removed in version 0.9." #-} +{-# DEPRECATED keepWhen "Use 'where_' or 'restrict' instead. Will be removed in version 0.10." #-} keepWhen :: (a -> F.Field T.SqlBool) -> S.SelectArr a a keepWhen p = proc a -> do restrict -< p a diff --git a/src/Opaleye/Order.hs b/src/Opaleye/Order.hs --- a/src/Opaleye/Order.hs +++ b/src/Opaleye/Order.hs @@ -28,7 +28,7 @@ ) where import qualified Data.Profunctor.Product.Default as D -import qualified Opaleye.Column as C +import qualified Opaleye.Field as F import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import qualified Opaleye.Internal.Order as O import qualified Opaleye.Internal.QueryArr as Q @@ -58,26 +58,26 @@ -- | Specify an ascending ordering by the given expression. -- (Any NULLs appear last) -asc :: SqlOrd b => (a -> C.Column b) -> O.Order a +asc :: SqlOrd b => (a -> F.Field b) -> O.Order a asc = O.order HPQ.OrderOp { HPQ.orderDirection = HPQ.OpAsc , HPQ.orderNulls = HPQ.NullsLast } -- | Specify an descending ordering by the given expression. -- (Any NULLs appear first) -desc :: SqlOrd b => (a -> C.Column b) -> O.Order a +desc :: SqlOrd b => (a -> F.Field b) -> O.Order a desc = O.order HPQ.OrderOp { HPQ.orderDirection = HPQ.OpDesc , HPQ.orderNulls = HPQ.NullsFirst } -- | Specify an ascending ordering by the given expression. -- (Any NULLs appear first) -ascNullsFirst :: SqlOrd b => (a -> C.Column b) -> O.Order a +ascNullsFirst :: SqlOrd b => (a -> F.Field b) -> O.Order a ascNullsFirst = O.order HPQ.OrderOp { HPQ.orderDirection = HPQ.OpAsc , HPQ.orderNulls = HPQ.NullsFirst } -- | Specify an descending ordering by the given expression. -- (Any NULLs appear last) -descNullsLast :: SqlOrd b => (a -> C.Column b) -> O.Order a +descNullsLast :: SqlOrd b => (a -> F.Field b) -> O.Order a descNullsLast = O.order HPQ.OrderOp { HPQ.orderDirection = HPQ.OpDesc , HPQ.orderNulls = HPQ.NullsLast } @@ -125,14 +125,14 @@ -- * Distinct on --- | Use 'distinctOn' instead. Will be deprecated in 0.9. +-- | Use 'distinctOn' instead. Will be deprecated in 0.10. distinctOnCorrect :: D.Default U.Unpackspec b b => (a -> b) -> S.Select a -> S.Select a distinctOnCorrect proj q = Q.productQueryArr (O.distinctOn D.def proj . Q.runSimpleQueryArr q) --- | Use 'distinctOnBy' instead. Will be deprecated in 0.9. +-- | Use 'distinctOnBy' instead. Will be deprecated in 0.10. distinctOnByCorrect :: D.Default U.Unpackspec b b => (a -> b) -> O.Order a @@ -161,7 +161,6 @@ instance SqlOrd T.SqlTimestamp instance SqlOrd T.SqlCitext instance SqlOrd T.SqlUuid -instance SqlOrd a => SqlOrd (C.Nullable a) -- | Keep a row from each set where the given function returns the same result. No -- ordering is guaranteed. Multiple fields may be distinguished by projecting out diff --git a/src/Opaleye/RunSelect.hs b/src/Opaleye/RunSelect.hs --- a/src/Opaleye/RunSelect.hs +++ b/src/Opaleye/RunSelect.hs @@ -141,8 +141,8 @@ unsafeFromField :: (b -> b') -> IRQ.FromField sqlType b -> IRQ.FromField sqlType' b' -unsafeFromField haskellF (IRQ.FromField u fp) = - fmap haskellF (IRQ.FromField (P.lmap C.unsafeCoerceColumn u) fp) +unsafeFromField haskellF (IRQ.FromField fp) = + fmap haskellF (IRQ.FromField fp) runSelectExplicit :: FromFields fields haskells -> PGS.Connection diff --git a/src/Opaleye/SqlTypes.hs b/src/Opaleye/SqlTypes.hs --- a/src/Opaleye/SqlTypes.hs +++ b/src/Opaleye/SqlTypes.hs @@ -70,6 +70,7 @@ sqlArray, -- ** Types SqlArray, + SqlArray_, -- * Range -- ** Creating values sqlRange, @@ -111,6 +112,7 @@ SqlUuid, SqlCitext, SqlArray, + SqlArray_, SqlBytea, SqlJson, SqlJsonb, @@ -221,7 +223,7 @@ sqlValueJSONB :: Ae.ToJSON a => a -> F.Field SqlJsonb sqlValueJSONB = P.pgValueJSONB -sqlArray :: IsSqlType b => (a -> F.Field b) -> [a] -> F.Field (SqlArray b) +sqlArray :: IsSqlType b => (a -> F.Field_ n b) -> [a] -> F.Field (SqlArray_ n b) sqlArray = P.pgArray sqlRange :: IsRangeType b diff --git a/src/Opaleye/Table.hs b/src/Opaleye/Table.hs --- a/src/Opaleye/Table.hs +++ b/src/Opaleye/Table.hs @@ -15,7 +15,7 @@ @ The leftmost argument is the type of writes. When you insert or - update into this column you must give it a @Field SqlInt4@ (which you + update into this field you must give it a @Field SqlInt4@ (which you can define with @sqlInt4 :: Int -> Field SqlInt4@). A required nullable @SqlInt4@ is defined with 'T.requiredTableField' and gives rise @@ -25,7 +25,7 @@ TableFields (FieldNullable SqlInt4) (FieldNullable SqlInt4) @ - When you insert or update into this column you must give it a + When you insert or update into this field you must give it a @FieldNullable SqlInt4@, which you can define either with @sqlInt4@ and @toNullable :: Field a -> FieldNullable a@, or with @null :: FieldNullable a@. @@ -37,10 +37,10 @@ TableFields (Maybe (Field SqlInt4)) (Field SqlInt4) @ - Optional columns are those that can be omitted on writes, such as + Optional fields 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 - (Field SqlInt4)@. If you provide @Nothing@ then the column will be + When you insert or update into this field you must give it a @Maybe + (Field SqlInt4)@. If you provide @Nothing@ then the field will be omitted from the query and the default value will be used. Otherwise you have to provide a @Just@ containing a @Field SqlInt4@. @@ -51,9 +51,9 @@ TableFields (Maybe (FieldNullable SqlInt4)) (FieldNullable SqlInt4) @ - Optional columns are those that can be omitted on writes, such as + Optional fields 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 + When you insert or update into this field you must give it a @Maybe (FieldNullable SqlInt4)@. If you provide @Nothing@ then the default value will be used. Otherwise you have to provide a @Just@ containing a @FieldNullable SqlInt4@ (which can be null). @@ -66,14 +66,16 @@ T.Table, T.tableField, T.optionalTableField, - T.readOnlyTableField, T.requiredTableField, + T.InferrableTableField, -- * Selecting from tables selectTable, -- * Data types TableFields, -- * Explicit versions selectTableExplicit, + -- * Deprecated versions + T.readOnlyTableField, ) where import qualified Opaleye.Internal.QueryArr as Q diff --git a/src/Opaleye/Values.hs b/src/Opaleye/Values.hs --- a/src/Opaleye/Values.hs +++ b/src/Opaleye/Values.hs @@ -22,13 +22,13 @@ import Data.Profunctor.Product.Default (Default, def) -{-# DEPRECATED valuesUnsafe "Use 'values' instead. Will be removed in 0.9." #-} +{-# DEPRECATED valuesUnsafe "Use 'values' instead. Will be removed in 0.10." #-} valuesUnsafe :: (Default V.ValuesspecUnsafe fields fields, Default U.Unpackspec fields fields) => [fields] -> S.Select fields valuesUnsafe = valuesUnsafeExplicit def def -{-# DEPRECATED valuesUnsafeExplicit "Use 'values' instead. Will be removed in 0.9." #-} +{-# DEPRECATED valuesUnsafeExplicit "Use 'values' instead. Will be removed in 0.10." #-} valuesUnsafeExplicit :: U.Unpackspec fields fields' -> V.ValuesspecUnsafe fields fields' -> [fields] -> S.Select fields' @@ -59,12 +59,12 @@ valuesExplicit valuesspec fields = Q.productQueryArr (V.valuesUSafe valuesspec fields) -{-# DEPRECATED valuesSafe "Use 'values' instead. Will be removed in 0.9." #-} +{-# DEPRECATED valuesSafe "Use 'values' instead. Will be removed in 0.10." #-} valuesSafe :: Default V.Valuesspec fields fields => [fields] -> S.Select fields valuesSafe = values -{-# DEPRECATED valuesSafeExplicit "Use 'values' instead. Will be removed in 0.9." #-} +{-# DEPRECATED valuesSafeExplicit "Use 'values' instead. Will be removed in 0.10." #-} valuesSafeExplicit :: V.Valuesspec fields fields' -> [fields] -> S.Select fields' valuesSafeExplicit = valuesExplicit