flick-duration (empty) → 1.0.0

raw patch · 7 files changed

+489/−0 lines, 7 filesdep +QuickCheckdep +basedep +clocksetup-changed

Dependencies added: QuickCheck, base, clock, flick-duration, hspec

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +1/−0
• Setup.hs +2/−0
• flick-duration.cabal +55/−0
• src/Data/Duration.hs +292/−0
• test/Spec.hs +106/−0

@@ -0,0 +1,3 @@+# Changelog for flick-duration++## Unreleased changes

@@ -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.

@@ -0,0 +1,1 @@+# flick-duration

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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 <https://github.com/pliosoft/flick-duration#readme>+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

@@ -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 <https:www.facebook.com/christopher.horvath.395/posts/1157292757692660 ChristopherHorvath>+-}+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+    -}+

@@ -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)+