reorg quickcheck to a separate module

This commit is contained in:
Joey Hess 2015-11-17 15:49:22 -04:00
parent 3449c0e8ec
commit 689bdae03a
Failed to extract signature
3 changed files with 53 additions and 38 deletions

View file

@ -83,6 +83,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.Scheduled.QuickCheck
import qualified Utility.HumanTime import qualified Utility.HumanTime
import qualified Utility.ThreadScheduler import qualified Utility.ThreadScheduler
import qualified Utility.Base64 import qualified Utility.Base64
@ -157,7 +158,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
, testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog , testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
, testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable , testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable
, testProperty "prop_mac_stable" Utility.Hash.prop_mac_stable , testProperty "prop_mac_stable" Utility.Hash.prop_mac_stable
, testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips , testProperty "prop_schedule_roundtrips" Utility.Scheduled.QuickCheck.prop_schedule_roundtrips
, testProperty "prop_past_sane" Utility.Scheduled.prop_past_sane , testProperty "prop_past_sane" Utility.Scheduled.prop_past_sane
, testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips , testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
, testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane , testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane

View file

@ -23,12 +23,10 @@ module Utility.Scheduled (
toRecurrance, toRecurrance,
toSchedule, toSchedule,
parseSchedule, parseSchedule,
prop_schedule_roundtrips,
prop_past_sane, prop_past_sane,
) where ) where
import Utility.Data import Utility.Data
import Utility.QuickCheck
import Utility.PartialPrelude import Utility.PartialPrelude
import Utility.Misc import Utility.Misc
@ -337,41 +335,6 @@ parseSchedule s = do
recurrance = unwords rws recurrance = unwords rws
scheduledtime = unwords tws scheduledtime = unwords tws
instance Arbitrary Schedule where
arbitrary = Schedule <$> arbitrary <*> arbitrary
instance Arbitrary ScheduledTime where
arbitrary = oneof
[ pure AnyTime
, SpecificTime
<$> choose (0, 23)
<*> choose (1, 59)
]
instance Arbitrary Recurrance where
arbitrary = oneof
[ pure Daily
, Weekly <$> arbday
, Monthly <$> arbday
, Yearly <$> arbday
, Divisible
<$> positive arbitrary
<*> oneof -- no nested Divisibles
[ pure Daily
, Weekly <$> arbday
, Monthly <$> arbday
, Yearly <$> arbday
]
]
where
arbday = oneof
[ Just <$> nonNegative arbitrary
, pure Nothing
]
prop_schedule_roundtrips :: Schedule -> Bool
prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s
prop_past_sane :: Bool prop_past_sane :: Bool
prop_past_sane = and prop_past_sane = and
[ all (checksout oneMonthPast) (mplus1 ++ yplus1) [ all (checksout oneMonthPast) (mplus1 ++ yplus1)

View file

@ -0,0 +1,51 @@
{- quickcheck for scheduled activities
-
- Copyright 2013-2014 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Utility.Scheduled.QuickCheck where
import Utility.Scheduled
import Utility.QuickCheck
import Control.Applicative
import Prelude
instance Arbitrary Schedule where
arbitrary = Schedule <$> arbitrary <*> arbitrary
instance Arbitrary ScheduledTime where
arbitrary = oneof
[ pure AnyTime
, SpecificTime
<$> choose (0, 23)
<*> choose (1, 59)
]
instance Arbitrary Recurrance where
arbitrary = oneof
[ pure Daily
, Weekly <$> arbday
, Monthly <$> arbday
, Yearly <$> arbday
, Divisible
<$> positive arbitrary
<*> oneof -- no nested Divisibles
[ pure Daily
, Weekly <$> arbday
, Monthly <$> arbday
, Yearly <$> arbday
]
]
where
arbday = oneof
[ Just <$> nonNegative arbitrary
, pure Nothing
]
prop_schedule_roundtrips :: Schedule -> Bool
prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s