summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-11-17 15:49:22 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-11-17 15:49:22 -0400
commit9ed65a1226cc67000b12d768d6f5e8acaada1c65 (patch)
treec5804230e2f0a35ceb4ae68b8d9cdd778ee9898f
parentb30f9c5660be384e0fc75a9378101439f15954a7 (diff)
reorg quickcheck to a separate module
-rw-r--r--Test.hs3
-rw-r--r--Utility/Scheduled.hs37
-rw-r--r--Utility/Scheduled/QuickCheck.hs51
3 files changed, 53 insertions, 38 deletions
diff --git a/Test.hs b/Test.hs
index 5718b5821..f4035f605 100644
--- a/Test.hs
+++ b/Test.hs
@@ -83,6 +83,7 @@ import qualified Utility.Matcher
import qualified Utility.Exception
import qualified Utility.Hash
import qualified Utility.Scheduled
+import qualified Utility.Scheduled.QuickCheck
import qualified Utility.HumanTime
import qualified Utility.ThreadScheduler
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_hashes_stable" Utility.Hash.prop_hashes_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_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
, testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane
diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs
index 5e813d4a2..ead8f7716 100644
--- a/Utility/Scheduled.hs
+++ b/Utility/Scheduled.hs
@@ -23,12 +23,10 @@ module Utility.Scheduled (
toRecurrance,
toSchedule,
parseSchedule,
- prop_schedule_roundtrips,
prop_past_sane,
) where
import Utility.Data
-import Utility.QuickCheck
import Utility.PartialPrelude
import Utility.Misc
@@ -337,41 +335,6 @@ parseSchedule s = do
recurrance = unwords rws
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 = and
[ all (checksout oneMonthPast) (mplus1 ++ yplus1)
diff --git a/Utility/Scheduled/QuickCheck.hs b/Utility/Scheduled/QuickCheck.hs
new file mode 100644
index 000000000..a2051cd2a
--- /dev/null
+++ b/Utility/Scheduled/QuickCheck.hs
@@ -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