diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for flick-duration + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Christopher Lord (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Christopher Lord nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# flick-duration diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/flick-duration.cabal b/flick-duration.cabal new file mode 100644 --- /dev/null +++ b/flick-duration.cabal @@ -0,0 +1,55 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 22cbaca7047b68aa7c84e97decb74683a65efbf5d5855c4dba496881aac47284 + +name: flick-duration +version: 1.0.0 +synopsis: work with durations of time using the Flick as the smallest unit +description: Please see the README on GitHub at +category: Time +homepage: https://github.com/pliosoft/flick-duration#readme +bug-reports: https://github.com/pliosoft/flick-duration/issues +author: Christopher Lord +maintainer: christopher@pliosoft.com +copyright: (C) Christopher Lord (Pliosoft), All Rights Reserved +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/pliosoft/flick-duration + +library + exposed-modules: + Data.Duration + other-modules: + Paths_flick_duration + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , clock >=0.5 && <1 + default-language: Haskell2010 + +test-suite flick-duration-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_flick_duration + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + QuickCheck + , base >=4.7 && <5 + , clock >=0.5 && <1 + , flick-duration + , hspec + default-language: Haskell2010 diff --git a/src/Data/Duration.hs b/src/Data/Duration.hs new file mode 100644 --- /dev/null +++ b/src/Data/Duration.hs @@ -0,0 +1,292 @@ + +{-| +Module : Data.FlickDuration +Copyright : (c) 2018 Christopher C Lord, Pliosoft +License : BSD Style +Stability : experimental +Maintainer : christopher@pliosoft.com +Portability : GHC + +Use a to contain some number of flicks, and provide standard numerical operations. + +Based on idea from +-} +module Data.Duration + ( + -- * The 'Duration' type + Duration + + -- * Constant Ratios + , flicksPerMillisecond + , flicksPerSecond + , flicksPerMinute + , flickRatio + , durationToRationalFlicks + , durationToRationalSeconds + + -- * 'Duration' to various human units + , durationAsHours + , durationAsNanoseconds + , durationAsMicroseconds + , durationAsMilliseconds + , durationAsMinutes + , durationAsSeconds + , durationAsHms + + -- * Creating 'Duration' from various human units + , durationFromFlicks + , durationFromHours + , durationFromNanoseconds + , durationFromMicroseconds + , durationFromMilliseconds + , durationFromMinutes + , durationFromSeconds + + -- * 'Duration' from wavelength at some frequency, and vice versa + , durationOfOneBeatAtBPM + , durationOfOneCycleAtHz + , frequencyInHzForWavePeriod + + -- * 'Duration' manipulations + , durationOfRepeatedDuration + , durationFromDividingDuration + , durationIntoDuration + , negateDuration + , compareDurationsWithEpsilon + + -- * Thread delay + , delayThreadByDuration + + -- * Measuring delay with the system clock + , StartOfDuration + , startMeasuring + , durationSince + , measurementEpsilon + ) +where + +import Prelude +import Data.Ratio +import Data.Semigroup +import Data.Maybe +import System.Clock +import Control.Concurrent(threadDelay) +import Control.Monad ((>>), when) + +-- | Flicks are a small unit of time that are very evenly divisible by common file format time durations; i.e., for common durations they will have no rounding. +-- Even if there is rounding, it is a very short amount of time -- 1.417 nanoseconds, so rounding is typically not a concern. +flicksPerMillisecond :: Num a => a +flicksPerMillisecond = 705600 + +-- | How many flicks are in a second +flicksPerSecond :: Num a => a +flicksPerSecond = 705600000 + +-- | How many flicks are in a minute +flicksPerMinute :: Num a => a +flicksPerMinute = 60 * 705600000 + +-- | 'Ratio' of seconds to flicks. for example, 100 seconds of flicks is @(100 * flickRatio)@ +flickRatio :: Fractional a => a +flickRatio = recip flicksPerSecond + +-- | Represents a span of time using some number of flicks. To create a 'Duration' use: +-- +-- * 'durationFromFlicks' +-- * 'durationFromHours' +-- * 'durationFromMicroseconds' +-- * 'durationFromMilliseconds' +-- * 'durationFromMinutes' +-- * 'durationFromSeconds' +-- +-- 'Duration' can be concatinated with 'mappend' or the '(<>)' operator. +newtype Duration = Duration { fromDuration :: Integer } + deriving (Eq, Ord, Show) + +instance Semigroup Duration where + a <> b = Duration $ fromDuration a + fromDuration b + +instance Monoid Duration where + mempty = Duration 0 + mappend = (<>) + +{- +Can't have Num instance since it makes little sense to multiply durations Durations are not a ring. But we can have monoid (and group?) instances. +instance Num Duration where + a + b = Duration $ fromDuration a + fromDuration b + a * b = Duration $ fromDuration a * fromDuration b + abs a = Duration $ abs (fromDuration a) + signum a = Duration $ signum (fromDuration a) + fromInteger a = Duration (fromInteger a) + negate a = Duration (negate (fromDuration a)) +-} + +-- | Convert a 'Duration' into flicks, stored in a 'Rational' +durationToRationalFlicks :: Duration -> Rational +durationToRationalFlicks d = toRational (fromDuration d) + +-- | Convert a 'Duration' into seconds, stored in a 'Rational' +durationToRationalSeconds :: Duration -> Rational +durationToRationalSeconds d = flickRatio * durationToRationalFlicks d + +-- | given some 'Duration' d1, how many times can we iterate that duration into another duration +durationIntoDuration :: Duration -> Duration -> Maybe Rational +durationIntoDuration _ d2 | fromDuration d2 == 0 = Nothing +durationIntoDuration d1 d2 = Just $ fromDuration d1 % fromDuration d2 + +-- | Repeat a 'Duration' some rational number of times to produce the total duration +durationOfRepeatedDuration :: Duration -> Rational -> Duration +durationOfRepeatedDuration d r = Duration $ truncate (durationToRationalFlicks d * r) + +-- | take a 'Duration' and divide it into equal pieces of some length (the result) +durationFromDividingDuration :: Duration -> Rational -> Maybe Duration +durationFromDividingDuration d r = if r == 0 then Nothing else Just $ durationOfRepeatedDuration d (recip r) + +-- | Given a number of flicks, produce a 'Duration' +durationFromFlicks :: Integral a => a -> Duration +durationFromFlicks i = Duration (fromIntegral i) + +-- | Given a number of nanoseconds, produce a 'Duration'. +-- Note that flicks are larger than nanoseconds, so rounding will occur +durationFromNanoseconds :: Rational -> Duration +durationFromNanoseconds i = durationFromMicroseconds (i / 1000) + +-- | Given a number of microseconds, produce a 'Duration' +durationFromMicroseconds :: Rational -> Duration +durationFromMicroseconds i = durationFromMilliseconds (i / 1000) + +-- | Given a number of milliseconds, produce a 'Duration' +durationFromMilliseconds :: Rational -> Duration +durationFromMilliseconds i = Duration (truncate (i * flicksPerMillisecond)) + +-- | Given a number of seconds, produce a 'Duration' +durationFromSeconds :: Rational -> Duration +durationFromSeconds i = Duration (truncate (i * flicksPerSecond)) + +-- | Given a number of minutes, produce a 'Duration' +durationFromMinutes :: Rational -> Duration +durationFromMinutes i = Duration (truncate (i * flicksPerMinute)) + +-- | Given a number of hours, produce a 'Duration' +durationFromHours :: Rational -> Duration +durationFromHours i = durationFromMinutes (i * 60) + +-- | Given an epsilon e and two durations, will determine their 'Ord' with respect to the epsilon +compareDurationsWithEpsilon :: Duration -> Duration -> Duration -> Ordering +compareDurationsWithEpsilon e a b = + let diff = (fromDuration a) - (fromDuration b) + in if abs diff <= fromDuration e + then EQ + else if diff < 0 + then LT + else GT + +-- | given some frequency in cycles per second, produce the 'Duration' of a single wavelength's period +durationOfOneCycleAtHz :: Rational -> Maybe Duration +durationOfOneCycleAtHz hz = + if hz <= 0 + then Nothing + else durationFromDividingDuration (durationFromSeconds 1) hz + +-- | given some frequency in beats per minute, produce the 'Duration' between beats +durationOfOneBeatAtBPM :: Rational -> Maybe Duration +durationOfOneBeatAtBPM bpm = + if bpm <= 0 + then Nothing + else durationFromDividingDuration (durationFromMinutes 1) bpm + +-- | If 'Duration' d is the time for one period of a wave, produce the corresponding frequency in hz. +frequencyInHzForWavePeriod :: Duration -> Maybe Rational +frequencyInHzForWavePeriod = durationIntoDuration (durationFromSeconds 1) + +-- | given some 'Duration', represent it as a count of seconds +durationAsSeconds :: Duration -> Rational +durationAsSeconds d = durationAsMilliseconds d / 1000 + +-- | given some 'Duration', represent it as a count of minutes +durationAsMinutes :: Duration -> Rational +durationAsMinutes d = durationAsSeconds d / 60 + +-- | given some 'Duration', represent it as a count of hours +durationAsHours :: Duration -> Rational +durationAsHours d = durationAsMinutes d / 60 + +-- | given some 'Duration', represent it as a count of milliseconds +durationAsMilliseconds :: Duration -> Rational +durationAsMilliseconds d = fromDuration d % flicksPerMillisecond + +-- | given some 'Duration', represent it as a count of microseconds +durationAsMicroseconds :: Duration -> Rational +durationAsMicroseconds d = fromRational 1000 * durationAsMilliseconds d + +-- | given some 'Duration', represent it as a count of nanoseconds +durationAsNanoseconds :: Duration -> Rational +durationAsNanoseconds d = fromRational 1000 * durationAsMicroseconds d + +-- | given some 'Duration' produce a negative version +negateDuration :: Duration -> Duration +negateDuration d = Duration (negate (fromDuration d)) + +-- | Given two durations, produce the larger of the two +maximumOfDurations :: Duration -> Duration -> Duration +maximumOfDurations d1 d2 = + if d1 > d2 then d1 else d2 + +-- | Given two durations, produce the smaller of the two +minimumOfDurations :: Duration -> Duration -> Duration +minimumOfDurations d1 d2 = + if d1 < d2 then d1 else d2 + +-- | present a 'Duration' as a count of hours, minutes, seconds, ms, us +durationAsHms :: Duration -> (Integer, Integer, Integer, Integer, Integer) +durationAsHms d = + let (h,hr) = fromDuration d `divMod` fromDuration (durationFromHours 1) + (m,mr) = hr `divMod` fromDuration (durationFromMinutes 1) + (s,sr) = mr `divMod` fromDuration (durationFromSeconds 1) + (ms,msr) = sr `divMod` fromDuration (durationFromMilliseconds 1) + (us,usr) = msr `divMod` fromDuration (durationFromMicroseconds 1) + in (h,m,s,ms,us) + +-- | Suspend currently running thread for a 'Duration' of time. +-- +-- Provides no exact guarantee on when the thread will be resumed after the delay. +delayThreadByDuration :: Duration -> IO () +delayThreadByDuration d = do + let maxMicroseconds = durationFromMicroseconds (fromIntegral (maxBound :: Int)) + let w = min d maxMicroseconds + threadDelay (truncate (durationAsMicroseconds (min d maxMicroseconds))) + when (w /= d) (delayThreadByDuration (d <> negateDuration w)) + +-- | Holds implementation-defined start of time measurment for 'startMeasuring' +newtype StartOfDuration = StartOfDuration { toDurationFromOrigin :: Duration } + +-- | Helper for internal math +timespecToDuration :: TimeSpec -> Duration +timespecToDuration ts = durationFromSeconds (fromIntegral (sec ts)) <> durationFromNanoseconds (fromIntegral (nsec ts)) + +-- | start measuring a duration +startMeasuring :: IO StartOfDuration +startMeasuring = do + now <- getTime Monotonic + let d1 = timespecToDuration now + return (StartOfDuration d1) + +-- | How long since the start of measuring has it mean, plus or minus 'measurementEpsilon' +durationSince :: StartOfDuration -> IO Duration +durationSince s = do + now <- getTime Monotonic + let d1 = toDurationFromOrigin s + let d2 = timespecToDuration now + return (Duration ((fromDuration d2) - (fromDuration d1))) + +-- | About how accurate is are the methods 'durationSince' and 'startMeasuring' +measurementEpsilon :: IO Duration +measurementEpsilon = return (durationFromMilliseconds 100) + {- ugg, this does not seem to give a reasonable e + do + res <- getRes Monotonic + let rres = timespecToDuration res + putStrLn (show (durationToRationalSeconds rres)) + return $ rres + -} + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,106 @@ +import Test.Hspec +import Test.QuickCheck +import Data.Duration +import Data.Semigroup +import Data.Maybe (fromJust) +import Data.Ratio + +main :: IO () +main = hspec $ do + describe "Data.FlickDuration" $ do + describe "Core" $ do + it "should have correct flicks for a second" $ + durationFromSeconds 1 + `shouldBe` (durationFromFlicks 705600000) + it "microseconds should round correct" $ + durationFromMicroseconds (1 % 10) + `shouldBe` durationFromFlicks 70 + it "should do basic combinations" $ + (durationFromSeconds 12 <> durationFromHours 1 <> durationFromMinutes 12) + `shouldBe` (durationFromFlicks 3056659200000) + it "should do basic convert to hms correctly" $ + durationAsHms (durationFromSeconds 12 <> durationFromHours 1 <> durationFromMinutes 12) + `shouldBe` (1, 12, 12, 0, 0) + it "should wrap larger values" $ + durationAsHms (durationFromSeconds 1201 <> durationFromHours 2 <> durationFromMinutes 18012 <> durationFromMilliseconds 123947 <> durationFromMicroseconds 97435) + `shouldBe` (302, 34, 5, 44, 435) + it "should convert correctly to microseconds" $ property $ + \x -> durationAsMicroseconds (durationFromMicroseconds (fromIntegral (x :: Integer))) + `shouldSatisfy` (\y -> abs (y - fromIntegral x) < 0.01) + it "should convert correctly to milliseconds" $ property $ + \x -> durationAsMilliseconds (durationFromMilliseconds (fromIntegral (x :: Integer))) + `shouldBe` (fromIntegral x) + it "should convert correctly to seconds" $ property $ + \x -> durationAsSeconds (durationFromSeconds (fromIntegral (x :: Integer))) + `shouldBe` (fromIntegral x) + it "should convert correctly to minutes" $ property $ + \x -> durationAsMinutes (durationFromMinutes (fromIntegral (x :: Integer))) + `shouldBe` (fromIntegral x) + it "should convert correctly to hours" $ property $ + \x -> durationAsHours (durationFromHours (fromIntegral (x :: Integer))) + `shouldBe` (fromIntegral x) + it "should compute multiple durations" $ + durationOfRepeatedDuration (durationFromSeconds 12) 10 + `shouldBe` durationFromSeconds (12 * 10) + it "should not divide by zero" $ + durationFromDividingDuration (durationFromSeconds 12) 0 + `shouldBe` Nothing + it "durationIntoDuration" $ + durationIntoDuration (durationFromSeconds 1) (durationFromMicroseconds 100) + `shouldBe` Just 10000 + it "handles iterating zero duration" $ + durationIntoDuration (durationFromSeconds 1) (durationFromSeconds 0) + `shouldBe` Nothing + it "should divide durations into parts" $ + durationFromDividingDuration (durationFromSeconds 12) 6 + `shouldBe` (Just (durationFromSeconds 2)) + it "mconcat array of durations" $ + mconcat [durationFromMilliseconds 100, durationFromMilliseconds 200, durationFromMilliseconds 40, durationFromMilliseconds 60] + `shouldBe` durationFromMilliseconds 400 + it "compare durations with eps LT" $ + compareDurationsWithEpsilon (durationFromMilliseconds 1) (durationFromMilliseconds 100) (durationFromMilliseconds 110) + `shouldBe` LT + it "compare durations with eps GT" $ + compareDurationsWithEpsilon (durationFromMilliseconds 1) (durationFromMilliseconds 100) (durationFromMilliseconds 11) + `shouldBe` GT + it "compare durations with eps EQ" $ + compareDurationsWithEpsilon (durationFromMilliseconds 1) (durationFromMilliseconds 100) (durationFromMilliseconds 101) + `shouldBe` EQ + it "min of two durations" $ + (min (durationFromMilliseconds 100) (durationFromMicroseconds 1000), max (durationFromMilliseconds 100) (durationFromMicroseconds 1000)) + `shouldBe` (durationFromMicroseconds 1000, durationFromMilliseconds 100) + + describe "Sleep and Measure" $ do + it "should sleep for about the right amount of time" $ do + e <- measurementEpsilon + b <- startMeasuring + let specDelay = durationFromMilliseconds 120 + delayThreadByDuration specDelay + duration <- durationSince b + duration `shouldSatisfy` (\y -> EQ == compareDurationsWithEpsilon e specDelay y) + + describe "Frequency" $ do + it "should not support negative bpm" $ + durationOfOneBeatAtBPM (-110) + `shouldBe` Nothing + it "should compute correct duration of bpm" $ + durationOfOneBeatAtBPM 120 + `shouldBe` Just (durationFromMilliseconds 500) + it "should get the exact period and frequency of bpm for particular value" $ + (maybe Nothing frequencyInHzForWavePeriod (durationOfOneBeatAtBPM 100)) + `shouldBe` (Just (100 % 60)) + it "should get the exact period and frequency of hz for particular value" $ + (maybe Nothing frequencyInHzForWavePeriod (durationOfOneCycleAtHz 100)) + `shouldBe` (Just 100) + it "should get the approx period and frequency for arbitrary hz" $ property $ + \x -> (maybe Nothing frequencyInHzForWavePeriod (durationOfOneCycleAtHz (fromIntegral (x :: Integer)))) + `shouldSatisfy` (\y -> if x <= 0 then y == Nothing else let fy = fromJust y in abs (fromIntegral x - fy) < 1) + it "should exclude zero hz" $ + durationOfOneCycleAtHz 0 + `shouldBe` Nothing + it "should compute correct duration of cycle" $ property $ + \x -> if x > 0 then durationOfOneCycleAtHz x `shouldBe` Just (durationFromSeconds (recip x)) else return () + it "should compute correct hz" $ + Just (durationFromMilliseconds 500) + `shouldBe` (durationOfOneCycleAtHz 2) +