diff --git a/.travis.yml b/.travis.yml index 0b696e7..e563175 100644 --- a/.travis.yml +++ b/.travis.yml @@ -81,7 +81,7 @@ script: - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - - cabal test + - cabal test --flag quickcheck - cabal check - cabal sdist # tests that a source-distribution can be generated diff --git a/include/thyme.h b/include/thyme.h index ee4449c..db25029 100644 --- a/include/thyme.h +++ b/include/thyme.h @@ -1,6 +1,10 @@ #define INSTANCES_USUAL Eq, Ord, Data, Typeable, Generic #define INSTANCES_NEWTYPE INSTANCES_USUAL, Enum, Ix, Hashable, NFData +#ifdef QUICKCHECK #define INSTANCES_MICRO INSTANCES_NEWTYPE, Bounded, Random, Arbitrary, CoArbitrary +#else +#define INSTANCES_MICRO INSTANCES_NEWTYPE, Bounded, Random +#endif #define LensP Lens' #define LENS(S,F,A) {-# INLINE _/**/F #-}; _/**/F :: LensP S A; _/**/F = lens F $ \ S {..} F/**/_ -> S {F = F/**/_, ..} diff --git a/src/Data/Thyme/Calendar.hs b/src/Data/Thyme/Calendar.hs index 5d4793a..319e121 100644 --- a/src/Data/Thyme/Calendar.hs +++ b/src/Data/Thyme/Calendar.hs @@ -38,13 +38,15 @@ import Control.Applicative import Control.Arrow import Control.Category import Control.Lens -import Control.Monad import Data.AdditiveGroup import Data.AffineSpace import Data.Thyme.Calendar.Internal import Data.Thyme.Clock.Internal import System.Random +#ifdef QUICKCHECK +import Control.Monad import Test.QuickCheck +#endif -- "Data.Thyme.Calendar.Internal" cannot import "Data.Thyme.Clock.Internal", -- therefore these orphan 'Bounded' instances must live here. @@ -67,6 +69,7 @@ instance Random YearMonthDay where randomR = randomIsoR gregorian random = first (^. gregorian) . random +#ifdef QUICKCHECK instance Arbitrary Day where arbitrary = ModifiedJulianDay <$> choose (join (***) toModifiedJulianDay (minBound, maxBound)) @@ -79,6 +82,7 @@ instance Arbitrary YearMonthDay where instance CoArbitrary YearMonthDay where coarbitrary (YearMonthDay y m d) = coarbitrary y . coarbitrary m . coarbitrary d +#endif ------------------------------------------------------------------------ diff --git a/src/Data/Thyme/Calendar/Internal.hs b/src/Data/Thyme/Calendar/Internal.hs index 3a9f60b..002d1b2 100644 --- a/src/Data/Thyme/Calendar/Internal.hs +++ b/src/Data/Thyme/Calendar/Internal.hs @@ -43,7 +43,9 @@ import qualified Data.Vector.Unboxed as VU import Data.Vector.Unboxed.Deriving import GHC.Generics (Generic) import System.Random +#ifdef QUICKCHECK import Test.QuickCheck hiding ((.&.)) +#endif -- | A duration/count of years. type Years = Int @@ -82,9 +84,15 @@ type Days = Int -- @ -- -- Other ways of viewing a 'Day' include 'ordinalDate', and 'weekDate'. +#ifdef QUICKCHECK newtype Day = ModifiedJulianDay { toModifiedJulianDay :: Int } deriving (INSTANCES_NEWTYPE, CoArbitrary) +#else +newtype Day = ModifiedJulianDay + { toModifiedJulianDay :: Int + } deriving (INSTANCES_NEWTYPE) +#endif instance AffineSpace Day where type Diff Day = Days @@ -385,12 +393,14 @@ instance Random MonthDay where (isLeapYear -> leap, g') = random g random = randomR (minBound, maxBound) +#ifdef QUICKCHECK instance Arbitrary MonthDay where arbitrary = choose (minBound, maxBound) shrink md = view (monthDay True) <$> shrink (monthDay True # md) instance CoArbitrary MonthDay where coarbitrary (MonthDay m d) = coarbitrary m . coarbitrary d +#endif -- | Predicated on whether or not it's a leap year, convert between an -- ordinal 'DayOfYear' and the corresponding 'Month' and 'DayOfMonth'. diff --git a/src/Data/Thyme/Calendar/OrdinalDate.hs b/src/Data/Thyme/Calendar/OrdinalDate.hs index e467d6e..9d1c37a 100644 --- a/src/Data/Thyme/Calendar/OrdinalDate.hs +++ b/src/Data/Thyme/Calendar/OrdinalDate.hs @@ -27,7 +27,9 @@ import Control.Monad import Data.Thyme.Calendar import Data.Thyme.Calendar.Internal import System.Random +#ifdef QUICKCHECK import Test.QuickCheck +#endif instance Bounded OrdinalDate where minBound = minBound ^. ordinalDate @@ -37,12 +39,14 @@ instance Random OrdinalDate where randomR = randomIsoR ordinalDate random = first (^. ordinalDate) . random +#ifdef QUICKCHECK instance Arbitrary OrdinalDate where arbitrary = view ordinalDate <$> arbitrary shrink od = view ordinalDate <$> shrink (ordinalDate # od) instance CoArbitrary OrdinalDate where coarbitrary (OrdinalDate y d) = coarbitrary y . coarbitrary d +#endif -- | Convert an 'OrdinalDate' to a 'Day', or 'Nothing' for invalid input. -- diff --git a/src/Data/Thyme/Calendar/WeekDate.hs b/src/Data/Thyme/Calendar/WeekDate.hs index fcc8ea1..044c77c 100644 --- a/src/Data/Thyme/Calendar/WeekDate.hs +++ b/src/Data/Thyme/Calendar/WeekDate.hs @@ -38,7 +38,9 @@ import Control.Lens import Data.Thyme.Calendar.OrdinalDate import Data.Thyme.Calendar.Internal import System.Random +#ifdef QUICKCHECK import Test.QuickCheck +#endif instance Bounded WeekDate where minBound = minBound ^. weekDate @@ -64,6 +66,7 @@ instance Random MondayWeek where randomR = randomIsoR mondayWeek random = first (^. mondayWeek) . random +#ifdef QUICKCHECK instance Arbitrary WeekDate where arbitrary = view weekDate <$> arbitrary shrink wd = view weekDate <$> shrink (weekDate # wd) @@ -87,6 +90,7 @@ instance CoArbitrary SundayWeek where instance CoArbitrary MondayWeek where coarbitrary (MondayWeek y w d) = coarbitrary y . coarbitrary w . coarbitrary d +#endif -- * Compatibility diff --git a/src/Data/Thyme/Calendar/WeekdayOfMonth.hs b/src/Data/Thyme/Calendar/WeekdayOfMonth.hs index 0c56ffa..6bf8e7a 100644 --- a/src/Data/Thyme/Calendar/WeekdayOfMonth.hs +++ b/src/Data/Thyme/Calendar/WeekdayOfMonth.hs @@ -39,7 +39,9 @@ import qualified Data.Vector.Generic.Mutable import Data.Vector.Unboxed.Deriving import GHC.Generics (Generic) import System.Random +#ifdef QUICKCHECK import Test.QuickCheck hiding ((.&.)) +#endif -- | Calendar date with year, month-of-year, and n-th day-of-week. data WeekdayOfMonth = WeekdayOfMonth @@ -77,6 +79,7 @@ instance Random WeekdayOfMonth where randomR = randomIsoR weekdayOfMonth random = first (^. weekdayOfMonth) . random +#ifdef QUICKCHECK instance Arbitrary WeekdayOfMonth where arbitrary = view weekdayOfMonth <$> arbitrary shrink wom = view weekdayOfMonth <$> shrink (weekdayOfMonth # wom) @@ -85,6 +88,7 @@ instance CoArbitrary WeekdayOfMonth where coarbitrary (WeekdayOfMonth y m n d) = coarbitrary y . coarbitrary m . coarbitrary n . coarbitrary d +#endif -- | Conversion between a 'Day' and and 'WeekdayOfMonth'. -- diff --git a/src/Data/Thyme/Clock/Internal.hs b/src/Data/Thyme/Clock/Internal.hs index 82dd339..1c97742 100644 --- a/src/Data/Thyme/Clock/Internal.hs +++ b/src/Data/Thyme/Clock/Internal.hs @@ -38,7 +38,9 @@ import Data.Vector.Unboxed.Deriving import Data.VectorSpace import GHC.Generics (Generic) import System.Random +#ifdef QUICKCHECK import Test.QuickCheck +#endif #if !SHOW_INTERNAL import Control.Monad diff --git a/src/Data/Thyme/Clock/TAI.hs b/src/Data/Thyme/Clock/TAI.hs index 336d81d..06041de 100644 --- a/src/Data/Thyme/Clock/TAI.hs +++ b/src/Data/Thyme/Clock/TAI.hs @@ -66,7 +66,9 @@ import Data.Vector.Unboxed.Deriving import Data.VectorSpace import GHC.Generics (Generic) import System.Random (Random) +#ifdef QUICKCHECK import Test.QuickCheck +#endif -- | -- (TAI). Note that for most applications 'UTCTime' is perfectly sufficient, diff --git a/src/Data/Thyme/Internal/Micro.hs b/src/Data/Thyme/Internal/Micro.hs index 611a16f..b092db6 100644 --- a/src/Data/Thyme/Internal/Micro.hs +++ b/src/Data/Thyme/Internal/Micro.hs @@ -29,7 +29,9 @@ import Data.Vector.Unboxed.Deriving import Data.VectorSpace import GHC.Generics (Generic) import System.Random +#ifdef QUICKCHECK import Test.QuickCheck +#endif #if !SHOW_INTERNAL import Control.Monad diff --git a/src/Data/Thyme/LocalTime.hs b/src/Data/Thyme/LocalTime.hs index 941b902..cc6cdc8 100644 --- a/src/Data/Thyme/LocalTime.hs +++ b/src/Data/Thyme/LocalTime.hs @@ -50,7 +50,9 @@ import Data.Vector.Unboxed.Deriving import Data.VectorSpace import GHC.Generics (Generic) import System.Random +#ifdef QUICKCHECK import Test.QuickCheck hiding ((.&.)) +#endif -- | Hours duration. type Hours = Int @@ -102,6 +104,7 @@ instance Random TimeZone where randChar nR (ns, g) = (: ns) `first` randomR nR g random = randomR (minBound, maxBound) +#ifdef QUICKCHECK instance Arbitrary TimeZone where arbitrary = choose (minBound, maxBound) shrink tz@TimeZone {..} @@ -112,6 +115,7 @@ instance Arbitrary TimeZone where instance CoArbitrary TimeZone where coarbitrary (TimeZone m s n) = coarbitrary m . coarbitrary s . coarbitrary n +#endif -- | Text representing the offset of this timezone, e.g. \"-0800\" or -- \"+0400\" (like @%z@ in 'Data.Thyme.Format.formatTime') @@ -218,6 +222,7 @@ instance Random TimeOfDay where randomR = randomIsoR timeOfDay random = first (^. timeOfDay) . random +#ifdef QUICKCHECK instance Arbitrary TimeOfDay where arbitrary = do h <- choose (0, 23) @@ -231,6 +236,7 @@ instance Arbitrary TimeOfDay where instance CoArbitrary TimeOfDay where coarbitrary (TimeOfDay h m s) = coarbitrary h . coarbitrary m . coarbitrary s +#endif -- | The maximum possible length of a minute. Always /60s/, except at -- /23:59/ due to leap seconds. @@ -380,6 +386,7 @@ instance Random LocalTime where randomR = randomIsoR (utcLocalTime utc) random = randomR (minBound, maxBound) +#ifdef QUICKCHECK instance Arbitrary LocalTime where arbitrary = choose (minBound, maxBound) shrink lt@LocalTime {..} @@ -388,6 +395,7 @@ instance Arbitrary LocalTime where instance CoArbitrary LocalTime where coarbitrary (LocalTime d t) = coarbitrary d . coarbitrary t +#endif -- | Conversion between 'UTCTime' and 'LocalTime'. -- @@ -482,6 +490,7 @@ instance Random ZonedTime where u' = snd $ zonedTime # u random = randomR (minBound, maxBound) +#ifdef QUICKCHECK instance Arbitrary ZonedTime where arbitrary = choose (minBound, maxBound) shrink zt@ZonedTime {..} @@ -490,6 +499,7 @@ instance Arbitrary ZonedTime where instance CoArbitrary ZonedTime where coarbitrary (ZonedTime lt tz) = coarbitrary lt . coarbitrary tz +#endif -- | Conversion between ('TimeZone', 'UTCTime') and 'ZonedTime'. -- diff --git a/thyme.cabal b/thyme.cabal index 893de5f..5c9df7b 100644 --- a/thyme.cabal +++ b/thyme.cabal @@ -53,6 +53,11 @@ flag show-internal default: False manual: True +flag quickcheck + description: whether to compile quickcheck things + default: False + manual: True + library default-language: Haskell2010 include-dirs: include @@ -84,7 +89,6 @@ library if !(flag(lens) || flag(docs)) other-modules: Control.Lens build-depends: - QuickCheck >= 2.4, attoparsec >= 0.10, aeson >= 0.6, base >= 4.5 && < 5, @@ -117,6 +121,9 @@ library cpp-options: -DBUG_FOR_BUG=1 if flag(show-internal) cpp-options: -DSHOW_INTERNAL=1 + if flag(quickcheck) + build-depends: QuickCheck >= 2.4 + cpp-options: -DQUICKCHECK=1 test-suite sanity default-language: Haskell2010