diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,32 @@ o'clock uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +1.4.0.1 +======= +* [#145](https://github.com/serokell/o-clock/pull/145) + + Bump some upper bounds. + + Get rid of warnings with GHC-9.12. + +1.4.0 +===== + +* [#136](https://github.com/serokell/o-clock/pull/136) + + Remove `toNum`. +* [#139](https://github.com/serokell/o-clock/pull/139) + + Add `Data` instance to `Time`. +* [#140](https://github.com/serokell/o-clock/pull/140) + + Increase some upper bounds. + +1.3.0 +===== + +* [#129](https://github.com/serokell/o-clock/pull/129) + + Deprecate `toNum`: may cause accidental flooring. + + Add the `toFractional` function to avoid the accidental flooring. + + Change the order of the type variables in the definition of `floorRat` so that the target type comes first. +* [#131](https://github.com/serokell/o-clock/pull/131) + + Add `ceilingRat` and `ceilingUnit`. + 1.2.1.1 ===== diff --git a/o-clock.cabal b/o-clock.cabal --- a/o-clock.cabal +++ b/o-clock.cabal @@ -4,7 +4,7 @@ -- SPDX-License-Identifier: MPL-2.0 name: o-clock -version: 1.2.1.1 +version: 1.4.0.1 synopsis: Type-safe time library. description: See README.md for details. homepage: https://github.com/serokell/o-clock @@ -20,11 +20,13 @@ extra-doc-files: CHANGELOG.md , README.md , README.lhs -tested-with: GHC == 8.6.5 - , GHC == 8.8.3 - , GHC == 8.10.4 - , GHC == 9.0.1 - , GHC == 9.2.1 +tested-with: GHC == 9.0.2 + , GHC == 9.2.8 + , GHC == 9.4.8 + , GHC == 9.6.6 + , GHC == 9.8.4 + , GHC == 9.10.1 + , GHC == 9.12.1 source-repository head type: git @@ -32,7 +34,7 @@ common common-options build-depends: - base >=4.12 && <4.17 + base >=4.12 && <5 ghc-options: -Wall default-language: Haskell2010 @@ -50,7 +52,7 @@ TypeApplications TypeFamilies if flag(aeson) - build-depends: aeson >= 1.2.4 && < 2.1 + build-depends: aeson >= 1.2.4 && < 2.3 , text cpp-options: -DHAS_aeson @@ -74,10 +76,10 @@ Test.Time.Units build-depends: o-clock - , hedgehog >= 0.6 && < 1.2 + , hedgehog >= 0.6 && < 1.6 , hspec-expectations ^>= 0.8 - , tasty >= 0.12 && < 1.5 - , tasty-hedgehog >= 0.1 && < 1.2 + , tasty >= 0.12 && < 1.6 + , tasty-hedgehog >= 0.1 && < 1.5.0 , tasty-hunit-compat ^>= 0.2 , type-spec >= 0.3.0.1 && < 0.5 @@ -95,7 +97,7 @@ main-is: Doctest.hs build-tool-depends: doctest:doctest - build-depends: doctest >= 0.16 && < 0.21 + build-depends: doctest >= 0.16 && < 0.24 , Glob >= 0.9 && < 0.11 ghc-options: -threaded -rtsopts -with-rtsopts=-N @@ -109,8 +111,8 @@ build-tool-depends: markdown-unlit:markdown-unlit build-depends: o-clock - , markdown-unlit ^>= 0.5 - ghc-options: -threaded -rtsopts -with-rtsopts=-N -pgmL markdown-unlit + , markdown-unlit >= 0.5 && < 0.7 + ghc-options: -threaded -rtsopts -with-rtsopts=-N -pgmL markdown-unlit -Wno-orphans benchmark o-clock-benchmark import: common-options diff --git a/src/Time/Rational.hs b/src/Time/Rational.hs --- a/src/Time/Rational.hs +++ b/src/Time/Rational.hs @@ -1,18 +1,28 @@ --- SPDX-FileCopyrightText: 2019 Serokell +-- SPDX-FileCopyrightText: 2019-2023 Serokell -- -- SPDX-License-Identifier: MPL-2.0 {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoStarIsType #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Rank2Types #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +-- See https://github.com/ghc/ghc/commit/13d627bbd0bc3dd30d672de341aa7f471be0aa2c +-- Starting from 9.6, GHC doesn't print promotion ticks when they are not necessary. +-- Because of that we need to support too many cases in doctests. +-- Let's force redundant ticks for now and remove this flag later when we stop +-- supporting 9.0 at least. +#if ( __GLASGOW_HASKELL__ >= 906 ) +{-# OPTIONS_GHC -fprint-redundant-promotion-ticks #-} +#endif + -- | This module introduces 'Rat' kind and all necessary functional. module Time.Rational @@ -43,6 +53,11 @@ import GHC.TypeNats (Div, KnownNat, Mod, Nat, natVal, type (<=?)) import qualified GHC.TypeNats import Unsafe.Coerce (unsafeCoerce) + +#if ( __GLASGOW_HASKELL__ >= 906 ) +-- $setup +-- >>> {-# OPTIONS_GHC -fprint-redundant-promotion-ticks #-} +#endif -- | Data structure represents the rational number. -- Rational number can be represented as a pair of diff --git a/src/Time/Timestamp.hs b/src/Time/Timestamp.hs --- a/src/Time/Timestamp.hs +++ b/src/Time/Timestamp.hs @@ -82,9 +82,9 @@ -> Timestamp timeAdd t (Timestamp ts) = Timestamp (toRational (unTime $ toUnit @Second t) + ts) --- | Returns the result of multiplication of two 'Time' elements. -timeMul :: forall (unit :: Rat) . KnownRat unit - => RatioNat +-- | Returns the result of multiplying a number by a 'Time' element. +timeMul :: forall (unit :: Rat) . + RatioNat -> Time unit -> Time unit timeMul n (Time t) = Time (n * t) diff --git a/src/Time/Units.hs b/src/Time/Units.hs --- a/src/Time/Units.hs +++ b/src/Time/Units.hs @@ -3,9 +3,10 @@ -- SPDX-License-Identifier: MPL-2.0 {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} @@ -43,7 +44,9 @@ , time , floorUnit , floorRat - , toNum + , ceilingUnit + , ceilingRat + , toFractional , sec , ms @@ -68,7 +71,10 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Char (isDigit, isLetter) import Data.Coerce (coerce) +import Data.Data (Data) +#if !(MIN_VERSION_base(4,20,0)) import Data.Foldable (foldl') +#endif import Data.Proxy (Proxy (..)) import Data.Semigroup (Semigroup (..)) import GHC.Generics (Generic) @@ -80,12 +86,12 @@ import Text.ParserCombinators.ReadPrec (ReadPrec, lift) #ifdef HAS_aeson -import Data.Aeson (ToJSON (..), FromJSON (..), withText) -import Text.Read (readMaybe) +import Data.Aeson (FromJSON (..), ToJSON (..), withText) import qualified Data.Text as Text +import Text.Read (readMaybe) #endif -import Time.Rational (type (*), type (/), type (:%), KnownDivRat, Rat, RatioNat, KnownRat, ratVal) +import Time.Rational (KnownDivRat, KnownRat, Rat, RatioNat, ratVal, type (*), type (/), type (:%)) import qualified Control.Concurrent as Concurrent import qualified System.CPUTime as CPUTime @@ -113,7 +119,7 @@ -- | Time unit is represented as type level rational multiplier with kind 'Rat'. newtype Time (rat :: Rat) = Time { unTime :: RatioNat } - deriving (Eq, Ord, Enum, Generic) + deriving (Eq, Ord, Enum, Generic, Data) -- | Addition is associative binary operation for 'Semigroup' of 'Time'. instance Semigroup (Time (rat :: Rat)) where @@ -300,7 +306,7 @@ {-# INLINE fortnight #-} -- | Returns the greatest integer not greater than given 'Time'. -floorRat :: forall (unit :: Rat) b . (Integral b) => Time unit -> b +floorRat :: forall b (unit :: Rat) . Integral b => Time unit -> b floorRat = floor . unTime {- | Similar to 'floor', but works with 'Time' units. @@ -318,36 +324,42 @@ floorUnit :: forall (unit :: Rat) . Time unit -> Time unit floorUnit = time . fromIntegral @Natural . floorRat -{- | Convert time to the 'Num' in given units. +-- | Returns the smallest integer greater than or equal to the given 'Time'. +-- +-- @since 1.3.0 +ceilingRat :: forall b (unit :: Rat) . (Integral b) => Time unit -> b +ceilingRat = ceiling . unTime -For example, instead of writing +{- | Similar to 'ceiling', but works with 'Time' units. -@ -foo :: POSIXTime -foo = 10800 -- 3 hours -@ +>>> ceilingUnit @Day (Time $ 5 % 2) +3d -one can write more safe implementation: +>>> ceilingUnit (Time @Second $ 2 % 3) +1s -@ -foo = toNum @Second $ hour 3 -@ +>>> ceilingUnit $ ps 42 +42ps -__Examples:__ +@since 1.3.0 +-} +ceilingUnit :: forall (unit :: Rat) . Time unit -> Time unit +ceilingUnit = time . fromIntegral @Natural . ceilingRat ->>> toNum @Second @Natural $ hour 3 -10800 +{- | Convert the 'Time' object to the 'Fractional' value. ->>> toNum @Minute @Int $ hour 3 -180 +__Examples:__ ->>> toNum @Hour @Natural $ hour 3 -3 +>>> toFractional @Rational $ hour (1 % 8) +1 % 8 +>>> toFractional @Double $ hour (1 % 8) +0.125 + +@since 1.3.0 -} -toNum :: forall (unitTo :: Rat) n (unit :: Rat) . (KnownDivRat unit unitTo, Num n) - => Time unit -> n -toNum = fromIntegral @Natural . floorRat . toUnit @unitTo +toFractional :: forall r (unit :: Rat) . Fractional r => Time unit -> r +toFractional = fromRational . toRational . unTime ---------------------------------------------------------------------------- -- Functional diff --git a/test/Test/Time/Units.hs b/test/Test/Time/Units.hs --- a/test/Test/Time/Units.hs +++ b/test/Test/Time/Units.hs @@ -12,14 +12,16 @@ ) where import Control.Exception (evaluate) -import GHC.Real (Ratio ((:%))) +import GHC.Real (Ratio ((:%)), (%)) import Test.Hspec.Expectations (anyException, shouldBe, shouldThrow) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) -import Time (Day, Hour, Millisecond, Minute, Second, Time (..), Week, day, floorUnit, fortnight, - hour, mcs, minute, ms, ns, ps, sec, seriesF, toUnit, unitsF, week, (+:+)) +import Time (Day, Hour, Millisecond, Minute, Second, Time (..), Week, day, floorUnit, ceilingUnit, + fortnight, hour, mcs, minute, ms, ns, ps, sec, seriesF, toUnit, toFractional, unitsF, + week, (+:+)) + unitsTestTree :: TestTree unitsTestTree = testGroup "Units" unitsTests @@ -74,6 +76,20 @@ floorUnit (Time $ 5 :% 2) `shouldBe` day 2 , testCase "returns 42ps when floor integer" $ floorUnit (ps 42) `shouldBe` ps 42 + ] + , testGroup "Ceiling tests" + [ testCase "returns 1s, given 2/3 seconds" $ + ceilingUnit (Time @Second $ 2 :% 3) `shouldBe` sec 1 + , testCase "returns 3d, given 2+1/2 days" $ + ceilingUnit (Time $ 5 :% 2) `shouldBe` day 3 + , testCase "returns 42ps, given exactly 42 picoseconds" $ + ceilingUnit (ps 42) `shouldBe` ps 42 + ] + , testGroup "Conversion to Fractional values" + [ testCase "The 'Rational' representation of (hour $ 1 % 8) should be equal to 1 % 8" $ + toFractional @Rational (hour (1 % 8)) `shouldBe` 1 % 8 + , testCase "The 'Double' representation of (hour $ 1 % 8) should be equal to 0.125" $ + toFractional @Double (hour (1 % 8)) `shouldBe` 0.125 ] , testGroup "Formatting tests" [ testCase "4000 minutes should be formatted without ending-zeros" $