diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +## 0.7.5.0 + +* Added `enumMapperWithSchema`. Thanks to Steve Mao. + +* Added `SqlInterval`. Thanks to Bas van Dijk. + ## 0.7.4.0 * Added `distinctOnCorrect` and `distinctOnByCorrect` which will diff --git a/Doc/Tutorial/TutorialBasic.lhs b/Doc/Tutorial/TutorialBasic.lhs --- a/Doc/Tutorial/TutorialBasic.lhs +++ b/Doc/Tutorial/TutorialBasic.lhs @@ -9,11 +9,11 @@ > > import Opaleye (Field, FieldNullable, matchNullable, isNull, > Table, table, tableField, selectTable, -> Select, restrict, (.==), (.<=), (.&&), (.<), +> Select, (.==), (.<=), (.&&), (.<), > (.===), > (.++), ifThenElse, sqlString, aggregate, groupBy, > count, avg, sum, leftJoin, runSelect, -> showSql, viaLateral, Unpackspec, +> showSql, where_, Unpackspec, > SqlInt4, SqlInt8, SqlText, SqlDate, SqlFloat8, SqlBool) > > import Data.Profunctor.Product (p2, p3) @@ -253,7 +253,7 @@ > youngPeople :: Select (Field SqlText, Field SqlInt4, Field SqlText) > youngPeople = do > row@(_, age, _) <- personSelect -> viaLateral restrict (age .<= 18) +> where_ (age .<= 18) > > pure row @@ -284,8 +284,8 @@ > twentiesAtAddress = do > row@(_, age, address) <- personSelect > -> viaLateral restrict $ (20 .<= age) .&& (age .< 30) -> viaLateral restrict $ address .== sqlString "1 My Street, My Town" +> where_ $ (20 .<= age) .&& (age .< 30) +> where_ $ address .== sqlString "1 My Street, My Town" > > pure row @@ -326,7 +326,7 @@ > (name, age, address) <- personSelect > birthday <- birthdaySelect > -> viaLateral restrict $ name .== bdName birthday +> where_ $ name .== bdName birthday > > pure (name, age, address, bdDay birthday) @@ -470,11 +470,11 @@ > restrictIsTwenties :: Field SqlInt4 -> Select () > restrictIsTwenties age = do -> viaLateral restrict $ (20 .<= age) .&& (age .< 30) +> where_ $ (20 .<= age) .&& (age .< 30) > > restrictAddressIs1MyStreet :: Field SqlText -> Select () > restrictAddressIs1MyStreet address = do -> viaLateral restrict $ address .== sqlString "1 My Street, My Town" +> where_ $ address .== sqlString "1 My Street, My Town" We can't generate "the SQL of" these combinators. They are not `Select`s so they don't have any SQL! (This corresponds to the @@ -517,7 +517,7 @@ > birthdayOfPerson name = do > birthday <- birthdaySelect > -> viaLateral restrict $ name .== bdName birthday +> where_ $ name .== bdName birthday > > pure (bdDay birthday) diff --git a/Test/Test.hs b/Test/Test.hs --- a/Test/Test.hs +++ b/Test/Test.hs @@ -21,7 +21,8 @@ import qualified Data.String as String import qualified Data.ByteString as SBS import qualified Data.Text as T -import qualified Data.Time as Time +import qualified Data.Time.Compat as Time +import qualified Data.Time.Clock.POSIX.Compat as Time import qualified Database.PostgreSQL.Simple as PGS import qualified Database.PostgreSQL.Simple.Range as R import GHC.Int (Int64) @@ -1255,6 +1256,8 @@ testH (pure (O.sqlZonedTime value)) (\r -> map Time.zonedTimeToUTC r `shouldBe` [Time.zonedTimeToUTC value]) + it "sqlInterval" $ testLiteral O.sqlInterval (Time.calendarTimeTime 1) + -- Check that MaybeFields's "Nothings" are not distinct, even if we -- fmap different values over their inner fields. testMaybeFieldsDistinct :: Test @@ -1274,7 +1277,108 @@ it "Returns same rows from a table" $ testH (OL.forUpdate table1Q) (`shouldBe` table1data) +testAddIntervalFromDateToTimestamptz :: Test +testAddIntervalFromDateToTimestamptz = do + it "date + interval = timestamptz" $ testH query (`shouldBe` [expectation]) + where query :: Select (Field O.SqlTimestamp) + query = pure $ (O.toFields d :: Field O.SqlDate) + `O.addInterval` + (O.toFields c :: Field O.SqlInterval) + d :: Time.Day + d = Time.ModifiedJulianDay 0 -- = 1858-11-17 + + -- 1 second + c :: Time.CalendarDiffTime + c = Time.calendarTimeTime 1 + + expectation :: Time.LocalTime + expectation = Time.ctTime c `Time.addLocalTime` + Time.LocalTime + { Time.localDay = d + , Time.localTimeOfDay = Time.TimeOfDay 0 0 0 + } + +testAddIntervalFromIntervalToInterval :: Test +testAddIntervalFromIntervalToInterval = do + it "interval + interval = interval" $ testH query (`shouldBe` [expectation]) + where query :: Select (Field O.SqlInterval) + query = pure $ (O.toFields c1 :: Field O.SqlInterval) + `O.addInterval` + (O.toFields c2 :: Field O.SqlInterval) + + -- 1 second + c1 :: Time.CalendarDiffTime + c1 = Time.calendarTimeTime 1 + + -- 2 second + c2 :: Time.CalendarDiffTime + c2 = Time.calendarTimeTime 2 + + expectation :: Time.CalendarDiffTime + expectation = Time.calendarTimeTime $ Time.ctTime c1 + Time.ctTime c2 + +testAddIntervalFromTimestampToTimestamp :: Test +testAddIntervalFromTimestampToTimestamp = do + it "timestamp + interval = timestamp" $ testH query (`shouldBe` [expectation]) + where query :: Select (Field O.SqlTimestamp) + query = pure $ (O.toFields t :: Field O.SqlTimestamp) + `O.addInterval` + (O.toFields c :: Field O.SqlInterval) + + t :: Time.LocalTime + t = Time.LocalTime + { Time.localDay = Time.ModifiedJulianDay 0 -- = 1858-11-17 + , Time.localTimeOfDay = Time.TimeOfDay 0 0 0 -- midnight + } + + -- 1 second + c :: Time.CalendarDiffTime + c = Time.calendarTimeTime 1 + + expectation :: Time.LocalTime + expectation = Time.ctTime c `Time.addLocalTime` t + +testAddIntervalFromTimestamptzToTimestamptz :: Test +testAddIntervalFromTimestamptzToTimestamptz = do + it "timestamptz + interval = timestamptz" $ testH query (`shouldBe` [expectation]) + where query :: Select (Field O.SqlTimestamptz) + query = pure $ (O.toFields t :: Field O.SqlTimestamptz) + `O.addInterval` + (O.toFields c :: Field O.SqlInterval) + + -- UNIX epoch + t :: Time.UTCTime + t = Time.posixSecondsToUTCTime 0 + + -- 1 second + c :: Time.CalendarDiffTime + c = Time.calendarTimeTime 1 + + expectation :: Time.UTCTime + expectation = Time.ctTime c `Time.addUTCTime` t + +testAddIntervalFromTimeToTime :: Test +testAddIntervalFromTimeToTime = do + it "time + interval = time" $ testH query (`shouldBe` [expectation]) + where query :: Select (Field O.SqlTime) + query = pure $ (O.toFields t :: Field O.SqlTime) + `O.addInterval` + (O.toFields c :: Field O.SqlInterval) + + -- midnight + t :: Time.TimeOfDay + t = Time.TimeOfDay 0 0 0 + + -- 1 second + c :: Time.CalendarDiffTime + c = Time.calendarTimeTime 1 + + expectation :: Time.TimeOfDay + expectation = Time.timeToTimeOfDay $ + (realToFrac (Time.ctTime c :: Time.NominalDiffTime) :: Time.DiffTime) + + Time.timeOfDayToTime t + main :: IO () main = do let envVarName = "POSTGRES_CONNSTRING" @@ -1323,6 +1427,9 @@ Connection.close conn2 conn3 <- PGS.connectPostgreSQL connectString + -- intervals can only be decoded to CalendarDiffTimes + -- when the interval rendering style is set to ISO-8601. + _nrOfAffectedRows <- PGS.execute_ conn3 "SET intervalstyle TO iso_8601;" hspec $ do before (return conn3) $ do describe "core dsl?" $ do @@ -1428,3 +1535,9 @@ testMaybeFieldsDistinct describe "Locking" $ do testForUpdate + describe "Interval" $ do + testAddIntervalFromDateToTimestamptz + testAddIntervalFromIntervalToInterval + testAddIntervalFromTimestampToTimestamp + testAddIntervalFromTimestamptzToTimestamptz + testAddIntervalFromTimeToTime 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.7.4.0 +version: 0.7.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 @@ -41,7 +41,7 @@ , semigroups >= 0.13 && < 0.20 , text >= 0.11 && < 1.3 , transformers >= 0.3 && < 0.6 - , time >= 1.4 && < 1.10 + , time-compat >= 1.9.5 && < 1.12 , time-locale-compat >= 0.1 && < 0.2 , uuid >= 1.3 && < 1.4 , void >= 0.4 && < 0.8 @@ -141,7 +141,7 @@ QuickCheck, semigroups, text >= 0.11 && < 1.3, - time, + time-compat, uuid, transformers, hspec, 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 @@ -5,6 +5,7 @@ ( enumMapper, EnumMapper, + enumMapperWithSchema, enumFromField, enumToFields, fromFieldToFieldsEnum, @@ -17,6 +18,8 @@ import Data.ByteString.Char8 (unpack) import qualified Data.Profunctor.Product.Default as D +import Text.PrettyPrint.HughesPJ ((<>), doubleQuotes, render, text) +import Prelude hiding ((<>)) data EnumMapper sqlEnum haskellSum = EnumMapper { enumFromField :: RQ.FromField sqlEnum haskellSum @@ -97,7 +100,37 @@ -- ^ The @sqlEnum@ type variable is phantom. To protect -- yourself against type mismatches you should set it to -- the Haskell type that you use to represent the @ENUM@. -enumMapper type_ from to_ = EnumMapper { +enumMapper type_ = enumMapper' (render (doubleQuotes (text type_))) + +enumMapperWithSchema :: String + -- ^ The schema of the @ENUM@ type + -> String + -- ^ The name of the @ENUM@ type + -> (String -> Maybe haskellSum) + -- ^ A function which converts from the string + -- representation of the ENUM field + -> (haskellSum -> String) + -- ^ A function which converts to the string representation + -- of the ENUM field + -> EnumMapper sqlEnum haskellSum + -- ^ The @sqlEnum@ type variable is phantom. To protect + -- yourself against type mismatches you should set it to + -- the Haskell type that you use to represent the @ENUM@. +enumMapperWithSchema schema type_ = enumMapper' (render (doubleQuotes (text schema) <> text "." <> doubleQuotes (text type_))) + +enumMapper' :: String + -- ^ The name of the @ENUM@ type + -> (String -> Maybe haskellSum) + -- ^ A function which converts from the string + -- representation of the ENUM field + -> (haskellSum -> String) + -- ^ A function which converts to the string representation + -- of the ENUM field + -> EnumMapper sqlEnum haskellSum + -- ^ The @sqlEnum@ type variable is phantom. To protect + -- yourself against type mismatches you should set it to + -- the Haskell type that you use to represent the @ENUM@. +enumMapper' type_ from to_ = EnumMapper { enumFromField = fromFieldEnum , enumToFields = toFieldsEnum } 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 @@ -14,7 +14,7 @@ import qualified Data.ByteString as SBS import qualified Data.ByteString.Lazy as LBS import qualified Data.Scientific as Sci -import qualified Data.Time as Time +import qualified Data.Time.Compat as Time import qualified Data.UUID as UUID import qualified Data.Profunctor.Product as PP @@ -103,6 +103,9 @@ instance D.Default ToFields Time.TimeOfDay (Column T.SqlTime) where def = toToFields T.sqlTimeOfDay + +instance D.Default ToFields Time.CalendarDiffTime (Column T.SqlInterval) where + def = toToFields T.sqlInterval instance D.Default ToFields (CI.CI ST.Text) (Column T.SqlCitext) where def = toToFields T.sqlCiStrictText 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 @@ -21,7 +21,7 @@ import qualified Data.Scientific as Sci import qualified Data.Text.Lazy as LT import qualified Data.Text as ST -import qualified Data.Time as Time +import qualified Data.Time.Compat as Time import Data.Typeable (Typeable) import Data.UUID (UUID) import qualified Database.PostgreSQL.Simple.Range as R @@ -98,6 +98,10 @@ => D.Default (Inferrable FromField) T.SqlTime timeofday where def = Inferrable D.def +instance calendardifftime ~ Time.CalendarDiffTime + => D.Default (Inferrable FromField) T.SqlInterval calendardifftime where + def = Inferrable D.def + instance cttext ~ CI.CI ST.Text => D.Default (Inferrable FromField) T.SqlCitext cttext where def = Inferrable D.def @@ -204,6 +208,10 @@ instance C.Column T.SqlTime ~ cSqlTime => D.Default (Inferrable ToFields) Time.TimeOfDay cSqlTime where + def = Inferrable D.def + +instance C.Column T.SqlInterval ~ cSqlInterval + => D.Default (Inferrable ToFields) Time.CalendarDiffTime cSqlInterval where def = Inferrable D.def instance C.Column T.SqlCitext ~ cSqlCitext 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 @@ -13,7 +13,7 @@ import qualified Data.Text.Lazy.Encoding as LTextEncoding import qualified Data.ByteString as SByteString import qualified Data.ByteString.Lazy as LByteString -import qualified Data.Time as Time +import qualified Data.Time.Compat as Time import qualified Data.Time.Locale.Compat as Locale unsafePgFormatTime :: Time.FormatTime t => HPQ.Name -> String -> t -> Column c 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 @@ -20,7 +20,8 @@ import qualified Data.ByteString as SByteString import qualified Data.ByteString.Lazy as LByteString import Data.Scientific as Sci -import qualified Data.Time as Time +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) @@ -106,6 +107,10 @@ -- "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 = IPT.castToType "interval" . quote . Time.Format.ISO8601.iso8601Show + where + quote s = "'" ++ s ++ "'" pgCiStrictText :: CI.CI SText.Text -> Column PGCitext pgCiStrictText = IPT.literalColumn . HPQ.StringLit . SText.unpack . CI.original @@ -179,6 +184,8 @@ showSqlType _ = "integer" instance IsSqlType SqlInt2 where showSqlType _ = "smallint" +instance IsSqlType SqlInterval where + showSqlType _ = "interval" instance IsSqlType SqlNumeric where showSqlType _ = "numeric" instance IsSqlType SqlText where @@ -234,6 +241,12 @@ data SqlInt8 data SqlInt4 data SqlInt2 +-- | Requires you to configure @intervalstyle@ as @iso_8601@. +-- +-- You can configure @intervalstyle@ on every connection with a @SET@ command, +-- but for better performance you may want to configure it permanently in the +-- file found with @SHOW config_file;@. +data SqlInterval data SqlNumeric data SqlText data SqlTime @@ -264,6 +277,7 @@ type PGInt8 = SqlInt8 type PGInt4 = SqlInt4 type PGInt2 = SqlInt2 +type PGInterval = SqlInterval type PGNumeric = SqlNumeric type PGText = SqlText type PGTime = SqlTime 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 @@ -39,7 +39,7 @@ import qualified Data.Text.Lazy.Encoding as LTE import qualified Data.ByteString as SBS import qualified Data.ByteString.Lazy as LBS -import qualified Data.Time as Time +import qualified Data.Time.Compat as Time import qualified Data.Scientific as Sci import qualified Data.String as String import Data.UUID (UUID) @@ -242,6 +242,9 @@ defaultFromField = fromPGSFromField instance DefaultFromField T.SqlTimestamptz Time.ZonedTime where + defaultFromField = fromPGSFromField + +instance DefaultFromField T.SqlInterval Time.CalendarDiffTime where defaultFromField = fromPGSFromField instance DefaultFromField T.SqlTime Time.TimeOfDay where diff --git a/src/Opaleye/Operators.hs b/src/Opaleye/Operators.hs --- a/src/Opaleye/Operators.hs +++ b/src/Opaleye/Operators.hs @@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} -- We can probably disable ConstraintKinds and TypeSynonymInstances -- when we move to Sql... instead of PG.. @@ -100,6 +102,9 @@ , timestamptzAtTimeZone , dateOfTimestamp , now + , IntervalNum + , addInterval + , minusInterval -- * Deprecated , exists , notExists @@ -468,6 +473,27 @@ dateOfTimestamp :: F.Field T.SqlTimestamp -> F.Field T.SqlDate dateOfTimestamp (Column e) = Column (HPQ.FunExpr "date" [e]) + +-- | @IntervalNum from to@ determines from which date or time types an interval +-- can be added ('addInterval') or subtracted ('minusInterval`) and which is the +-- resulting type. +-- +-- The instances should correspond to the interval + and - operations listed in: +-- +-- https://www.postgresql.org/docs/current/functions-datetime.html#OPERATORS-DATETIME-TABLE +class IntervalNum from to | from -> to + +instance IntervalNum T.SqlDate T.SqlTimestamp +instance IntervalNum T.SqlInterval T.SqlInterval +instance IntervalNum T.SqlTimestamp T.SqlTimestamp +instance IntervalNum T.SqlTimestamptz T.SqlTimestamptz +instance IntervalNum T.SqlTime T.SqlTime + +addInterval :: IntervalNum from to => F.Field from -> F.Field T.SqlInterval -> F.Field to +addInterval = C.binOp (HPQ.:+) + +minusInterval :: IntervalNum from to => F.Field from -> F.Field T.SqlInterval -> F.Field to +minusInterval = C.binOp (HPQ.:-) {-# DEPRECATED exists "Identical to 'restrictExists'. Will be removed in version 0.8." #-} exists :: QueryArr a b -> QueryArr a () diff --git a/src/Opaleye/SqlTypes.hs b/src/Opaleye/SqlTypes.hs --- a/src/Opaleye/SqlTypes.hs +++ b/src/Opaleye/SqlTypes.hs @@ -23,11 +23,13 @@ sqlLocalTime, sqlZonedTime, sqlTimeOfDay, + P.sqlInterval, -- ** Types SqlDate, SqlTime, SqlTimestamp, SqlTimestamptz, + SqlInterval, -- * JSON -- ** Creating values sqlJSON, @@ -96,6 +98,7 @@ SqlTime, SqlTimestamp, SqlTimestamptz, + SqlInterval, SqlUuid, SqlCitext, SqlArray, @@ -112,7 +115,7 @@ import Data.Scientific as Sci import qualified Data.Text as SText import qualified Data.Text.Lazy as LText -import qualified Data.Time as Time +import qualified Data.Time.Compat as Time import qualified Data.UUID as UUID import qualified Database.PostgreSQL.Simple.Range as R @@ -169,7 +172,6 @@ -- "We recommend not using the type time with time zone" -- http://www.postgresql.org/docs/8.3/static/datatype-datetime.html - sqlCiStrictText :: CI.CI SText.Text -> F.Field SqlCitext sqlCiStrictText = P.pgCiStrictText