o-clock 1.0.0.1 → 1.4.0.1
raw patch · 18 files changed
Files
- CHANGELOG.md +70/−0
- LICENSE +308/−17
- README.lhs +11/−19
- README.md +11/−19
- benchmark/Main.hs +6/−9
- examples/Playground.hs +4/−0
- o-clock.cabal +56/−60
- src/Time.hs +4/−0
- src/Time/Rational.hs +96/−40
- src/Time/Series.hs +8/−31
- src/Time/Timestamp.hs +8/−4
- src/Time/Units.hs +44/−77
- test/Doctest.hs +4/−0
- test/Spec.hs +6/−7
- test/Test/Time/Property.hs +4/−4
- test/Test/Time/Timestamp.hs +26/−19
- test/Test/Time/TypeSpec.hs +7/−11
- test/Test/Time/Units.hs +70/−44
CHANGELOG.md view
@@ -1,7 +1,77 @@+<!--+SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>++SPDX-License-Identifier: MPL-2.0+-->+ Change log ========== 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+=====++* [#125](https://github.com/serokell/o-clock/pull/125):+ + Remove `ghc-prim` dependency.+ + Remove old artifacts of GHC<8.6 support.+ + Make `base` constraints stricter.++1.2.1+=====++* [#121](https://github.com/serokell/o-clock/pull/121):+ + Remove `tasty-hspec` dependency from tests.++1.2.0.1+=======++Bump upper versions of some dependencies.++1.2.0+=====++* [#113](https://github.com/serokell/o-clock/pull/113):+ + Increase some upper bounds.+ + Drop support for GHC-8.4.+ + Drop `deepseq`, `serialize` and `hashable` flags.+ + Fix some warnings.++1.1.0+=====++* [#110](https://github.com/serokell/o-clock/issues/110):+ Resurrect `o-clock` in nightly resolver. Specifically:+ + Explicitly support GHC-8.8.+ + Bump many upper bounds.+ + Make benchmarks not buildable by default.+ + Drop support for GHC-8.0 and GHC-8.2. 1.0.0.1 =======
LICENSE view
@@ -1,21 +1,312 @@-MIT License+Mozilla Public License Version 2.0 -Copyright (c) 2018 Serokell+ 1. Definitions -Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:+1.1. "Contributor" means each individual or legal entity that creates, contributes+to the creation of, or owns Covered Software. -The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.+1.2. "Contributor Version" means the combination of the Contributions of others+(if any) used by a Contributor and that particular Contributor's Contribution. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-SOFTWARE.+ 1.3. "Contribution" means Covered Software of a particular Contributor.++1.4. "Covered Software" means Source Code Form to which the initial Contributor+has attached the notice in Exhibit A, the Executable Form of such Source Code+Form, and Modifications of such Source Code Form, in each case including portions+thereof.++ 1.5. "Incompatible With Secondary Licenses" means++(a) that the initial Contributor has attached the notice described in Exhibit+B to the Covered Software; or++(b) that the Covered Software was made available under the terms of version+1.1 or earlier of the License, but not also under the terms of a Secondary+License.++1.6. "Executable Form" means any form of the work other than Source Code Form.++1.7. "Larger Work" means a work that combines Covered Software with other+material, in a separate file or files, that is not Covered Software.++ 1.8. "License" means this document.++1.9. "Licensable" means having the right to grant, to the maximum extent possible,+whether at the time of the initial grant or subsequently, any and all of the+rights conveyed by this License.++ 1.10. "Modifications" means any of the following:++(a) any file in Source Code Form that results from an addition to, deletion+from, or modification of the contents of Covered Software; or++(b) any new file in Source Code Form that contains any Covered Software.++1.11. "Patent Claims" of a Contributor means any patent claim(s), including+without limitation, method, process, and apparatus claims, in any patent Licensable+by such Contributor that would be infringed, but for the grant of the License,+by the making, using, selling, offering for sale, having made, import, or+transfer of either its Contributions or its Contributor Version.++1.12. "Secondary License" means either the GNU General Public License, Version+2.0, the GNU Lesser General Public License, Version 2.1, the GNU Affero General+Public License, Version 3.0, or any later versions of those licenses.++1.13. "Source Code Form" means the form of the work preferred for making modifications.++1.14. "You" (or "Your") means an individual or a legal entity exercising rights+under this License. For legal entities, "You" includes any entity that controls,+is controlled by, or is under common control with You. For purposes of this+definition, "control" means (a) the power, direct or indirect, to cause the+direction or management of such entity, whether by contract or otherwise,+or (b) ownership of more than fifty percent (50%) of the outstanding shares+or beneficial ownership of such entity.++ 2. License Grants and Conditions++ 2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free, non-exclusive+license:++(a) under intellectual property rights (other than patent or trademark) Licensable+by such Contributor to use, reproduce, make available, modify, display, perform,+distribute, and otherwise exploit its Contributions, either on an unmodified+basis, with Modifications, or as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer for+sale, have made, import, and otherwise transfer either its Contributions or+its Contributor Version.++ 2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution become+effective for each Contribution on the date the Contributor first distributes+such Contribution.++ 2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under this+License. No additional rights or licenses will be implied from the distribution+or licensing of Covered Software under this License. Notwithstanding Section+2.1(b) above, no patent license is granted by a Contributor:++(a) for any code that a Contributor has removed from Covered Software; or++(b) for infringements caused by: (i) Your and any other third party's modifications+of Covered Software, or (ii) the combination of its Contributions with other+software (except as part of its Contributor Version); or++(c) under Patent Claims infringed by Covered Software in the absence of its+Contributions.++This License does not grant any rights in the trademarks, service marks, or+logos of any Contributor (except as may be necessary to comply with the notice+requirements in Section 3.4).++ 2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to distribute+the Covered Software under a subsequent version of this License (see Section+10.2) or under the terms of a Secondary License (if permitted under the terms+of Section 3.3).++ 2.5. Representation++Each Contributor represents that the Contributor believes its Contributions+are its original creation(s) or it has sufficient rights to grant the rights+to its Contributions conveyed by this License.++ 2.6. Fair Use++This License is not intended to limit any rights You have under applicable+copyright doctrines of fair use, fair dealing, or other equivalents.++ 2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted in+Section 2.1.++ 3. Responsibilities++ 3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any Modifications+that You create or to which You contribute, must be under the terms of this+License. You must inform recipients that the Source Code Form of the Covered+Software is governed by the terms of this License, and how they can obtain+a copy of this License. You may not attempt to alter or restrict the recipients'+rights in the Source Code Form.++ 3.2. Distribution of Executable Form++ If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code Form,+as described in Section 3.1, and You must inform recipients of the Executable+Form how they can obtain a copy of such Source Code Form by reasonable means+in a timely manner, at a charge no more than the cost of distribution to the+recipient; and++(b) You may distribute such Executable Form under the terms of this License,+or sublicense it under different terms, provided that the license for the+Executable Form does not attempt to limit or alter the recipients' rights+in the Source Code Form under this License.++ 3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice, provided+that You also comply with the requirements of this License for the Covered+Software. If the Larger Work is a combination of Covered Software with a work+governed by one or more Secondary Licenses, and the Covered Software is not+Incompatible With Secondary Licenses, this License permits You to additionally+distribute such Covered Software under the terms of such Secondary License(s),+so that the recipient of the Larger Work may, at their option, further distribute+the Covered Software under the terms of either this License or such Secondary+License(s).++ 3.4. Notices++You may not remove or alter the substance of any license notices (including+copyright notices, patent notices, disclaimers of warranty, or limitations+of liability) contained within the Source Code Form of the Covered Software,+except that You may alter any license notices to the extent required to remedy+known factual inaccuracies.++ 3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support, indemnity+or liability obligations to one or more recipients of Covered Software. However,+You may do so only on Your own behalf, and not on behalf of any Contributor.+You must make it absolutely clear that any such warranty, support, indemnity,+or liability obligation is offered by You alone, and You hereby agree to indemnify+every Contributor for any liability incurred by such Contributor as a result+of warranty, support, indemnity or liability terms You offer. You may include+additional disclaimers of warranty and limitations of liability specific to+any jurisdiction.++ 4. Inability to Comply Due to Statute or Regulation++If it is impossible for You to comply with any of the terms of this License+with respect to some or all of the Covered Software due to statute, judicial+order, or regulation then You must: (a) comply with the terms of this License+to the maximum extent possible; and (b) describe the limitations and the code+they affect. Such description must be placed in a text file included with+all distributions of the Covered Software under this License. Except to the+extent prohibited by statute or regulation, such description must be sufficiently+detailed for a recipient of ordinary skill to be able to understand it.++ 5. Termination++5.1. The rights granted under this License will terminate automatically if+You fail to comply with any of its terms. However, if You become compliant,+then the rights granted under this License from a particular Contributor are+reinstated (a) provisionally, unless and until such Contributor explicitly+and finally terminates Your grants, and (b) on an ongoing basis, if such Contributor+fails to notify You of the non-compliance by some reasonable means prior to+60 days after You have come back into compliance. Moreover, Your grants from+a particular Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the first+time You have received notice of non-compliance with this License from such+Contributor, and You become compliant prior to 30 days after Your receipt+of the notice.++5.2. If You initiate litigation against any entity by asserting a patent infringement+claim (excluding declaratory judgment actions, counter-claims, and cross-claims)+alleging that a Contributor Version directly or indirectly infringes any patent,+then the rights granted to You by any and all Contributors for the Covered+Software under Section 2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all end+user license agreements (excluding distributors and resellers) which have+been validly granted by You or Your distributors under this License prior+to termination shall survive termination.++ 6. Disclaimer of Warranty++Covered Software is provided under this License on an "as is" basis, without+warranty of any kind, either expressed, implied, or statutory, including,+without limitation, warranties that the Covered Software is free of defects,+merchantable, fit for a particular purpose or non-infringing. The entire risk+as to the quality and performance of the Covered Software is with You. Should+any Covered Software prove defective in any respect, You (not any Contributor)+assume the cost of any necessary servicing, repair, or correction. This disclaimer+of warranty constitutes an essential part of this License. No use of any Covered+Software is authorized under this License except under this disclaimer.++ 7. Limitation of Liability++Under no circumstances and under no legal theory, whether tort (including+negligence), contract, or otherwise, shall any Contributor, or anyone who+distributes Covered Software as permitted above, be liable to You for any+direct, indirect, special, incidental, or consequential damages of any character+including, without limitation, damages for lost profits, loss of goodwill,+work stoppage, computer failure or malfunction, or any and all other commercial+damages or losses, even if such party shall have been informed of the possibility+of such damages. This limitation of liability shall not apply to liability+for death or personal injury resulting from such party's negligence to the+extent applicable law prohibits such limitation. Some jurisdictions do not+allow the exclusion or limitation of incidental or consequential damages,+so this exclusion and limitation may not apply to You.++ 8. Litigation++Any litigation relating to this License may be brought only in the courts+of a jurisdiction where the defendant maintains its principal place of business+and such litigation shall be governed by laws of that jurisdiction, without+reference to its conflict-of-law provisions. Nothing in this Section shall+prevent a party's ability to bring cross-claims or counter-claims.++ 9. Miscellaneous++This License represents the complete agreement concerning the subject matter+hereof. If any provision of this License is held to be unenforceable, such+provision shall be reformed only to the extent necessary to make it enforceable.+Any law or regulation which provides that the language of a contract shall+be construed against the drafter shall not be used to construe this License+against a Contributor.++ 10. Versions of the License++ 10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section 10.3,+no one other than the license steward has the right to modify or publish new+versions of this License. Each version will be given a distinguishing version+number.++ 10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version of+the License under which You originally received the Covered Software, or under+the terms of any subsequent version published by the license steward.++ 10.3. Modified Versions++If you create software not governed by this License, and you want to create+a new license for such software, you may create and use a modified version+of this License if you rename the license and remove any references to the+name of the license steward (except to note that such modified license differs+from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary Licenses++If You choose to distribute Source Code Form that is Incompatible With Secondary+Licenses under the terms of this version of the License, the notice described+in Exhibit B of this License must be attached. Exhibit A - Source Code Form+License Notice++This Source Code Form is subject to the terms of the Mozilla Public License,+v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain+one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular file,+then You may include the notice in a location (such as a LICENSE file in a+relevant directory) where a recipient would be likely to look for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice++This Source Code Form is "Incompatible With Secondary Licenses", as defined+by the Mozilla Public License, v. 2.0.
README.lhs view
@@ -1,10 +1,16 @@+<!--+SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>++SPDX-License-Identifier: MPL-2.0+-->+ # O'Clock +[](https://github.com/serokell/o-clock/actions) [](https://hackage.haskell.org/package/o-clock)-[](https://travis-ci.org/serokell/o-clock) [](http://stackage.org/lts/package/o-clock) [](http://stackage.org/nightly/package/o-clock)-[](https://github.com/serokell/o-clock/blob/master/LICENSE)+[](https://github.com/serokell/o-clock/blob/master/LICENSE) ## Overview @@ -54,11 +60,9 @@ * It means that if you want to roll out your own time units and use it in your project, this can be done in easy and convenient way (see tutorial below). -6. `O'Clock` contains useful instances like `Hashable`, `NFData`, `Serialise`, `ToJSON`, `FromJSON`- but it's not included to the package by default. To do that you need to provide corresponding- flag from this list: `hashable`, `deepseq`, `serialise` and `aeson`.--_**Note:**_ features support for `GHC-8.2.2` and `GHC-8.0.2` is quite limited.+6. `O'Clock` contains useful instances: `ToJSON` and `FromJSON`.+ However, they are not included to the package by default.+ To do that, you need to provide the corresponding flag: `aeson`. ## Example: How to make your own time unit @@ -76,18 +80,14 @@ ```haskell {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}-#if ( __GLASGOW_HASKELL__ >= 806 ) {-# LANGUAGE NoStarIsType #-}-#endif {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Main where -#if ( __GLASGOW_HASKELL__ >= 804 ) import Time (type (*))-#endif import Time ((:%), (-:-), Time, Hour, UnitName,floorUnit, hour, seriesF, toUnit) ```@@ -99,18 +99,10 @@ ```haskell -- | Time unit for a working day (8 hours).-#if ( __GLASGOW_HASKELL__ >= 804 ) type WorkDay = 8 * Hour-#else-type WorkDay = 28800 :% 1-#endif -- | Time unit for a work week (5 working days).-#if ( __GLASGOW_HASKELL__ >= 804 ) type WorkWeek = 5 * WorkDay-#else-type WorkWeek = 144000 :% 1-#endif -- this allows to use 'Show' and 'Read' functions for our time units type instance UnitName (28800 :% 1) = "wd" -- One WorkDay contains 28800 seconds
README.md view
@@ -1,10 +1,16 @@+<!--+SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>++SPDX-License-Identifier: MPL-2.0+-->+ # O'Clock +[](https://github.com/serokell/o-clock/actions) [](https://hackage.haskell.org/package/o-clock)-[](https://travis-ci.org/serokell/o-clock) [](http://stackage.org/lts/package/o-clock) [](http://stackage.org/nightly/package/o-clock)-[](https://github.com/serokell/o-clock/blob/master/LICENSE)+[](https://github.com/serokell/o-clock/blob/master/LICENSE) ## Overview @@ -54,11 +60,9 @@ * It means that if you want to roll out your own time units and use it in your project, this can be done in easy and convenient way (see tutorial below). -6. `O'Clock` contains useful instances like `Hashable`, `NFData`, `Serialise`, `ToJSON`, `FromJSON`- but it's not included to the package by default. To do that you need to provide corresponding- flag from this list: `hashable`, `deepseq`, `serialise` and `aeson`.--_**Note:**_ features support for `GHC-8.2.2` and `GHC-8.0.2` is quite limited.+6. `O'Clock` contains useful instances: `ToJSON` and `FromJSON`.+ However, they are not included to the package by default.+ To do that, you need to provide the corresponding flag: `aeson`. ## Example: How to make your own time unit @@ -76,18 +80,14 @@ ```haskell {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}-#if ( __GLASGOW_HASKELL__ >= 806 ) {-# LANGUAGE NoStarIsType #-}-#endif {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Main where -#if ( __GLASGOW_HASKELL__ >= 804 ) import Time (type (*))-#endif import Time ((:%), (-:-), Time, Hour, UnitName,floorUnit, hour, seriesF, toUnit) ```@@ -99,18 +99,10 @@ ```haskell -- | Time unit for a working day (8 hours).-#if ( __GLASGOW_HASKELL__ >= 804 ) type WorkDay = 8 * Hour-#else-type WorkDay = 28800 :% 1-#endif -- | Time unit for a work week (5 working days).-#if ( __GLASGOW_HASKELL__ >= 804 ) type WorkWeek = 5 * WorkDay-#else-type WorkWeek = 144000 :% 1-#endif -- this allows to use 'Show' and 'Read' functions for our time units type instance UnitName (28800 :% 1) = "wd" -- One WorkDay contains 28800 seconds
benchmark/Main.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2020 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-}@@ -9,24 +13,17 @@ module Main where -#ifdef NO_deepseq import Control.DeepSeq (NFData)-#endif import Gauge (bench, bgroup, defaultMain, nf, whnf) -#ifdef NO_deepseq-import Time (Rat, Time)-#endif-import Time (Day, Hour, Microsecond, Nanosecond, Second, hour, mcs, ns, sec, toUnit, week)+import Time (Day, Hour, Microsecond, Nanosecond, Rat, Second, Time, hour, mcs, ns, sec, toUnit,+ week) import qualified Data.Time.Units as TU (Day, Hour, Microsecond, Nanosecond, Second, Week, convertUnit) import qualified Tiempo (hours, microSeconds, toHours, toMicroSeconds) --#ifdef NO_deepseq instance NFData (Time (unit :: Rat))-#endif main :: IO () main = defaultMain
examples/Playground.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# LANGUAGE ScopedTypeVariables #-} module Main where
o-clock.cabal view
@@ -1,70 +1,71 @@+cabal-version: 2.2+-- SPDX-FileCopyrightText: 2020-2021 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ name: o-clock-version: 1.0.0.1+version: 1.4.0.1 synopsis: Type-safe time library. description: See README.md for details. homepage: https://github.com/serokell/o-clock bug-reports: https://github.com/serokell/o-clock/issues-license: MIT+license: MPL-2.0 license-file: LICENSE author: @serokell maintainer: Serokell <hi@serokell.io>-copyright: 2018 Serokell+copyright: 2020 Serokell category: Time build-type: Simple stability: stable extra-doc-files: CHANGELOG.md , README.md , README.lhs-cabal-version: 2.0-tested-with: GHC == 8.0.2- , GHC == 8.2.2- , GHC == 8.4.3- , GHC == 8.6.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 location: https://github.com/serokell/o-clock +common common-options+ build-depends:+ base >=4.12 && <5+ ghc-options: -Wall+ default-language: Haskell2010+ library+ import: common-options hs-source-dirs: src exposed-modules: Time Time.Rational Time.Series Time.Timestamp Time.Units- ghc-options: -Wall- build-depends: base >= 4.9 && < 5- , ghc-prim ^>= 0.5- default-language: Haskell2010 default-extensions: OverloadedStrings RecordWildCards ScopedTypeVariables TypeApplications TypeFamilies if flag(aeson)- build-depends: aeson >= 1.2.4 && < 1.5+ build-depends: aeson >= 1.2.4 && < 2.3 , text cpp-options: -DHAS_aeson- if flag(hashable)- build-depends: hashable >= 1.2.6 && < 1.3- cpp-options: -DHAS_hashable- if flag(deepseq)- build-depends: deepseq ^>= 1.4- cpp-options: -DHAS_deepseq- if flag(serialise)- build-depends: serialise >= 0.2- cpp-options: -DHAS_serialise executable play-o-clock+ import: common-options main-is: Playground.hs build-depends: o-clock- , base >= 4.9 && < 5 hs-source-dirs: examples- default-language: Haskell2010- ghc-options: -threaded -Wall+ ghc-options: -threaded -fno-warn-orphans test-suite o-clock-test+ import: common-options type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs@@ -74,56 +75,59 @@ Test.Time.TypeSpec Test.Time.Units - build-depends: base >= 4.9 && < 5- , o-clock- , hedgehog ^>= 0.6- , tasty >= 0.12 && < 1.2- , tasty-hedgehog >= 0.1 && < 0.3- , tasty-hspec ^>= 1.1.3- , type-spec ^>= 0.3.0.1+ build-depends: o-clock+ , hedgehog >= 0.6 && < 1.6+ , hspec-expectations ^>= 0.8+ , 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 - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- default-language: Haskell2010+ ghc-options: -threaded -rtsopts -with-rtsopts=-N default-extensions: OverloadedStrings RecordWildCards test-suite o-clock-doctest+ import: common-options+ if os(windows)+ buildable: False+ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Doctest.hs build-tool-depends: doctest:doctest- build-depends: base >= 4.10 && < 5- , doctest ^>= 0.16- , Glob ^>= 0.9- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- default-language: Haskell2010+ build-depends: doctest >= 0.16 && < 0.24+ , Glob >= 0.9 && < 0.11+ ghc-options: -threaded -rtsopts -with-rtsopts=-N test-suite readme-test+ import: common-options+ if os(windows)+ buildable: False+ type: exitcode-stdio-1.0 main-is: README.lhs build-tool-depends: markdown-unlit:markdown-unlit- build-depends: base >= 4.10 && < 5- , o-clock- , markdown-unlit ^>= 0.5- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -pgmL markdown-unlit- default-language: Haskell2010+ build-depends: o-clock+ , 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 type: exitcode-stdio-1.0- default-language: Haskell2010- ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: benchmark main-is: Main.hs- build-depends: base >= 4.8 && < 5+ build-depends: deepseq >= 1.4 , o-clock , gauge >= 0.2.1 && < 1 , tiempo >= 0.0.1.1 , time-units == 1.0.0- if !flag(deepseq)- build-depends: deepseq >= 1.4- cpp-options: -DNO_deepseq+ -- ghc 9.2 is not supported by gauge (due to basement)+ if !flag(bench-buildable) || impl(ghc >= 9.2)+ buildable: False default-extensions: OverloadedStrings RecordWildCards@@ -134,14 +138,6 @@ description: Provide instances for @aeson@ default: False -flag hashable- description: Provide instances for @hashable@- default: False--flag deepseq- description: Provide instances for @deepseq@- default: False--flag serialise- description: Provide instances for @serialise@+flag bench-buildable+ description: Make benchmarks buildable default: False
src/Time.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ -- | This module reexports main functionality. -- -- More information about @O'Clock@ features
src/Time/Rational.hs view
@@ -1,42 +1,48 @@+-- SPDX-FileCopyrightText: 2019-2023 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE TypeInType #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-#if ( __GLASGOW_HASKELL__ >= 806 )-{-# LANGUAGE NoStarIsType #-}-#endif+{-# LANGUAGE NoStarIsType #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Rank2Types #-} {-# 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 ( Rat (..) , type (:%)-#if ( __GLASGOW_HASKELL__ >= 804 ) , type (%) , type (*) , type (/)-#endif , MulK , DivK-#if ( __GLASGOW_HASKELL__ >= 804 ) , Gcd , Normalize , DivRat , type (>=%)-#endif -- Utilities , RatioNat , KnownRat (..) -#if ( __GLASGOW_HASKELL__ >= 804 ) , withRuntimeDivRat-#endif , KnownDivRat ) where @@ -44,23 +50,13 @@ import Data.Proxy (Proxy (..)) import GHC.Natural (Natural) import GHC.Real (Ratio ((:%)))--#if ( __GLASGOW_HASKELL__ >= 804 )-import GHC.TypeNats (Div, Mod, type (<=?))-#endif--#if ( __GLASGOW_HASKELL__ >= 802 )-import GHC.TypeNats (KnownNat, Nat, natVal)-#else-import GHC.TypeLits (KnownNat, Nat, natVal)-#endif--#if ( __GLASGOW_HASKELL__ >= 804 )+import GHC.TypeNats (Div, KnownNat, Mod, Nat, natVal, type (<=?))+import qualified GHC.TypeNats import Unsafe.Coerce (unsafeCoerce)-#endif -#if ( __GLASGOW_HASKELL__ >= 804 )-import qualified GHC.TypeNats+#if ( __GLASGOW_HASKELL__ >= 906 )+-- $setup+-- >>> {-# OPTIONS_GHC -fprint-redundant-promotion-ticks #-} #endif -- | Data structure represents the rational number.@@ -85,7 +81,6 @@ type instance DivK Rat Nat = Rat type instance DivK Nat Rat = Rat -#if ( __GLASGOW_HASKELL__ >= 804 ) -- | Overloaded multiplication. type family (*) (a :: k1) (b :: k2) :: MulK k1 k2 @@ -101,17 +96,20 @@ type instance (a :: Rat) / (b :: Rat) = DivRat a b type instance (a :: Rat) / (b :: Nat) = DivRatNat a b type instance (a :: Nat) / (b :: Rat) = DivRat (a :% 1) b-#endif -- | More convenient name for promoted constructor of 'Rat'. type (:%) = '(::%) -#if ( __GLASGOW_HASKELL__ >= 804 ) -- | Type family for normalized pair of 'Nat's — 'Rat'. type family (m :: Nat) % (n :: Nat) :: Rat where a % b = Normalize (a :% b) infixl 7 % +-- Note about usage of CPP for doctests:+-- @:%@ is a synonym for @'::%@. GHC older than 9.2 does not expand+-- type synonyms when @:kind!@ is used in REPL, so we get the short synonym.+-- Starting from 9.2 type synonyms are expanded, so we get @'::%@.+ {- | Division of type-level rationals. If there are 'Rat' with 'Nat's @a@ and @b@ and another@@ -121,51 +119,103 @@ \] __Example:__-+-}+#if ( __GLASGOW_HASKELL__ >= 902 )+{- | >>> :kind! DivRat (9 % 11) (9 % 11) DivRat (9 % 11) (9 % 11) :: Rat+= 1 '::% 1+-}+#else+{- |+>>> :kind! DivRat (9 % 11) (9 % 11)+DivRat (9 % 11) (9 % 11) :: Rat = 1 :% 1 -}+#endif type family DivRat (m :: Rat) (n :: Rat) :: Rat where DivRat (a :% b) (c :% d) = (a * d) % (b * c) {- | Multiplication for type-level rationals. __Example:__-+-}+#if ( __GLASGOW_HASKELL__ >= 902 )+{- | >>> :kind! MulRat (2 % 3) (9 % 11) MulRat (2 % 3) (9 % 11) :: Rat+= 6 '::% 11+-}+#else+{- |+>>> :kind! MulRat (2 % 3) (9 % 11)+MulRat (2 % 3) (9 % 11) :: Rat = 6 :% 11 -}+#endif type family MulRat (m :: Rat) (n :: Rat) :: Rat where MulRat (a :% b) (c :% d) = (a * c) % (b * d) {- | Multiplication of type-level natural with rational. __Example:__+-}+#if ( __GLASGOW_HASKELL__ >= 902 )+{- | >>> :kind! MulNatRat 2 (9 % 11) MulNatRat 2 (9 % 11) :: Rat+= 18 '::% 11+-}+#else+{- |++>>> :kind! MulNatRat 2 (9 % 11)+MulNatRat 2 (9 % 11) :: Rat = 18 :% 11 -}+#endif type family MulNatRat (n :: Nat) (r :: Rat) :: Rat where MulNatRat x (a :% b) = (x * a) % b {- | Division of type-level rational and natural. __Example:__+-}+#if ( __GLASGOW_HASKELL__ >= 902 )+{- | >>> :kind! DivRatNat (9 % 11) 2 DivRatNat (9 % 11) 2 :: Rat+= 9 '::% 22+-}+#else+{- |++>>> :kind! DivRatNat (9 % 11) 2+DivRatNat (9 % 11) 2 :: Rat = 9 :% 22 -}+#endif type family DivRatNat (r :: Rat) (n :: Nat) :: Rat where DivRatNat (a :% b) x = a % (b * x) {- | Greatest common divisor for type-level naturals. __Example:__+-}+#if ( __GLASGOW_HASKELL__ >= 902 )+{- |+>>> :kind! Gcd 9 11+Gcd 9 11 :: Natural+= 1 +>>> :kind! Gcd 9 12+Gcd 9 12 :: Natural+= 3+-}+#else+{- | >>> :kind! Gcd 9 11 Gcd 9 11 :: Nat = 1@@ -174,6 +224,7 @@ Gcd 9 12 :: Nat = 3 -}+#endif type family Gcd (m :: Nat) (n :: Nat) :: Nat where Gcd a 0 = a Gcd a b = Gcd b (a `Mod` b)@@ -181,7 +232,19 @@ {- | Normalization of type-level rational. __Example:__+-}+#if ( __GLASGOW_HASKELL__ >= 902 )+{- |+>>> :kind! Normalize (9 % 11)+Normalize (9 % 11) :: Rat+= 9 '::% 11 +>>> :kind! Normalize (9 % 12)+Normalize (9 % 12) :: Rat+= 3 '::% 4+-}+#else+{- | >>> :kind! Normalize (9 % 11) Normalize (9 % 11) :: Rat = 9 :% 11@@ -190,6 +253,8 @@ Normalize (9 % 12) :: Rat = 3 :% 4 -}+#endif+ type family Normalize (r :: Rat) :: Rat where Normalize (a :% b) = (a `Div` Gcd a b) :% (b `Div` Gcd a b) @@ -213,7 +278,6 @@ type family (m :: Rat) >=% (n :: Rat) :: Bool where (a :% b) >=% (c :% d) = c * b <=? a * d -#endif -- | Rational numbers, with numerator and denominator of 'Natural' type. type RatioNat = Ratio Natural@@ -223,13 +287,8 @@ ratVal :: RatioNat instance (KnownNat a, KnownNat b) => KnownRat (a :% b) where-#if ( __GLASGOW_HASKELL__ >= 802 ) ratVal = natVal (Proxy @a) :% natVal (Proxy @b)-#else- ratVal = fromIntegral (natVal (Proxy @a)) :% fromIntegral (natVal (Proxy @b))-#endif -#if ( __GLASGOW_HASKELL__ >= 804 ) newtype KnownRatDict (unit :: Rat) r = MkKnownRatDict (KnownRat unit => r) giftRat :: forall (unit :: Rat) r . (KnownRat unit => r) -> RatioNat -> r@@ -240,12 +299,9 @@ withRuntimeDivRat :: forall (a :: Rat) (b :: Rat) r . (KnownRat a, KnownRat b) => (KnownRat (a / b) => r) -> r withRuntimeDivRat r = giftRat @(a / b) r (ratVal @a / ratVal @b) {-# INLINE withRuntimeDivRat #-}-#endif -- | Constraint alias for 'DivRat' units. type KnownDivRat a b = ( KnownRat a , KnownRat b-#if ( __GLASGOW_HASKELL__ >= 804 ) , KnownRat (a / b)-#endif )
src/Time/Series.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}@@ -12,9 +16,7 @@ module Time.Series ( AllTimes-#if ( __GLASGOW_HASKELL__ >= 804 ) , type (...)-#endif -- * Formatting , SeriesF (..) , unitsF@@ -25,20 +27,17 @@ ) where import Data.Char (isDigit, isLetter)-import Data.Semigroup ((<>))-import Text.Read (readMaybe)-#if ( __GLASGOW_HASKELL__ >= 804 ) import Data.Kind (Constraint) import Data.Type.Bool (type (&&), If) import Data.Type.Equality (type (==))-import GHC.TypeLits (TypeError, ErrorMessage (Text))+import GHC.TypeLits (ErrorMessage (Text), TypeError)+import Text.Read (readMaybe) import Time.Rational (type (>=%), withRuntimeDivRat)-#endif import Time.Rational (Rat)+import Time.Timestamp ((-:-)) import Time.Units (Day, Fortnight, Hour, KnownRatName, Microsecond, Millisecond, Minute, Nanosecond, Picosecond, Second, Time (..), Week, floorUnit, toUnit)-import Time.Timestamp ((-:-)) -- $setup -- >>> import Time.Units (Time (..), fortnight, hour, minute, ms, sec)@@ -53,7 +52,6 @@ , Millisecond , Microsecond, Nanosecond, Picosecond ] -#if ( __GLASGOW_HASKELL__ >= 804 ) {- | Creates the list of time units in descending order by provided the highest and the lowest bound of the desired list. Throws the error when time units are not in the right order.@@ -90,7 +88,6 @@ type family DescendingConstraint (b :: Bool) :: Constraint where DescendingConstraint 'True = () -- empty constraint; always satisfiable DescendingConstraint 'False = TypeError ('Text "List of units should be in descending order")-#endif {- | Class for time formatting. @@ -117,7 +114,6 @@ The received list should be in descending order. It would be verified at compile-time. Example of the error from @ghci@: -#if ( __GLASGOW_HASKELL__ >= 804 ) >>> seriesF @'[Millisecond, Second] (minute 42) ... • List of units should be in descending order@@ -125,7 +121,6 @@ In an equation for ‘it’: it = seriesF @'[Millisecond, Second] (minute 42) ...-#endif -} class SeriesF (units :: [Rat]) where@@ -141,37 +136,23 @@ seriesF :: forall (someUnit :: Rat) . KnownRatName someUnit => Time someUnit -> String seriesF t =-#if ( __GLASGOW_HASKELL__ >= 804 ) let newTime = withRuntimeDivRat @someUnit @unit $ toUnit @unit t-#else- let newTime = toUnit @unit t-#endif in show newTime instance ( KnownRatName unit , SeriesF (nextUnit : units)-#if ( __GLASGOW_HASKELL__ >= 804 ) , DescendingConstraint (IsDescending (unit ': nextUnit ': units))-#endif ) => SeriesF (unit ': nextUnit ': units :: [Rat]) where seriesF :: forall (someUnit :: Rat) . KnownRatName someUnit => Time someUnit -> String-#if ( __GLASGOW_HASKELL__ >= 804 ) seriesF t = let newUnit = withRuntimeDivRat @someUnit @unit $ toUnit @unit t-#else- seriesF t = let newUnit = toUnit @unit t-#endif flooredNewUnit = floorUnit newUnit timeStr = case flooredNewUnit of Time 0 -> ""- _ -> show flooredNewUnit+ _ -> show flooredNewUnit -#if ( __GLASGOW_HASKELL__ >= 804 ) nextUnit = withRuntimeDivRat @unit @unit $ newUnit -:- flooredNewUnit-#else- nextUnit = newUnit -:- flooredNewUnit-#endif in if nextUnit == Time 0 then show newUnit else timeStr ++ seriesF @(nextUnit ': units) @unit nextUnit@@ -239,9 +220,7 @@ instance ( KnownRatName unit , SeriesP (nextUnit : units)-#if ( __GLASGOW_HASKELL__ >= 804 ) , DescendingConstraint (IsDescending (unit ': nextUnit ': units))-#endif ) => SeriesP (unit ': nextUnit ': units :: [Rat]) where seriesP :: forall (someUnit :: Rat) . KnownRatName someUnit@@ -273,7 +252,5 @@ readMaybeTime :: forall (unit :: Rat) (someUnit :: Rat) . (KnownRatName unit, KnownRatName someUnit) => String -> Maybe (Time someUnit) readMaybeTime str =-#if ( __GLASGOW_HASKELL__ >= 804 ) withRuntimeDivRat @unit @someUnit $-#endif toUnit @someUnit <$> (readMaybe @(Time unit) str)
src/Time/Timestamp.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-}@@ -23,7 +27,7 @@ ) where -import GHC.Prim (coerce)+import Data.Coerce (coerce) import Time.Rational (KnownDivRat, KnownRat, Rat, RatioNat) import Time.Units (Second, Time (..), sec, toUnit)@@ -78,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)
src/Time/Units.hs view
@@ -1,15 +1,18 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-}-#if ( __GLASGOW_HASKELL__ >= 806 ) {-# LANGUAGE NoStarIsType #-}-#endif {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -41,7 +44,9 @@ , time , floorUnit , floorRat- , toNum+ , ceilingUnit+ , ceilingRat+ , toFractional , sec , ms@@ -62,44 +67,31 @@ , timeout ) where -import Control.Applicative ((*>)) import Control.Monad (unless) 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) import GHC.Natural (Natural)-import GHC.Prim (coerce) import GHC.Read (Read (readPrec)) import GHC.Real (denominator, numerator, (%)) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Text.ParserCombinators.ReadP (ReadP, char, munch1, option, pfail, (+++)) import Text.ParserCombinators.ReadPrec (ReadPrec, lift) -#ifdef HAS_hashable-import Data.Hashable (Hashable)-#endif--#ifdef HAS_deepseq-import Control.DeepSeq (NFData)-#endif--#ifdef HAS_serialise-import Codec.Serialise (Serialise (..))-#endif- #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 -#if ( __GLASGOW_HASKELL__ >= 804 )-import Time.Rational (type (*), type (/))-#endif-import Time.Rational (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@@ -109,7 +101,6 @@ -- Units ---------------------------------------------------------------------------- -#if ( __GLASGOW_HASKELL__ >= 804 ) type Second = 1 / 1 type Millisecond = Second / 1000 type Microsecond = Millisecond / 1000@@ -122,27 +113,13 @@ type Week = 7 * Day type Fortnight = 2 * Week -#else-type Second = 1 :% 1-type Millisecond = 1 :% 1000-type Microsecond = 1 :% 1000000-type Nanosecond = 1 :% 1000000000-type Picosecond = 1 :% 1000000000000--type Minute = 60 :% 1-type Hour = 3600 :% 1-type Day = 86400 :% 1-type Week = 604800 :% 1-type Fortnight = 1209600 :% 1-#endif- ---------------------------------------------------------------------------- -- Time data type ---------------------------------------------------------------------------- -- | 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@@ -161,18 +138,6 @@ mconcat = foldl' (<>) mempty {-# INLINE mconcat #-} -#ifdef HAS_hashable-instance Hashable (Time (rat :: Rat))-#endif--#ifdef HAS_deepseq-instance NFData (Time (rat :: Rat))-#endif--#ifdef HAS_serialise-instance Serialise (Time (rat :: Rat))-#endif- #ifdef HAS_aeson instance (KnownUnitName unit) => ToJSON (Time (unit :: Rat)) where toJSON = toJSON . show@@ -341,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.@@ -359,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@@ -415,11 +386,7 @@ toUnit :: forall (unitTo :: Rat) (unitFrom :: Rat) . KnownDivRat unitFrom unitTo => Time unitFrom -> Time unitTo-#if ( __GLASGOW_HASKELL__ >= 804 ) toUnit Time{..} = Time $ unTime * ratVal @(unitFrom / unitTo)-#else-toUnit (Time t) = Time (t * ratVal @unitFrom / ratVal @unitTo)-#endif {-# INLINE toUnit #-} {- | Convenient version of 'Control.Concurrent.threadDelay' which takes
test/Doctest.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ module Main (main) where import System.FilePath.Glob (glob)
test/Spec.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ module Main where import Test.Tasty (defaultMain, testGroup)@@ -11,12 +15,7 @@ main = do -- type specs runTypeSpecTests- -- Units tests with tasty:- -- * toUnit tests- -- * read tests- unitTests <- unitsTestTree- -- Timestamp tests- tsTests <- timeStampTestTree - let allTests = testGroup "O'Clock" $ [unitTests, tsTests] ++ hedgehogTestTrees+ let allTests = testGroup "O'Clock" $+ [unitsTestTree, timeStampTestTree] ++ hedgehogTestTrees defaultMain allTests
test/Test/Time/Property.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitForAll #-}@@ -20,9 +24,7 @@ import Time (Day, Fortnight, Hour, KnownRat, KnownRatName, Microsecond, Millisecond, Minute, Nanosecond, Picosecond, Rat, RatioNat, Second, Time (..), Week, toUnit, unitsF, unitsP)-#if ( __GLASGOW_HASKELL__ >= 804 ) import Time (withRuntimeDivRat)-#endif import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range@@ -75,10 +77,8 @@ -> Time unitTo -> m () checkToUnit t _ =-#if ( __GLASGOW_HASKELL__ >= 804 ) withRuntimeDivRat @unitTo @unitFrom $ withRuntimeDivRat @unitFrom @unitTo $-#endif toUnit (toUnit @unitTo t) === t -- | Verifier for @ seriesP . seriesF @.
test/Test/Time/Timestamp.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE TypeApplications #-}@@ -8,32 +12,35 @@ ) where import Control.Exception (evaluate)-import Test.Tasty (TestTree)-import Test.Tasty.Hspec (Spec, anyException, describe, it, shouldBe, shouldThrow, testSpec)+import Test.Hspec.Expectations (anyException, shouldBe, shouldThrow)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase) import Time (Minute, Second, Time (..), Timestamp (..), Week, hour, ms, ps, sec, timeAdd, timeDiff, timeDiv, timeMul) -timeStampTestTree :: IO TestTree-timeStampTestTree = testSpec "Timestamp and time operations" spec_Timestamp---spec_Timestamp :: Spec-spec_Timestamp = do- describe "TimeDiff" $ do- it "1 is less than 5, diff is 4 seconds" $+timeStampTestTree :: TestTree+timeStampTestTree = testGroup "Timestamp and time operations"+ [ testGroup "timeDiff"+ [ testCase "1 is less than 5, diff is 4 seconds" $ timeDiff @Second (Timestamp 1) (Timestamp 5) `shouldBe` (LT, Time 4)- it "100 is greater that 40, diff is 60 sec == 1 min" $+ , testCase "100 is greater that 40, diff is 60 sec == 1 min" $ timeDiff @Minute (Timestamp 100) (Timestamp 40) `shouldBe` (GT, Time 1)- it "42 is equal to 42, diff is 0 Weeks" $+ , testCase "42 is equal to 42, diff is 0 Weeks" $ timeDiff @Week (Timestamp 42) (Timestamp 42) `shouldBe` (EQ, Time 0)- it "3 hours offset 7 is 10" $- timeAdd (hour 3) (Timestamp 7) `shouldBe` (Timestamp 10807)- it "twice 21 mcs is 42 mcs" $+ ]+ , testGroup "timeAdd"+ [ testCase "3 hours offset 7 is 10" $+ timeAdd (hour 3) (Timestamp 7) `shouldBe` Timestamp 10807+ ]+ , testGroup "timeMul"+ [ testCase "twice 21 mcs is 42 mcs" $ timeMul 2 (ms 21) `shouldBe` ms 42- it "zero x 42 s is zero" $- timeMul 0 (sec 42) `shouldBe` sec 0- it "84 picoseconds divide by 2 is 42" $+ ]+ , testGroup "timeDiv"+ [ testCase "84 picoseconds divide by 2 is 42" $ timeDiv (ps 84) (ps 2) `shouldBe` 42- it "fails when trying to divide by zero" $+ , testCase "fails when trying to divide by zero" $ evaluate (timeDiv (sec 42) $ sec 0) `shouldThrow` anyException+ ]+ ]
test/Test/Time/TypeSpec.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-}@@ -10,25 +14,19 @@ import Test.TypeSpec import Test.TypeSpecCrazy -import Time.Rational ((:%))-#if ( __GLASGOW_HASKELL__ >= 804 )-import Time.Rational (type (/), type (>=%), Gcd, Normalize)-#endif-import Time.Units (Day, Fortnight, Hour, Microsecond, Millisecond, Minute,- Nanosecond, Picosecond, Second, UnitName, Week)+import Time.Rational (type (/), (:%), type (>=%), Gcd, Normalize)+import Time.Units (Day, Fortnight, Hour, Microsecond, Millisecond, Minute, Nanosecond, Picosecond,+ Second, UnitName, Week) runTypeSpecTests :: IO () runTypeSpecTests = do-#if ( __GLASGOW_HASKELL__ >= 804 ) print typeSpec_Gcd print typeSpec_Normalize print typeSpec_DivRat print typeSpec_Compare-#endif print typeSpec_UnitCalculation print typeSpec_UnitNames -#if ( __GLASGOW_HASKELL__ >= 804 ) typeSpec_Gcd :: "GCD"@@ -104,8 +102,6 @@ -*- It "5%42 >=% 1%42 = True" (((5 :% 42) >=% (1 :% 42)) `Is` 'True) typeSpec_Compare = Valid--#endif typeSpec_UnitCalculation ::
test/Test/Time/Units.hs view
@@ -1,3 +1,7 @@+-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>+--+-- SPDX-License-Identifier: MPL-2.0+ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE TypeApplications #-}@@ -8,84 +12,106 @@ ) where import Control.Exception (evaluate)-import GHC.Real (Ratio ((:%)))-import Test.Tasty (TestTree)-import Test.Tasty.Hspec (Spec, anyException, describe, it, shouldBe, shouldThrow, testSpec)+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, (+:+)) -unitsTestTree :: IO TestTree-unitsTestTree = testSpec "Units" spec_Units+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, (+:+)) -spec_Units :: Spec-spec_Units = do- describe "Unit Conversion Test" $ do- it "11 seconds is 11000 milliseconds" $+unitsTestTree :: TestTree+unitsTestTree = testGroup "Units" unitsTests++unitsTests :: [TestTree]+unitsTests =+ [ testGroup "Unit Conversion Test"+ [ testCase "11 seconds is 11000 milliseconds" $ toUnit (sec 11) `shouldBe` ms 11000- it "5000 milliseconds is 5 seconds" $+ , testCase "5000 milliseconds is 5 seconds" $ toUnit (ms 5000) `shouldBe` sec 5- it "3 seconds is 3000000 microseconds" $+ , testCase "3 seconds is 3000000 microseconds" $ toUnit (sec 3) `shouldBe` mcs 3000000- it "3 microseconds is 3/1000000 seconds" $+ , testCase "3 microseconds is 3/1000000 seconds" $ toUnit @Second (mcs 3) `shouldBe` Time (3 :% 1000000)- it "7 days is 1 week" $+ , testCase "7 days is 1 week" $ toUnit (day 7) `shouldBe` week 1- it "2 fornights is 28 days" $+ , testCase "2 fornights is 28 days" $ toUnit (fortnight 2) `shouldBe` day 28- it "1 nanosecond is 1000 picoseconds" $+ , testCase "1 nanosecond is 1000 picoseconds" $ toUnit (ns 1) `shouldBe` ps 1000- describe "Read Time Test" $ do- it "parses '42s' as 42 seconds" $+ ]+ , testGroup "Read Time Test"+ [ testCase "parses '42s' as 42 seconds" $ read "42s" `shouldBe` sec 42- it "fails when '42mm' is expected as seconds" $+ , testCase "fails when '42mm' is expected as seconds" $ evaluate (read @(Time Second) "42mm") `shouldThrow` anyException- it "parses '7/2s' as 7/2 seconds" $+ , testCase "parses '7/2s' as 7/2 seconds" $ read @(Time Second) "7/2s" `shouldBe` Time (7 :% 2)- it "fails when '-4s' is expected as seconds" $+ , testCase "fails when '-4s' is expected as seconds" $ evaluate (read @(Time Second) "-4s") `shouldThrow` anyException- it "parses '25+5/7s' as 180/7 seconds" $+ , testCase "parses '25+5/7s' as 180/7 seconds" $ read @(Time Second) "25+5/7s" `shouldBe` Time (180 :% 7)- it "fails when '3+2s' is expected as seconds" $+ , testCase "fails when '3+2s' is expected as seconds" $ evaluate (read @(Time Second) "3+2s") `shouldThrow` anyException- it "fails when '+3s' is expected as seconds" $+ , testCase "fails when '+3s' is expected as seconds" $ evaluate (read @(Time Second) "+3s") `shouldThrow` anyException- it "fails when '/3s' is expected as seconds" $+ , testCase "fails when '/3s' is expected as seconds" $ evaluate (read @(Time Second) "/3s") `shouldThrow` anyException- it "parses '14/2h' as 7 hours" $+ , testCase "parses '14/2h' as 7 hours" $ read "14/2h" `shouldBe` hour 7- it "fails when '14/2h' expected as 7 seconds" $+ , testCase "fails when '14/2h' expected as 7 seconds" $ evaluate (read @(Time Second) "14/2h") `shouldThrow` anyException- it "parses big number to big number" $+ , testCase "parses big number to big number" $ read ('1' : replicate 20 '0' ++ "mcs") `shouldBe` mcs (10 ^ (20 :: Int))- it "fails when '4ms' expected as 4 seconds" $+ , testCase "fails when '4ms' expected as 4 seconds" $ evaluate (read @(Time Second) "4ms") `shouldThrow` anyException- describe "Floor tests" $ do- it "returns 0s when floor < 1 second" $+ ]+ , testGroup "Floor tests"+ [ testCase "returns 0s when floor < 1 second" $ floorUnit (Time @Second $ 2 :% 3) `shouldBe` sec 0- it "returns 2d when floor 2.5 days" $+ , testCase "returns 2d when floor 2.5 days" $ floorUnit (Time $ 5 :% 2) `shouldBe` day 2- it "returns 42ps when floor integer" $+ , testCase "returns 42ps when floor integer" $ floorUnit (ps 42) `shouldBe` ps 42- describe "Formatting tests" $ do- it "4000 minutes should be formatted without ending-zeros" $+ ]+ , 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" $ seriesF @'[Day, Hour, Minute, Second] (minute 4000) `shouldBe` "2d18h40m"- it "4000 minutes should be formatted without beginning-zeros" $+ , testCase "4000 minutes should be formatted without beginning-zeros" $ seriesF @'[Week, Day, Hour, Minute] (minute 4000) `shouldBe` "2d18h40m"- it "3601 sec should be formatted without middle-zeros" $+ , testCase "3601 sec should be formatted without middle-zeros" $ seriesF @'[Hour, Minute, Second] (sec 3601) `shouldBe` "1h1s"- it "works on rational nums" $+ , testCase "works on rational nums" $ seriesF @'[Hour, Second, Millisecond] (Time @Minute $ 3 :% 2) `shouldBe` "90s"- it "works without minutes formatting" $+ , testCase "works without minutes formatting" $ seriesF @'[Day, Minute, Second] (minute 4000) `shouldBe` "2d1120m" - it "4000 minutes should be formatted like 2d18h40m" $+ , testCase "4000 minutes should be formatted like 2d18h40m" $ unitsF (minute 4000) `shouldBe` "2d18h40m"- it "42 fortnights should be formatted like 42fn" $+ , testCase "42 fortnights should be formatted like 42fn" $ unitsF (fortnight 42) `shouldBe` "42fn"- it "the first zero time unit when receive zero time" $+ , testCase "the first zero time unit when receive zero time" $ unitsF (Time @Hour 0) `shouldBe` "0fn"- it "sums all time units" $+ , testCase "sums all time units" $ unitsF ( fortnight 1 +:+ week 1 +:+ day 1 +:+ hour 1 +:+ minute 1 +:+ sec 1 +:+ ms 1 +:+ mcs 1 +:+ ns 1 +:+ ps 1 ) `shouldBe` "1fn1w1d1h1m1s1ms1mcs1ns1ps"+ ]+ ]