diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## 0.8.1.0 + +* Cosmetic and re-export changes only. + ## 0.8.0.1 * Support GHC 9.2 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014-2018 Purely Agile Limited; 2019-2021 Tom Ellis +Copyright (c) 2014-2018 Purely Agile Limited; 2019-2022 Tom Ellis All rights reserved. diff --git a/Test/Test.hs b/Test/Test.hs --- a/Test/Test.hs +++ b/Test/Test.hs @@ -26,9 +26,10 @@ import qualified Database.PostgreSQL.Simple as PGS import qualified Database.PostgreSQL.Simple.Range as R import GHC.Int (Int64) -import Opaleye (Field, Nullable, Select, +import Opaleye (Field, FieldNullable, Select, SelectArr, (.==), (.>)) import qualified Opaleye as O +import qualified Opaleye.Field as F import qualified Opaleye.Internal.Aggregate as IA import Opaleye.Internal.RunQuery (DefaultFromField) import Opaleye.Internal.MaybeFields as OM @@ -724,7 +725,7 @@ testDoubleLeftJoin :: Test testDoubleLeftJoin = it "" $ testDoubleH lj [(1 :: Int, Just (1 :: Int))] where lj :: Select (Field O.SqlInt4) - -> Select (Field O.SqlInt4, Field (Nullable O.SqlInt4)) + -> Select (Field O.SqlInt4, FieldNullable O.SqlInt4) lj q = O.leftJoin q q (uncurry (.==)) testDoubleValues :: Test @@ -737,7 +738,7 @@ where u q = q `O.unionAll` q aLeftJoin :: Select ((Field O.SqlInt4, Field O.SqlInt4), - (Field (Nullable O.SqlInt4), Field (Nullable O.SqlInt4))) + (FieldNullable O.SqlInt4, FieldNullable O.SqlInt4)) aLeftJoin = O.leftJoin table1Q table3Q (\(l, r) -> fst l .== fst r) testLeftJoin :: Test @@ -751,9 +752,9 @@ testLeftJoinNullable :: Test testLeftJoinNullable = it "" $ testH q (`shouldBe` expected) where q :: Select ((Field O.SqlInt4, Field O.SqlInt4), - ((Field (Nullable O.SqlInt4), Field (Nullable O.SqlInt4)), - (Field (Nullable O.SqlInt4), - Field (Nullable O.SqlInt4)))) + ((FieldNullable O.SqlInt4, FieldNullable O.SqlInt4), + (FieldNullable O.SqlInt4, + FieldNullable O.SqlInt4))) q = O.leftJoin table3Q aLeftJoin cond cond (x, y) = fst x .== fst (fst y) @@ -1068,10 +1069,13 @@ testRestrictWithJsonOp dataSelect = it "restricts the rows returned by checking equality with a value extracted using JSON operator" $ testH select (`shouldBe` table8data) where select = dataSelect >>> proc col1 -> do t <- table8Q -< () - O.restrict -< (O.toNullable col1 O..->> O.sqlStrictText "c") - .== O.toNullable (O.sqlStrictText "21") + O.restrict -< nonNullOrFalse (O.toNullable col1 O..->> O.sqlStrictText "c") $ \x1 -> + nonNullOrFalse (O.toNullable (O.sqlStrictText "21")) $ \x2 -> + x1 .== x2 Arr.returnA -< t + nonNullOrFalse = flip (F.matchNullable (O.sqlBool False)) + -- Test opaleye's equivalent of c1->'a'->2 testJsonGetArrayValue :: (O.SqlIsJson a, DefaultFromField a Json.Value) => Select (Field a) -> Test @@ -1405,12 +1409,12 @@ let mconnectString = connectStringEnvVar <|> connectStringDotEnv - connectString <- maybe - (fail ("Set " ++ envVarName ++ " environment variable\n" - ++ "For example " ++ envVarName ++ "='user=tom dbname=opaleye_test " - ++ "host=localhost port=25433 password=tom'")) - (pure . String.fromString) - mconnectString + connectString <- case mconnectString of + Nothing -> + fail ("Set " ++ envVarName ++ " environment variable\n" + ++ "For example " ++ envVarName ++ "='user=tom dbname=opaleye_test " + ++ "host=localhost port=25433 password=tom'") + Just s -> pure (String.fromString s) conn <- PGS.connectPostgreSQL connectString 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-2021 Tom Ellis -version: 0.8.0.1 +copyright: Copyright (c) 2014-2018 Purely Agile Limited; 2019-2022 Tom Ellis +version: 0.8.1.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 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 @@ -80,7 +80,7 @@ -- defaultFromField = enumFromField sqlRatingMapper -- -- instance rating ~ Rating --- => D.Default (Inferrable O.FromFields) (O.Column SqlRating) rating where +-- => D.Default (Inferrable O.FromField) SqlRating rating where -- def = Inferrable D.def -- -- instance D.Default O.ToFields Rating (O.Column SqlRating) where diff --git a/src/Opaleye/Field.hs b/src/Opaleye/Field.hs --- a/src/Opaleye/Field.hs +++ b/src/Opaleye/Field.hs @@ -51,6 +51,8 @@ type FieldNullable a = Field_ 'Nullable a type Field a = Field_ 'NonNullable a +-- FIXME Put Nullspec (or sqltype?) constraint on this + -- | A NULL of any type null :: FieldNullable a null = C.null @@ -64,46 +66,38 @@ -- using the provided function. -- -- The Opaleye equivalent of 'Data.Maybe.maybe'. --- --- Will be generalized to @Field_ n b@ in a later version. -matchNullable :: Field_ 'NonNullable b +matchNullable :: Field b -- ^ - -> (Field_ 'NonNullable a -> Field_ 'NonNullable b) + -> (Field a -> Field b) -- ^ - -> Field_ 'Nullable a + -> FieldNullable a -- ^ - -> Field_ 'NonNullable b + -> Field b matchNullable = C.matchNullable --- | If the @Field 'Nullable a@ is NULL then return the provided --- @Field 'NonNullable a@ otherwise return the underlying @Field --- 'NonNullable a@. +-- | If the @FieldNullable a@ is NULL then return the provided +-- @Field a@ otherwise return the underlying @Field +-- a@. -- -- The Opaleye equivalent of 'Data.Maybe.fromMaybe' and very similar -- to PostgreSQL's @COALESCE@. --- --- Will be generalized to @Field_ n a@ in a later version. -fromNullable :: Field_ 'NonNullable a +fromNullable :: Field a -- ^ - -> Field_ 'Nullable a + -> FieldNullable a -- ^ - -> Field_ 'NonNullable a + -> Field a fromNullable = C.fromNullable -- | Treat a field as though it were nullable. This is always safe. -- -- The Opaleye equivalent of 'Data.Maybe.Just'. --- --- Will be generalized to @Field_ n a@ in a later version. -toNullable :: Field_ 'NonNullable a -> Field_ 'Nullable a +toNullable :: Field a -> FieldNullable a toNullable = C.unsafeCoerceColumn -- | If the argument is 'Data.Maybe.Nothing' return NULL otherwise return the -- provided value coerced to a nullable type. --- --- Will be generalized to @Maybe (Field_ n a)@ in a later version. -maybeToNullable :: Maybe (Field_ 'NonNullable a) - -> Field_ 'Nullable a +maybeToNullable :: Maybe (Field a) + -> FieldNullable a maybeToNullable = C.maybeToNullable unsafeCoerceField :: C.Column a -> C.Column b 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 @@ -50,7 +50,7 @@ unOp :: HPQ.UnOp -> Column a -> Column b unOp op (Column e) = Column (HPQ.UnExpr op e) --- For import order reasons we can't make the return type SqlBool +-- For import order reasons we can't make the argument type SqlBool unsafeCase_ :: [(Column pgBool, Column a)] -> Column a -> Column a unsafeCase_ alts (Column otherwise_) = Column (HPQ.CaseExpr (unColumns alts) otherwise_) where unColumns = map (\(Column e, Column e') -> (e, e')) 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 @@ -6,6 +6,7 @@ where import Opaleye.Internal.Column (Column (Column)) +import Opaleye.Field (Field) import Opaleye.Internal.HaskellDB.PrimQuery (Literal (StringLit), PrimExpr (ConstExpr, FunExpr)) import Opaleye.Internal.PGTypesExternal (SqlJson) import Data.Semigroup @@ -35,7 +36,7 @@ -- | Create an 'SqlJson' object from a collection of fields. -- -- Note: This is implemented as a variadic function in postgres, and as such, is limited to 50 arguments, or 25 key-value pairs. -jsonBuildObject :: JSONBuildObjectFields -> Column SqlJson +jsonBuildObject :: JSONBuildObjectFields -> Field SqlJson jsonBuildObject (JSONBuildObjectFields jbofs) = Column $ FunExpr "json_build_object" args where args = concatMap mapLabelsToPrimExpr jbofs 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 @@ -15,7 +15,7 @@ import qualified Opaleye.Internal.PGTypesExternal as T import qualified Opaleye.Internal.Rebind as Rebind import qualified Opaleye.SqlTypes as T -import qualified Opaleye.Column as C +import qualified Opaleye.Field as C import Opaleye.Field (Field) import qualified Opaleye.Internal.Map as Map import Opaleye.Internal.MaybeFields (MaybeFields(MaybeFields), @@ -47,7 +47,7 @@ -> (columnsB -> returnedColumnsB) -> PQ.JoinType -> Q.Query columnsA -> Q.Query columnsB - -> ((columnsA, columnsB) -> Column T.PGBool) + -> ((columnsA, columnsB) -> Field T.PGBool) -> Q.Query (returnedColumnsA, returnedColumnsB) joinExplicit uA uB returnColumnsA returnColumnsB joinType qA qB cond = Q.productQueryArr q where @@ -71,7 +71,7 @@ leftJoinAExplicit :: U.Unpackspec a a -> NullMaker a nullableA -> Q.Query a - -> Q.QueryArr (a -> Column T.PGBool) nullableA + -> Q.QueryArr (a -> Field T.PGBool) nullableA leftJoinAExplicit uA nullmaker rq = Q.leftJoinQueryArr $ \(p, t1) -> let (newColumnsR, right, tag') = flip Q.runSimpleQueryArr ((), t1) $ proc () -> do @@ -94,7 +94,7 @@ -> S.SelectArr (a -> Field T.SqlBool) (MaybeFields a) optionalRestrictExplicit uA q = dimap (. snd) (\(nonNullIfPresent, rest) -> - let present = Op.not (C.isNull (C.unsafeCoerceColumn nonNullIfPresent)) + let present = Op.not (C.isNull (C.unsafeCoerceField nonNullIfPresent)) in MaybeFields { mfPresent = present , mfFields = rest }) $ 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 @@ -8,6 +8,7 @@ import qualified Control.Applicative as A import Opaleye.Internal.Column (Column(Column)) +import Opaleye.Field (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 @@ -130,7 +131,7 @@ arrangeDeleteReturning :: U.Unpackspec columnsReturned ignored -> T.Table columnsW columnsR - -> (columnsR -> Column SqlBool) + -> (columnsR -> Field SqlBool) -> (columnsR -> columnsReturned) -> Sql.Returning HSql.SqlDelete -- this implementation was copied, it does not make sense yet @@ -143,7 +144,7 @@ arrangeDeleteReturningSql :: U.Unpackspec columnsReturned ignored -> T.Table columnsW columnsR - -> (columnsR -> Column SqlBool) + -> (columnsR -> Field SqlBool) -> (columnsR -> columnsReturned) -> String arrangeDeleteReturningSql = @@ -155,7 +156,7 @@ -- ^ -> T.Table a columnsR -- ^ Table to delete rows from - -> (columnsR -> Column SqlBool) + -> (columnsR -> Field SqlBool) -- ^ Predicate function @f@ to choose which rows to delete. -- 'runDeleteReturning' will delete rows for which @f@ returns @TRUE@ -- and leave unchanged rows for @@ -168,7 +169,7 @@ runDeleteReturningExplicit :: RS.FromFields columnsReturned haskells -> PGS.Connection -> T.Table a columnsR - -> (columnsR -> Column SqlBool) + -> (columnsR -> Field SqlBool) -> (columnsR -> columnsReturned) -> IO [haskells] runDeleteReturningExplicit qr conn t cond r = @@ -178,7 +179,7 @@ parser = IRQ.prepareRowParser qr (r v) TI.View v = TI.tableColumnsView (TI.tableColumns t) -arrangeDelete :: T.Table a columnsR -> (columnsR -> Column SqlBool) -> HSql.SqlDelete +arrangeDelete :: T.Table a columnsR -> (columnsR -> Field SqlBool) -> HSql.SqlDelete arrangeDelete t cond = SG.sqlDelete SD.defaultSqlGenerator (PQ.tiToSqlTable (TI.tableIdentifier t)) [condExpr] where Column condExpr = cond tableCols @@ -226,7 +227,7 @@ arrangeInsertManySqlI t c = arrangeInsertManySql t c Nothing arrangeUpdate :: T.Table columnsW columnsR - -> (columnsR -> columnsW) -> (columnsR -> Column SqlBool) + -> (columnsR -> columnsW) -> (columnsR -> Field SqlBool) -> HSql.SqlUpdate arrangeUpdate t update cond = SG.sqlUpdate SD.defaultSqlGenerator @@ -237,11 +238,11 @@ Column condExpr = cond tableCols arrangeUpdateSql :: T.Table columnsW columnsR - -> (columnsR -> columnsW) -> (columnsR -> Column SqlBool) + -> (columnsR -> columnsW) -> (columnsR -> Field SqlBool) -> String arrangeUpdateSql = show . HPrint.ppUpdate .:. arrangeUpdate -arrangeDeleteSql :: T.Table a columnsR -> (columnsR -> Column SqlBool) -> String +arrangeDeleteSql :: T.Table a columnsR -> (columnsR -> Field SqlBool) -> String arrangeDeleteSql = show . HPrint.ppDelete .: arrangeDelete arrangeInsertManyReturningI :: U.Unpackspec columnsReturned ignored @@ -263,7 +264,7 @@ arrangeUpdateReturning :: U.Unpackspec columnsReturned ignored -> T.Table columnsW columnsR -> (columnsR -> columnsW) - -> (columnsR -> Column SqlBool) + -> (columnsR -> Field SqlBool) -> (columnsR -> columnsReturned) -> Sql.Returning HSql.SqlUpdate arrangeUpdateReturning unpackspec t updatef cond returningf = @@ -276,7 +277,7 @@ arrangeUpdateReturningSql :: U.Unpackspec columnsReturned ignored -> T.Table columnsW columnsR -> (columnsR -> columnsW) - -> (columnsR -> Column SqlBool) + -> (columnsR -> Field SqlBool) -> (columnsR -> columnsReturned) -> String arrangeUpdateReturningSql = 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 @@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} module Opaleye.Internal.MaybeFields where @@ -32,7 +31,7 @@ ifExplict, IfPP, EqPP(EqPP)) import qualified Opaleye.Internal.Lateral import qualified Opaleye.SqlTypes -import Opaleye.SqlTypes (SqlBool, IsSqlType, SqlInt4) +import Opaleye.SqlTypes (SqlBool, IsSqlType) import Control.Monad (replicateM_) @@ -137,13 +136,13 @@ optional = Opaleye.Internal.Lateral.laterally (optionalInternal (MaybeFields . isNotNull)) where isNotNull = Opaleye.Internal.Operators.not . Opaleye.Field.isNull -optionalInternal :: (Field (Opaleye.Column.Nullable SqlBool) -> a -> r) -> Select a -> Select r +optionalInternal :: (Opaleye.Field.FieldNullable SqlBool -> a -> r) -> Select a -> Select r optionalInternal f query = IQ.leftJoinQueryArr $ \arg -> -- This is basically a left join on TRUE, but Shane (@duairc) -- wrote it to ensure that we don't need an Unpackspec a a. let (r, right, tag') = flip IQ.runSimpleQueryArr arg $ proc () -> do a <- query -< () - true_ <- Rebind.rebind -< Opaleye.Column.toNullable (IC.Column true) + true_ <- Rebind.rebind -< Opaleye.Field.toNullable (IC.Column true) returnA -< f true_ a true = HPQ.ConstExpr (HPQ.BoolLit True) in (r, true, right, tag') @@ -245,7 +244,7 @@ newtype WithNulls p a b = WithNulls (p (MaybeFields a) b) --- | This is only safe if d is OK with having nulls passed through it +-- | This is only safe if @b@ is OK with having nulls passed through it -- when they claim to be non-null. mapMaybeFieldsWithNulls :: PP.ProductProfunctor p => p (Field SqlBool) (Field SqlBool) @@ -255,7 +254,7 @@ MaybeFields <$> P.lmap mfPresent (withNullsField b) <*> P.lmap mfFields d --- | This is only safe if d is OK with having nulls passed through it +-- | 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) 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 @@ -15,6 +15,7 @@ import qualified Opaleye.Internal.Unpackspec as U import qualified Opaleye.Internal.PGTypesExternal as T import qualified Opaleye.Field as F +import Opaleye.Field (Field) import qualified Opaleye.Select as S import Data.Profunctor (Profunctor, dimap, lmap, rmap) @@ -29,7 +30,7 @@ infix 4 .== (.==) :: forall columns. D.Default EqPP columns columns - => columns -> columns -> Column T.PGBool + => columns -> columns -> Field T.PGBool (.==) = eqExplicit (D.def :: EqPP columns columns) infixr 2 .|| @@ -40,28 +41,28 @@ infixr 3 .&& -- | Boolean and -(.&&) :: Column T.PGBool -> Column T.PGBool -> Column T.PGBool +(.&&) :: Field T.PGBool -> Field T.PGBool -> Field T.PGBool (.&&) = C.binOp HPQ.OpAnd not :: F.Field T.SqlBool -> F.Field T.SqlBool not = C.unOp HPQ.OpNot -newtype EqPP a b = EqPP (a -> a -> Column T.PGBool) +newtype EqPP a b = EqPP (a -> a -> Field T.PGBool) eqPPField :: EqPP (Column a) ignored eqPPField = EqPP C.unsafeEq -eqExplicit :: EqPP columns a -> columns -> columns -> Column T.PGBool +eqExplicit :: EqPP columns a -> columns -> columns -> Field T.PGBool eqExplicit (EqPP f) = f instance D.Default EqPP (Column a) (Column a) where def = eqPPField -newtype IfPP a b = IfPP (Column T.PGBool -> a -> a -> b) +newtype IfPP a b = IfPP (Field T.PGBool -> a -> a -> b) ifExplict :: IfPP columns columns' - -> Column T.PGBool + -> Field T.PGBool -> columns -> columns -> columns' 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,6 +1,5 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeSynonymInstances #-} module Opaleye.Internal.PGTypesExternal (module Opaleye.Internal.PGTypesExternal, IsSqlType(..)) where @@ -21,7 +20,6 @@ import qualified Data.ByteString.Lazy as LByteString import Data.Scientific as Sci import qualified Data.Time.Compat as Time -import qualified Data.Time.Format.ISO8601.Compat as Time.Format.ISO8601 import qualified Data.UUID as UUID import Data.Int (Int64) 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 @@ -75,8 +75,8 @@ -- just a FieldParser. -- Why isn't this a newtype? -data FromField pgType haskellType = - FromField (U.Unpackspec (Column pgType) ()) (FieldParser haskellType) +data FromField sqlType haskellType = + FromField (U.Unpackspec (Column sqlType) ()) (FieldParser haskellType) instance Functor (FromField u) where fmap f ~(FromField u fp) = FromField u ((fmap . fmap . fmap) f fp) @@ -149,6 +149,9 @@ 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 => @@ -304,17 +307,13 @@ -- No CI String instance since postgresql-simple doesn't define FromField (CI String) -arrayColumn :: Column (T.SqlArray a) -> Column a -arrayColumn = C.unsafeCoerceColumn - instance (Typeable b, DefaultFromField a b) => DefaultFromField (T.SqlArray a) [b] where defaultFromField = fromFieldArray defaultFromField fromFieldArray :: Typeable h => FromField f h -> FromField (T.SqlArray f) [h] fromFieldArray q = - FromField (P.lmap arrayColumn c) - ((fmap . fmap . fmap) fromPGArray (pgArrayFieldParser f)) + fmap fromPGArray (unsafeAdjustFromField (FromField c (pgArrayFieldParser f))) where FromField c f = q -- } 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 @@ -111,6 +111,7 @@ readOnlyTableField :: String -> TableFields () (Column a) readOnlyTableField = lmap (const Nothing) . optionalTableField +-- TODO: Rename this TableField class TableColumn writeType sqlType | writeType -> sqlType where -- | Infer either a required ('requiredTableField') or optional -- ('optionalTableField') field depending on diff --git a/src/Opaleye/Manipulation.hs b/src/Opaleye/Manipulation.hs --- a/src/Opaleye/Manipulation.hs +++ b/src/Opaleye/Manipulation.hs @@ -168,7 +168,7 @@ { uTable :: T.Table fieldsW fieldsR , uUpdateWith :: fieldsR -> fieldsW -- ^ Be careful: providing 'Nothing' to a field created by - -- 'Opaleye.Table.optional' updates the field to its default + -- 'Opaleye.Table.optionalTableFields' 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'. diff --git a/src/Opaleye/Operators.hs b/src/Opaleye/Operators.hs --- a/src/Opaleye/Operators.hs +++ b/src/Opaleye/Operators.hs @@ -115,6 +115,7 @@ 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_, unsafeIfThenElse, unsafeGt) import qualified Opaleye.Internal.Column as C @@ -276,7 +277,7 @@ ilike :: F.Field T.SqlText -> F.Field T.SqlText -> F.Field T.SqlBool ilike = C.binOp HPQ.OpILike -sqlLength :: C.PGString a => F.Field a -> F.Field T.SqlInt4 +sqlLength :: C.SqlString a => F.Field a -> F.Field T.SqlInt4 sqlLength (Column e) = Column (HPQ.FunExpr "length" [e]) -- | 'in_' is designed to be used in prefix form. @@ -285,9 +286,9 @@ -- 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_ fcas (Column a) = Column $ case NEL.nonEmpty (F.toList fcas) of - Nothing -> HPQ.ConstExpr (HPQ.BoolLit False) - Just xs -> HPQ.BinExpr HPQ.OpIn a (HPQ.ListExpr (fmap C.unColumn xs)) +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)) -- | True if the first argument occurs amongst the rows of the second, -- false otherwise. @@ -301,7 +302,7 @@ -- Used to overload functions and operators that work on both 'T.SqlJson' and 'T.SqlJsonb'. -- -- Warning: making additional instances of this class can lead to broken code! -class SqlIsJson a +class SqlIsJson json instance SqlIsJson T.SqlJson instance SqlIsJson T.SqlJsonb @@ -311,6 +312,7 @@ -- Warning: making additional instances of this class can lead to broken code! class SqlJsonIndex a +-- | Use 'SqlJsonIndex' instead. Will be deprecated in a future version. type PGJsonIndex = SqlJsonIndex instance SqlJsonIndex T.SqlInt4 @@ -319,33 +321,33 @@ -- | Get JSON object field by key. infixl 8 .-> -(.->) :: (SqlIsJson a, SqlJsonIndex k) - => F.FieldNullable a -- ^ +(.->) :: (SqlIsJson json, SqlJsonIndex k) + => F.FieldNullable json -- ^ -> F.Field k -- ^ key or index - -> F.FieldNullable a + -> F.FieldNullable json (.->) = C.binOp (HPQ.:->) -- | Get JSON object field as text. infixl 8 .->> -(.->>) :: (SqlIsJson a, SqlJsonIndex k) - => F.FieldNullable a -- ^ +(.->>) :: (SqlIsJson json, SqlJsonIndex k) + => F.FieldNullable json -- ^ -> F.Field k -- ^ key or index -> F.FieldNullable T.SqlText (.->>) = C.binOp (HPQ.:->>) -- | Get JSON object at specified path. infixl 8 .#> -(.#>) :: (SqlIsJson a) - => F.FieldNullable a -- ^ - -> Column (T.SqlArray T.SqlText) -- ^ path - -> F.FieldNullable a +(.#>) :: (SqlIsJson json) + => F.FieldNullable json -- ^ + -> Field (T.SqlArray T.SqlText) -- ^ path + -> F.FieldNullable json (.#>) = C.binOp (HPQ.:#>) -- | Get JSON object at specified path as text. infixl 8 .#>> -(.#>>) :: (SqlIsJson a) - => F.FieldNullable a -- ^ - -> Column (T.SqlArray T.SqlText) -- ^ path +(.#>>) :: (SqlIsJson json) + => F.FieldNullable json -- ^ + -> Field (T.SqlArray T.SqlText) -- ^ path -> F.FieldNullable T.SqlText (.#>>) = C.binOp (HPQ.:#>>) @@ -367,14 +369,14 @@ -- | Do any of these key/element strings exist? infix 4 .?| (.?|) :: F.Field T.SqlJsonb - -> Column (T.SqlArray T.SqlText) + -> Field (T.SqlArray T.SqlText) -> F.Field T.SqlBool (.?|) = C.binOp (HPQ.:?|) -- | Do all of these key/element strings exist? infix 4 .?& (.?&) :: F.Field T.SqlJsonb - -> Column (T.SqlArray T.SqlText) + -> Field (T.SqlArray T.SqlText) -> F.Field T.SqlBool (.?&) = C.binOp (HPQ.:?&) @@ -418,38 +420,38 @@ -> F.Field T.SqlBool sqlElem f fs = (O.not . F.isNull . arrayPosition fs) f -overlap :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool +overlap :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool overlap = C.binOp (HPQ.:&&) -liesWithin :: T.IsRangeType a => Column a -> Column (T.SqlRange a) -> F.Field T.SqlBool +liesWithin :: T.IsRangeType a => Field a -> Field (T.SqlRange a) -> F.Field T.SqlBool liesWithin = C.binOp (HPQ.:<@) -- | Access the upper bound of a range. For discrete range types it is the exclusive bound. -upperBound :: T.IsRangeType a => Column (T.SqlRange a) -> Column (C.Nullable a) +upperBound :: T.IsRangeType a => Field (T.SqlRange a) -> FieldNullable a upperBound (Column range) = Column $ HPQ.FunExpr "upper" [range] -- | Access the lower bound of a range. For discrete range types it is the inclusive bound. -lowerBound :: T.IsRangeType a => Column (T.SqlRange a) -> Column (C.Nullable a) +lowerBound :: T.IsRangeType a => Field (T.SqlRange a) -> FieldNullable a lowerBound (Column range) = Column $ HPQ.FunExpr "lower" [range] infix 4 .<< -(.<<) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool +(.<<) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool (.<<) = C.binOp (HPQ.:<<) infix 4 .>> -(.>>) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool +(.>>) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool (.>>) = C.binOp (HPQ.:>>) infix 4 .&< -(.&<) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool +(.&<) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool (.&<) = C.binOp (HPQ.:&<) infix 4 .&> -(.&>) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool +(.&>) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool (.&>) = C.binOp (HPQ.:&>) infix 4 .-|- -(.-|-) :: Column (T.SqlRange a) -> Column (T.SqlRange a) -> F.Field T.SqlBool +(.-|-) :: Field (T.SqlRange a) -> Field (T.SqlRange a) -> F.Field T.SqlBool (.-|-) = C.binOp (HPQ.:-|-) timestamptzAtTimeZone :: F.Field T.SqlTimestamptz diff --git a/src/Opaleye/RunSelect.hs b/src/Opaleye/RunSelect.hs --- a/src/Opaleye/RunSelect.hs +++ b/src/Opaleye/RunSelect.hs @@ -142,7 +142,7 @@ -> IRQ.FromField sqlType b -> IRQ.FromField sqlType' b' unsafeFromField haskellF (IRQ.FromField u fp) = - fmap haskellF (IRQ.FromField (P.lmap (C.unsafeCoerceColumn) u) fp) + fmap haskellF (IRQ.FromField (P.lmap C.unsafeCoerceColumn u) 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 @@ -16,6 +16,9 @@ SqlInt8, SqlInt2, SqlFloat4, + -- ** Type classes + IC.SqlNum, + IC.SqlIntegral, -- * Date and time -- ** Creating values sqlDay, @@ -60,6 +63,8 @@ SqlText, SqlVarcharN, SqlCitext, + -- ** Type classes + IC.SqlString, -- * Array -- ** Creating values sqlArray, @@ -86,6 +91,7 @@ ) where import qualified Opaleye.Field as F +import qualified Opaleye.Internal.Column as IC import qualified Opaleye.Internal.PGTypesExternal as P import Opaleye.Internal.PGTypesExternal (IsSqlType, IsRangeType) import Opaleye.Internal.PGTypesExternal (SqlBool,