opaleye 0.10.4.0 → 0.10.5.0

raw patch · 13 files changed

+146/−64 lines, 13 files

Files

• CHANGELOG.md +6/−0
• LICENSE +1/−1
• Test/Test.hs +37/−0
• opaleye.cabal +4/−3
• src/Opaleye/Experimental/Enum.hs +1/−1
• src/Opaleye/Inferrable.hs +9/−0
• src/Opaleye/Internal/Inferrable.hs +47/−41
• src/Opaleye/Internal/Order.hs +4/−3
• src/Opaleye/Internal/PrimQuery.hs +3/−1
• src/Opaleye/Internal/Print.hs +9/−4
• src/Opaleye/Internal/Sql.hs +5/−5
• src/Opaleye/Internal/Table.hs +5/−3
• src/Opaleye/Order.hs +15/−2

@@ -1,3 +1,9 @@+## 0.10.5.0++* Added `Opaleye.Inferrable`++* Added `limitField` and `offsetField`+ ## 0.10.4.0  * Added `instance Default Updater (Field_ n a) ()`

@@ -1,4 +1,4 @@-Copyright (c) 2014-2018 Purely Agile Limited; 2019-2024 Tom Ellis+Copyright (c) 2014-2018 Purely Agile Limited; 2019-2025 Tom Ellis  All rights reserved. 

@@ -739,6 +739,38 @@ testOffsetLimit :: Test testOffsetLimit = it "" $ limitOrderShouldMatch (O.offset 2 . O.limit 2) (drop 2 . take 2) +limitFieldOrderShouldMatch+  :: (Field O.SqlInt8 -> Select (Field O.SqlInt4, Field O.SqlInt4) -> Select (Field O.SqlInt4, Field O.SqlInt4))+  -> (Int -> [(Int, Int)] -> [(Int, Int)])+  -> (PGS.Connection -> Expectation)+limitFieldOrderShouldMatch olQ ol =+  testH+    (nsQ >>= \n -> olQ n (orderQ table1Q))+    ((ns >>= \n -> ol n (order table1data)) `shouldBe`)+  where+    orderQ = O.orderBy (O.desc snd)+    order = L.sortBy (flip (Ord.comparing snd))+    ns = [1, 2, 3, 4]+    nsQ = O.values $ fromIntegral <$> ns++testLimitField :: Test+testLimitField = it "" $ limitFieldOrderShouldMatch O.limitField take++testOffsetField :: Test+testOffsetField = it "" $ limitFieldOrderShouldMatch O.offsetField drop++testLimitFieldOffset :: Test+testLimitFieldOffset = it "" $+  limitFieldOrderShouldMatch+    (\n -> O.limitField n . O.offsetField n)+    (\n -> take n . drop n)++testOffsetFieldLimit :: Test+testOffsetFieldLimit = it "" $+  limitFieldOrderShouldMatch+    (\n -> O.offsetField n . O.limitField n)+    (\n -> drop n . take n)+ testDistinctAndAggregate :: Test testDistinctAndAggregate = it "" $ q `selectShouldReturnSorted` expectedResult   where q = O.distinct table1Q@@ -1595,6 +1627,11 @@         testOffset         testLimitOffset         testOffsetLimit+      describe "limit field" $ do+        testLimitField+        testOffsetField+        testLimitFieldOffset+        testOffsetFieldLimit       describe "double" $ do         testDoubleDistinct         testDoubleLeftJoin

@@ -1,6 +1,6 @@ name:            opaleye-copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2024 Tom Ellis-version:         0.10.4.0+copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2025 Tom Ellis+version:         0.10.5.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@@ -45,7 +45,7 @@     , transformers        >= 0.3     && < 0.7     , time-compat         >= 1.9.5   && < 1.12     , time-locale-compat  >= 0.1     && < 0.2-    , uuid-types          >= 1.0.6   && < 1.1+    , uuid-types          >= 1.0.5   && < 1.1     , void                >= 0.4     && < 0.8   exposed-modules: Opaleye,                    Opaleye.Adaptors,@@ -57,6 +57,7 @@                    Opaleye.Exists,                    Opaleye.Field,                    Opaleye.FunctionalJoin,+                   Opaleye.Inferrable,                    Opaleye.Join,                    Opaleye.Label,                    Opaleye.Lateral,

@@ -83,7 +83,7 @@ -- -- instance rating ~ Rating --   => D.Default (Inferrable O.FromField) SqlRating rating where---   def = Inferrable D.def+--   def = inferrableDef -- -- instance D.Default O.ToFields Rating (O.Field SqlRating) where --   def = enumToFields sqlRatingMapper

@@ -0,0 +1,9 @@+module Opaleye.Inferrable+  ( Inferrable,+    inferrableDef,+    inferrable,+    runInferrable,+  )+where++import Opaleye.Internal.Inferrable

@@ -43,19 +43,25 @@   => D.Default (Inferrable FromFields) (F.FieldNullable a) maybe_b where   def = Inferrable (RQ.fromFieldsNullable (runInferrable D.def)) +inferrable :: p a b -> Inferrable p a b+inferrable = Inferrable++inferrableDef :: D.Default p a b => Inferrable p a b+inferrableDef = inferrable D.def+ -- FromField  instance int ~ Int => D.Default (Inferrable FromField) T.SqlInt4 int where-  def = Inferrable D.def+  def = inferrableDef  instance int64 ~ Int64 => D.Default (Inferrable FromField) T.SqlInt8 int64 where-  def = Inferrable D.def+  def = inferrableDef  instance text ~ ST.Text => D.Default (Inferrable FromField) T.SqlText text where-  def = Inferrable D.def+  def = inferrableDef  instance varchar ~ ST.Text => D.Default (Inferrable FromField) T.SqlVarcharN varchar where-  def = Inferrable D.def+  def = inferrableDef  instance (Typeable h, D.Default (Inferrable FromField) f h, hs ~ [h])   => D.Default (Inferrable FromField) (T.SqlArray f) hs where@@ -66,25 +72,25 @@   def = Inferrable (RQ.fromFieldArrayNullable (runInferrable D.def))  instance double ~ Double => D.Default (Inferrable FromField) T.SqlFloat8 double where-  def = Inferrable D.def+  def = inferrableDef  instance scientific ~ Sci.Scientific   => D.Default (Inferrable FromField) T.SqlNumeric scientific where-  def = Inferrable D.def+  def = inferrableDef  instance bool ~ Bool => D.Default (Inferrable FromField) T.SqlBool bool where-  def = Inferrable D.def+  def = inferrableDef  instance uuid ~ UUID => D.Default (Inferrable FromField) T.SqlUuid uuid where-  def = Inferrable D.def+  def = inferrableDef  instance bytestring ~ SBS.ByteString   => D.Default (Inferrable FromField) T.SqlBytea bytestring where-  def = Inferrable D.def+  def = inferrableDef  instance day ~ Time.Day   => D.Default (Inferrable FromField) T.SqlDate day where-  def = Inferrable D.def+  def = inferrableDef  -- I'm not certain what we should map timestamptz to.  The -- postgresql-simple types it maps to are ZonedTime and UTCTime, but@@ -93,23 +99,23 @@  --instance utctime ~ Time.UTCTime --  => D.Default (Inferrable FromField) T.SqlTimestamptz utctime where---  def = Inferrable D.def+--  def = inferrableDef  instance localtime ~ Time.LocalTime   => D.Default (Inferrable FromField) T.SqlTimestamp localtime where-  def = Inferrable D.def+  def = inferrableDef  instance timeofday ~ Time.TimeOfDay   => D.Default (Inferrable FromField) T.SqlTime timeofday where-  def = Inferrable D.def+  def = inferrableDef  instance calendardifftime ~ Time.CalendarDiffTime   => D.Default (Inferrable FromField) T.SqlInterval calendardifftime where-  def = Inferrable D.def+  def = inferrableDef  instance cttext ~ CI.CI ST.Text   => D.Default (Inferrable FromField) T.SqlCitext cttext where-  def = Inferrable D.def+  def = inferrableDef  -- It's not clear what to map JSON types to @@ -149,107 +155,107 @@  instance F.Field a ~ fieldA   => D.Default (Inferrable ToFields) (F.Field a) fieldA where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlText ~ cSqlText   => D.Default (Inferrable ToFields) String cSqlText where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlBytea ~ cSqlBytea   => D.Default (Inferrable ToFields) LBS.ByteString cSqlBytea where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlBytea ~ cSqlBytea   => D.Default (Inferrable ToFields) SBS.ByteString cSqlBytea where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlText ~ cSqlText   => D.Default (Inferrable ToFields) ST.Text cSqlText where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlText ~ cSqlText   => D.Default (Inferrable ToFields) LT.Text cSqlText where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlNumeric ~ cSqlNumeric   => D.Default (Inferrable ToFields) Sci.Scientific cSqlNumeric where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlInt4 ~ cSqlInt4   => D.Default (Inferrable ToFields) Int cSqlInt4 where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlInt4 ~ cSqlInt4   => D.Default (Inferrable ToFields) Int32 cSqlInt4 where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlInt8 ~ cSqlInt8   => D.Default (Inferrable ToFields) Int64 cSqlInt8 where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlFloat8 ~ cSqlFloat8   => D.Default (Inferrable ToFields) Double cSqlFloat8 where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlBool ~ cSqlBool   => D.Default (Inferrable ToFields) Bool cSqlBool where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlUuid ~ cSqlUuid   => D.Default (Inferrable ToFields) UUID cSqlUuid where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlDate ~ cSqlDate   => D.Default (Inferrable ToFields) Time.Day cSqlDate where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlTimestamptz ~ cSqlTimestamptz   => D.Default (Inferrable ToFields) Time.UTCTime cSqlTimestamptz where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlTimestamptz ~ cSqlTimestamptz   => D.Default (Inferrable ToFields) Time.ZonedTime cSqlTimestamptz where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlTime ~ cSqlTime   => D.Default (Inferrable ToFields) Time.TimeOfDay cSqlTime where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlInterval ~ cSqlInterval   => D.Default (Inferrable ToFields) Time.CalendarDiffTime cSqlInterval where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlCitext ~ cSqlCitext   => D.Default (Inferrable ToFields) (CI.CI ST.Text) cSqlCitext where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field T.SqlCitext ~ cSqlCitext   => D.Default (Inferrable ToFields) (CI.CI LT.Text) cSqlCitext where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field (T.SqlRange T.SqlInt4) ~ cRangeInt4   => D.Default (Inferrable ToFields) (R.PGRange Int) cRangeInt4 where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field (T.SqlRange T.SqlInt8) ~ cRangeInt8   => D.Default (Inferrable ToFields) (R.PGRange Int64) cRangeInt8 where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field (T.SqlRange T.SqlNumeric) ~ cRangeScientific   => D.Default (Inferrable ToFields) (R.PGRange Sci.Scientific) cRangeScientific where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field (T.SqlRange T.SqlTimestamp) ~ cRangeTimestamp   => D.Default (Inferrable ToFields) (R.PGRange Time.LocalTime) cRangeTimestamp where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field (T.SqlRange T.SqlTimestamptz) ~ cRangeTimestamptz   => D.Default (Inferrable ToFields) (R.PGRange Time.UTCTime) cRangeTimestamptz where-  def = Inferrable D.def+  def = inferrableDef  instance F.Field (T.SqlRange T.SqlDate) ~ cRangeDate   => D.Default (Inferrable ToFields) (R.PGRange Time.Day) cRangeDate where-  def = Inferrable D.def+  def = inferrableDef  {-  It's not clear if Aeson Value should map to JSON or JSONB. 

@@ -60,10 +60,10 @@ orderExprs :: a -> Order a -> [HPQ.OrderExpr] orderExprs x (Order os) = map (uncurry HPQ.OrderExpr) (os x) -limit' :: Int -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)+limit' :: HPQ.PrimExpr -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery) limit' n (x, q) = (x, PQ.Limit (PQ.LimitOp n) q) -offset' :: Int -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery)+offset' :: HPQ.PrimExpr -> (a, PQ.PrimQuery) -> (a, PQ.PrimQuery) offset' n (x, q) = (x, PQ.Limit (PQ.OffsetOp n) q)  distinctOn :: U.Unpackspec b b -> (a -> b)@@ -75,8 +75,9 @@ distinctOnBy ups proj ord (cols, pq) = (cols, pqOut)     where pqOut = case NL.nonEmpty (U.collectPEs ups (proj cols)) of             Just xs -> PQ.DistinctOnOrderBy (Just xs) oexprs pq-            Nothing -> PQ.Limit (PQ.LimitOp 1) (PQ.DistinctOnOrderBy Nothing oexprs pq)+            Nothing -> PQ.Limit (PQ.LimitOp one) (PQ.DistinctOnOrderBy Nothing oexprs pq)           oexprs = orderExprs cols ord+          one = HPQ.ConstExpr (HPQ.IntegerLit 1)  -- | Order the results of a given query exactly, as determined by the given list -- of input fields. Note that this list does not have to contain an entry for

@@ -9,7 +9,9 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import           Opaleye.Internal.HaskellDB.PrimQuery (Symbol) -data LimitOp = LimitOp Int | OffsetOp Int | LimitOffsetOp Int Int+data LimitOp = LimitOp HPQ.PrimExpr+             | OffsetOp HPQ.PrimExpr+             | LimitOffsetOp HPQ.PrimExpr HPQ.PrimExpr              deriving Show  data BinOp = Except

@@ -192,13 +192,18 @@ ppGroupBy Nothing   = empty ppGroupBy (Just xs) = HPrint.ppGroupBy (NEL.toList xs) -ppLimit :: Maybe Int -> Doc+ppLimit :: Maybe HSql.SqlExpr -> Doc ppLimit Nothing = empty-ppLimit (Just n) = text ("LIMIT " ++ show n)+ppLimit (Just n) = text "LIMIT" <+> ppSqlExprParens n -ppOffset :: Maybe Int -> Doc+ppOffset :: Maybe HSql.SqlExpr -> Doc ppOffset Nothing = empty-ppOffset (Just n) = text ("OFFSET " ++ show n)+ppOffset (Just n) = text "OFFSET" <+> ppSqlExprParens n++ppSqlExprParens :: HSql.SqlExpr -> Doc+ppSqlExprParens = \case+  HSql.ConstSqlExpr a -> text a+  a -> parens (HPrint.ppSqlExpr a)  ppFor :: Maybe Sql.LockStrength -> Doc ppFor Nothing       = empty

@@ -47,8 +47,8 @@   groupBy    :: Maybe (NEL.NonEmpty HSql.SqlExpr),   orderBy    :: [(HSql.SqlExpr, HSql.SqlOrder)],   distinctOn :: Maybe (NEL.NonEmpty HSql.SqlExpr),-  limit      :: Maybe Int,-  offset     :: Maybe Int,+  limit      :: Maybe HSql.SqlExpr,+  offset     :: Maybe HSql.SqlExpr,   for        :: Maybe LockStrength   }           deriving Show@@ -231,9 +231,9 @@                                      , limit = limit'                                      , offset = offset' }   where (limit', offset') = case lo of-          PQ.LimitOp n         -> (Just n, Nothing)-          PQ.OffsetOp n        -> (Nothing, Just n)-          PQ.LimitOffsetOp l o -> (Just l, Just o)+          PQ.LimitOp n         -> (Just (sqlExpr n), Nothing)+          PQ.OffsetOp n        -> (Nothing, Just (sqlExpr n))+          PQ.LimitOffsetOp l o -> (Just (sqlExpr l), Just (sqlExpr o))  join :: PQ.JoinType      -> HPQ.PrimExpr

@@ -90,12 +90,12 @@ coerceWriterOutput :: Writer columns dummy -> Writer columns dummy' coerceWriterOutput (Writer w) = Writer w --- | 'requiredTableField' is for fields which are not optional.  You+-- | @requiredTableField@ is for fields which are not optional.  You -- must provide them on writes. requiredTableField :: String -> TableFields (Field_ n a) (Field_ n a) requiredTableField = lmap Just . optionalTableField --- | 'optionalTableField' is for fields that you can omit on writes,+-- | @optionalTableField@ is for fields that you can be set to @DEFAULT@ on writes, -- such as fields which have defaults or which are SERIAL.  Setting -- the write value to @Nothing@ uses SQL @DEFAULT@ in the generated -- update.@@ -104,7 +104,7 @@   (optionalW columnName)   (View (Column (HPQ.BaseTableAttrExpr columnName))) --- | Don't use 'readOnlyTableField'.  It will be formally deprecated+-- | 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@@ -112,6 +112,8 @@ readOnlyTableField :: String -> TableFields () (Field_ n a) readOnlyTableField = lmap (const Nothing) . optionalTableField +-- | @omitOnwritetablefield@ is for fields that should be omitted on+-- writes, such as those that are @GENERATED ALWAYS@. omitOnWriteTableField :: String -> TableFields () (Field_ n a) omitOnWriteTableField columnName = TableFields   (coerceWriterOutput (pure ()))

@@ -12,7 +12,9 @@                      , descNullsFirst                      -- * Limit and offset                      , limit+                     , limitField                      , offset+                     , offsetField                      -- * Distinct on                      , distinctOn                      , distinctOnBy@@ -30,6 +32,7 @@  import qualified Data.Profunctor.Product.Default as D 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.Order as O import qualified Opaleye.Internal.QueryArr as Q@@ -123,7 +126,12 @@ @ -} limit :: Int -> S.Select a -> S.Select a-limit n a = Q.productQueryArr $ do+limit = limitField . fromIntegral++-- | A version of 'limit' that can accept a @Field@ rather than a+-- constant @Int@.+limitField :: F.Field T.SqlInt8 -> S.Select a -> S.Select a+limitField (C.Column n) a = Q.productQueryArr $ do   a_pq <- Q.runSimpleSelect a   pure (O.limit' n a_pq) @@ -135,7 +143,12 @@ 'offset' with 'limit'. -} offset :: Int -> S.Select a -> S.Select a-offset n a = Q.productQueryArr $ do+offset = offsetField . fromIntegral++-- | A version of 'offset' that can accept a @Field@ rather than a+-- constant @Int@.+offsetField :: F.Field T.SqlInt8 -> S.Select a -> S.Select a+offsetField (C.Column n) a = Q.productQueryArr $ do   a_pq <- Q.runSimpleSelect a   pure (O.offset' n a_pq)