quickcheck duration
This commit is contained in:
parent
ca83b16415
commit
51c44b26aa
2 changed files with 17 additions and 3 deletions
2
Test.hs
2
Test.hs
|
@ -60,6 +60,7 @@ import qualified Utility.Matcher
|
||||||
import qualified Utility.Exception
|
import qualified Utility.Exception
|
||||||
import qualified Utility.Hash
|
import qualified Utility.Hash
|
||||||
import qualified Utility.Scheduled
|
import qualified Utility.Scheduled
|
||||||
|
import qualified Utility.HumanTime
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
import qualified GitAnnex
|
import qualified GitAnnex
|
||||||
import qualified Remote.Helper.Encryptable
|
import qualified Remote.Helper.Encryptable
|
||||||
|
@ -140,6 +141,7 @@ quickcheck =
|
||||||
, check "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
|
, check "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
|
||||||
, check "prop_hashes_stable" Utility.Hash.prop_hashes_stable
|
, check "prop_hashes_stable" Utility.Hash.prop_hashes_stable
|
||||||
, check "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips
|
, check "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips
|
||||||
|
, check "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
check desc prop = do
|
check desc prop = do
|
||||||
|
|
|
@ -10,13 +10,16 @@ module Utility.HumanTime (
|
||||||
durationToPOSIXTime,
|
durationToPOSIXTime,
|
||||||
parseDuration,
|
parseDuration,
|
||||||
fromDuration,
|
fromDuration,
|
||||||
|
prop_duration_roundtrips
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Utility.PartialPrelude
|
import Utility.PartialPrelude
|
||||||
import Utility.Applicative
|
import Utility.Applicative
|
||||||
|
import Utility.QuickCheck
|
||||||
|
|
||||||
import Data.Time.Clock.POSIX (POSIXTime)
|
import Data.Time.Clock.POSIX (POSIXTime)
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
import Control.Applicative
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
newtype Duration = Duration { durationSeconds :: Integer }
|
newtype Duration = Duration { durationSeconds :: Integer }
|
||||||
|
@ -37,14 +40,16 @@ parseDuration = Duration <$$> go 0
|
||||||
go (n + num * u) rest
|
go (n + num * u) rest
|
||||||
|
|
||||||
fromDuration :: Duration -> String
|
fromDuration :: Duration -> String
|
||||||
fromDuration = concat . map showunit . go [] units . durationSeconds
|
fromDuration Duration { durationSeconds = d }
|
||||||
|
| d == 0 = "0s"
|
||||||
|
| otherwise = concat $ map showunit $ go [] units d
|
||||||
where
|
where
|
||||||
showunit (u, n)
|
showunit (u, n)
|
||||||
| n > 0 = show n ++ [u]
|
| n > 0 = show n ++ [u]
|
||||||
| otherwise = ""
|
| otherwise = ""
|
||||||
go c [] _ = reverse c
|
go c [] _ = reverse c
|
||||||
go c ((u, n):us) d =
|
go c ((u, n):us) v =
|
||||||
let (q,r) = d `quotRem` n
|
let (q,r) = v `quotRem` n
|
||||||
in go ((u, q):c) us r
|
in go ((u, q):c) us r
|
||||||
|
|
||||||
units :: [(Char, Integer)]
|
units :: [(Char, Integer)]
|
||||||
|
@ -70,3 +75,10 @@ hsecs = msecs * 60
|
||||||
|
|
||||||
msecs :: Integer
|
msecs :: Integer
|
||||||
msecs = 60
|
msecs = 60
|
||||||
|
|
||||||
|
-- Durations cannot be negative.
|
||||||
|
instance Arbitrary Duration where
|
||||||
|
arbitrary = Duration <$> nonNegative arbitrary
|
||||||
|
|
||||||
|
prop_duration_roundtrips :: Duration -> Bool
|
||||||
|
prop_duration_roundtrips d = parseDuration (fromDuration d) == Just d
|
||||||
|
|
Loading…
Reference in a new issue