o-clock (empty) → 0.0.0
raw patch · 17 files changed
+1635/−0 lines, 17 filesdep +basedep +deepseqdep +gauge
Dependencies added: base, deepseq, gauge, ghc-prim, hedgehog, markdown-unlit, o-clock, tasty, tasty-hedgehog, tasty-hspec, tiempo, time-units, transformers, type-spec
Files
- CHANGELOG.md +14/−0
- LICENSE +21/−0
- README.lhs +139/−0
- README.md +139/−0
- benchmark/Main.hs +48/−0
- examples/Playground.hs +12/−0
- o-clock.cabal +96/−0
- src/Time.hs +16/−0
- src/Time/Formatting.hs +78/−0
- src/Time/Rational.hs +219/−0
- src/Time/TimeStamp.hs +59/−0
- src/Time/Units.hs +396/−0
- test/Spec.hs +22/−0
- test/Test/Time/Property.hs +110/−0
- test/Test/Time/TimeStamp.hs +39/−0
- test/Test/Time/TypeSpec.hs +143/−0
- test/Test/Time/Units.hs +84/−0
+ CHANGELOG.md view
@@ -0,0 +1,14 @@+Change log+==========+o'clock uses [PVP Versioning][1].+The change log is available [on GitHub][2].++0.0.0+=====++* Initially created. See [`README`][3] for more information.+++[1]: https://pvp.haskell.org+[2]: https://github.com/serokell/o-clock/releases+[3]: https://github.com/serokell/o-clock#readme
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Serokell++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:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++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.
+ README.lhs view
@@ -0,0 +1,139 @@+# O'Clock++[](https://hackage.haskell.org/package/o-clock)+[](https://travis-ci.org/serokell/o-clock)+[](https://github.com/serokell/o-clock/blob/master/LICENSE)++## Overview++O'Clock is the library that provides type-safe time units data types.++Most understandable use case is using [`threadDelay`](http://hackage.haskell.org/package/base-4.10.1.0/docs/Control-Concurrent.html#v:threadDelay) function.+If you want to wait for _5 seconds_ in your program, you need to write something like this:++```haskell ignore+threadDelay (5 * 10^(6 :: Int))+```++With O'Clock you can write in several more convenient ways (and use more preferred to you):++```haskell ignore+threadDelay $ sec 5+threadDelay (5 :: Time Second)+threadDelay @Second 5+```++## Features++`O'Clock` provides the following features to its users:++1. Single data type for all time units.++ * Different time units represented as different type parameters for single `Time` data type.+ Amount of required boilerplate is minimal.++2. Time stored as `Rational` number.++ * It means that if you convert `900` milliseconds to seconds, you will have `0.9` second instead of `0` seconds.+ So property `toUnit @to @from . toUnit @from @to ≡ id` is satisfied.++3. Different unit types are stored as rational multiplier in type.++ * `o-clock` package introduces its own kind `Rat` for type-level rational numbers.+ Units are stored as rational multipliers in type. Because of that some computation is performed on type-level.+ So if you want to convert `Week` to `Day`, `o-clock` library ensures that time units will just be multipled by `7`.++4. Functions from `base` that work with time are converted to more time-safe versions:++ * These functions are: `threadDelay`, `timeout`, `getCPUTime`.++5. Externally extensible interface.++ * 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).++_**Note:**_ features support for `GHC-8.2.2` is quite limited.++## Example: How to make your own time unit++This README section contains tutorial on how you can introduce your own time units.+Let's solve the following problem:++_You're CEO of big company. Your employers report you number of hours they worked this month.+You want format hours in more human-readable way, i.e. in number of work weeks and work days.+So we want `140 hours` be formatted as `3ww2wd` (3 full work weeks and 2 full work days)._++### Setting up++Since this tutorial is literate haskell file, let's first write some pragmas and imports.++```haskell+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# 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)++```++### Introduce custom units++You need to write some code in order to introduce your own time units. In our task we need+work day represented as `8` hours and work week represented as `5` work days.++```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+type instance UnitName (144000 :% 1) = "ww" -- One WorkWeek contains 144000 seconds++```++### Calculations++Now let's implement main logic of our application. Our main function should take hours,+convert them to work weeks and work days and then show in human readable format.++```haskell+calculateWork :: Time Hour -- type synonym for 'Time HourUnit'+ -> (Time WorkWeek, Time WorkDay)+calculateWork workHours =+ let completeWeeks = floorUnit $ toUnit @WorkWeek workHours+ completeDays = floorUnit $ toUnit @WorkDay workHours - toUnit completeWeeks+ in (completeWeeks, completeDays)++formatHours :: Time Hour -> String+formatHours hours = let (weeks, days) = calculateWork hours in show weeks ++ show days+```++After that we can simply print the output we wanted.++Thought we have special function for this kind of formatting purposes `seriesF`.+So the same result can be gained with the usage of it. Check it out:++```haskell+main :: IO ()+main = do+ putStrLn $ formatHours 140+ putStrLn $ seriesF @'[WorkWeek, WorkDay] $ hour 140+```
+ README.md view
@@ -0,0 +1,139 @@+# O'Clock++[](https://hackage.haskell.org/package/o-clock)+[](https://travis-ci.org/serokell/o-clock)+[](https://github.com/serokell/o-clock/blob/master/LICENSE)++## Overview++O'Clock is the library that provides type-safe time units data types.++Most understandable use case is using [`threadDelay`](http://hackage.haskell.org/package/base-4.10.1.0/docs/Control-Concurrent.html#v:threadDelay) function.+If you want to wait for _5 seconds_ in your program, you need to write something like this:++```haskell ignore+threadDelay (5 * 10^(6 :: Int))+```++With O'Clock you can write in several more convenient ways (and use more preferred to you):++```haskell ignore+threadDelay $ sec 5+threadDelay (5 :: Time Second)+threadDelay @Second 5+```++## Features++`O'Clock` provides the following features to its users:++1. Single data type for all time units.++ * Different time units represented as different type parameters for single `Time` data type.+ Amount of required boilerplate is minimal.++2. Time stored as `Rational` number.++ * It means that if you convert `900` milliseconds to seconds, you will have `0.9` second instead of `0` seconds.+ So property `toUnit @to @from . toUnit @from @to ≡ id` is satisfied.++3. Different unit types are stored as rational multiplier in type.++ * `o-clock` package introduces its own kind `Rat` for type-level rational numbers.+ Units are stored as rational multipliers in type. Because of that some computation is performed on type-level.+ So if you want to convert `Week` to `Day`, `o-clock` library ensures that time units will just be multipled by `7`.++4. Functions from `base` that work with time are converted to more time-safe versions:++ * These functions are: `threadDelay`, `timeout`, `getCPUTime`.++5. Externally extensible interface.++ * 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).++_**Note:**_ features support for `GHC-8.2.2` is quite limited.++## Example: How to make your own time unit++This README section contains tutorial on how you can introduce your own time units.+Let's solve the following problem:++_You're CEO of big company. Your employers report you number of hours they worked this month.+You want format hours in more human-readable way, i.e. in number of work weeks and work days.+So we want `140 hours` be formatted as `3ww2wd` (3 full work weeks and 2 full work days)._++### Setting up++Since this tutorial is literate haskell file, let's first write some pragmas and imports.++```haskell+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# 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)++```++### Introduce custom units++You need to write some code in order to introduce your own time units. In our task we need+work day represented as `8` hours and work week represented as `5` work days.++```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+type instance UnitName (144000 :% 1) = "ww" -- One WorkWeek contains 144000 seconds++```++### Calculations++Now let's implement main logic of our application. Our main function should take hours,+convert them to work weeks and work days and then show in human readable format.++```haskell+calculateWork :: Time Hour -- type synonym for 'Time HourUnit'+ -> (Time WorkWeek, Time WorkDay)+calculateWork workHours =+ let completeWeeks = floorUnit $ toUnit @WorkWeek workHours+ completeDays = floorUnit $ toUnit @WorkDay workHours - toUnit completeWeeks+ in (completeWeeks, completeDays)++formatHours :: Time Hour -> String+formatHours hours = let (weeks, days) = calculateWork hours in show weeks ++ show days+```++After that we can simply print the output we wanted.++Thought we have special function for this kind of formatting purposes `seriesF`.+So the same result can be gained with the usage of it. Check it out:++```haskell+main :: IO ()+main = do+ putStrLn $ formatHours 140+ putStrLn $ seriesF @'[WorkWeek, WorkDay] $ hour 140+```
+ benchmark/Main.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Control.DeepSeq (NFData)+import Gauge (bench, bgroup, defaultMain, nf, whnf)++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)+++deriving instance NFData (Time (unit :: Rat))++main :: IO ()+main = defaultMain+ [ bgroup "Second to Nanosecond"+ [ bench "o'clock" $ nf (toUnit @Nanosecond . sec) 1+ , bench "time-units" $ whnf (TU.convertUnit :: TU.Second -> TU.Nanosecond) 1+ ]+ , bgroup "Hour to Microsecond"+ [ bench "o'clock" $ nf (toUnit @Microsecond . hour) 1+ , bench "time-units" $ whnf (TU.convertUnit :: TU.Hour -> TU.Microsecond) 1+ , bench "tiempo" $ nf (Tiempo.toMicroSeconds . Tiempo.hours) 1+ ]+ , bgroup "3600000000 Microsecond to Hours"+ [ bench "o'clock" $ nf (toUnit @Hour . mcs) 3600000000+ , bench "time-units" $ whnf (TU.convertUnit :: TU.Microsecond -> TU.Hour) 3600000000+ , bench "tiempo" $ nf (Tiempo.toHours . Tiempo.microSeconds) 3600000000+ ]+ , bgroup "1000ns to s"+ [ bench "o'clock" $ nf (toUnit @Second . ns) 1000+ , bench "time-units" $ whnf (TU.convertUnit :: TU.Nanosecond -> TU.Second) 1000+ ]+ , bgroup "week to days"+ [ bench "o'clock" $ nf (toUnit @Day . week ) 1+ , bench "time-units" $ whnf (TU.convertUnit :: TU.Week -> TU.Day) 1+ ]+ ]
+ examples/Playground.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Time (Second, Time, threadDelay)++main :: IO ()+main = do+ let twoSecs = 2 :: Time Second+ putStrLn "Hello!"+ threadDelay twoSecs+ putStrLn "Hello after 2 seconds"
+ o-clock.cabal view
@@ -0,0 +1,96 @@+name: o-clock+version: 0.0.0+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-file: LICENSE+author: @serokell+maintainer: Serokell <hi@serokell.io>+copyright: 2018 Serokell+category: Time+build-type: Simple+extra-doc-files: CHANGELOG.md+ , README.md+ , README.lhs+cabal-version: >=2.0+tested-with: GHC == 8.4.1++source-repository head+ type: git+ location: https://github.com/serokell/o-clock++library+ hs-source-dirs: src+ exposed-modules: Time+ Time.Formatting+ Time.Rational+ Time.TimeStamp+ Time.Units+ ghc-options: -Wall+ build-depends: base >= 4.10 && < 5+ , ghc-prim >= 0.5+ , transformers >= 0.5+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ RecordWildCards++executable play-o-clock+ main-is: Playground.hs+ build-depends: o-clock+ , base >= 4.10 && < 5+ hs-source-dirs: examples+ default-language: Haskell2010+ ghc-options: -threaded -Wall+ -fno-warn-orphans++test-suite o-clock-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs++ other-modules: Test.Time.Property+ Test.Time.TimeStamp+ Test.Time.TypeSpec+ Test.Time.Units++ build-depends: base >= 4.10 && < 5+ , o-clock+ , hedgehog ^>= 0.5.1+ , tasty ^>= 0.12+ , tasty-hedgehog ^>= 0.1+ , tasty-hspec ^>= 1.1.3+ , type-spec ^>= 0.3.0.1++ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ RecordWildCards+++test-suite readme-test+ 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++benchmark o-clock-benchmark+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N+ hs-source-dirs: benchmark+ main-is: Main.hs+ build-depends: base >= 4.8 && < 5+ , o-clock+ , deepseq >= 1.4+ , gauge >= 0.2.1 && < 1+ , tiempo >= 0.0.1.1+ , time-units == 1.0.0+ default-extensions: OverloadedStrings+ RecordWildCards
+ src/Time.hs view
@@ -0,0 +1,16 @@+-- | This module reexports main functionality.+--+-- More information about @O'Clock@ features+-- can be found here: <https://github.com/serokell/o-clock#readme>++module Time+ ( module Time.Formatting+ , module Time.Rational+ , module Time.TimeStamp+ , module Time.Units+ ) where++import Time.Formatting+import Time.Rational+import Time.TimeStamp+import Time.Units
+ src/Time/Formatting.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{- | This module introduces function to format time in desired way.++__Examples__++>>> seriesF @'[Day, Hour, Minute, Second] (minute 4000)+"2d18h40m"++>>> seriesF @'[Day, Minute, Second] (minute 4000)+"2d1120m"++>>> seriesF @'[Hour, Minute, Second] (sec 3601)+"1h1s"++>>> seriesF @'[Hour, Second, Millisecond] (Time @Minute $ 3 % 2)+"90s"++-}++module Time.Formatting+ ( Series (..)+ , unitsF+ ) where++import Time.Rational (Rat)+#if ( __GLASGOW_HASKELL__ >= 804 )+import Time.Rational (withRuntimeDivRat)+#endif+import Time.Units (AllTimes, KnownRatName, Time, floorUnit, toUnit)++-- | Class for time formatting.+class Series (units :: [Rat]) where+ seriesF :: forall (someUnit :: Rat) . KnownRatName someUnit+ => Time someUnit+ -> String++instance Series ('[] :: [Rat]) where+ seriesF :: Time someUnit -> String+ seriesF _ = ""++instance (KnownRatName unit, Series units)+ => Series (unit ': 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+ format = floorUnit newUnit+ timeStr = case floor newUnit :: Int of+ 0 -> ""+ _ -> show format+ in timeStr ++ seriesF @units @unit (newUnit - format)++{- | Similar to 'seriesF', but formats using all time units of the library.++>>> unitsF $ fortnight 5+"5fn"++>>> unitsF $ minute 4000+"2d18h40m"++-}+unitsF :: forall unit . KnownRatName unit => Time unit -> String+unitsF = seriesF @AllTimes
+ src/Time/Rational.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | 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+#endif++ -- Utilities+ , RatioNat+ , KnownRat (..)++#if ( __GLASGOW_HASKELL__ >= 804 )+ , withRuntimeDivRat+#endif+ , KnownDivRat+ ) where++import Data.Kind (Type)+import Data.Proxy (Proxy (..))+import GHC.Natural (Natural)+import GHC.Real (Ratio ((:%)))+#if ( __GLASGOW_HASKELL__ >= 804 )+import GHC.TypeNats (Div, Mod)+#endif+import GHC.TypeNats (KnownNat, Nat, natVal)+#if ( __GLASGOW_HASKELL__ >= 804 )+import Unsafe.Coerce (unsafeCoerce)+#endif++#if ( __GLASGOW_HASKELL__ >= 804 )+import qualified GHC.TypeNats+#endif++-- | Data structure represents the rational number.+-- Rational number can be represented as a pair of+-- natural numbers @n@ and @m@ where @m@ is nor equal+-- to zero.+data Rat = Nat ::% Nat++-- | The result kind of overloaded multiplication.+type family MulK (k1 :: Type) (k2 :: Type) :: Type++type instance MulK Nat Nat = Nat+type instance MulK Rat Rat = Rat+type instance MulK Rat Nat = Rat+type instance MulK Nat Rat = Rat++-- | The result kind of overloaded division.+type family DivK (k1 :: Type) (k2 :: Type) :: Type++type instance DivK Nat Nat = Rat+type instance DivK Rat Rat = Rat+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++type instance (a :: Nat) * (b :: Nat) = (GHC.TypeNats.*) a b+type instance (a :: Rat) * (b :: Rat) = MulRat a b+type instance (a :: Rat) * (b :: Nat) = MulNatRat b a+type instance (a :: Nat) * (b :: Rat) = MulNatRat a b++-- | Overloaded division.+type family (/) (a :: k1) (b :: k2) :: DivK k1 k2++type instance (a :: Nat) / (b :: Nat) = a % b+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 %++{- | Division of type-level rationals.++If there are 'Rat' with 'Nat's @a@ and @b@ and another+'Rat' with @c@ @d@ then the following formula should be applied:+ \[+ \frac{a}{b} / \frac{c}{d} = \frac{a * d}{b * c}+ \]++__Example:__++>>> :kind! DivRat (9 % 11) (9 % 11)+DivRat (9 % 11) (9 % 11) :: Rat+= 1 :% 1+-}+type family DivRat (m :: Rat) (n :: Rat) :: Rat where+ DivRat (a :% b) (c :% d) = (a * d) % (b * c)++{- | Multiplication for type-level rationals.++__Example:__++>>> :kind! MulRat (2 % 3) (9 % 11)+MulRat (2 % 3) (9 % 11) :: Rat+= 6 :% 11+-}+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:__++>>> :kind! MulNatRat 2 (9 % 11)+MulNatRat 2 (9 % 11) :: Rat+= 18 :% 11+-}+type family MulNatRat (n :: Nat) (r :: Rat) :: Rat where+ MulNatRat x (a :% b) = (x * a) % b++{- | Division of type-level rational and natural.++__Example:__++>>> :kind! DivRatNat (9 % 11) 2+DivRatNat (9 % 11) 2 :: Rat+= 9 :% 22+-}+type family DivRatNat (r :: Rat) (n :: Nat) :: Rat where+ DivRatNat (a :% b) x = a % (b * x)++{- | Greatest common divisor for type-level naturals.++__Example:__++>>> :kind! Gcd 9 11+Gcd 9 11 :: Nat+= 1++>>> :kind! Gcd 9 12+Gcd 9 12 :: Nat+= 3+-}+type family Gcd (m :: Nat) (n :: Nat) :: Nat where+ Gcd a 0 = a+ Gcd a b = Gcd b (a `Mod` b)++{- | Normalization of type-level rational.++__Example:__++>>> :kind! Normalize (9 % 11)+Normalize (9 % 11) :: Rat+= 9 :% 11++>>> :kind! Normalize (9 % 12)+Normalize (9 % 12) :: Rat+= 3 :% 4+-}+type family Normalize (r :: Rat) :: Rat where+ Normalize (a :% b) = (a `Div` Gcd a b) :% (b `Div` Gcd a b)+#endif++-- | Rational numbers, with numerator and denominator of 'Natural' type.+type RatioNat = Ratio Natural++-- | This class gives the integer associated with a type-level rational.+class KnownRat (r :: Rat) where+ ratVal :: RatioNat++instance (KnownNat a, KnownNat b) => KnownRat (a :% b) where+ ratVal = natVal (Proxy @a) :% natVal (Proxy @b)+++#if ( __GLASGOW_HASKELL__ >= 804 )+newtype KnownRatDict (unit :: Rat) r = MkKnownRatDict (KnownRat unit => r)++giftRat :: forall (unit :: Rat) r . (KnownRat unit => r) -> RatioNat -> r+giftRat given = unsafeCoerce (MkKnownRatDict given :: KnownRatDict unit r)+{-# INLINE giftRat #-}++-- | Performs action with introduced 'DivRat' constraint for rational numbers.+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/TimeStamp.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++-- | This module introduces 'TimeStamp' data type+-- and corresponding functions for operations with time.++module Time.TimeStamp+ ( TimeStamp (..)+ , timeDiff+ , timeAdd+ , timeMul+ , timeDiv+ ) where++import Time.Rational (KnownRat, Rat, RatioNat)+import Time.Units (Time (..))++-- | Similar to 'Time' but has no units and can be negative.+newtype TimeStamp = TimeStamp Rational+ deriving (Show, Read, Num, Eq, Ord, Enum, Fractional, Real, RealFrac)+++-- | Returns the result of comparison of two 'Timestamp's and+-- the 'Time' of that difference of given time unit.+timeDiff :: forall (unit :: Rat) . KnownRat unit+ => TimeStamp+ -> TimeStamp+ -> (Ordering, Time unit)+timeDiff (TimeStamp a) (TimeStamp b) =+ let order = compare a b+ d = fromRational $ case order of+ EQ -> 0+ GT -> a - b+ LT -> b - a+ in (order, d)++-- | Returns the result of addition of two 'Time' elements.+timeAdd :: forall (unit :: Rat) . KnownRat unit+ => Time unit+ -> Time unit+ -> Time unit+timeAdd = (+)++-- | Returns the result of multiplication of two 'Time' elements.+timeMul :: forall (unit :: Rat) . KnownRat unit+ => RatioNat+ -> Time unit+ -> Time unit+timeMul n (Time t) = Time (n * t)++-- | Returns the result of division of two 'Time' elements.+timeDiv :: forall (unit :: Rat) . KnownRat unit+ => Time unit+ -> Time unit+ -> RatioNat+timeDiv (Time t1) (Time t2) = t1 / t2
+ src/Time/Units.hs view
@@ -0,0 +1,396 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | This module contains time unit data structures+-- and functions to work with time.++module Time.Units+ ( -- * Time+ Time (..)++ -- ** Time data types+ , Second+ , Millisecond+ , Microsecond+ , Nanosecond+ , Picosecond+ , Minute+ , Hour+ , Day+ , Week+ , Fortnight++ , AllTimes++ , UnitName+ , KnownUnitName+ , KnownRatName+ , unitNameVal++ -- ** Creation helpers+ , time+ , floorUnit++ , sec+ , ms+ , mcs+ , ns+ , ps++ , minute+ , hour+ , day+ , week+ , fortnight++ , (+:)++ -- ** Functions+ , toUnit+ , threadDelay+ , getCPUTime+ , timeout+ ) where++import Control.Applicative ((*>))+import Control.Monad (unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Char (isDigit, isLetter)+import Data.Proxy (Proxy (..))+import GHC.Generics (Generic)+import GHC.Natural (Natural)+import GHC.Prim (coerce)+import GHC.Read (Read (readPrec))+import GHC.Real (Ratio ((:%)), denominator, numerator, (%))+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)+import Text.ParserCombinators.ReadP (ReadP, char, munch1, option, pfail)+import Text.ParserCombinators.ReadPrec (ReadPrec, lift)++#if ( __GLASGOW_HASKELL__ >= 804 )+import Time.Rational (type (*), type (/))+#endif+import Time.Rational (type (:%), KnownDivRat, Rat, RatioNat, KnownRat, ratVal)++import qualified Control.Concurrent as Concurrent+import qualified System.CPUTime as CPUTime+import qualified System.Timeout as Timeout++----------------------------------------------------------------------------+-- Units+----------------------------------------------------------------------------++#if ( __GLASGOW_HASKELL__ >= 804 )+type Second = 1 / 1+type Millisecond = Second / 1000+type Microsecond = Millisecond / 1000+type Nanosecond = Microsecond / 1000+type Picosecond = Nanosecond / 1000++type Minute = 60 * Second+type Hour = 60 * Minute+type Day = 24 * Hour+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, Real, RealFrac, Generic)++-- | Type-level list that consist of all times.+type AllTimes =+ '[ Fortnight, Week, Day, Hour, Minute, Second+ , Millisecond , Microsecond, Nanosecond, Picosecond+ ]+++-- | Type family for prettier 'show' of time units.+type family UnitName (unit :: Rat) :: Symbol++type instance UnitName (1 :% 1) = "s" -- second unit+type instance UnitName (1 :% 1000) = "ms" -- millisecond unit+type instance UnitName (1 :% 1000000) = "mcs" -- microsecond unit+type instance UnitName (1 :% 1000000000) = "ns" -- nanosecond unit+type instance UnitName (1 :% 1000000000000) = "ps" -- picosecond unit++type instance UnitName (60 :% 1) = "m" -- minute unit+type instance UnitName (3600 :% 1) = "h" -- hour unit+type instance UnitName (86400 :% 1) = "d" -- day unit+type instance UnitName (604800 :% 1) = "w" -- week unit+type instance UnitName (1209600 :% 1) = "fn" -- fortnight unit++-- | Constraint alias for 'KnownSymbol' 'UnitName'.+type KnownUnitName unit = KnownSymbol (UnitName unit)++-- | Constraint alias for 'KnownUnitName' and 'KnownRat' for time unit.+type KnownRatName unit = (KnownUnitName unit, KnownRat unit)++-- | Returns type-level 'Symbol' of the time unit converted to 'String'.+unitNameVal :: forall (unit :: Rat) . (KnownUnitName unit) => String+unitNameVal = symbolVal (Proxy @(UnitName unit))++instance KnownUnitName unit => Show (Time unit) where+ show (Time rat) = let numeratorStr = show (numerator rat)+ denominatorStr = case denominator rat of+ 1 -> ""+ n -> '/' : show n+ in numeratorStr ++ denominatorStr ++ unitNameVal @unit++instance KnownUnitName unit => Read (Time unit) where+ readPrec :: ReadPrec (Time unit)+ readPrec = lift readP+ where+ readP :: ReadP (Time unit)+ readP = do+ let naturalP = read <$> munch1 isDigit+ n <- naturalP+ m <- option 1 (char '/' *> naturalP)+ timeUnitStr <- munch1 isLetter+ unless (timeUnitStr == unitNameVal @unit) pfail+ pure $ Time (n % m)++-- | Has the same behavior as derived instance, but '*' operator+-- throws the runtime error with 'error'.+instance Num (Time unit) where+ (+) = coerce ((+) :: RatioNat -> RatioNat -> RatioNat)+ {-# INLINE (+) #-}+ (-) = coerce ((-) :: RatioNat -> RatioNat -> RatioNat)+ {-# INLINE (-) #-}+ (*) = error "It's not possible to multiply time"+ abs = id+ {-# INLINE abs #-}+ signum = coerce (signum :: RatioNat -> RatioNat)+ {-# INLINE signum #-}+ fromInteger = coerce (fromInteger :: Integer -> RatioNat)+ {-# INLINE fromInteger #-}++-- | Has the same behavior as derived instance, but '/' operator+-- throws the runtime error with 'error'.+instance Fractional (Time unit) where+ fromRational = coerce (fromRational :: Rational -> RatioNat)+ {-# INLINE fromRational #-}+ (/) = error "It's not possible to divide time"++----------------------------------------------------------------------------+-- Creation helpers+----------------------------------------------------------------------------++-- | Creates 'Time' of some type from given 'Natural'.+time :: Natural -> Time unit+time n = Time (n :% 1)+{-# INLINE time #-}++-- | Creates 'Second' from given 'Natural'.+--+-- >>> sec 42+-- 42s :: Time Second+sec :: Natural -> Time Second+sec = time+{-# INLINE sec #-}++-- | Creates 'Millisecond' from given 'Natural'.+--+-- >>> ms 42+-- 42ms :: Time Millisecond+ms :: Natural -> Time Millisecond+ms = time+{-# INLINE ms #-}++-- | Creates 'Microsecond' from given 'Natural'.+--+-- >>> mcs 42+-- 42mcs :: Time Microsecond+mcs :: Natural -> Time Microsecond+mcs = time+{-# INLINE mcs #-}++-- | Creates 'Nanosecond' from given 'Natural'.+--+-- >>> ns 42+-- 42ns :: Time Nanosecond+ns :: Natural -> Time Nanosecond+ns = time+{-# INLINE ns #-}++-- | Creates 'Picosecond' from given 'Natural'.+--+-- >>> ps 42+-- 42ps :: Time Picosecond+ps :: Natural -> Time Picosecond+ps = time+{-# INLINE ps #-}++-- | Creates 'Minute' from given 'Natural'.+--+-- >>> minute 42+-- 42m :: Time Minute+minute :: Natural -> Time Minute+minute = time+{-# INLINE minute #-}++-- | Creates 'Hour' from given 'Natural'.+--+-- >>> hour 42+-- 42h :: Time Hour+hour :: Natural -> Time Hour+hour = time+{-# INLINE hour #-}++-- | Creates 'Day' from given 'Natural'.+--+-- >>> day 42+-- 42d :: Time Day+day :: Natural -> Time Day+day = time+{-# INLINE day #-}++-- | Creates 'Week' from given 'Natural'.+--+-- >>> sec 42+-- 42w :: Time Week+week :: Natural -> Time Week+week = time+{-# INLINE week #-}++-- | Creates 'Fortnight' from given 'Natural'.+--+-- >>> fortnight 42+-- 42fn :: Time Fortnight+fortnight :: Natural -> Time Fortnight+fortnight = time+{-# INLINE fortnight #-}++{- | Similar to 'floor', but works with 'Time' units.++>>> floorUnit @Day (Time $ 5 % 2)+2d++>>> floorUnit (Time @Second $ 2 % 3)+0s++>>> floorUnit $ ps 42+42ps++-}+floorUnit :: forall (unit :: Rat) . Time unit -> Time unit+floorUnit = time . floor++-- | Sums times of different units.+--+-- >>> minute 1 +: sec 1+-- 61s+--+(+:) :: forall (unitResult :: Rat) (unitLeft :: Rat) . KnownDivRat unitLeft unitResult+ => Time unitLeft+ -> Time unitResult+ -> Time unitResult+t1 +: t2 = toUnit t1 + t2+{-# INLINE (+:) #-}++----------------------------------------------------------------------------+-- Functional+----------------------------------------------------------------------------++{- | Converts from one time unit to another time unit.++>>> toUnit @Hour (120 :: Time Minute)+2h++>>> toUnit @Second (ms 7)+7/1000s++>>> toUnit @Week (Time @Day 45)+45/7w++>>> toUnit @Second @Minute 3+180s++>>> toUnit (day 42000000) :: Time Second+3628800000000s++-}+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+ any time-unit and operates in any MonadIO.+++>>> threadDelay $ sec 2+>>> threadDelay (2 :: Time Second)+>>> threadDelay @Second 2++-}+threadDelay :: forall (unit :: Rat) m . (KnownDivRat unit Microsecond, MonadIO m)+ => Time unit+ -> m ()+threadDelay = liftIO . Concurrent.threadDelay . floor . toUnit @Microsecond+{-# INLINE threadDelay #-}++-- | Similar to 'CPUTime.getCPUTime' but returns the CPU time used by the current+-- program in the given time unit.+-- The precision of this result is implementation-dependent.+--+-- >>> getCPUTime @Second+-- 1064046949/1000000000s+getCPUTime :: forall (unit :: Rat) m . (KnownDivRat Picosecond unit, MonadIO m)+ => m (Time unit)+getCPUTime = toUnit . ps . fromInteger <$> liftIO CPUTime.getCPUTime+{-# INLINE getCPUTime #-}++{- | Similar to 'Timeout.timeout' but receiving any time unit+instead of number of microseconds.++>>> timeout (sec 1) (putStrLn "Hello O'Clock")+Hello O'Clock+Just ()++>>> timeout (ps 1) (putStrLn "Hello O'Clock")+Nothing++>>> timeout (mcs 1) (putStrLn "Hello O'Clock")+HellNothing++-}+timeout :: forall (unit :: Rat) m a . (MonadIO m, KnownDivRat unit Microsecond)+ => Time unit -- ^ time+ -> IO a -- ^ 'IO' action+ -> m (Maybe a) -- ^ returns 'Nothing' if no result is available within the given time+timeout t = liftIO . Timeout.timeout (floor $ toUnit @Microsecond t)+{-# INLINE timeout #-}
+ test/Spec.hs view
@@ -0,0 +1,22 @@+module Main where++import Test.Tasty (defaultMain, testGroup)++import Test.Time.Property (hedgehogTestTrees)+import Test.Time.TimeStamp (timeStampTestTree)+import Test.Time.TypeSpec (runTypeSpecTests)+import Test.Time.Units (unitsTestTree)++main :: IO ()+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+ defaultMain allTests
+ test/Test/Time/Property.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Test.Time.Property+ ( hedgehogTestTrees+ ) where++import GHC.Natural (Natural)+import GHC.Real ((%))+import Hedgehog (MonadGen, MonadTest, Property, PropertyT, forAll, property, (===))+import Test.Tasty (TestTree)+import Test.Tasty.Hedgehog (testProperty)++import Time (Day, Fortnight, Hour, KnownRat, KnownRatName, Microsecond,+ Millisecond, Minute, Nanosecond, Picosecond, Rat, RatioNat, Second,+ Time (..), Week, toUnit)+#if ( __GLASGOW_HASKELL__ >= 804 )+import Time (withRuntimeDivRat)+#endif++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++hedgehogTestTrees :: [TestTree]+hedgehogTestTrees = [readShowTestTree, toUnitTestTree]++readShowTestTree :: TestTree+readShowTestTree = testProperty "Hedgehog read . show == id" prop_readShowUnit++toUnitTestTree :: TestTree+toUnitTestTree = testProperty "Hedgehog toUnit @to @from . toUnit @from @to ≡ id' property" prop_toUnit++-- | Existential data type for 'Unit's.+data AnyTime = forall (unit :: Rat) . (KnownRatName unit)+ => MkAnyTime (Time unit)++instance Show AnyTime where+ show (MkAnyTime t) = show t++-- | Returns random 'AnyTime'.+unitChooser :: (MonadGen m) => RatioNat -> m AnyTime+unitChooser t = Gen.element+ [ MkAnyTime (Time @Second t)+ , MkAnyTime (Time @Millisecond t)+ , MkAnyTime (Time @Microsecond t)+ , MkAnyTime (Time @Nanosecond t)+ , MkAnyTime (Time @Picosecond t)+ , MkAnyTime (Time @Minute t)+ , MkAnyTime (Time @Hour t)+ , MkAnyTime (Time @Day t)+ , MkAnyTime (Time @Week t)+ , MkAnyTime (Time @Fortnight t)+ ]++-- | Verifier for 'AnyTime' @read . show = id@.+verifyAnyTime :: (MonadTest m) => AnyTime -> m ()+verifyAnyTime (MkAnyTime t) = read (show t) === t++-- | Verifier for 'toUnit'.+verifyToUnit :: forall m . (MonadTest m) => AnyTime -> AnyTime -> m ()+verifyToUnit (MkAnyTime t1) (MkAnyTime t2) = checkToUnit t1 t2+ where+ checkToUnit :: forall (unitFrom :: Rat) (unitTo :: Rat) .+ (KnownRatName unitFrom, KnownRat unitTo)+ => Time unitFrom+ -> Time unitTo+ -> m ()+ checkToUnit t _ =+#if ( __GLASGOW_HASKELL__ >= 804 )+ withRuntimeDivRat @unitTo @unitFrom $+ withRuntimeDivRat @unitFrom @unitTo $+#endif+ toUnit (toUnit @unitTo t) === t++-- | Generates random natural number up to 10^20.+-- it receives the lower bound so that it wouldn't be possible+-- to get 0 for denominator.+natural :: (MonadGen m) => Natural -> m Natural+natural n = Gen.integral (Range.constant n $ 10 ^ (20 :: Int))++-- | Generates random rational number.+rationalNum :: (MonadGen m) => m RatioNat+rationalNum = do+ numeratorVal <- natural 0+ isOne <- Gen.bool+ denomVal <- if isOne then pure 1+ else natural 1+ return $ numeratorVal % denomVal++anyTime :: (MonadGen m) => m AnyTime+anyTime = rationalNum >>= unitChooser++genAnyTime :: Monad m => PropertyT m AnyTime+genAnyTime = forAll anyTime++-- | Property test.+prop_readShowUnit :: Property+prop_readShowUnit = property $ genAnyTime >>= verifyAnyTime++prop_toUnit :: Property+prop_toUnit = property $ do+ t1 <- genAnyTime+ t2 <- genAnyTime+ verifyToUnit t1 t2
+ test/Test/Time/TimeStamp.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module Test.Time.TimeStamp+ ( timeStampTestTree+ ) where++import Control.Exception (evaluate)+import Test.Tasty (TestTree)+import Test.Tasty.Hspec (Spec, anyException, describe, it, shouldBe, shouldThrow, testSpec)++import Time (Day, Hour, Microsecond, Picosecond, Second, TimeStamp (..), Week, 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" $+ timeDiff @Second (TimeStamp 1) (TimeStamp 5) `shouldBe` (LT, 4)+ it "100 is greater that 11, diff is 89 Days" $+ timeDiff @Day (TimeStamp 100) (TimeStamp 11) `shouldBe` (GT, 89)+ it "42 is equal to 42, diff is 0 Weeks" $+ timeDiff @Week (TimeStamp 42) (TimeStamp 42) `shouldBe` (EQ, 0)+ it "3 hours + 7 hours is 10" $+ timeAdd @Hour 3 7 `shouldBe` 10+ it "twice 21 mcs is 42 mcs" $+ timeMul @Microsecond 2 21 `shouldBe` 42+ it "zero x 42 s is zero" $+ timeMul @Second 0 42 `shouldBe` 0+ it "84 picoseconds divide by 2 is 42" $+ timeDiv @Picosecond 84 2 `shouldBe` 42+ it "fails when trying to divide by zero" $+ evaluate (timeDiv @Second 42 0) `shouldThrow` anyException
+ test/Test/Time/TypeSpec.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++module Test.Time.TypeSpec+ ( runTypeSpecTests+ ) where++-- implicit import because we import a lot of strange operators here...+import Test.TypeSpec+import Test.TypeSpecCrazy++import Time.Rational ((:%))+#if ( __GLASGOW_HASKELL__ >= 804 )+import Time.Rational (type (/), Gcd, Normalize)+#endif+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+#endif+ print typeSpec_UnitCalculation+ print typeSpec_UnitNames++#if ( __GLASGOW_HASKELL__ >= 804 )+typeSpec_Gcd ::++ "GCD"+ ######++ "Base cases"+ ~~~~~~~~~~~~+ It "GCD 3 0 = 3" (Gcd 3 0 `Is` 3)+ -*- It "GCD 0 3 = 3" (Gcd 0 3 `Is` 3)+ -*- It "GCD 3 3 = 3" (Gcd 3 3 `Is` 3)++ -/-++ "Relatively simple"+ ~~~~~~~~~~~~+ It "GCD 3 5 = 1" (Gcd 3 5 `Is` 1)+ -*- It "GCD 2 7 = 1" (Gcd 2 7 `Is` 1)+ -*- It "GCD 9 1000 = 1" (Gcd 9 1000 `Is` 1)+ -*- It "GCD 1000 9 = 1" (Gcd 1000 9 `Is` 1)++ -/-++ "Common divisor"+ ~~~~~~~~~~~~+ It "GCD 2 6 = 2" (Gcd 2 6 `Is` 2)+ -*- It "GCD 3 6 = 3" (Gcd 3 6 `Is` 3)+ -*- It "GCD 500 1000 = 500" (Gcd 500 1000 `Is` 500)+ -*- It "GCD 400 1000 = 200" (Gcd 400 1000 `Is` 200)++typeSpec_Gcd = Valid++typeSpec_Normalize ::++ "Normalize"+ ######++ "Already normalized"+ ~~~~~~~~~~~~+ It "Norm: 2/7 = 2%7" (Normalize (2 :% 7) `Is` (2 :% 7))+ -*- It "Norm: 1/9 = 1%9" (Normalize (1 :% 9) `Is` (1 :% 9))++ -/-++ "GCD"+ ~~~~~~~~~~~~+ It "Norm: 2%14 = 1%7" (Normalize (2 :% 14) `Is` (1 :% 7))+ -*- It "Norm: 300%900 = 1%3" (Normalize (300 :% 900) `Is` (1 :% 3))++typeSpec_Normalize = Valid++typeSpec_DivRat ::++ "DivRat"+ ######++ "Dividing"+ ~~~~~~~~~~~~+ It "2%7 / 2%7 = 1%1" ((2 / 7) / (2 / 7) `Is` (1 :% 1))+ -*- It "2%7 / 7%2 = 4%49" ((2 / 7) / (7 / 2) `Is` (4 :% 49))+ -*- It "5%6 / 25%3 = 1%10" ((5 / 6) / (25 / 3) `Is` (1 :% 10))++typeSpec_DivRat = Valid+#endif++typeSpec_UnitCalculation ::++ "Units"+ ######++ "Lower"+ ~~~~~~~~~~~~+ It "Second = 1 % 1" ( Second `Is` (1 :% 1))+ -*- It "Millisecond = 1 % 1000" (Millisecond `Is` (1 :% 1000))+ -*- It "Microsecond = 1 % 1000000" (Microsecond `Is` (1 :% 1000000))+ -*- It "Nanosecond = 1 % 1000000000" ( Nanosecond `Is` (1 :% 1000000000))+ -*- It "Picosecond = 1 % 1000000000000" ( Picosecond `Is` (1 :% 1000000000000))++ -/-++ "Bigger"+ ~~~~~~~~~~~~+ It "Minute = 60 % 1" (Minute `Is` (60 :% 1))+ -*- It "Hour = 3600 % 1" (Hour `Is` (3600 :% 1))+ -*- It "Day = 86400 % 1" (Day `Is` (86400 :% 1))+ -*- It "Week = 604800 % 1" (Week `Is` (604800 :% 1))+ -*- It "Fortnight = 1209600 % 1" (Fortnight `Is` (1209600 :% 1))++typeSpec_UnitCalculation = Valid++typeSpec_UnitNames ::++ "Units"+ ######++ "Lower"+ ~~~~~~~~~~~~+ It "UnitName Second = 's'" (UnitName Second `Is` "s")+ -*- It "UnitName Millisecond = 'ms'" (UnitName Millisecond `Is` "ms")+ -*- It "UnitName Microsecond = 'mcs'" (UnitName Microsecond `Is` "mcs")+ -*- It "UnitName Nanosecond = 'ns'" (UnitName Nanosecond `Is` "ns")+ -*- It "UnitName Picosecond = 'ps'" (UnitName Picosecond `Is` "ps")++ -/-++ "Bigger"+ ~~~~~~~~~~~~+ It "UnitName Minute = 'm'" (UnitName Minute `Is` "m")+ -*- It "UnitName Hour = 'h'" (UnitName Hour `Is` "h")+ -*- It "UnitName Day = 'd'" (UnitName Day `Is` "d")+ -*- It "UnitName Week = 'w'" (UnitName Week `Is` "w")+ -*- It "UnitName Fortnight = 'fn'" (UnitName Fortnight `Is` "fn")++typeSpec_UnitNames = Valid
+ test/Test/Time/Units.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module Test.Time.Units+ ( unitsTestTree+ ) 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 Time (Day, Hour, Microsecond, Millisecond, Minute, Picosecond, 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++spec_Units :: Spec+spec_Units = do+ describe "Unit Conversion Test" $ do+ it "11 seconds is 11000 milliseconds" $+ toUnit @Millisecond (sec 11) `shouldBe` 11000+ it "5000 milliseconds is 5 seconds" $+ toUnit @Second (ms 5000) `shouldBe` 5+ it "3 seconds is 3000000 microseconds" $+ toUnit @Microsecond (sec 3) `shouldBe` 3000000+ it "3 microseconds is 3/1000000 seconds" $+ toUnit @Second (mcs 3) `shouldBe` Time (3 :% 1000000)+ it "7 days is 1 week" $+ toUnit @Week (day 7) `shouldBe` 1+ it "2 fornights is 28 days" $+ toUnit @Day (fortnight 2) `shouldBe` 28+ it "1 nanosecond is 1000 picoseconds" $+ toUnit @Picosecond (ns 1) `shouldBe` 1000+ describe "Read Time Test" $ do+ it "parses '42s' as 42 seconds" $+ read @(Time Second) "42s" `shouldBe` 42+ it "fails when '42mm' is expected as seconds" $+ evaluate (read @(Time Second) "42mm") `shouldThrow` anyException+ it "parses '7/2s' as 7/2 seconds" $+ read @(Time Second) "7/2s" `shouldBe` Time (7 :% 2)+ it "fails when '-4s' is expected as seconds" $+ evaluate (read @(Time Second) "-4s") `shouldThrow` anyException+ it "parses '14/2h' as 7 hours" $+ read @(Time Hour) "14/2h" `shouldBe` 7+ it "fails when '14/2h' expected as 7 seconds" $+ evaluate (read @(Time Second) "14/2h") `shouldThrow` anyException+ it "parses big number to big number" $+ read @(Time Microsecond) ('1' : replicate 20 '0' ++ "mcs") `shouldBe` 100000000000000000000+ it "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" $+ floorUnit (Time @Second $ 2 :% 3) `shouldBe` 0+ it "returns 2d when floor 2.5 days" $+ floorUnit @Day (Time $ 5 :% 2) `shouldBe` 2+ it "returns 42ps when floor integer" $+ floorUnit (ps 42) `shouldBe` 42+ describe "Formatting tests" $ do+ it "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" $+ seriesF @'[Week, Day, Hour, Minute] (minute 4000) `shouldBe` "2d18h40m"+ it "3601 sec should be formatted without middle-zeros" $+ seriesF @'[Hour, Minute, Second] (sec 3601) `shouldBe` "1h1s"+ it "works on rational nums" $+ seriesF @'[Hour, Second, Millisecond] (Time @Minute $ 3 :% 2) `shouldBe` "90s"+ it "works without minutes formatting" $+ seriesF @'[Day, Minute, Second] (minute 4000) `shouldBe` "2d1120m"++ it "4000 minutes should be formatted like 2d18h40m" $+ unitsF (minute 4000) `shouldBe` "2d18h40m"+ it "42 fortnights should be formatted like 42fn" $+ unitsF (fortnight 42) `shouldBe` "42fn"+ it "empty when receive zero time" $+ unitsF (Time @Hour 0) `shouldBe` ""+ it "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"