pact-time 0.2.0.2 → 0.3.0.0

raw patch · 7 files changed

+533/−57 lines, 7 filesdep +data-dworddep −vector-spacePVP ok

version bump matches the API change (PVP)

Dependencies added: data-dword

Dependencies removed: vector-space

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• numeric/src/Numeric/Additive.hs +317/−0
• numeric/src/Numeric/AffineSpace.hs +110/−0
• pact-time.cabal +34/−20
• src/Pact/Time.hs +10/−2
• src/Pact/Time/Format/Internal.hs +5/−6
• src/Pact/Time/Internal.hs +42/−29

@@ -1,5 +1,20 @@ # Revision history for pact-time +## 0.3.0.0 -- 2024-06-30++Breaking changes:++*   Replaced dependency on the vector-spaces package by internal public+    `numeric` library.++    Most notably class method `zeroV` is now just called `zero`. Otherwise, most+    numeric operators remain identical and are now (re-)exported by the main+    module `Pact.Time`.++Other changes:++*   Support for builds with GHC-9.10.1.+ ## 0.2.0.2 -- 2023-05-11  *   Support mtl-2.3

@@ -0,0 +1,317 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module: Numeric.Additive+-- Copyright: Copyright © 2018 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+-- Haskell's @Num@ class doesn't support fine grained control+-- over what arithmetic operations are defined for a type.+-- Sometimes only some operations have a well defined semantics+-- and @Num@ instances are notorious for including undefined/error+-- values or unlawful workarounds.+--+module Numeric.Additive+(+-- * Additive Semigroup+  AdditiveSemigroup(..)+, AdditiveAbelianSemigroup+, (^+^)++-- * Additive Monoid+, AdditiveMonoid(..)+, AdditiveAbelianMonoid++-- * Additive Group+, AdditiveGroup(..)++-- * Additive Abelian Group+, AdditiveAbelianGroup+, (^-^)+) where++import Data.DoubleWord+import Data.Int+import Data.Word++import Numeric.Natural++-- -------------------------------------------------------------------------- --+-- | Additive Semigroup+--+-- prop> (a `plus` b) `plus` c == a `plus` (b `plus` c)+--+class AdditiveSemigroup g where+    plus :: g -> g -> g++instance AdditiveSemigroup Integer where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Rational where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Natural where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Int where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Word where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Word8 where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Word16 where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Word32 where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Word64 where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Word128 where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Word256 where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Int8 where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Int16 where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Int32 where+    plus = (+)+    {-# INLINE plus #-}++instance AdditiveSemigroup Int64 where+    plus = (+)+    {-# INLINE plus #-}++-- -------------------------------------------------------------------------- --+-- | Additive Abelian Semigroup+--+-- prop> a `plus` b == b `plus` a+--+class AdditiveSemigroup g => AdditiveAbelianSemigroup g++instance AdditiveAbelianSemigroup Integer+instance AdditiveAbelianSemigroup Rational+instance AdditiveAbelianSemigroup Natural+instance AdditiveAbelianSemigroup Int+instance AdditiveAbelianSemigroup Int8+instance AdditiveAbelianSemigroup Int16+instance AdditiveAbelianSemigroup Int32+instance AdditiveAbelianSemigroup Int64+instance AdditiveAbelianSemigroup Word+instance AdditiveAbelianSemigroup Word8+instance AdditiveAbelianSemigroup Word16+instance AdditiveAbelianSemigroup Word32+instance AdditiveAbelianSemigroup Word64+instance AdditiveAbelianSemigroup Word128+instance AdditiveAbelianSemigroup Word256++infixl 6 ^+^+(^+^) :: AdditiveAbelianSemigroup g => g -> g -> g+(^+^) = plus+{-# INLINE (^+^) #-}++-- -------------------------------------------------------------------------- --+-- | Additive Monoid+--+-- prop> a `plus` zero == a+-- prop> zero `plus` a == a+--+class AdditiveSemigroup g => AdditiveMonoid g where+    zero :: g++instance AdditiveMonoid Integer where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Rational where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Natural where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Int where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Word where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Word8 where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Word16 where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Word32 where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Word64 where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Word128 where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Word256 where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Int8 where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Int16 where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Int32 where+    zero = 0+    {-# INLINE zero #-}++instance AdditiveMonoid Int64 where+    zero = 0+    {-# INLINE zero #-}++type AdditiveAbelianMonoid g = (AdditiveMonoid g, AdditiveAbelianSemigroup g)++-- -------------------------------------------------------------------------- --+-- | Additive Group+--+-- prop> a `plus` inverse a == zero+-- prop> inverse a `plus` a == zero+--+class AdditiveMonoid g => AdditiveGroup g where+    invert :: g -> g+    invert a = zero `minus` a++    minus :: g -> g -> g+    minus a b = a `plus` invert b++    {-# MINIMAL invert | minus #-}++instance AdditiveGroup Integer where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Rational where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Int where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Word where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Word8 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Word16 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Word32 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Word64 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Word128 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Word256 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Int8 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Int16 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Int32 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++instance AdditiveGroup Int64 where+    invert a = -a+    minus = (-)+    {-# INLINE invert #-}+    {-# INLINE minus #-}++-- -------------------------------------------------------------------------- --+-- | Additive Abelian Group+--+type AdditiveAbelianGroup g = (AdditiveGroup g, AdditiveAbelianMonoid g)++infix 6 ^-^+(^-^) :: AdditiveAbelianGroup g => g -> g -> g+(^-^) = minus+{-# INLINE (^-^) #-}

@@ -0,0 +1,110 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module: Numeric.AffineSpace+-- Copyright: Copyright © 2018 Kadena LLC.+-- License: MIT+-- Maintainer: Lars Kuhtz <lars@kadena.io>+-- Stability: experimental+--+module Numeric.AffineSpace+(+-- * Torsor+  LeftTorsor(..)+, (.+^)+, (^+.)+, (.-.)+, (.-^)++-- * Vector Space+, FractionalVectorSpace(..)++-- * AfficeSpace+, AffineSpace+) where++import Numeric.Additive++-- -------------------------------------------------------------------------- --+-- Torsor++-- | A torsor is a generalization of affine spaces. It doesn't require the+-- underlying structure to be vector space, but an additive group suffices.+-- This means that it doesn't support scalar multiplication. In particular+-- it doesn't require an inverse operation to multiplication, which would+-- add unneeded complexity to the formal definition of the operational+-- semantics.+--+-- A Torsor is also called principal homogeous space.+--+-- prop> zero `add` a == a+-- prop> (a `plus` b) `add` t == a `add` (b `add` t)+-- prop> (s `diff` t) `add` t == s+--+-- The last property is states that `add` is a bijection.+--+class (AdditiveGroup (Diff t)) => LeftTorsor t where+    type Diff t+    add :: Diff t -> t -> t+    diff :: t -> t -> Diff t++instance LeftTorsor Integer where+    type Diff Integer = Integer+    add = (+)+    diff = (-)+    {-# INLINE add #-}+    {-# INLINE diff #-}++instance LeftTorsor Rational where+    type Diff Rational = Rational+    add = (+)+    diff = (-)+    {-# INLINE add #-}+    {-# INLINE diff #-}++infix 6 .-.+(.-.) :: AdditiveAbelianGroup (Diff t) => LeftTorsor t => t -> t -> Diff t+(.-.) = diff++infixl 6 ^+.+(^+.) :: AdditiveAbelianGroup (Diff t) => LeftTorsor t => Diff t -> t -> t+(^+.) = add++infixl 6 .+^+(.+^) :: AdditiveAbelianGroup (Diff t) => LeftTorsor t => t -> Diff t -> t+(.+^) = flip add++infixl 6 .-^+(.-^) :: AdditiveAbelianGroup (Diff t) => LeftTorsor t => t -> Diff t -> t+(.-^) t d = t .+^ invert d++-- -------------------------------------------------------------------------- --+-- | Vector Space over Fractional Numbers+--+-- A real vector space is an additive abelian group that forms an module+-- with the field of real numbers.+--+-- prop> a * (b `scale` c) == (a * b) `scale` c+-- prop> 1 `scale` a == a+-- prop> a `scale` (b `plus` c) == (a `scale` b) `plus` (a `scale` c)+-- prop> (a + b) `scale` c == (a `scale` c) `plus` (b `scale` c)+--+class (AdditiveAbelianGroup v, Fractional (Scalar v)) => FractionalVectorSpace v where+    type Scalar v+    scale :: Scalar v -> v -> v++instance FractionalVectorSpace Rational where+    type Scalar Rational = Rational+    scale = (*)++-- -------------------------------------------------------------------------- --+-- Affine Space++-- | An affine space is a torsor for the action of the additive group+-- of a vector space.+--+type AffineSpace t = (FractionalVectorSpace (Diff t), LeftTorsor t)

@@ -1,6 +1,6 @@-cabal-version: 2.4+cabal-version: 3.0 name: pact-time-version: 0.2.0.2+version: 0.3.0.0 synopsis: Time Library for Pact Description:     A minimal time library for usage with the [Pact Smart Contract@@ -27,11 +27,10 @@ copyright: Copyright (c) 2021 Kadena LLC. category: Data, System tested-with:+    GHC==9.10+    GHC==9.8     GHC==9.6     GHC==9.4-    GHC==9.2-    GHC==9.0-    GHC==8.10.7  extra-source-files: @@ -48,6 +47,19 @@     manual: True     default: False +library numeric+    visibility: public+    hs-source-dirs: numeric/src+    default-language: Haskell2010+    ghc-options:+        -Wall+    exposed-modules:+        Numeric.Additive+        Numeric.AffineSpace+    build-depends:+        -- external+        , base >=4.11 && <5+        , data-dword >=0.3 library     hs-source-dirs: src     default-language: Haskell2010@@ -59,6 +71,8 @@         Pact.Time.Format         Pact.Time.System     build-depends:+        -- internal+        , pact-time:numeric         -- external         , Decimal >=0.4         , aeson >=0.11@@ -70,20 +84,19 @@         , microlens >=0.4         , text >=1.2         , vector >=0.12-        , vector-space >=0.10 -  if flag(with-time)-    cpp-options: -DWITH_TIME=1-    other-modules: Pact.Time.Format.External-    build-depends: time >= 1.8-  else-    cpp-options: -DWITH_TIME=0-    other-modules:-        Pact.Time.Format.Internal-        Pact.Time.Format.Locale-    build-depends:-        , clock >= 0.7.2-        , mtl >=2.2+    if flag(with-time)+        cpp-options: -DWITH_TIME=1+        other-modules: Pact.Time.Format.External+        build-depends: time >= 1.8+    else+        cpp-options: -DWITH_TIME=0+        other-modules:+            Pact.Time.Format.Internal+            Pact.Time.Format.Locale+        build-depends:+            , clock >= 0.7.2+            , mtl >=2.2  test-suite tests     type: exitcode-stdio-1.0@@ -98,8 +111,9 @@     other-modules:         Test.Pact.Time.Format     build-depends:-        pact-time-+        -- internal+        , pact-time+        -- external         , base >=4.11 && <5         , tasty >=1.4         , tasty-hunit >=0.10

@@ -48,8 +48,16 @@ , formatTime  -- * Reexports-, AffineSpace(..)-, VectorSpace(..)+, AdditiveSemigroup(..)+, AdditiveMonoid(..)+, AdditiveGroup(..)+, (^-^)+, (^+^)+, (.+^)+, (^+.)+, (.-.)+, (.-^)+, (*^) ) where  import Pact.Time.Format

@@ -42,7 +42,6 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Vector.Unboxed as VU-import Data.VectorSpace  import Lens.Micro @@ -793,7 +792,7 @@             'q' -> lift micro >>= assign tpSecFrac . NominalDiffTime >> go rspec              'v' -> lift micro >>= assign tpSecFrac . NominalDiffTime >> go rspec-            'Q' -> lift ((P.char '.' >> NominalDiffTime <$> micro) <|> return zeroV)+            'Q' -> lift ((P.char '.' >> NominalDiffTime <$> micro) <|> return zero)                 >>= assign tpSecFrac >> go rspec              -- Year@@ -923,8 +922,8 @@         , _tpHour = 0         , _tpMinute = 0         , _tpSecond = 0-        , _tpSecFrac = zeroV-        , _tpPOSIXTime = zeroV+        , _tpSecFrac = zero+        , _tpPOSIXTime = zero         , _tpTimeZone = utc         }     {-# INLINE unixEpoch #-}@@ -1029,8 +1028,8 @@          toDayTime :: TimeOfDay -> NominalDiffTime         toDayTime (TimeOfDay h m s) = s-            ^+^ fromIntegral m *^ NominalDiffTime 60000000-            ^+^ fromIntegral h *^ NominalDiffTime 3600000000+            ^+^ m *^ NominalDiffTime 60000000+            ^+^ h *^ NominalDiffTime 3600000000         {-# INLINEABLE toDayTime #-}     {-# INLINE buildTime #-} 

@@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}  -- | -- Module: Pact.Time.Internal@@ -29,6 +30,8 @@ , toSeconds , fromSeconds , nominalDay+, scaleNominalDiffTime+, divNominalDiffTime  -- * UTCTime , UTCTime(..)@@ -48,17 +51,23 @@ , fromModifiedJulianDate  -- * Reexports-, AffineSpace(..)-, VectorSpace(..)+, AdditiveSemigroup(..)+, AdditiveMonoid(..)+, AdditiveGroup(..)+, (^-^)+, (^+^)+, (.+^)+, (^+.)+, (.-.)+, (.-^)+, (*^) ) where  import Control.DeepSeq -import Data.AdditiveGroup-import Data.AffineSpace import Data.Decimal import Data.Serialize-import Data.VectorSpace+-- import Data.VectorSpace  import GHC.Generics hiding (from) import GHC.Int (Int64)@@ -69,6 +78,9 @@  import Pact.Time.System +import Numeric.Additive+import Numeric.AffineSpace+ -- -------------------------------------------------------------------------- -- -- Types for internal representations @@ -83,7 +95,11 @@ -- newtype NominalDiffTime = NominalDiffTime { _microseconds :: Micros }     deriving (Eq, Ord)-    deriving newtype (NFData)+    deriving newtype+        ( NFData+        , AdditiveSemigroup, AdditiveAbelianSemigroup, AdditiveMonoid, AdditiveGroup+        , Enum, Bounded+        )  -- | Convert from 'NominalDiffTime' to a 64-bit representation of microseconds. --@@ -97,21 +113,6 @@ fromMicroseconds = NominalDiffTime {-# INLINE fromMicroseconds #-} -instance AdditiveGroup NominalDiffTime where-    zeroV = NominalDiffTime 0-    NominalDiffTime a ^+^ NominalDiffTime b = NominalDiffTime (a + b)-    negateV (NominalDiffTime v) = NominalDiffTime (-v)-    NominalDiffTime a ^-^ NominalDiffTime b = NominalDiffTime (a - b)-    {-# INLINE zeroV #-}-    {-# INLINE (^+^) #-}-    {-# INLINE negateV #-}-    {-# INLINE (^-^) #-}--instance VectorSpace NominalDiffTime where-    type Scalar NominalDiffTime = Rational-    s *^ (NominalDiffTime m) = NominalDiffTime $ round (s * fromIntegral m)-    {-# INLINE (*^) #-}- -- | Serializes 'NominalDiffTime' as 64-bit signed microseconds in little endian -- encoding. --@@ -150,6 +151,18 @@ fromPosixTimestampMicros = fromPosix . fromTimestampMicros {-# INLINE fromPosixTimestampMicros #-} +scaleNominalDiffTime :: Integral a => a -> NominalDiffTime -> NominalDiffTime+scaleNominalDiffTime scalar (NominalDiffTime t) = NominalDiffTime (fromIntegral scalar * t)+{-# INLINE scaleNominalDiffTime #-}++(*^) :: Integral a => a -> NominalDiffTime -> NominalDiffTime+(*^) = scaleNominalDiffTime+{-# INLINE (*^) #-}++divNominalDiffTime :: Integral a => NominalDiffTime -> a -> NominalDiffTime+divNominalDiffTime (NominalDiffTime a) s = NominalDiffTime $ a `div` (fromIntegral s)+{-# INLINE divNominalDiffTime #-}+ -- -------------------------------------------------------------------------- -- -- UTCTime @@ -167,12 +180,12 @@     deriving newtype (NFData)     deriving newtype (Serialize) -instance AffineSpace UTCTime where+instance LeftTorsor UTCTime where     type Diff UTCTime = NominalDiffTime-    UTCTime a .-. UTCTime b = a ^-^ b-    UTCTime a .+^ b = UTCTime (a ^+^ b)-    {-# INLINE (.-.) #-}-    {-# INLINE (.+^) #-}+    add s (UTCTime t) = UTCTime (s `plus` t)+    diff (UTCTime t₁) (UTCTime t₂) = t₁ `minus` t₂+    {-# INLINE add #-}+    {-# INLINE diff #-}  getCurrentTime :: IO UTCTime getCurrentTime = UTCTime . (^+^ _utcTime posixEpoch) . _posixTime@@ -210,7 +223,7 @@ -- | The POSIX Epoch represented as UTCTime. -- posixEpoch :: UTCTime-posixEpoch = UTCTime (fromIntegral d *^ nominalDay)+posixEpoch = UTCTime (d *^ nominalDay)   where     ModifiedJulianDay d = posixEpochDay {-# INLINE posixEpoch #-}@@ -218,7 +231,7 @@ -- | The Epoch of the modified Julian day represented as 'UTCTime'. -- mjdEpoch :: UTCTime-mjdEpoch = UTCTime zeroV+mjdEpoch = UTCTime zero {-# INLINE mjdEpoch #-}  -- -------------------------------------------------------------------------- --@@ -311,6 +324,6 @@ -- fromModifiedJulianDate :: ModifiedJulianDate -> UTCTime fromModifiedJulianDate (ModifiedJulianDate (ModifiedJulianDay d) t)-    = UTCTime $ (fromIntegral d *^ nominalDay) ^+^ t+    = UTCTime $ (d *^ nominalDay) ^+^ t {-# INLINE fromModifiedJulianDate #-}