opaleye 0.5.2.2 → 0.5.3.0

raw patch · 12 files changed

+164/−8 lines, 12 filesdep ~aesondep ~product-profunctorsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, product-profunctors

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• LICENSE +1/−1
• Test/Test.hs +40/−1
• opaleye.cabal +4/−4
• src/Opaleye/Constant.hs +20/−0
• src/Opaleye/Internal/HaskellDB/PrimQuery.hs +5/−0
• src/Opaleye/Internal/HaskellDB/Sql.hs +4/−0
• src/Opaleye/Internal/HaskellDB/Sql/Default.hs +12/−1
• src/Opaleye/Internal/HaskellDB/Sql/Print.hs +13/−1
• src/Opaleye/Internal/RunQuery.hs +5/−0
• src/Opaleye/Operators.hs +23/−0
• src/Opaleye/PGTypes.hs +33/−0

@@ -1,3 +1,7 @@+## 0.5.3.0++* Added support for range types+ ## 0.5.2.2  * Corrected fixity for .&&

@@ -1,4 +1,4 @@-Copyright (c) 2014-2016 Purely Agile Limited+Copyright (c) 2014-2017 Purely Agile Limited  All rights reserved. 

@@ -11,6 +11,7 @@ import qualified Opaleye.Internal.Aggregate as IA  import qualified Database.PostgreSQL.Simple as PGS+import qualified Database.PostgreSQL.Simple.Range as R import qualified Data.Profunctor.Product.Default as D import qualified Data.Profunctor.Product as PP import qualified Data.Profunctor as P@@ -854,6 +855,42 @@   where q = table9Q >>> proc c1 -> do               Arr.returnA -< c1 O..?& O.pgArray O.pgStrictText ["a", "b", "c"] +testRangeOverlap :: Test+testRangeOverlap = testG q (== [True])+  where range :: Int -> Int -> Column (O.PGRange O.PGInt4)+        range a b = O.pgRange O.pgInt4 (R.Inclusive a) (R.Inclusive b)+        q = A.pure $ (range 3 7) `O.overlap` (range 4 12)++testRangeLeftOf :: Test+testRangeLeftOf = testG q (== [True])+  where range :: Int -> Int -> Column (O.PGRange O.PGInt4)+        range a b = O.pgRange O.pgInt4 (R.Inclusive a) (R.Inclusive b)+        q = A.pure $ (range 1 10) O..<< (range 100 110)++testRangeRightOf :: Test+testRangeRightOf = testG q (== [True])+  where range :: Int -> Int -> Column (O.PGRange O.PGInt4)+        range a b = O.pgRange O.pgInt4 (R.Inclusive a) (R.Inclusive b)+        q = A.pure $ (range 50 60) O..>> (range 20 30)++testRangeRightExtension :: Test+testRangeRightExtension = testG q (== [True])+  where range :: Int -> Int -> Column (O.PGRange O.PGInt4)+        range a b = O.pgRange O.pgInt4 (R.Inclusive a) (R.Inclusive b)+        q = A.pure $ (range 1 20) O..&< (range 18 20)++testRangeLeftExtension :: Test+testRangeLeftExtension = testG q (== [True])+  where range :: Int -> Int -> Column (O.PGRange O.PGInt4)+        range a b = O.pgRange O.pgInt4 (R.Inclusive a) (R.Inclusive b)+        q = A.pure $ (range 7 20) O..&> (range 5 10)++testRangeAdjacency :: Test+testRangeAdjacency = testG q (== [True])+  where range :: Int -> Int -> Column (O.PGRange O.PGInt4)+        range a b = O.pgRange O.pgInt4 (R.Inclusive a) (R.Exclusive b)+        q = A.pure $ (range 1 2) O..-|- (range 2 3)+ allTests :: [Test] allTests = [testSelect, testProduct, testRestrict, testNum, testDiv, testCase,             testDistinct, testAggregate, testAggregate0, testAggregateFunction,@@ -872,7 +909,9 @@             testJsonGetFieldValue   table8Q, testJsonGetFieldText  table8Q,             testJsonGetMissingField table8Q, testJsonGetArrayValue table8Q,             testJsonGetArrayText    table8Q, testJsonGetPathValue  table8Q,-            testJsonGetPathText     table8Q+            testJsonGetPathText     table8Q,+            testRangeOverlap, testRangeLeftOf, testRangeRightOf,+            testRangeRightExtension, testRangeLeftExtension, testRangeAdjacency             ]  -- Note: these tests are left out of allTests until Travis supports

@@ -1,6 +1,6 @@ name:            opaleye-copyright:       Copyright (c) 2014-2016 Purely Agile Limited-version:         0.5.2.2+copyright:       Copyright (c) 2014-2017 Purely Agile Limited+version:         0.5.3.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@@ -28,7 +28,7 @@   build-depends:       -- attoparsec can be removed once postgresql-simple patch in       -- Internal.RunQuery is merged upstream-      aeson               >= 0.6     && < 1.1+      aeson               >= 0.6     && < 1.2     , attoparsec          >= 0.10.3  && < 0.14     , base                >= 4.6     && < 5     , base16-bytestring   >= 0.1.1.6 && < 0.2@@ -100,7 +100,7 @@   other-modules: QuickCheck   hs-source-dirs: Test   build-depends:-    aeson >= 0.6 && < 1.1,+    aeson >= 0.6 && < 1.2,     base >= 4 && < 5,     containers,     contravariant,

@@ -24,6 +24,8 @@ import           Control.Applicative (Applicative, pure, (<*>)) import           Data.Functor                    ((<$>)) +import qualified Database.PostgreSQL.Simple.Range as R+ -- | 'constant' provides a convenient typeclass wrapper around the -- 'Column' creation functions in "Opaleye.PGTypes".  Besides -- convenience it doesn't provide any additional functionality.@@ -131,6 +133,24 @@ instance (D.Default Constant a (Column b), T.IsSqlType b)          => D.Default Constant [a] (Column (T.PGArray b)) where   def = Constant (T.pgArray (constantExplicit D.def))++instance D.Default Constant (R.PGRange Int.Int) (Column (T.PGRange T.PGInt4)) where+  def = Constant $ \(R.PGRange a b) -> T.pgRange T.pgInt4 a b++instance D.Default Constant (R.PGRange Int.Int64) (Column (T.PGRange T.PGInt8)) where+  def = Constant $ \(R.PGRange a b) -> T.pgRange T.pgInt8 a b++-- TODO+--instance D.Default Constant (R.PGRange _) (Column (T.PGRange PGNumeric)) where++instance D.Default Constant (R.PGRange Time.LocalTime) (Column (T.PGRange T.PGTimestamp)) where+  def = Constant $ \(R.PGRange a b) -> T.pgRange T.pgLocalTime a b++instance D.Default Constant (R.PGRange Time.UTCTime) (Column (T.PGRange T.PGTimestamptz)) where+  def = Constant $ \(R.PGRange a b) -> T.pgRange T.pgUTCTime a b++instance D.Default Constant (R.PGRange Time.Day) (Column (T.PGRange T.PGDate)) where+  def = Constant $ \(R.PGRange a b) -> T.pgRange T.pgDay a b  -- { Boilerplate instances 

@@ -34,6 +34,7 @@                                     -- here.  Perhaps a special type is                                     -- needed for insert expressions.                 | ArrayExpr [PrimExpr] -- ^ ARRAY[..]+                | RangeExpr BoundExpr BoundExpr                 deriving (Read,Show)  data Literal = NullLit@@ -58,6 +59,7 @@                  | (:->) | (:->>) | (:#>) | (:#>>)                 | (:@>) | (:<@) | (:?) | (:?|) | (:?&)+                | (:&&) | (:<<) | (:>>) | (:&<) | (:&>) | (:-|-)                 deriving (Show,Read)  data UnOp = OpNot@@ -89,3 +91,6 @@ data OrderOp = OrderOp { orderDirection :: OrderDirection                        , orderNulls     :: OrderNulls }                deriving (Show,Read)++data BoundExpr = Inclusive PrimExpr | Exclusive PrimExpr | PosInfinity | NegInfinity+                 deriving (Show,Read)

@@ -31,6 +31,9 @@                          , sqlOrderNulls     :: SqlOrderNulls }   deriving Show +data SqlRangeBound = Inclusive SqlExpr | Exclusive SqlExpr | PosInfinity | NegInfinity+                   deriving Show+ -- | Expressions in SQL statements. data SqlExpr = ColumnSqlExpr  SqlColumn              | CompositeSqlExpr SqlExpr String@@ -48,6 +51,7 @@              | CastSqlExpr String SqlExpr              | DefaultSqlExpr              | ArraySqlExpr [SqlExpr]+             | RangeSqlExpr SqlRangeBound SqlRangeBound   deriving Show  -- | Data type for SQL UPDATE statements.

@@ -141,6 +141,12 @@       CastExpr typ e1 -> CastSqlExpr typ (sqlExpr gen e1)       DefaultInsertExpr -> DefaultSqlExpr       ArrayExpr es -> ArraySqlExpr (map (sqlExpr gen) es)+      RangeExpr l r -> let bound :: PQ.BoundExpr -> Sql.SqlRangeBound+                           bound (PQ.Inclusive a) = Sql.Inclusive (sqlExpr gen a)+                           bound (PQ.Exclusive a) = Sql.Exclusive (sqlExpr gen a)+                           bound (PQ.PosInfinity) = Sql.PosInfinity+                           bound (PQ.NegInfinity) = Sql.NegInfinity+                        in RangeSqlExpr (bound l) (bound r)  showBinOp :: BinOp -> String showBinOp  (:==)        = "="@@ -176,7 +182,12 @@ showBinOp  (:?)         = "?" showBinOp  (:?|)        = "?|" showBinOp  (:?&)        = "?&"-+showBinOp  (:&&)        = "&&"+showBinOp  (:<<)        = "<<"+showBinOp  (:>>)        = ">>"+showBinOp  (:&<)        = "&<"+showBinOp  (:&>)        = "&>"+showBinOp  (:-|-)       = "-|-"  data UnOpType = UnOpFun | UnOpPrefix | UnOpPostfix 

@@ -19,7 +19,7 @@  import Opaleye.Internal.HaskellDB.Sql (SqlColumn(..), SqlDelete(..),                                SqlExpr(..), SqlOrder(..), SqlInsert(..),-                               SqlUpdate(..), SqlTable(..))+                               SqlUpdate(..), SqlTable(..), SqlRangeBound(..)) import qualified Opaleye.Internal.HaskellDB.Sql as Sql  import Data.List (intersperse)@@ -113,7 +113,18 @@   where     tname = doubleQuotes (text (sqlTableName st)) +ppStartBound :: SqlRangeBound -> Doc+ppStartBound (Inclusive a) = text "'[" <> ppSqlExpr a+ppStartBound (Exclusive a) = text "'(" <> ppSqlExpr a+ppStartBound (PosInfinity) = text "'(infinity"+ppStartBound (NegInfinity) = text "'(-infinity" +ppEndBound :: SqlRangeBound -> Doc+ppEndBound (Inclusive a) = ppSqlExpr a <> text "]'"+ppEndBound (Exclusive a) = ppSqlExpr a <> text ")'"+ppEndBound (PosInfinity) = text "infinity)'"+ppEndBound (NegInfinity) = text "-infinity)'"+ ppSqlExpr :: SqlExpr -> Doc ppSqlExpr expr =     case expr of@@ -136,6 +147,7 @@       CastSqlExpr typ e -> text "CAST" <> parens (ppSqlExpr e <+> text "AS" <+> text typ)       DefaultSqlExpr    -> text "DEFAULT"       ArraySqlExpr es -> text "ARRAY" <> brackets (commaH ppSqlExpr es)+      RangeSqlExpr start end -> (hcat . punctuate comma) [ppStartBound start, ppEndBound end]  commaH :: (a -> Doc) -> [a] -> Doc commaH f = hcat . punctuate comma . map f

@@ -47,6 +47,7 @@ import qualified Database.PostgreSQL.Simple.TypeInfo as TI import qualified Database.PostgreSQL.Simple.Arrays as Arrays import           Database.PostgreSQL.Simple.Arrays (array, fmt)+import qualified Database.PostgreSQL.Simple.Range as PGSR import           Data.String (fromString) import           Data.Typeable (Typeable) @@ -220,6 +221,10 @@     where QueryRunnerColumn c f = queryRunnerColumnDefault  -- }++instance (Typeable b, FromField b, QueryRunnerColumnDefault a b) =>+         QueryRunnerColumnDefault (T.PGRange a) (PGSR.PGRange b) where+  queryRunnerColumnDefault = fieldQueryRunnerColumn  -- Boilerplate instances 

@@ -301,3 +301,26 @@ -- | Cast a 'PGInt4' to a 'PGFloat8' doubleOfInt :: Column T.PGInt4 -> Column T.PGFloat8 doubleOfInt (Column e) = Column (HPQ.CastExpr "float8" e)++overlap :: Column (T.PGRange a) -> Column (T.PGRange a) -> Column T.PGBool+overlap = C.binOp (HPQ.:&&)++infix 4 .<<+(.<<) :: Column (T.PGRange a) -> Column (T.PGRange a) -> Column T.PGBool+(.<<) = C.binOp (HPQ.:<<)++infix 4 .>>+(.>>) :: Column (T.PGRange a) -> Column (T.PGRange a) -> Column T.PGBool+(.>>) = C.binOp (HPQ.:>>)++infix 4 .&<+(.&<) :: Column (T.PGRange a) -> Column (T.PGRange a) -> Column T.PGBool+(.&<) = C.binOp (HPQ.:&<)++infix 4 .&>+(.&>) :: Column (T.PGRange a) -> Column (T.PGRange a) -> Column T.PGBool+(.&>) = C.binOp (HPQ.:&>)++infix 4 .-|-+(.-|-) :: Column (T.PGRange a) -> Column (T.PGRange a) -> Column T.PGBool+(.-|-) = C.binOp (HPQ.:-|-)

@@ -24,6 +24,8 @@  import           Data.Int (Int64) +import qualified Database.PostgreSQL.Simple.Range as R+ instance C.PGNum PGFloat8 where   pgFromInteger = pgDouble . fromInteger @@ -140,6 +142,13 @@     oneEl = C.unColumn . pgEl     arrayTy = showPGType ([] :: [PGArray b]) +pgRange :: forall a b. IsRangeType b => (a -> C.Column b) -> R.RangeBound a -> R.RangeBound a -> C.Column (PGRange b)+pgRange pgEl start end = C.Column (HPQ.CastExpr (showRangeType ([] :: [b])) $ HPQ.RangeExpr (oneEl start) (oneEl end))+  where oneEl (R.Inclusive a) = HPQ.Inclusive . C.unColumn $ pgEl a+        oneEl (R.Exclusive a) = HPQ.Exclusive . C.unColumn $ pgEl a+        oneEl (R.NegInfinity) = HPQ.NegInfinity+        oneEl (R.PosInfinity) = HPQ.PosInfinity+ class IsSqlType pgType where   showPGType :: proxy pgType -> String instance IsSqlType PGBool where@@ -180,7 +189,30 @@   showPGType _ = "json" instance IsSqlType PGJsonb where   showPGType _ = "jsonb"+instance IsRangeType a => IsSqlType (PGRange a) where+  showPGType _ = showRangeType ([] :: [a]) +class IsSqlType pgType => IsRangeType pgType where+  showRangeType :: proxy pgType -> String++instance IsRangeType PGInt4 where+  showRangeType _ = "int4range"++instance IsRangeType PGInt8 where+  showRangeType _ = "int8range"++instance IsRangeType PGNumeric where+  showRangeType _ = "numrange"++instance IsRangeType PGTimestamp where+  showRangeType _ = "tsrange"++instance IsRangeType PGTimestamptz where+  showRangeType _ = "tstzrange"++instance IsRangeType PGDate where+  showRangeType _ = "daterange"+ -- * SQL datatypes  data PGBool@@ -201,6 +233,7 @@ data PGBytea data PGJson data PGJsonb+data PGRange a  -- * Deprecated functions