diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +# 0.4.2 +* Drop dependency on derive in tests. +* Add some Generic and Typeable instances. # 0.4.1.1 * Bug fix for checking nextMatch where either the day of month or day of week fields were a singleton list of star. # 0.4.1.1 diff --git a/cron.cabal b/cron.cabal --- a/cron.cabal +++ b/cron.cabal @@ -1,5 +1,5 @@ Name: cron -Version: 0.4.1.2 +Version: 0.4.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 @@ -77,13 +77,13 @@ , tasty , tasty-hunit , tasty-quickcheck - , derive , attoparsec , text , time , transformers-compat , semigroups , quickcheck-instances + , generics-sop >= 0.2 if flag(lib-Werror) ghc-options: -Werror diff --git a/src/System/Cron/Types.hs b/src/System/Cron/Types.hs --- a/src/System/Cron/Types.hs +++ b/src/System/Cron/Types.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -56,6 +58,8 @@ import Data.Monoid import Data.Text (Text) import qualified Data.Text as T +import Data.Typeable (Typeable) +import GHC.Generics (Generic) ------------------------------------------------------------------------------- @@ -124,7 +128,7 @@ , 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) + } deriving (Eq, Generic, Typeable) instance Show CronSchedule where @@ -147,7 +151,7 @@ -- | Crontab file, omitting comments. newtype Crontab = Crontab { crontabEntries :: [CrontabEntry] - } deriving (Eq) + } deriving (Eq, Generic, Typeable) instance ShowT Crontab where @@ -165,7 +169,7 @@ ------------------------------------------------------------------------------- newtype CronCommand = CronCommand { cronCommand :: Text - } deriving (Show, Eq, Ord, ShowT) + } deriving (Show, Eq, Ord, ShowT, Generic, Typeable) ------------------------------------------------------------------------------- @@ -173,7 +177,7 @@ -- command after it or setting an environment variable (e.g. FOO=BAR) data CrontabEntry = CommandEntry CronSchedule CronCommand | EnvVariable Text Text - deriving (Eq) + deriving (Eq, Generic, Typeable) instance ShowT CrontabEntry where @@ -188,7 +192,7 @@ -- | Minutes field of a cron expression newtype MinuteSpec = Minutes { minuteSpec :: CronField - } deriving (Eq, ShowT) + } deriving (Eq, ShowT, Generic, Typeable) instance Show MinuteSpec where @@ -206,7 +210,7 @@ -- | Hours field of a cron expression newtype HourSpec = Hours { hourSpec :: CronField - } deriving (Eq, ShowT) + } deriving (Eq, ShowT, Generic, Typeable) instance Show HourSpec where @@ -223,7 +227,7 @@ -- | Day of month field of a cron expression newtype DayOfMonthSpec = DaysOfMonth { dayOfMonthSpec :: CronField - } deriving (Eq, ShowT) + } deriving (Eq, ShowT, Generic, Typeable) instance Show DayOfMonthSpec where @@ -240,7 +244,7 @@ -- | Month field of a cron expression newtype MonthSpec = Months { monthSpec :: CronField - } deriving (Eq, ShowT) + } deriving (Eq, ShowT, Generic, Typeable) instance Show MonthSpec where @@ -257,7 +261,7 @@ -- | Day of week field of a cron expression newtype DayOfWeekSpec = DaysOfWeek { dayOfWeekSpec :: CronField - } deriving (Eq, ShowT) + } deriving (Eq, ShowT, Generic, Typeable) instance Show DayOfWeekSpec where @@ -304,7 +308,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) + deriving (Eq, Generic, Typeable) instance ShowT BaseField where @@ -320,7 +324,7 @@ ------------------------------------------------------------------------------- newtype SpecificField = SpecificField { specificField :: Int - } deriving (Eq, ShowT) + } deriving (Eq, ShowT, Generic, Typeable) instance Show SpecificField where @@ -337,7 +341,7 @@ data RangeField = RangeField { rfBegin :: Int , rfEnd :: Int - } deriving (Eq) + } deriving (Eq, Generic, Typeable) instance ShowT RangeField where @@ -359,6 +363,7 @@ data CronField = Field BaseField | ListField (NonEmpty BaseField) -- ^ Matches a list of expressions. | StepField' StepField -- ^ Matches a stepped expression, e.g. (*/2). + deriving (Generic) instance Eq CronField where @@ -383,7 +388,7 @@ ------------------------------------------------------------------------------- data StepField = StepField { sfField :: BaseField , sfStepping :: Int - } deriving (Eq) + } deriving (Eq, Generic) instance ShowT StepField where diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell #-} module SpecHelper ( module X , module SpecHelper @@ -9,16 +11,19 @@ ------------------------------------------------------------------------------- import Control.Applicative as X import Data.Attoparsec.Text as X (Parser, parseOnly) -import Data.DeriveTH -import Data.List.NonEmpty (NonEmpty (..)) +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.GGP as SOP +import GHC.Generics (Generic) import Test.QuickCheck.Instances () import Test.Tasty as X import Test.Tasty.HUnit as X @@ -28,10 +33,35 @@ ------------------------------------------------------------------------------- -$(derive makeArbitrary ''NonEmpty) -$(derive makeArbitrary ''BaseField) -$(derive makeArbitrary ''CronField) -$(derive makeArbitrary ''CronSchedule) +-- this workaround is in place until we successfully beat down the +-- doors of castle QuickCheck and get generic deriving through. See +-- +sopArbitrary :: (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a +sopArbitrary = fmap SOP.gto sopArbitrary' + + +sopArbitrary' :: (SOP.All SOP.SListI xss, SOP.All2 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