cron 0.6.1 → 0.6.2

raw patch · 9 files changed

+222/−202 lines, 9 filesdep +hedgehogdep +tasty-hedgehogdep −generics-sopdep −quickcheck-instancesdep −tasty-quickcheckPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hedgehog, tasty-hedgehog

Dependencies removed: generics-sop, quickcheck-instances, tasty-quickcheck

API changes (from Hackage documentation)

Files

• changelog +2/−0
• cron.cabal +6/−8
• src/System/Cron/Internal/Check.hs +5/−3
• src/System/Cron/Internal/Describe/Options.hs +2/−2
• src/System/Cron/Parser.hs +5/−4
• src/System/Cron/Types.hs +17/−16
• test/SpecHelper.hs +86/−91
• test/System/Test/Cron.hs +94/−76
• test/System/Test/Cron/Parser.hs +5/−2

@@ -1,3 +1,5 @@+# 0.6.2+* Updates to allow GHC 8.8 # 0.6.1 * Add support for day and month literals, Ahti Katiska (@HariGyogu). # 0.6.0

@@ -1,5 +1,5 @@ Name:                cron-Version:             0.6.1+Version:             0.6.2 Description:   Cron data structure and Attoparsec parser. The idea is to embed it in larger   systems which want to roll their own scheduled tasks in a format that people@@ -20,10 +20,9 @@ Maintainer:          Michael Xavier <michael@michaelxavier.net> Build-Type:          Simple Stability:           experimental-Tested-With:         GHC == 7.4.1-                   , GHC == 7.6.3-                   , GHC == 7.8.3-                   , GHC == 7.10.1+Tested-With:         GHC == 8.4.4+                   , GHC == 8.6.5+                   , GHC == 8.8.1 Cabal-Version:       >= 1.10 Extra-Source-Files:   README.md@@ -85,14 +84,13 @@                   , cron                   , tasty                   , tasty-hunit-                  , tasty-quickcheck+                  , tasty-hedgehog+                  , hedgehog                   , attoparsec                   , text                   , time                   , transformers-compat                   , semigroups-                  , quickcheck-instances-                  , generics-sop >= 0.2    if flag(lib-Werror)     ghc-options: -Werror

@@ -9,11 +9,13 @@ import qualified Data.List.NonEmpty          as NE import           Data.Maybe import           Data.Semigroup              (sconcat)-import           Data.Time+import           Data.Time                   (Day, DiffTime, UTCTime (..),+                                              addUTCTime, fromGregorianValid,+                                              toGregorian) import           Data.Time.Calendar.WeekDate import qualified Data.Traversable            as FT --------------------------------------------------------------------------------import           System.Cron.Types+import           System.Cron.Types           as CT -------------------------------------------------------------------------------  @@ -41,7 +43,7 @@       domStarSpec <- mkDayOfMonthSpec (Field Star)       dowStarSpec <- mkDayOfWeekSpec (Field Star)       let domStarResult = nextMatch cs { dayOfMonth = domStarSpec } now-      let dowStarResult = nextMatch cs { dayOfWeek = dowStarSpec} now+      let dowStarResult = nextMatch cs { CT.dayOfWeek = dowStarSpec} now       listToMaybe (sort (catMaybes [domStarResult, dowStarResult]))   | otherwise = do     expanded@Expanded {..} <- expand cs

@@ -13,7 +13,7 @@  ------------------------------------------------------------------------------- import Data.Default.Class-import Data.Semigroup+import Data.Semigroup as Semigroup ------------------------------------------------------------------------------- import System.Cron.Internal.Describe.Types -------------------------------------------------------------------------------@@ -77,7 +77,7 @@ instance Default Options where   def = Opts {timeFormat = Hour12, verbosity = NotVerbose} -instance Semigroup OptionBuilder where+instance Semigroup.Semigroup OptionBuilder where   (Builder f) <> (Builder a) = Builder (a . f)  instance Monoid OptionBuilder where

@@ -34,6 +34,7 @@  ------------------------------------------------------------------------------- import           Control.Applicative        as Ap+import           Control.Monad.Fail         as F import           Data.Attoparsec.Combinator (choice) import           Data.Attoparsec.Text       (Parser) import qualified Data.Attoparsec.Text       as A@@ -160,8 +161,8 @@ neListP :: Parser a -> Parser (NonEmpty a) neListP p = coerceNE =<< A.sepBy1 p (A.char ',')   where-    coerceNE []     = fail "expected non-empty list"-    coerceNE [_]    = fail "invalid singleton list"+    coerceNE []     = F.fail "expected non-empty list"+    coerceNE [_]    = F.fail "invalid singleton list"     coerceNE (x:xs) = return $ x :| xs  @@ -298,5 +299,5 @@             , "dec"]  --------------------------------------------------------------------------------mParse :: (Monad m) => (a -> Maybe b) -> String -> a -> m b-mParse f msg = maybe (fail msg) return . f+mParse :: (Monad m, MonadFail m) => (a -> Maybe b) -> String -> a -> m b+mParse f msg = maybe (F.fail msg) return . f

@@ -55,11 +55,12 @@  ------------------------------------------------------------------------------- import           Control.Applicative as A+import           Data.Data           (Data) import qualified Data.Foldable       as FT import           Data.Ix import           Data.List.NonEmpty  (NonEmpty (..)) import qualified Data.List.NonEmpty  as NE-import           Data.Monoid+import           Data.Monoid         as Monoid import           Data.Text           (Text) import qualified Data.Text           as T import           Data.Typeable       (Typeable)@@ -132,11 +133,11 @@     , dayOfMonth :: DayOfMonthSpec -- ^ Which days of the month to run. Third field in a cron specification.     , month      :: MonthSpec      -- ^ Which months to run. Fourth field in a cron specification.     , dayOfWeek  :: DayOfWeekSpec  -- ^ Which days of the week to run. Fifth field in a cron specification.-    } deriving (Eq, Generic, Typeable)+    } deriving (Eq, Generic, Data, Typeable)   instance Show CronSchedule where-  show cs = "CronSchedule " <> T.unpack (showT cs)+  show cs = "CronSchedule " Monoid.<> T.unpack (showT cs)   instance ShowT CronSchedule where@@ -155,7 +156,7 @@ -- | Crontab file, omitting comments. newtype Crontab = Crontab {       crontabEntries :: [CrontabEntry]-    } deriving (Eq, Generic, Typeable)+    } deriving (Eq, Generic, Data, Typeable)   instance ShowT Crontab where@@ -173,7 +174,7 @@ ------------------------------------------------------------------------------- newtype CronCommand = CronCommand {       cronCommand :: Text-    } deriving (Show, Eq, Ord, ShowT, Generic, Typeable)+    } deriving (Show, Eq, Ord, ShowT, Generic, Data, Typeable)   -------------------------------------------------------------------------------@@ -181,7 +182,7 @@ -- command after it or setting an environment variable (e.g. FOO=BAR) data CrontabEntry = CommandEntry CronSchedule CronCommand                   | EnvVariable Text Text-                  deriving (Eq, Generic, Typeable)+                  deriving (Eq, Generic, Data, Typeable)   instance ShowT CrontabEntry where@@ -196,7 +197,7 @@ -- | Minutes field of a cron expression newtype MinuteSpec = Minutes {       minuteSpec :: CronField-    } deriving (Eq, ShowT, Generic, Typeable)+    } deriving (Eq, ShowT, Generic, Data, Typeable)   instance Show MinuteSpec where@@ -214,7 +215,7 @@ -- | Hours field of a cron expression newtype HourSpec = Hours {       hourSpec :: CronField-    } deriving (Eq, ShowT, Generic, Typeable)+    } deriving (Eq, ShowT, Generic, Data, Typeable)   instance Show HourSpec where@@ -231,7 +232,7 @@ -- | Day of month field of a cron expression newtype DayOfMonthSpec = DaysOfMonth {       dayOfMonthSpec :: CronField-    } deriving (Eq, ShowT, Generic, Typeable)+    } deriving (Eq, ShowT, Generic, Data, Typeable)   instance Show DayOfMonthSpec where@@ -248,7 +249,7 @@ -- | Month field of a cron expression newtype MonthSpec = Months {       monthSpec :: CronField-    } deriving (Eq, ShowT, Generic, Typeable)+    } deriving (Eq, ShowT, Generic, Data, Typeable)   instance Show MonthSpec where@@ -265,7 +266,7 @@ -- | Day of week field of a cron expression newtype DayOfWeekSpec = DaysOfWeek {       dayOfWeekSpec :: CronField-    } deriving (Eq, ShowT, Generic, Typeable)+    } deriving (Eq, ShowT, Generic, Data, Typeable)   instance Show DayOfWeekSpec where@@ -312,7 +313,7 @@ data BaseField = Star                         -- ^ Matches anything                | SpecificField' SpecificField -- ^ Matches a specific value (e.g. 1)                | RangeField' RangeField       -- ^ Matches a range of values (e.g. 1-3)-               deriving (Eq, Generic, Typeable)+               deriving (Eq, Generic, Data, Typeable)   instance ShowT BaseField where@@ -328,7 +329,7 @@ ------------------------------------------------------------------------------- newtype SpecificField = SpecificField {       specificField :: Int-    } deriving (Eq, ShowT, Generic, Typeable)+    } deriving (Eq, ShowT, Generic, Data, Typeable)   instance Show SpecificField where@@ -345,7 +346,7 @@ data RangeField = RangeField {       rfBegin :: Int     , rfEnd   :: Int-    } deriving (Eq, Generic, Typeable)+    } deriving (Eq, Generic, Data, Typeable)   instance ShowT RangeField where@@ -367,7 +368,7 @@ data CronField = Field BaseField                | ListField (NonEmpty BaseField) -- ^ Matches a list of expressions.                | StepField' StepField           -- ^ Matches a stepped expression, e.g. (*/2).-               deriving (Generic)+               deriving (Generic, Data, Typeable)   instance Eq CronField where@@ -392,7 +393,7 @@ ------------------------------------------------------------------------------- data StepField = StepField { sfField    :: BaseField                            , sfStepping :: Int-                           } deriving (Eq, Generic)+                           } deriving (Eq, Generic, Data, Typeable)   instance ShowT StepField where

@@ -1,6 +1,8 @@ {-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DefaultSignatures     #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators         #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE TemplateHaskell       #-} module SpecHelper@@ -10,117 +12,110 @@   --------------------------------------------------------------------------------import           Control.Applicative       as X-import           Data.Attoparsec.Text      as X (Parser, parseOnly)-import qualified Data.List.NonEmpty        as NE-import           Data.Maybe                as X-import           Data.Monoid               as X-import           Data.Proxy                (Proxy (..))-import           Data.Text                 (Text)-import qualified Data.Text                 as T-import           Data.Time.Calendar        as X-import           Data.Time.Clock           as X-import           Data.Time.LocalTime       as X-import           Debug.Trace               as X-import qualified Generics.SOP              as SOP-import qualified Generics.SOP.Constraint   as SOP-import qualified Generics.SOP.GGP          as SOP-import           GHC.Generics              (Generic)-import           Test.QuickCheck.Instances ()-import           Test.Tasty                as X-import           Test.Tasty.HUnit          as X-import           Test.Tasty.QuickCheck     as X+import           Control.Applicative   as X+import           Data.Attoparsec.Text  as X (Parser, parseOnly)+import qualified Data.List.NonEmpty    as NE+import           Data.Maybe            as X+import           Data.Monoid           as X+import           Data.Text             (Text)+import           Data.Time.Calendar    as X (fromGregorian, toGregorian)+import           Data.Time.Clock       as X (DiffTime, UTCTime (..), addUTCTime,+                                             secondsToDiffTime)+import qualified Data.Time.Clock.POSIX as POSIX+import           Data.Time.LocalTime   as X+import           Debug.Trace           as X+import           GHC.Generics          (Generic)+import qualified GHC.Generics          as G+import           Hedgehog+import qualified Hedgehog.Gen          as Gen+import qualified Hedgehog.Range        as Range+import           Test.Tasty            as X+import           Test.Tasty.Hedgehog   as X+import           Test.Tasty.HUnit      as X --------------------------------------------------------------------------------import           System.Cron               as X+import           System.Cron           as X -------------------------------------------------------------------------------  --- this workaround is in place until we successfully beat down the--- doors of castle QuickCheck and get generic deriving through. See--- <https://github.com/nick8325/quickcheck/pull/40>-sopArbitrary :: (SOP.GTo b, SOP.SListI (SOP.GCode b), Generic b, SOP.AllF (SOP.All Arbitrary) (SOP.GCode b), SOP.AllF SOP.SListI (SOP.GCode b)) => Gen b-sopArbitrary = fmap SOP.gto sopArbitrary'---sopArbitrary' :: (SOP.SListI xss, SOP.AllF SOP.SListI xss, SOP.AllF (SOP.All Arbitrary) xss) => Gen (SOP.SOP SOP.I xss)-sopArbitrary' = oneof (map SOP.hsequence $ SOP.apInjs_POP $ SOP.hcpure p arbitrary)-  where-    p :: Proxy Arbitrary-    p = Proxy---instance Arbitrary BaseField where-  arbitrary = sopArbitrary-  shrink = genericShrink---instance Arbitrary CronField where-  arbitrary = oneof [ Field <$> arbitrary-                    , ListField . NE.fromList . getNonEmpty <$> arbitrary-                    , StepField' <$> arbitrary-                    ]---instance Arbitrary CronSchedule where-  arbitrary = sopArbitrary-  shrink = genericShrink---instance Arbitrary Crontab where-  arbitrary = Crontab <$> resize 20 arbitrary---instance Arbitrary CronCommand where-  arbitrary = CronCommand <$> alphaGen---instance Arbitrary CrontabEntry where-  arbitrary = oneof [ CommandEntry <$> arbitrary <*> arbitrary-                    , EnvVariable <$> alphaGen <*> alphaGen-                    ]+-- | A necessary evil for generators that can generically make sure+-- all constructors of your sum type are covered. The tradeoff is that+-- you have no control over the range at the per-test level, so use+-- this sparingly where full coverage is more valuable than+-- fine-tuning generators.+class HasGen a where+  gen :: Gen a+  default gen :: (Generic a, GHasGen (G.Rep a)) => Gen a+  gen = Gen.choice (fmap G.to <$> ggen)  -alphaGen :: Gen Text-alphaGen = T.pack <$> listOf1 gen-  where-    gen = elements (['a'..'z'] <> ['A'..'Z'])--instance Arbitrary MinuteSpec where-  arbitrary = arbitraryMaybe mkMinuteSpec-+class GHasGen f where+  ggen :: [Gen (f a)] -instance Arbitrary HourSpec where-  arbitrary = arbitraryMaybe mkHourSpec+instance GHasGen G.U1 where+  ggen = [pure G.U1] +instance (HasGen a) => GHasGen (G.K1 i a) where+  ggen = [G.K1 <$> gen] -instance Arbitrary DayOfMonthSpec where-  arbitrary = arbitraryMaybe mkDayOfMonthSpec+instance (GHasGen a, GHasGen b) => GHasGen (a G.:*: b) where+  ggen = [ (G.:*:) <$> f <*> g | f <- ggen, g <- ggen] +instance (GHasGen a, GHasGen b) => GHasGen (a G.:+: b) where+  ggen = (fmap G.L1 <$> ggen) <> (fmap G.R1 <$> ggen) -instance Arbitrary MonthSpec where-  arbitrary = arbitraryMaybe mkMonthSpec+-- we don't care about metadata, lift over it+instance (GHasGen c) => GHasGen (G.M1 _a _b c) where+  ggen = fmap G.M1 <$> ggen  -instance Arbitrary DayOfWeekSpec where-  arbitrary = arbitraryMaybe mkDayOfWeekSpec-+instance HasGen BaseField+instance HasGen SpecificField+instance HasGen RangeField+instance HasGen Int where+  gen = Gen.int Range.linearBounded+instance HasGen Text where+  gen = genAlpha+instance HasGen CronField+instance HasGen a => HasGen (NE.NonEmpty a) where+  gen = Gen.nonEmpty (Range.linear 1 50) gen+instance HasGen a => HasGen [a] where+  gen = Gen.list (Range.linear 0 50) gen+instance HasGen StepField where+  gen = Gen.just (mkStepField <$> gen <*> gen)+instance HasGen CronSchedule+instance HasGen Crontab+instance HasGen CronCommand where+  gen = CronCommand <$> genAlpha+instance HasGen CrontabEntry+instance HasGen MinuteSpec where+  gen = Gen.just (mkMinuteSpec <$> gen)+instance HasGen HourSpec where+  gen = Gen.just (mkHourSpec <$> gen)+instance HasGen DayOfMonthSpec where+  gen = Gen.just (mkDayOfMonthSpec <$> gen)+instance HasGen DayOfWeekSpec where+  gen = Gen.just (mkDayOfWeekSpec <$> gen)+instance HasGen MonthSpec where+  gen = Gen.just (mkMonthSpec <$> gen)+instance HasGen UTCTime where+  gen = genUTCTime -instance Arbitrary SpecificField where-  arbitrary = arbitraryMaybe mkSpecificField+genAlpha :: Gen Text+genAlpha = Gen.text (Range.linear 1 50) Gen.alpha  -instance Arbitrary RangeField where-  arbitrary = arbitraryMaybe (uncurry mkRangeField)+genUTCTime :: Gen UTCTime+genUTCTime = genUTCTime' (Range.linear 0 maxBound)  -instance Arbitrary StepField where-  arbitrary = arbitraryMaybe (uncurry mkStepField)+-- | genUTCTime with a range of posix seconds+genUTCTime' :: Range.Range Int -> Gen UTCTime+genUTCTime' = fmap POSIX.posixSecondsToUTCTime . genPOSIXTime  -arbitraryMaybe :: Arbitrary a => (a -> Maybe b) -> Gen b-arbitraryMaybe f = do-  a <- arbitrary `suchThat` (isJust . f)-  return (fromJust (f a))+genPOSIXTime :: Range.Range Int -> Gen POSIX.POSIXTime+genPOSIXTime rnge = do+  fromInteger . toInteger <$> Gen.int rnge   mkMinuteSpec' :: CronField -> MinuteSpec

@@ -2,9 +2,13 @@ module System.Test.Cron (tests) where  --------------------------------------------------------------------------------import           Data.List                   (find)-import           Data.List.NonEmpty          (NonEmpty (..))+import           Control.Monad+import           Data.List             (find)+import           Data.List.NonEmpty    (NonEmpty (..)) import           Data.Time.Clock.POSIX+import           Hedgehog              as HH+import qualified Hedgehog.Gen          as Gen+import qualified Hedgehog.Range        as Range ------------------------------------------------------------------------------- import           SpecHelper -------------------------------------------------------------------------------@@ -107,51 +111,59 @@       scheduleMatches evenMinute t1 @?= False       scheduleMatches evenMinute t2 @?= True -    , testProperty "star matches everything" $ \t ->-            scheduleMatches stars t+    , testProperty "star matches everything" $ property $ do+        t <- forAll gen+        HH.assert (scheduleMatches stars t) -    , testProperty "exact time matches" $ \t ->-      let (_, m, d, h, mn) = timeComponents t-          sched = CronSchedule (mkMinuteSpec' (Field (SpecificField' (mkSpecificField' mn))))-                               (mkHourSpec' (Field (SpecificField' (mkSpecificField' h))))-                               (mkDayOfMonthSpec' (Field (SpecificField' (mkSpecificField' d))))-                               (mkMonthSpec' (Field (SpecificField' (mkSpecificField' m))))-                               (mkDayOfWeekSpec' (Field Star))-      in scheduleMatches sched t+    , testProperty "exact time matches" $ property $ do+        t <- forAll gen+        let (_, m, d, h, mn) = timeComponents t+            sched = CronSchedule (mkMinuteSpec' (Field (SpecificField' (mkSpecificField' mn))))+                                 (mkHourSpec' (Field (SpecificField' (mkSpecificField' h))))+                                 (mkDayOfMonthSpec' (Field (SpecificField' (mkSpecificField' d))))+                                 (mkMonthSpec' (Field (SpecificField' (mkSpecificField' m))))+                                 (mkDayOfWeekSpec' (Field Star))+        HH.assert (scheduleMatches sched t) -    , testProperty "any time with the same minute as n * * * * matches" $ arbitraryTimeFields $ \y m d h mn ->-      let sched = stars { minute = mkMinuteSpec' (Field (SpecificField' (mkSpecificField' mn))) }-          t     = day' y m d h mn-      in scheduleMatches sched t+    , testProperty "any time with the same minute as n * * * * matches" $ property $ do+        (y, m, d, h, mn) <- forAll genTimeFields+        let sched = stars { minute = mkMinuteSpec' (Field (SpecificField' (mkSpecificField' mn))) }+            t     = day' y m d h mn+        HH.assert (scheduleMatches sched t) -    , testProperty "any time with the diff minute as n * * * * does not match" $ arbitraryTimeFields $ \y m d h mn ->-      let sched = stars { minute = mkMinuteSpec' (Field (SpecificField' (mkSpecificField' (stepMax 59 mn)))) }-          t     = day' y m d h mn-      in not $ scheduleMatches sched t+    , testProperty "any time with the diff minute as n * * * * does not match" $ property $ do+        (y, m, d, h, mn) <- forAll genTimeFields+        let sched = stars { minute = mkMinuteSpec' (Field (SpecificField' (mkSpecificField' (stepMax 59 mn)))) }+            t     = day' y m d h mn+        HH.assert (not (scheduleMatches sched t)) -    , testProperty "any time with the same hour as * n * * * matches" $ arbitraryTimeFields $ \y m d h mn ->-      let sched = stars { hour = mkHourSpec' (Field (SpecificField' (mkSpecificField' h))) }-          t     = day' y m d h mn-      in scheduleMatches sched t+    , testProperty "any time with the same hour as * n * * * matches" $ property $ do+        (y, m, d, h, mn) <- forAll genTimeFields+        let sched = stars { hour = mkHourSpec' (Field (SpecificField' (mkSpecificField' h))) }+            t     = day' y m d h mn+        HH.assert (scheduleMatches sched t) -    , testProperty "any time with the diff hour as * n * * * does not match" $ arbitraryTimeFields $ \y m d h mn ->-      let sched = stars { hour = mkHourSpec' (Field (SpecificField' (mkSpecificField' (stepMax 23 h)))) }-          t     = day' y m d h mn-      in not $ scheduleMatches sched t+    , testProperty "any time with the diff hour as * n * * * does not match" $ property $ do+        (y, m, d, h, mn) <- forAll genTimeFields+        let sched = stars { hour = mkHourSpec' (Field (SpecificField' (mkSpecificField' (stepMax 23 h)))) }+            t     = day' y m d h mn+        HH.assert (not (scheduleMatches sched t)) -    , testProperty "any time with the same day as * * n * * matches" $ \t ->-      let (_, m, d, h, mn) = timeComponents t-          sched = CronSchedule (mkMinuteSpec' (Field (SpecificField' (mkSpecificField' mn))))-                               (mkHourSpec' (Field (SpecificField' (mkSpecificField' h))))-                               (mkDayOfMonthSpec' (Field (SpecificField' (mkSpecificField' d))))-                               (mkMonthSpec' (Field (SpecificField' (mkSpecificField' m))))-                               (mkDayOfWeekSpec' (Field Star))-      in scheduleMatches sched t+    , testProperty "any time with the same day as * * n * * matches" $ property $ do+        t <- forAll gen+        let (_, m, d, h, mn) = timeComponents t+            sched = CronSchedule (mkMinuteSpec' (Field (SpecificField' (mkSpecificField' mn))))+                                 (mkHourSpec' (Field (SpecificField' (mkSpecificField' h))))+                                 (mkDayOfMonthSpec' (Field (SpecificField' (mkSpecificField' d))))+                                 (mkMonthSpec' (Field (SpecificField' (mkSpecificField' m))))+                                 (mkDayOfWeekSpec' (Field Star))+        HH.assert (scheduleMatches sched t) -    , testProperty "any time with the diff day as * * n * * does not match" $ arbitraryTimeFields $ \y m d h mn ->-      let sched = stars { dayOfMonth = mkDayOfMonthSpec' (Field (SpecificField' (mkSpecificField' (stepMax 31 d)))) }-          t     = day' y m d h mn-      in not $ scheduleMatches sched t+    , testProperty "any time with the diff day as * * n * * does not match" $ property $ do+        (y, m, d, h, mn) <- forAll genTimeFields+        let sched = stars { dayOfMonth = mkDayOfMonthSpec' (Field (SpecificField' (mkSpecificField' (stepMax 31 d)))) }+            t     = day' y m d h mn+        HH.assert (not (scheduleMatches sched t))    ] @@ -159,29 +171,18 @@         day' y m d h mn = UTCTime (fromGregorian y m d) (diffTime h mn)         diffTime h mn = timeOfDayToTime $ TimeOfDay h mn 1 -arbitraryTimeFields-    :: (Num r-       , Num r1-       , Num r2-       , Num r3-       , Ord r-       , Ord r1-       , Ord r2-       , Ord r3-       )-    => (a -> r -> r1 -> r2 -> r3 -> t)-    -> Positive a-    -> Positive r-    -> Positive r1-    -> Positive r2-    -> Positive r3-    -> t-arbitraryTimeFields f y m d h mn = f (getPositive y)-                                     (min 12 $ getPositive m)-                                     (min 28 $ getPositive d)-                                     (min 23 $ getPositive h)-                                     (min 59 $ getPositive mn) +genTimeFields+  :: Gen (Integer, Int, Int, Int, Int)+genTimeFields = do+  y <- Gen.integral (Range.linear 0 9999)+  m <- Gen.int (Range.linear 1 12)+  d <- Gen.int (Range.linear 1 28)+  h <- Gen.int (Range.linear 1 23)+  mn <- Gen.int (Range.linear 1 59)+  pure (y, m, d, h, mn)++ hoursMins :: DiffTime -> (Int, Int) hoursMins uTime = (hr, mn)   where@@ -255,32 +256,49 @@  describeNextMatch :: TestTree describeNextMatch = testGroup "nextMatch"-  [ testProperty "is always in the future (at least 1 minute advanced)" $ \cs t ->+  [ testProperty "is always in the future (at least 1 minute advanced)" $ property $ do+      cs <- forAll gen+      t <- forAll gen       let tSecs = floor (utcTimeToPOSIXSeconds t) :: Integer           minT2 = posixSecondsToUTCTime (fromInteger ((tSecs `div` 60) + 1) * 60)-      in case nextMatch cs t of-           Just t2 -> t2 >= minT2-           Nothing -> True-  , testProperty "always produces a time that will match the schedule" $ \cs t ->       case nextMatch cs t of-        Just t2 -> counterexample (show t2 <> " does not match " <> show cs) (scheduleMatches cs t2)-        Nothing -> property True+        Just t2 -> HH.assert (t2 >= minT2)+        Nothing -> success+  , testProperty "always produces a time that will match the schedule" $ property $ do+      cs <- forAll gen+      t <- forAll gen+      case nextMatch cs t of+        Just t2 -> do+          unless (scheduleMatches cs t2) $ do+            annotate (show t2 <> " does not match " <> show cs)+            failure+        Nothing -> success   -- , testCase "special case" $ do   --     let Right cs = parseOnly cronSchedule "* * * * *"   --         t = mkTime 1858 11 20 0 0 1   --     nextMatch cs t @?= Just (mkTime 1858 11 20 0 1 0)   -- this test has a really variable workload but is usually quite slow because it has to walk minute by minute until it finds the test case, so we'll set an upper bound here-  , localOption (QuickCheckTests 20) $ testProperty "returns the first minute in the future that matches" $ \cs t ->+  --TODO: resize 20?+  , testProperty "returns the first minute in the future that matches" $ property $ do+      cs <- forAll gen+      t <- forAll gen       case nextMatch cs t of         Just res ->           let mactual = find (scheduleMatches cs) ((takeWhile (<= res) (nextMinutes t)))           in case mactual of              Just actual -> res `sameMinute` actual-             Nothing -> counterexample ("Could not find a next minute match for " <> show t <> ", expected " <> show res) False-        Nothing -> property True-  , testProperty "a schedule that produces Just for one t will produce it for any t" $ \cs t1 t2 -> isJust (nextMatch cs t1) ==>-      counterexample ("nextMatch produced Just for " <> show t1 <> " but not " <> show t2)-                     (isJust (nextMatch cs t2) == True)+             Nothing -> do+               annotate ("Could not find a next minute match for " <> show t <> ", expected " <> show res)+               failure+        Nothing -> success+  , testProperty "a schedule that produces Just for one t will produce it for any t" $ property $ do+      cs <- forAll gen+      t1 <- forAll (Gen.filter (isJust . nextMatch cs) gen)+      t2 <- forAll gen+      unless (isJust (nextMatch cs t2) == True) $ do+        annotate ("nextMatch produced Just for " <> show t1 <> " but not " <> show t2)+        failure+   , testCase "does not match impossible dates (restricted dow/dom bug)" $ do       let t = posixSecondsToUTCTime 0       let cs = stars { month = mkMonthSpec' (Field (SpecificField' (mkSpecificField' 9)))@@ -291,7 +309,7 @@   ]  -sameMinute :: UTCTime -> UTCTime -> Property+sameMinute :: (MonadTest m) => UTCTime -> UTCTime -> m () sameMinute t1 t2 = t1' === t2'   where     t1' = t1 { utctDayTime = roundToMinute (utctDayTime t1)}

@@ -4,6 +4,7 @@ ------------------------------------------------------------------------------- import           Data.List.NonEmpty (NonEmpty (..)) import           Data.Text          (Text)+import           Hedgehog ------------------------------------------------------------------------------- import           SpecHelper -------------------------------------------------------------------------------@@ -175,7 +176,8 @@ describeSerializeParseCronSchedule :: TestTree describeSerializeParseCronSchedule = testGroup "serialize/parse CronSchedule"   [-    testProperty "roundtrips" $ \cs -> do+    testProperty "roundtrips" $ property $ do+      cs <- forAll gen       parseCronSchedule (serializeCronSchedule cs) === Right cs   ] @@ -184,7 +186,8 @@ describeSerializeParseCrontab :: TestTree describeSerializeParseCrontab = testGroup "serialize/parse Crontab"   [-    testProperty "roundtrips" $ \ct -> do+    testProperty "roundtrips" $ property $ do+      ct <- forAll gen       parseCrontab (serializeCrontab ct) === Right ct   ]