fix: add interval support

package.json

@@ -15,6 +15,8 @@
     "decimal.js": "^10.4.3",
     "pg": "^8.11.3",
     "pg-copy-streams": "^6.0.6",
+    "pg-listen": "^1.7.0",
+    "postgres-interval": "1.2.0",
     "postgres-range": "^1.1.4"
   }
 }

src/Data.Postgres.Interval.js

@@ -0,0 +1,30 @@
+import PostgresInterval from 'postgres-interval'
+
+/** @typedef {import('postgres-interval').IPostgresInterval} I */
+
+/** @type {(o: {years: number, months: number, days: number, hours: number, minutes: number, seconds: number, milliseconds: number}) => I} */
+export const make = o => Object.assign(PostgresInterval(''), o)
+
+/** @type {(s: string) => () => I} */
+export const parse = s => () => PostgresInterval(s)
+
+/** @type {(a: I) => number} */
+export const getYears = i => i.years || 0.0
+
+/** @type {(a: I) => number} */
+export const getMonths = i => i.months || 0.0
+
+/** @type {(a: I) => number} */
+export const getDays = i => i.days || 0.0
+
+/** @type {(a: I) => number} */
+export const getMinutes = i => i.minutes || 0.0
+
+/** @type {(a: I) => number} */
+export const getHours = i => i.hours || 0.0
+
+/** @type {(a: I) => number} */
+export const getSeconds = i => i.seconds || 0.0
+
+/** @type {(a: I) => number} */
+export const getMilliseconds = i => i.milliseconds || 0.0

src/Data.Postgres.Interval.purs

@@ -0,0 +1,88 @@
+module Data.Postgres.Interval where
+
+import Prelude
+
+import Data.Int as Int
+import Data.Maybe (Maybe(..))
+import Data.Newtype (unwrap)
+import Data.Time.Duration (class Duration, Days(..), Hours(..), Milliseconds(..), Minutes(..), Seconds(..), convertDuration)
+import Effect (Effect)
+
+zero :: IntervalRecord
+zero = {years: 0, months: 0, days: 0, hours: 0, minutes: 0, seconds: 0, milliseconds: 0.0}
+
+type IntervalRecord =
+  { years :: Int
+  , months :: Int
+  , days :: Int
+  , hours :: Int
+  , minutes :: Int
+  , seconds :: Int
+  , milliseconds :: Number
+  }
+
+foreign import data Interval :: Type
+
+foreign import make :: IntervalRecord -> Interval
+foreign import parse :: String -> Effect Interval
+
+foreign import getYears :: Interval -> Int
+foreign import getMonths :: Interval -> Int
+foreign import getDays :: Interval -> Int
+foreign import getHours :: Interval -> Int
+foreign import getMinutes :: Interval -> Int
+foreign import getSeconds :: Interval -> Int
+foreign import getMilliseconds :: Interval -> Number
+
+toDuration :: forall d. Semigroup d => Duration d => Interval -> Maybe d
+toDuration a =
+  let
+    includesMonths = getYears a > 0 || getMonths a > 0
+
+    days :: d
+    days = convertDuration $ Days $ Int.toNumber $ getDays a
+
+    hours :: d
+    hours = convertDuration $ Hours $ Int.toNumber $ getHours a
+
+    minutes :: d
+    minutes = convertDuration $ Minutes $ Int.toNumber $ getMinutes a
+
+    seconds :: d
+    seconds = convertDuration $ Seconds $ Int.toNumber $ getSeconds a
+
+    milliseconds :: d
+    milliseconds = convertDuration $ Milliseconds $ getMilliseconds a
+  in
+    if includesMonths then Nothing else Just (days <> hours <> minutes <> seconds <> milliseconds)
+
+toRecord :: Interval -> IntervalRecord
+toRecord a =
+  { years: getYears a
+  , months: getMonths a
+  , days: getDays a
+  , hours: getHours a
+  , minutes: getMinutes a
+  , seconds: getSeconds a
+  , milliseconds: getMilliseconds a
+  }
+
+fromDuration :: forall d. Duration d => d -> Interval
+fromDuration a =
+  let
+    millisTotal :: Number
+    millisTotal = (unwrap :: Milliseconds -> Number) $ convertDuration a
+    secondFactor = 1000.0
+    minuteFactor = 60.0 * secondFactor
+    hourFactor = 60.0 * minuteFactor
+    dayFactor = 24.0 * hourFactor
+    days = Int.trunc $ millisTotal / dayFactor
+    daysRem = millisTotal - (Int.toNumber days * dayFactor)
+    hours = Int.trunc $ daysRem / hourFactor
+    hoursRem = daysRem - (Int.toNumber hours * hourFactor)
+    minutes = Int.trunc $ hoursRem / minuteFactor
+    minutesRem = hoursRem - (Int.toNumber minutes * minuteFactor)
+    seconds = Int.trunc $ minutesRem / secondFactor
+    milliseconds = minutesRem - (Int.toNumber seconds * secondFactor)
+  in
+    make {years: 0, months: 0, days, hours, minutes, seconds, milliseconds}

src/Data.Postgres.js

@@ -1,10 +1,25 @@
 import Pg from 'pg'
 import Range from 'postgres-range'
 import { Buffer } from 'buffer'
+import PostgresInterval from 'postgres-interval'
 
 /** @type {(a: unknown) => boolean} */
 export const isInstanceOfBuffer = a => a instanceof Buffer
 
+/** @type {(a: unknown) => boolean} */
+export const isInstanceOfInterval = a => {
+  return typeof a === 'object'
+    && a !== null
+    && ('years' in a
+    || 'months' in a
+    || 'days' in a
+    || 'hours' in a
+    || 'minutes' in a
+    || 'seconds' in a
+    || 'milliseconds' in a
+    )
+}
+
 export const modifyPgTypes = () => {
   // https://github.com/brianc/node-pg-types/blob/master/lib/textParsers.js
   const oid = {

src/Data.Postgres.purs

@@ -9,13 +9,18 @@ import Control.Monad.Morph (hoist)
 import Control.Monad.Trans.Class (lift)
 import Data.Bifunctor (lmap)
 import Data.DateTime (DateTime)
+import Data.DateTime.Instant (Instant)
+import Data.DateTime.Instant as Instant
 import Data.List.NonEmpty (NonEmptyList)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype, unwrap, wrap)
+import Data.Postgres.Interval (Interval)
+import Data.Postgres.Interval as Interval
 import Data.Postgres.Range (Range, __rangeFromRecord, __rangeRawFromRaw, __rangeRawFromRecord, __rangeRawToRecord, __rangeToRecord)
 import Data.Postgres.Raw (Null(..), Raw, jsNull)
 import Data.Postgres.Raw (unsafeFromForeign, asForeign) as Raw
 import Data.RFC3339String as DateTime.ISO
+import Data.Time.Duration (Days, Hours, Milliseconds, Minutes, Seconds)
 import Data.Traversable (traverse)
 import Effect (Effect)
 import Effect.Exception (error)
@@ -41,6 +46,7 @@ derive newtype instance ReadForeign a => ReadForeign (JSON a)
 foreign import modifyPgTypes :: Effect Unit
 
 foreign import isInstanceOfBuffer :: F.Foreign -> Boolean
+foreign import isInstanceOfInterval :: F.Foreign -> Boolean
 
 -- | The serialization & deserialization monad.
 type RepT = ExceptT (NonEmptyList ForeignError) Effect
@@ -70,6 +76,9 @@ instance (Serialize a, Deserialize a) => Rep a
 unsafeSerializeCoerce :: forall m a. Monad m => a -> m Raw
 unsafeSerializeCoerce = pure <<< Raw.unsafeFromForeign <<< F.unsafeToForeign
 
+invalidDuration :: NonEmptyList ForeignError
+invalidDuration = pure $ ForeignError $ "Can't convert interval with year or month components to Milliseconds"
+
 instance Serialize Raw where
   serialize = pure
 
@@ -109,10 +118,38 @@ instance Serialize String where
 instance Serialize Number where
   serialize = unsafeSerializeCoerce
 
--- | `timestamp`, `timestamptz`
+-- | `interval`
 instance Serialize DateTime where
   serialize = serialize <<< unwrap <<< DateTime.ISO.fromDateTime
 
+-- | `interval`
+instance Serialize Interval where
+  serialize = unsafeSerializeCoerce
+
+-- | `interval`
+instance Serialize Milliseconds where
+  serialize = serialize <<< Interval.fromDuration
+
+-- | `interval`
+instance Serialize Seconds where
+  serialize = serialize <<< Interval.fromDuration
+
+-- | `interval`
+instance Serialize Minutes where
+  serialize = serialize <<< Interval.fromDuration
+
+-- | `interval`
+instance Serialize Hours where
+  serialize = serialize <<< Interval.fromDuration
+
+-- | `interval`
+instance Serialize Days where
+  serialize = serialize <<< Interval.fromDuration
+
+-- | `timestamp`, `timestamptz`
+instance Serialize Instant where
+  serialize = serialize <<< Instant.toDateTime
+
 -- | `Just` -> `a`, `Nothing` -> `NULL`
 instance Serialize a => Serialize (Maybe a) where
   serialize (Just a) = serialize a
@@ -151,6 +188,35 @@ instance Deserialize Buffer where
     in
       readBuffer <<< Raw.asForeign
 
+-- | `interval`
+instance Deserialize Interval where
+  deserialize =
+    let
+      notInterval a = pure $ TypeMismatch (tagOf a) "Interval"
+      readInterval a = when (not $ isInstanceOfInterval a) (throwError $ notInterval a) $> unsafeFromForeign a
+    in
+      readInterval <<< Raw.asForeign
+
+-- | `interval`
+instance Deserialize Milliseconds where
+  deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
+
+-- | `interval`
+instance Deserialize Seconds where
+  deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
+
+-- | `interval`
+instance Deserialize Minutes where
+  deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
+
+-- | `interval`
+instance Deserialize Hours where
+  deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
+
+-- | `interval`
+instance Deserialize Days where
+  deserialize = flip bind (liftMaybe invalidDuration) <<< map Interval.toDuration <<< deserialize
+
 -- | `int2`, `int4`
 instance Deserialize Int where
   deserialize = F.readInt <<< Raw.asForeign
@@ -183,6 +249,10 @@ instance Deserialize DateTime where
     let invalid = pure $ ForeignError $ "Not a valid ISO8601 string: `" <> s <> "`"
     liftMaybe invalid $ DateTime.ISO.toDateTime $ wrap s
 
+-- | `timestamp`, `timestamptz`
+instance Deserialize Instant where
+  deserialize = map Instant.fromDateTime <<< deserialize
+
 -- | postgres `array`
 instance Deserialize a => Deserialize (Array a) where
   deserialize = traverse (deserialize <<< Raw.unsafeFromForeign) <=< F.readArray <<< Raw.asForeign

test/Test.Data.Postgres.Interval.purs

@@ -0,0 +1,37 @@
+module Test.Data.Postgres.Interval where
+
+import Prelude
+
+import Data.Postgres.Interval as Interval
+import Data.Time.Duration (Milliseconds(..))
+import Data.Traversable (for_)
+import Data.Tuple.Nested (type (/\), (/\))
+import Effect.Class (liftEffect)
+import Test.Spec (Spec, describe, it)
+import Test.Spec.Assertions (shouldEqual)
+
+spec :: Spec Unit
+spec =
+  describe "Data.Postgres.Interval" do
+    it "parse & toRecord" do
+      p <- liftEffect $ Interval.parse "3 days 04:05:06"
+      Interval.toRecord p `shouldEqual` Interval.zero {days = 3, hours = 4, minutes = 5, seconds = 6}
+
+    it "make & toRecord" do
+      let p = Interval.make $ Interval.zero {days = 3, hours = 4, minutes = 5, seconds = 6}
+      Interval.toRecord p `shouldEqual` Interval.zero {days = 3, hours = 4, minutes = 5, seconds = 6}
+
+    describe "fromDuration" do
+      for_
+        [ Milliseconds 100.0 /\ Interval.zero {milliseconds = 100.0}
+        , Milliseconds 1000.0 /\ Interval.zero {seconds = 1}
+        , Milliseconds 1100.0 /\ Interval.zero {seconds = 1, milliseconds = 100.0}
+        , Milliseconds 60000.0 /\ Interval.zero {minutes = 1}
+        , Milliseconds 61100.0 /\ Interval.zero {minutes = 1, seconds = 1, milliseconds = 100.0}
+        , Milliseconds 3600000.0 /\ Interval.zero {hours = 1}
+        , Milliseconds 3661100.0 /\ Interval.zero {hours = 1, minutes = 1, seconds = 1, milliseconds = 100.0}
+        , Milliseconds 86400000.0 /\ Interval.zero {days = 1}
+        , Milliseconds 90061100.0 /\ Interval.zero {days = 1, hours = 1, minutes = 1, seconds = 1, milliseconds = 100.0}
+        ]
+        \(i /\ o) -> it ("converts " <> show i) do
+          Interval.toRecord (Interval.fromDuration i) `shouldEqual` o

test/Test.Data.Postgres.purs

@@ -2,28 +2,28 @@ module Test.Data.Postgres where
 
 import Prelude
 
-import Control.Monad.Gen (chooseInt, elements, oneOf)
+import Control.Monad.Gen (chooseFloat, chooseInt, elements, oneOf)
 import Control.Parallel (parTraverse_)
 import Data.Array (intercalate)
 import Data.Array as Array
 import Data.Array.NonEmpty as Array.NonEmpty
 import Data.DateTime (DateTime(..), canonicalDate)
-import Data.DateTime.Instant as Instant
 import Data.Enum (toEnum)
 import Data.Foldable (fold)
 import Data.Identity (Identity)
-import Data.Int as Int
-import Data.Maybe (Maybe(..), fromJust, maybe)
+import Data.Maybe (Maybe(..), fromJust, fromMaybe)
 import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.Number (abs) as Number
 import Data.Postgres (class Rep)
+import Data.Postgres.Interval (Interval)
+import Data.Postgres.Interval as Interval
 import Data.Postgres.Query.Builder as Q
 import Data.Postgres.Raw (Raw, jsNull)
 import Data.Postgres.Raw as Raw
 import Data.Postgres.Result (class FromRow)
-import Data.RFC3339String as DateTime.ISO
 import Data.String as String
 import Data.Time (Time(..))
+import Data.Time.Duration (class Duration, Days, Hours, Milliseconds, Minutes, Seconds)
 import Data.Traversable (for, sequence)
 import Data.Tuple.Nested ((/\))
 import Effect (Effect)
@@ -35,20 +35,45 @@ import Effect.Unsafe (unsafePerformEffect)
 import Foreign (Foreign, unsafeToForeign)
 import Foreign.Object as Object
 import JS.BigInt (BigInt)
-import JS.BigInt as BigInt
 import Node.Buffer (Buffer)
 import Node.Buffer as Buffer
 import Partial.Unsafe (unsafePartial)
 import Simple.JSON (writeJSON)
-import Test.Common (withClient, withPoolClient)
+import Test.Common (withPoolClient)
 import Test.QuickCheck (class Arbitrary, arbitrary, randomSeed)
 import Test.QuickCheck.Gen (sample, vectorOf)
-import Test.Spec (Spec, SpecT, around, describe, it, parallel)
+import Test.Spec (Spec, SpecT, around, describe, it)
 import Test.Spec.Assertions (fail)
 
 foreign import readBigInt64BE :: Buffer -> Effect BigInt
 foreign import dbg :: forall a. a -> Effect Unit
 
+newtype GenIntervalSubMonth = GenIntervalSubMonth Interval
+
+derive instance Newtype GenIntervalSubMonth _
+instance Arbitrary GenIntervalSubMonth where
+  arbitrary = do
+    days <- chooseInt 0 30
+    hours <- chooseInt 0 23
+    minutes <- chooseInt 0 59
+    seconds <- chooseInt 0 59
+    milliseconds <- chooseFloat 0.0 999.9
+    pure $ wrap $ Interval.make $ Interval.zero {days = days, hours = hours, minutes = minutes, seconds = seconds, milliseconds = milliseconds}
+
+newtype GenInterval = GenInterval Interval
+
+derive instance Newtype GenInterval _
+instance Arbitrary GenInterval where
+  arbitrary = do
+    years <- chooseInt 0 10
+    months <- chooseInt 0 11
+    days <- chooseInt 0 30
+    hours <- chooseInt 0 23
+    minutes <- chooseInt 0 59
+    seconds <- chooseInt 0 59
+    milliseconds <- chooseFloat 0.0 999.9
+    pure $ wrap $ Interval.make {years, months, days, hours, minutes, seconds, milliseconds}
+
 newtype GenSmallInt = GenSmallInt Int
 
 derive instance Newtype GenSmallInt _
@@ -196,6 +221,17 @@ spec =
     around withPoolClient
       $ describe "Data.Postgres"
       $ do
+          let
+            durationFromGenInterval :: forall d. Semigroup d => Duration d => Newtype d Number => GenIntervalSubMonth -> d
+            durationFromGenInterval = fromMaybe (wrap 0.0) <<< Interval.toDuration <<< unwrap
+            durationEq :: forall d. Duration d => Newtype d Number => d -> d -> Boolean
+            durationEq a b = Number.abs (unwrap a - unwrap b) <= 0.001
+          check @Milliseconds @GenIntervalSubMonth { purs: "Milliseconds", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
+          check @Seconds @GenIntervalSubMonth { purs: "Seconds", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
+          check @Minutes @GenIntervalSubMonth { purs: "Minutes", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
+          check @Hours @GenIntervalSubMonth { purs: "Hours", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
+          check @Days @GenIntervalSubMonth { purs: "Days", sql: "interval", fromArb: durationFromGenInterval, isEq: durationEq}
+
           check @Int @GenSmallInt { purs: "Int", sql: "int2", fromArb: unwrap, isEq: eq }
           check @Int { purs: "Int", sql: "int4", fromArb: identity, isEq: eq }
           check @String @GenString { purs: "String", sql: "text", fromArb: unwrap, isEq: eq }

test/Test.Main.purs

@@ -23,6 +23,7 @@ import Node.EventEmitter as Event
 import Test.Control.Monad.Postgres as Test.Control.Monad.Postgres
 import Test.Data.Postgres as Test.Data.Postgres
 import Test.Data.Postgres.Custom as Test.Data.Postgres.Custom
+import Test.Data.Postgres.Interval as Test.Data.Postgres.Interval
 import Test.Effect.Postgres.Client as Test.Effect.Postgres.Client
 import Test.Effect.Postgres.Pool as Test.Effect.Postgres.Pool
 import Test.Spec.Reporter (specReporter)
@@ -65,6 +66,7 @@ main = launchAff_ do
     $ runSpec [ specReporter ] do
         Test.Data.Postgres.Custom.spec
         Test.Data.Postgres.spec
+        Test.Data.Postgres.Interval.spec
         Test.Effect.Postgres.Client.spec
         Test.Effect.Postgres.Pool.spec
         Test.Control.Monad.Postgres.spec