genvalidity-time 0.3.0.0 → 1.0.0.0
raw patch · 11 files changed
+172/−148 lines, 11 filesdep ~genvaliditysetup-changed
Dependency ranges changed: genvalidity
Files
- CHANGELOG.md +35/−0
- LICENSE +1/−1
- Setup.hs +0/−3
- bench/Main.hs +12/−14
- genvalidity-time.cabal +7/−6
- src/Data/GenValidity/Time.hs +7/−6
- src/Data/GenValidity/Time/Calendar.hs +52/−9
- src/Data/GenValidity/Time/Clock.hs +7/−39
- src/Data/GenValidity/Time/Format.hs +9/−19
- src/Data/GenValidity/Time/LocalTime.hs +27/−42
- test/Data/GenValidity/TimeSpec.hs +15/−9
+ CHANGELOG.md view
@@ -0,0 +1,35 @@+# Changelog++## [1.0.0.0] - 2021-11-20++### Changed++* Compatibility with `genvalidity >= 1.0.0.0`+* Changed the `GenValid Day` instance to only generate days around 2020, no more millions or billions of years ago.++## [0.3.0.0] - 2020-02-10++### Added++* Benchmarks for all the types except 'TimeLocale'++### Changed++* Sped up 'GenValid TimeZoneName' and made it more varied.+ It now generates:+ - Empty+ - Any three characters+ - a ±HHMM+ - Any string+* Sped up 'GenValid TimeOfDay'+* Sped up 'GenValid UTCTime'+* Sped up 'GenUnchecked NominalDiffTime' on time >= 1.9.1+* Sped up 'GenValid NominalDiffTime'++## [0.2.1.2] - 2020-02-10++### Changed++* Improved the cabal file+* Fixed the 'GenValid Day' day instance to conform to the new 'Validity Day' instance.+* Removed the shrinking tests
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016-2020 Tom Sydney Kerckhove+Copyright (c) 2016-2021 Tom Sydney Kerckhove Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
− Setup.hs
@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain
bench/Main.hs view
@@ -1,27 +1,25 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module Main where -import Data.Time- import Criterion.Main as Criterion- import Data.GenValidity.Criterion import Data.GenValidity.Time ()+import Data.Time main :: IO () main = Criterion.defaultMain- [ genValidBench @Day- , genValidBench @UniversalTime- , genValidBench @DiffTime- , genValidBench @UTCTime- , genValidBench @NominalDiffTime- -- , genValidBench @TimeLocale -- No NFData instance- , genValidBench @TimeZone- , genValidBench @TimeOfDay- , genValidBench @LocalTime- , genValidBench @ZonedTime+ [ genValidBench @Day,+ genValidBench @UniversalTime,+ genValidBench @DiffTime,+ genValidBench @UTCTime,+ genValidBench @NominalDiffTime,+ -- , genValidBench @TimeLocale -- No NFData instance+ genValidBench @TimeZone,+ genValidBench @TimeOfDay,+ genValidBench @LocalTime,+ genValidBench @ZonedTime ]
genvalidity-time.cabal view
@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: d555d09c0ebb33d8de9eea283249aaf0bcb427c0af14d4c8e6b5051ebc0e85f0 name: genvalidity-time-version: 0.3.0.0+version: 1.0.0.0 synopsis: GenValidity support for time description: Please see README.md category: Testing@@ -15,10 +13,13 @@ bug-reports: https://github.com/NorfairKing/validity/issues author: Tom Sydney Kerckhove maintainer: syd@cs-syd.eu-copyright: Copyright: (c) 2017-2020 Tom Sydney Kerckhove+copyright: Copyright: (c) 2016-2021 Tom Sydney Kerckhove license: MIT license-file: LICENSE build-type: Simple+extra-source-files:+ LICENSE+ CHANGELOG.md source-repository head type: git@@ -38,7 +39,7 @@ build-depends: QuickCheck , base >=4.7 && <5- , genvalidity >=0.5+ , genvalidity >=1.0 , time , validity-time >=0.2 default-language: Haskell2010
src/Data/GenValidity/Time.hs view
@@ -1,10 +1,11 @@ {-# OPTIONS_GHC -fno-warn-dodgy-exports #-} module Data.GenValidity.Time- ( module X- ) where+ ( module X,+ )+where -import qualified Data.GenValidity.Time.Calendar as X ()-import qualified Data.GenValidity.Time.Clock as X ()-import qualified Data.GenValidity.Time.Format as X ()-import qualified Data.GenValidity.Time.LocalTime as X ()+import Data.GenValidity.Time.Calendar as X+import Data.GenValidity.Time.Clock as X ()+import Data.GenValidity.Time.Format as X ()+import Data.GenValidity.Time.LocalTime as X ()
src/Data/GenValidity/Time/Calendar.hs view
@@ -1,19 +1,62 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE CPP #-} module Data.GenValidity.Time.Calendar where import Data.GenValidity import Data.Time.Calendar import Data.Validity.Time.Calendar ()-#if !MIN_VERSION_base(4,8,0)-import Data.Functor ((<$>))-#endif import Test.QuickCheck -instance GenUnchecked Day where- genUnchecked = ModifiedJulianDay <$> genUnchecked- shrinkUnchecked _ = []- instance GenValid Day where- genValid = (ModifiedJulianDay <$> genValid) `suchThat` isValid+ genValid = uniformlyOneHundredYearsAround2020+ shrinkValid (ModifiedJulianDay i) = ModifiedJulianDay <$> shrinkValid i++uniformlyOneHundredYearsAround2020 :: Gen Day+uniformlyOneHundredYearsAround2020 = do+ y <- choose (1970, 2070)+ m <- choose (1, 12)+ d <- choose (1, 31)+ pure $ fromGregorian y m d++genSmartDayAround :: Day -> Gen Day+genSmartDayAround d = oneof [genValid, genDayAround d, genDayCloselyAround d]++-- We cannot put this in 'GenValid Day' around 'today' because that would break reproducability+genDayAround :: Day -> Gen Day+genDayAround today = do+ let (thisYear, _, _) = toGregorian today+ y <- choose (pred thisYear, succ thisYear)+ m <- choose (1, 12)+ d <- choose (1, 31)+ pure $ fromGregorian y m d++genDayCloselyAround :: Day -> Gen Day+genDayCloselyAround today = sized $ \s -> do+ diff <- choose (- s, s)+ pure $ addDays (fromIntegral diff) today++instance GenValid CalendarDiffDays where+ genValid = CalendarDiffDays <$> genValid <*> genValid+ shrinkValid (CalendarDiffDays m d) = [CalendarDiffDays m' d' | (m', d') <- shrinkValid (m, d)]++instance GenValid DayOfWeek where+ genValid =+ elements+ [ Monday,+ Tuesday,+ Wednesday,+ Thursday,+ Friday,+ Saturday,+ Sunday+ ]++ -- It's hard to know how to shrink this, because there is no official start of the week.+ -- However, just as we would shrink MonthOfYear to January, we will shrink the days of the week to monday+ shrinkValid Monday = []+ shrinkValid Tuesday = [Monday]+ shrinkValid Wednesday = [Monday, Tuesday]+ shrinkValid Thursday = [Monday, Tuesday, Wednesday]+ shrinkValid Friday = [Monday, Tuesday, Wednesday, Thursday]+ shrinkValid Saturday = [Monday, Tuesday, Wednesday, Thursday, Friday]+ shrinkValid Sunday = [Monday, Tuesday, Wednesday, Thursday, Friday, Saturday]
src/Data/GenValidity/Time/Clock.hs view
@@ -1,59 +1,27 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE CPP #-} module Data.GenValidity.Time.Clock where-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<*>))-import Data.Functor ((<$>))-#endif+ import Data.GenValidity import Data.GenValidity.Time.Calendar () import Data.Time.Clock import Data.Validity.Time.Clock ()- import Test.QuickCheck -instance GenUnchecked UniversalTime where- genUnchecked = ModJulianDate <$> genUnchecked- shrinkUnchecked = fmap ModJulianDate . shrinkUnchecked . getModJulianDate- instance GenValid UniversalTime where genValid = ModJulianDate <$> genValid+ shrinkValid = fmap ModJulianDate . shrinkValid . getModJulianDate -instance GenUnchecked DiffTime where- genUnchecked = picosecondsToDiffTime <$> genUnchecked-#if MIN_VERSION_time(1,6,0)- shrinkUnchecked =- fmap picosecondsToDiffTime . shrinkUnchecked . diffTimeToPicoseconds-#else- shrinkUnchecked = const []-#endif instance GenValid DiffTime where genValid = picosecondsToDiffTime <$> genValid--instance GenUnchecked UTCTime where- genUnchecked = UTCTime <$> genUnchecked <*> genUnchecked- shrinkUnchecked (UTCTime d dt) =- [UTCTime d' dt' | (d', dt') <- shrinkUnchecked (d, dt)]+ shrinkValid = fmap picosecondsToDiffTime . shrinkValid . diffTimeToPicoseconds instance GenValid UTCTime where genValid = UTCTime <$> genValid <*> (fromIntegral <$> choose (0 :: Int, 86400))+ shrinkValid (UTCTime d dt) =+ [UTCTime d' dt' | (d', dt') <- shrinkValid (d, dt)] -instance GenInvalid UTCTime-#if MIN_VERSION_time(1,9,1)-instance GenUnchecked NominalDiffTime where- genUnchecked = secondsToNominalDiffTime <$> genUnchecked-#else-instance GenUnchecked NominalDiffTime where- genUnchecked = diffUTCTime <$> genUnchecked <*> genUnchecked-#endif-#if MIN_VERSION_time(1,9,0)- shrinkUnchecked =- fmap secondsToNominalDiffTime . shrinkUnchecked . nominalDiffTimeToSeconds-#else- shrinkUnchecked = const []-#endif instance GenValid NominalDiffTime where- genValid = genUnchecked- shrinkValid = shrinkUnchecked+ genValid = secondsToNominalDiffTime <$> genValid+ shrinkValid = fmap secondsToNominalDiffTime . shrinkValid . nominalDiffTimeToSeconds
src/Data/GenValidity/Time/Format.hs view
@@ -1,28 +1,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE CPP #-} module Data.GenValidity.Time.Format where-#if MIN_VERSION_time(1,5,0)+ import Data.GenValidity import Data.GenValidity.Time.LocalTime () import Data.Time.Format import Data.Validity.Time.Format () -instance GenUnchecked TimeLocale where- genUnchecked =- TimeLocale <$> genUnchecked <*> genUnchecked <*> genUnchecked <*>- genUnchecked <*>- genUnchecked <*>- genUnchecked <*>- genUnchecked <*>- genUnchecked- shrinkUnchecked _ = []- instance GenValid TimeLocale where- genValid =- TimeLocale <$> genValid <*> genValid <*> genValid <*> genValid <*>- genValid <*>- genValid <*>- genValid <*>- genValid-#endif+ genValid =+ TimeLocale <$> genValid <*> genValid <*> genValid+ <*> genValid+ <*> genValid+ <*> genValid+ <*> genValid+ <*> genValid+ shrinkValid _ = []
src/Data/GenValidity/Time/LocalTime.hs view
@@ -1,70 +1,55 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE CPP #-} module Data.GenValidity.Time.LocalTime where-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<*>))-import Data.Functor ((<$>))-#endif+ import Data.Fixed import Data.GenValidity import Data.GenValidity.Time.Calendar ()+import Data.GenValidity.Time.Clock () import Data.Time.Format import Data.Time.LocalTime import Data.Validity.Time.LocalTime ()- import Test.QuickCheck -instance GenUnchecked TimeZone where- genUnchecked = TimeZone <$> genUnchecked <*> genUnchecked <*> genUnchecked- shrinkUnchecked (TimeZone m so n) =- [TimeZone m' so' n' | (m', so', n') <- shrinkUnchecked (m, so, n)]- instance GenValid TimeZone where genValid = TimeZone <$> genValid <*> genValid <*> genTimeZoneName+ shrinkValid (TimeZone m so n) =+ [TimeZone m' so' n' | (m', so', n') <- shrinkValid (m, so, n)] genTimeZoneName :: Gen String genTimeZoneName = frequency- [ (1, pure "")- , ( 4 -- Any three characters- , (:) <$> genValid <*>- ((:) <$> genValid <*> ((:) <$> genValid <*> pure [])))- , ( 4 -- A +HHMM string- , (:) <$> elements ['-', '+'] <*>- (formatTime defaultTimeLocale "%H%M" <$>- (TimeOfDay <$> choose (0, 23) <*> choose (0, 59) <*> pure 0)))- , (1, genValid)+ [ (1, pure ""),+ ( 4, -- Any three characters+ (:) <$> genValid+ <*> ((:) <$> genValid <*> ((:) <$> genValid <*> pure []))+ ),+ ( 4, -- A +HHMM string+ (:) <$> elements ['-', '+']+ <*> ( formatTime defaultTimeLocale "%H%M"+ <$> (TimeOfDay <$> choose (0, 23) <*> choose (0, 59) <*> pure 0)+ )+ ),+ (1, genValid) ] -instance GenUnchecked TimeOfDay where- genUnchecked = TimeOfDay <$> genUnchecked <*> genUnchecked <*> genUnchecked- shrinkUnchecked (TimeOfDay h m s) =- [TimeOfDay h' m' s' | (h', m', s') <- shrinkUnchecked (h, m, s)]- instance GenValid TimeOfDay where genValid =- TimeOfDay <$> (choose (0, 23)) <*> (choose (0, 59)) <*>- (MkFixed <$> choose (0, 60999999999999))--instance GenInvalid TimeOfDay--instance GenUnchecked LocalTime where- genUnchecked = LocalTime <$> genUnchecked <*> genUnchecked- shrinkUnchecked (LocalTime d tod) =- [LocalTime d' tod' | (d', tod') <- shrinkUnchecked (d, tod)]+ TimeOfDay <$> (choose (0, 23)) <*> (choose (0, 59))+ <*> (MkFixed <$> choose (0, 60999999999999))+ shrinkValid (TimeOfDay h m s) =+ filter isValid [TimeOfDay h' m' s' | (h', m', s') <- shrinkValid (h, m, s)] instance GenValid LocalTime where genValid = LocalTime <$> genValid <*> genValid--instance GenInvalid LocalTime--instance GenUnchecked ZonedTime where- genUnchecked = ZonedTime <$> genUnchecked <*> genUnchecked- shrinkUnchecked (ZonedTime lt tz) =- [ZonedTime lt' tz' | (lt', tz') <- shrinkUnchecked (lt, tz)]+ shrinkValid (LocalTime d tod) =+ filter isValid [LocalTime d' tod' | (d', tod') <- shrinkValid (d, tod)] instance GenValid ZonedTime where genValid = ZonedTime <$> genValid <*> genValid+ shrinkValid (ZonedTime lt tz) =+ filter isValid [ZonedTime lt' tz' | (lt', tz') <- shrinkValid (lt, tz)] -instance GenInvalid ZonedTime+instance GenValid CalendarDiffTime where+ genValid = CalendarDiffTime <$> genValid <*> genValid+ shrinkValid (CalendarDiffTime ms t) = [CalendarDiffTime ms' t' | (ms', t') <- shrinkValid (ms, t)]
test/Data/GenValidity/TimeSpec.hs view
@@ -1,24 +1,30 @@ {-# LANGUAGE TypeApplications #-} module Data.GenValidity.TimeSpec- ( spec- ) where+ ( spec,+ )+where +import Data.GenValidity.Time+import Data.Time import Test.Hspec import Test.Validity -import Data.GenValidity.Time ()-import Data.Time- spec :: Spec spec = do genValidSpec @Day+ describe "genSmartDayAround" $ it "generates valid days" $ forAllValid $ \d -> genGeneratesValid $ genSmartDayAround d+ describe "genDayAround" $ it "generates valid days" $ forAllValid $ \d -> genGeneratesValid $ genDayAround d+ describe "genDayCloselyAround" $ it "generates valid days" $ forAllValid $ \d -> genGeneratesValid $ genDayCloselyAround d genValidSpec @UniversalTime genValidSpec @DiffTime- genValiditySpec @UTCTime+ genValidSpec @UTCTime genValidSpec @NominalDiffTime genValidSpec @TimeZone- genValiditySpec @TimeOfDay- genValiditySpec @LocalTime- genValiditySpec @ZonedTime+ genValidSpec @TimeOfDay+ genValidSpec @LocalTime+ genValidSpec @ZonedTime genValidSpec @TimeLocale+ genValidSpec @CalendarDiffDays+ genValidSpec @DayOfWeek+ genValidSpec @CalendarDiffTime