saturn 1.0.0.9 → 1.1.0.0
raw patch · 86 files changed
+2217/−2180 lines, 86 filesdep +heckdep +hspec-coredep ~basedep ~parsecdep ~textPVP ok
version bump matches the API change (PVP)
Dependencies added: heck, hspec-core
Dependency ranges changed: base, parsec, text, time
API changes (from Hackage documentation)
+ Saturn.Unstable.Constant: daily :: Schedule
+ Saturn.Unstable.Constant: everyMinute :: Schedule
+ Saturn.Unstable.Constant: hourly :: Schedule
+ Saturn.Unstable.Constant: monthly :: Schedule
+ Saturn.Unstable.Constant: weekly :: Schedule
+ Saturn.Unstable.Constant: yearly :: Schedule
+ Saturn.Unstable.ConstantSpec: spec :: forall (m :: Type -> Type) n. (Applicative m, Monad n) => Test m n -> n ()
+ Saturn.Unstable.Extra.Int: fromWord8 :: Word8 -> Int
+ Saturn.Unstable.Extra.Int: toWord8 :: Int -> Maybe Word8
+ Saturn.Unstable.Extra.IntSpec: spec :: forall (m :: Type -> Type) n. (Applicative m, Monad n) => Test m n -> n ()
+ Saturn.Unstable.Extra.Ord: within :: Ord a => (a, a) -> a -> Bool
+ Saturn.Unstable.Extra.OrdSpec: spec :: forall (m :: Type -> Type) n. (Applicative m, Monad n) => Test m n -> n ()
+ Saturn.Unstable.Extra.Parsec: either :: forall s u (m :: Type -> Type) a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m (Either a b)
+ Saturn.Unstable.Extra.Parsec: sepByNE :: forall s u (m :: Type -> Type) a sep. ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m (NonEmpty a)
+ Saturn.Unstable.Extra.ParsecSpec: spec :: forall (m :: Type -> Type) n. (Applicative m, Monad n) => Test m n -> n ()
+ Saturn.Unstable.Extra.Time: dayOfWeekToWord8 :: DayOfWeek -> Word8
+ Saturn.Unstable.Extra.TimeSpec: spec :: forall (m :: Type -> Type) n. (Applicative m, Monad n) => Test m n -> n ()
+ Saturn.Unstable.Extra.Tuple: mapBoth :: (a -> b) -> (a, a) -> (b, b)
+ Saturn.Unstable.Extra.Tuple: toSequence :: Enum a => (a, a) -> [a]
+ Saturn.Unstable.Extra.TupleSpec: spec :: forall (m :: Type -> Type) n. (Applicative m, Monad n) => Test m n -> n ()
+ Saturn.Unstable.Match: dayIsWildcard :: Schedule -> Bool
+ Saturn.Unstable.Match: incompleteNextMatch :: UTCTime -> Schedule -> Maybe UTCTime
+ Saturn.Unstable.Match: isMatch :: UTCTime -> Schedule -> Bool
+ Saturn.Unstable.Match: nextMatch :: UTCTime -> Schedule -> Maybe UTCTime
+ Saturn.Unstable.Match: weekdayIsWildcard :: Schedule -> Bool
+ Saturn.Unstable.MatchSpec: arbitraryUtcTime :: Gen UTCTime
+ Saturn.Unstable.MatchSpec: newUtcTime :: MonadFail m => Year -> MonthOfYear -> DayOfMonth -> Int -> Int -> Pico -> m UTCTime
+ Saturn.Unstable.MatchSpec: overDay :: (Day -> Day) -> UTCTime -> UTCTime
+ Saturn.Unstable.MatchSpec: overTimeOfDay :: (TimeOfDay -> TimeOfDay) -> UTCTime -> UTCTime
+ Saturn.Unstable.MatchSpec: shrinkUtcTime :: UTCTime -> [UTCTime]
+ Saturn.Unstable.MatchSpec: spec :: Monad n => Test IO n -> n ()
+ Saturn.Unstable.MatchSpec: withDayOfMonth :: DayOfMonth -> UTCTime -> UTCTime
+ Saturn.Unstable.MatchSpec: withDayOfWeek :: DayOfWeek -> UTCTime -> UTCTime
+ Saturn.Unstable.MatchSpec: withHour :: Int -> UTCTime -> UTCTime
+ Saturn.Unstable.MatchSpec: withMinute :: Int -> UTCTime -> UTCTime
+ Saturn.Unstable.MatchSpec: withMonthOfYear :: MonthOfYear -> UTCTime -> UTCTime
+ Saturn.Unstable.Parse: fromLazyText :: Text -> Either ParseError Schedule
+ Saturn.Unstable.Parse: fromString :: String -> Either ParseError Schedule
+ Saturn.Unstable.Parse: fromText :: Text -> Either ParseError Schedule
+ Saturn.Unstable.Parse: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Schedule
+ Saturn.Unstable.ParseSpec: spec :: forall (m :: Type -> Type) n. (MonadFail m, Monad n) => Test m n -> n ()
+ Saturn.Unstable.Render: toLazyText :: Schedule -> Text
+ Saturn.Unstable.Render: toString :: Schedule -> String
+ Saturn.Unstable.Render: toText :: Schedule -> Text
+ Saturn.Unstable.RenderSpec: spec :: forall (m :: Type -> Type) n. (MonadFail m, Monad n) => Test m n -> n ()
+ Saturn.Unstable.Type.Day: Day :: Field -> Day
+ Saturn.Unstable.Type.Day: bounds :: (Word8, Word8)
+ Saturn.Unstable.Type.Day: expand :: Day -> Set Word8
+ Saturn.Unstable.Type.Day: fromField :: Field -> Maybe Day
+ Saturn.Unstable.Type.Day: instance GHC.Classes.Eq Saturn.Unstable.Type.Day.Day
+ Saturn.Unstable.Type.Day: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Day.Day
+ Saturn.Unstable.Type.Day: isMatch :: Word8 -> Day -> Bool
+ Saturn.Unstable.Type.Day: newtype Day
+ Saturn.Unstable.Type.Day: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Day
+ Saturn.Unstable.Type.Day: toBuilder :: Day -> Builder
+ Saturn.Unstable.Type.Day: toField :: Day -> Field
+ Saturn.Unstable.Type.DaySpec: arbitrary :: Gen Day
+ Saturn.Unstable.Type.DaySpec: new :: MonadFail m => [[Word8]] -> m Day
+ Saturn.Unstable.Type.DaySpec: shrink :: Day -> [Day]
+ Saturn.Unstable.Type.DaySpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Element: Element :: Either Range Number -> Element
+ Saturn.Unstable.Type.Element: expand :: Element -> Set Word8
+ Saturn.Unstable.Type.Element: fromEither :: Either Range Number -> Element
+ Saturn.Unstable.Type.Element: instance GHC.Classes.Eq Saturn.Unstable.Type.Element.Element
+ Saturn.Unstable.Type.Element: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Element.Element
+ Saturn.Unstable.Type.Element: isValid :: (Word8, Word8) -> Element -> Bool
+ Saturn.Unstable.Type.Element: newtype Element
+ Saturn.Unstable.Type.Element: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Element
+ Saturn.Unstable.Type.Element: toBuilder :: Element -> Builder
+ Saturn.Unstable.Type.Element: toEither :: Element -> Either Range Number
+ Saturn.Unstable.Type.ElementSpec: arbitrary :: Gen Element
+ Saturn.Unstable.Type.ElementSpec: new :: MonadFail m => [Word8] -> m Element
+ Saturn.Unstable.Type.ElementSpec: shrink :: Element -> [Element]
+ Saturn.Unstable.Type.ElementSpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Field: Field :: Either Wildcard (NonEmpty Element) -> Field
+ Saturn.Unstable.Type.Field: expand :: (Word8, Word8) -> Field -> Set Word8
+ Saturn.Unstable.Type.Field: fromEither :: Either Wildcard (NonEmpty Element) -> Field
+ Saturn.Unstable.Type.Field: instance GHC.Classes.Eq Saturn.Unstable.Type.Field.Field
+ Saturn.Unstable.Type.Field: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Field.Field
+ Saturn.Unstable.Type.Field: isValid :: (Word8, Word8) -> Field -> Bool
+ Saturn.Unstable.Type.Field: isWildcard :: Field -> Bool
+ Saturn.Unstable.Type.Field: newtype Field
+ Saturn.Unstable.Type.Field: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Field
+ Saturn.Unstable.Type.Field: toBuilder :: Field -> Builder
+ Saturn.Unstable.Type.Field: toEither :: Field -> Either Wildcard (NonEmpty Element)
+ Saturn.Unstable.Type.FieldSpec: arbitrary :: Gen Field
+ Saturn.Unstable.Type.FieldSpec: arbitraryNonEmpty :: Gen a -> Gen (NonEmpty a)
+ Saturn.Unstable.Type.FieldSpec: new :: MonadFail m => [[Word8]] -> m Field
+ Saturn.Unstable.Type.FieldSpec: shrink :: Field -> [Field]
+ Saturn.Unstable.Type.FieldSpec: shrinkNonEmpty :: (a -> [a]) -> NonEmpty a -> [NonEmpty a]
+ Saturn.Unstable.Type.FieldSpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Hour: Hour :: Field -> Hour
+ Saturn.Unstable.Type.Hour: bounds :: (Word8, Word8)
+ Saturn.Unstable.Type.Hour: expand :: Hour -> Set Word8
+ Saturn.Unstable.Type.Hour: fromField :: Field -> Maybe Hour
+ Saturn.Unstable.Type.Hour: instance GHC.Classes.Eq Saturn.Unstable.Type.Hour.Hour
+ Saturn.Unstable.Type.Hour: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Hour.Hour
+ Saturn.Unstable.Type.Hour: isMatch :: Word8 -> Hour -> Bool
+ Saturn.Unstable.Type.Hour: newtype Hour
+ Saturn.Unstable.Type.Hour: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Hour
+ Saturn.Unstable.Type.Hour: toBuilder :: Hour -> Builder
+ Saturn.Unstable.Type.Hour: toField :: Hour -> Field
+ Saturn.Unstable.Type.HourSpec: arbitrary :: Gen Hour
+ Saturn.Unstable.Type.HourSpec: new :: MonadFail m => [[Word8]] -> m Hour
+ Saturn.Unstable.Type.HourSpec: shrink :: Hour -> [Hour]
+ Saturn.Unstable.Type.HourSpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Minute: Minute :: Field -> Minute
+ Saturn.Unstable.Type.Minute: bounds :: (Word8, Word8)
+ Saturn.Unstable.Type.Minute: expand :: Minute -> Set Word8
+ Saturn.Unstable.Type.Minute: fromField :: Field -> Maybe Minute
+ Saturn.Unstable.Type.Minute: instance GHC.Classes.Eq Saturn.Unstable.Type.Minute.Minute
+ Saturn.Unstable.Type.Minute: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Minute.Minute
+ Saturn.Unstable.Type.Minute: isMatch :: Word8 -> Minute -> Bool
+ Saturn.Unstable.Type.Minute: newtype Minute
+ Saturn.Unstable.Type.Minute: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Minute
+ Saturn.Unstable.Type.Minute: toBuilder :: Minute -> Builder
+ Saturn.Unstable.Type.Minute: toField :: Minute -> Field
+ Saturn.Unstable.Type.MinuteSpec: arbitrary :: Gen Minute
+ Saturn.Unstable.Type.MinuteSpec: new :: MonadFail m => [[Word8]] -> m Minute
+ Saturn.Unstable.Type.MinuteSpec: shrink :: Minute -> [Minute]
+ Saturn.Unstable.Type.MinuteSpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Month: Month :: Field -> Month
+ Saturn.Unstable.Type.Month: bounds :: (Word8, Word8)
+ Saturn.Unstable.Type.Month: expand :: Month -> Set Word8
+ Saturn.Unstable.Type.Month: fromField :: Field -> Maybe Month
+ Saturn.Unstable.Type.Month: instance GHC.Classes.Eq Saturn.Unstable.Type.Month.Month
+ Saturn.Unstable.Type.Month: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Month.Month
+ Saturn.Unstable.Type.Month: isMatch :: Word8 -> Month -> Bool
+ Saturn.Unstable.Type.Month: newtype Month
+ Saturn.Unstable.Type.Month: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Month
+ Saturn.Unstable.Type.Month: toBuilder :: Month -> Builder
+ Saturn.Unstable.Type.Month: toField :: Month -> Field
+ Saturn.Unstable.Type.MonthSpec: arbitrary :: Gen Month
+ Saturn.Unstable.Type.MonthSpec: new :: MonadFail m => [[Word8]] -> m Month
+ Saturn.Unstable.Type.MonthSpec: shrink :: Month -> [Month]
+ Saturn.Unstable.Type.MonthSpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Number: Number :: Word8 -> Number
+ Saturn.Unstable.Type.Number: fromWord8 :: Word8 -> Number
+ Saturn.Unstable.Type.Number: instance GHC.Classes.Eq Saturn.Unstable.Type.Number.Number
+ Saturn.Unstable.Type.Number: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Number.Number
+ Saturn.Unstable.Type.Number: isValid :: (Word8, Word8) -> Number -> Bool
+ Saturn.Unstable.Type.Number: newtype Number
+ Saturn.Unstable.Type.Number: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Number
+ Saturn.Unstable.Type.Number: toBuilder :: Number -> Builder
+ Saturn.Unstable.Type.Number: toWord8 :: Number -> Word8
+ Saturn.Unstable.Type.NumberSpec: arbitrary :: Gen Number
+ Saturn.Unstable.Type.NumberSpec: shrink :: Number -> [Number]
+ Saturn.Unstable.Type.NumberSpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Range: Range :: (Number, Number) -> Range
+ Saturn.Unstable.Type.Range: expand :: Range -> Set Word8
+ Saturn.Unstable.Type.Range: fromTuple :: (Number, Number) -> Maybe Range
+ Saturn.Unstable.Type.Range: instance GHC.Classes.Eq Saturn.Unstable.Type.Range.Range
+ Saturn.Unstable.Type.Range: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Range.Range
+ Saturn.Unstable.Type.Range: isValid :: (Word8, Word8) -> Range -> Bool
+ Saturn.Unstable.Type.Range: newtype Range
+ Saturn.Unstable.Type.Range: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Range
+ Saturn.Unstable.Type.Range: toBuilder :: Range -> Builder
+ Saturn.Unstable.Type.Range: toTuple :: Range -> (Number, Number)
+ Saturn.Unstable.Type.RangeSpec: arbitrary :: Gen Range
+ Saturn.Unstable.Type.RangeSpec: new :: MonadFail m => (Word8, Word8) -> m Range
+ Saturn.Unstable.Type.RangeSpec: shrink :: Range -> [Range]
+ Saturn.Unstable.Type.RangeSpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Schedule: Schedule :: Minute -> Hour -> Day -> Month -> Weekday -> Schedule
+ Saturn.Unstable.Type.Schedule: [day] :: Schedule -> Day
+ Saturn.Unstable.Type.Schedule: [hour] :: Schedule -> Hour
+ Saturn.Unstable.Type.Schedule: [minute] :: Schedule -> Minute
+ Saturn.Unstable.Type.Schedule: [month] :: Schedule -> Month
+ Saturn.Unstable.Type.Schedule: [weekday] :: Schedule -> Weekday
+ Saturn.Unstable.Type.Schedule: data Schedule
+ Saturn.Unstable.Type.Schedule: instance GHC.Classes.Eq Saturn.Unstable.Type.Schedule.Schedule
+ Saturn.Unstable.Type.Schedule: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Schedule.Schedule
+ Saturn.Unstable.Type.Schedule: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Schedule
+ Saturn.Unstable.Type.Schedule: toBuilder :: Schedule -> Builder
+ Saturn.Unstable.Type.ScheduleSpec: arbitrary :: Gen Schedule
+ Saturn.Unstable.Type.ScheduleSpec: liftShrink5 :: (t1 -> [t1]) -> (t2 -> [t2]) -> (t3 -> [t3]) -> (t4 -> [t4]) -> (t5 -> [t5]) -> (t1, t2, t3, t4, t5) -> [(t1, t2, t3, t4, t5)]
+ Saturn.Unstable.Type.ScheduleSpec: new :: MonadFail m => [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
+ Saturn.Unstable.Type.ScheduleSpec: shrink :: Schedule -> [Schedule]
+ Saturn.Unstable.Type.ScheduleSpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Weekday: Weekday :: Field -> Weekday
+ Saturn.Unstable.Type.Weekday: bounds :: (Word8, Word8)
+ Saturn.Unstable.Type.Weekday: expand :: Weekday -> Set Word8
+ Saturn.Unstable.Type.Weekday: fromField :: Field -> Maybe Weekday
+ Saturn.Unstable.Type.Weekday: instance GHC.Classes.Eq Saturn.Unstable.Type.Weekday.Weekday
+ Saturn.Unstable.Type.Weekday: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Weekday.Weekday
+ Saturn.Unstable.Type.Weekday: isMatch :: Word8 -> Weekday -> Bool
+ Saturn.Unstable.Type.Weekday: newtype Weekday
+ Saturn.Unstable.Type.Weekday: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Weekday
+ Saturn.Unstable.Type.Weekday: toBuilder :: Weekday -> Builder
+ Saturn.Unstable.Type.Weekday: toField :: Weekday -> Field
+ Saturn.Unstable.Type.WeekdaySpec: arbitrary :: Gen Weekday
+ Saturn.Unstable.Type.WeekdaySpec: new :: MonadFail m => [[Word8]] -> m Weekday
+ Saturn.Unstable.Type.WeekdaySpec: shrink :: Weekday -> [Weekday]
+ Saturn.Unstable.Type.WeekdaySpec: spec :: Test IO n -> n ()
+ Saturn.Unstable.Type.Wildcard: Wildcard :: () -> Wildcard
+ Saturn.Unstable.Type.Wildcard: fromUnit :: () -> Wildcard
+ Saturn.Unstable.Type.Wildcard: instance GHC.Classes.Eq Saturn.Unstable.Type.Wildcard.Wildcard
+ Saturn.Unstable.Type.Wildcard: instance GHC.Internal.Show.Show Saturn.Unstable.Type.Wildcard.Wildcard
+ Saturn.Unstable.Type.Wildcard: newtype Wildcard
+ Saturn.Unstable.Type.Wildcard: parsec :: forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m Wildcard
+ Saturn.Unstable.Type.Wildcard: toBuilder :: Wildcard -> Builder
+ Saturn.Unstable.Type.Wildcard: toUnit :: Wildcard -> ()
+ Saturn.Unstable.Type.WildcardSpec: arbitrary :: Gen Wildcard
+ Saturn.Unstable.Type.WildcardSpec: shrink :: Wildcard -> [Wildcard]
+ Saturn.Unstable.Type.WildcardSpec: spec :: Test IO n -> n ()
+ SaturnSpec: spec :: Monad n => Test IO n -> n ()
Files
- saturn.cabal +31/−49
- source/libraries/saturn/Saturn.hs +0/−71
- source/libraries/spec/Saturn/Unstable/ConstantSpec.hs +0/−31
- source/libraries/spec/Saturn/Unstable/Extra/IntSpec.hs +0/−23
- source/libraries/spec/Saturn/Unstable/Extra/OrdSpec.hs +0/−22
- source/libraries/spec/Saturn/Unstable/Extra/ParsecSpec.hs +0/−37
- source/libraries/spec/Saturn/Unstable/Extra/TimeSpec.hs +0/−29
- source/libraries/spec/Saturn/Unstable/Extra/TupleSpec.hs +0/−20
- source/libraries/spec/Saturn/Unstable/MatchSpec.hs +0/−484
- source/libraries/spec/Saturn/Unstable/ParseSpec.hs +0/−214
- source/libraries/spec/Saturn/Unstable/RenderSpec.hs +0/−24
- source/libraries/spec/Saturn/Unstable/Type/DaySpec.hs +0/−29
- source/libraries/spec/Saturn/Unstable/Type/ElementSpec.hs +0/−45
- source/libraries/spec/Saturn/Unstable/Type/FieldSpec.hs +0/−53
- source/libraries/spec/Saturn/Unstable/Type/HourSpec.hs +0/−29
- source/libraries/spec/Saturn/Unstable/Type/MinuteSpec.hs +0/−29
- source/libraries/spec/Saturn/Unstable/Type/MonthSpec.hs +0/−29
- source/libraries/spec/Saturn/Unstable/Type/NumberSpec.hs +0/−21
- source/libraries/spec/Saturn/Unstable/Type/RangeSpec.hs +0/−38
- source/libraries/spec/Saturn/Unstable/Type/ScheduleSpec.hs +0/−85
- source/libraries/spec/Saturn/Unstable/Type/WeekdaySpec.hs +0/−29
- source/libraries/spec/Saturn/Unstable/Type/WildcardSpec.hs +0/−21
- source/libraries/spec/SaturnSpec.hs +0/−25
- source/libraries/unstable/Saturn/Unstable/Constant.hs +0/−96
- source/libraries/unstable/Saturn/Unstable/Extra/Int.hs +0/−10
- source/libraries/unstable/Saturn/Unstable/Extra/Ord.hs +0/−4
- source/libraries/unstable/Saturn/Unstable/Extra/Parsec.hs +0/−16
- source/libraries/unstable/Saturn/Unstable/Extra/Time.hs +0/−14
- source/libraries/unstable/Saturn/Unstable/Extra/Tuple.hs +0/−9
- source/libraries/unstable/Saturn/Unstable/Match.hs +0/−89
- source/libraries/unstable/Saturn/Unstable/Parse.hs +0/−30
- source/libraries/unstable/Saturn/Unstable/Render.hs +0/−21
- source/libraries/unstable/Saturn/Unstable/Type/Day.hs +0/−38
- source/libraries/unstable/Saturn/Unstable/Type/Element.hs +0/−34
- source/libraries/unstable/Saturn/Unstable/Type/Field.hs +0/−58
- source/libraries/unstable/Saturn/Unstable/Type/Hour.hs +0/−38
- source/libraries/unstable/Saturn/Unstable/Type/Minute.hs +0/−38
- source/libraries/unstable/Saturn/Unstable/Type/Month.hs +0/−38
- source/libraries/unstable/Saturn/Unstable/Type/Number.hs +0/−35
- source/libraries/unstable/Saturn/Unstable/Type/Range.hs +0/−47
- source/libraries/unstable/Saturn/Unstable/Type/Schedule.hs +0/−45
- source/libraries/unstable/Saturn/Unstable/Type/Weekday.hs +0/−38
- source/libraries/unstable/Saturn/Unstable/Type/Wildcard.hs +0/−24
- source/library/Saturn.hs +71/−0
- source/library/Saturn/Unstable/Constant.hs +96/−0
- source/library/Saturn/Unstable/ConstantSpec.hs +31/−0
- source/library/Saturn/Unstable/Extra/Int.hs +10/−0
- source/library/Saturn/Unstable/Extra/IntSpec.hs +23/−0
- source/library/Saturn/Unstable/Extra/Ord.hs +4/−0
- source/library/Saturn/Unstable/Extra/OrdSpec.hs +22/−0
- source/library/Saturn/Unstable/Extra/Parsec.hs +16/−0
- source/library/Saturn/Unstable/Extra/ParsecSpec.hs +37/−0
- source/library/Saturn/Unstable/Extra/Time.hs +14/−0
- source/library/Saturn/Unstable/Extra/TimeSpec.hs +29/−0
- source/library/Saturn/Unstable/Extra/Tuple.hs +9/−0
- source/library/Saturn/Unstable/Extra/TupleSpec.hs +20/−0
- source/library/Saturn/Unstable/Match.hs +89/−0
- source/library/Saturn/Unstable/MatchSpec.hs +503/−0
- source/library/Saturn/Unstable/Parse.hs +30/−0
- source/library/Saturn/Unstable/ParseSpec.hs +214/−0
- source/library/Saturn/Unstable/Render.hs +21/−0
- source/library/Saturn/Unstable/RenderSpec.hs +24/−0
- source/library/Saturn/Unstable/Type/Day.hs +38/−0
- source/library/Saturn/Unstable/Type/DaySpec.hs +31/−0
- source/library/Saturn/Unstable/Type/Element.hs +34/−0
- source/library/Saturn/Unstable/Type/ElementSpec.hs +47/−0
- source/library/Saturn/Unstable/Type/Field.hs +58/−0
- source/library/Saturn/Unstable/Type/FieldSpec.hs +55/−0
- source/library/Saturn/Unstable/Type/Hour.hs +38/−0
- source/library/Saturn/Unstable/Type/HourSpec.hs +31/−0
- source/library/Saturn/Unstable/Type/Minute.hs +38/−0
- source/library/Saturn/Unstable/Type/MinuteSpec.hs +31/−0
- source/library/Saturn/Unstable/Type/Month.hs +38/−0
- source/library/Saturn/Unstable/Type/MonthSpec.hs +31/−0
- source/library/Saturn/Unstable/Type/Number.hs +35/−0
- source/library/Saturn/Unstable/Type/NumberSpec.hs +23/−0
- source/library/Saturn/Unstable/Type/Range.hs +47/−0
- source/library/Saturn/Unstable/Type/RangeSpec.hs +40/−0
- source/library/Saturn/Unstable/Type/Schedule.hs +45/−0
- source/library/Saturn/Unstable/Type/ScheduleSpec.hs +87/−0
- source/library/Saturn/Unstable/Type/Weekday.hs +38/−0
- source/library/Saturn/Unstable/Type/WeekdaySpec.hs +31/−0
- source/library/Saturn/Unstable/Type/Wildcard.hs +24/−0
- source/library/Saturn/Unstable/Type/WildcardSpec.hs +23/−0
- source/library/SaturnSpec.hs +29/−0
- source/test-suite/Main.hs +31/−21
saturn.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: saturn-version: 1.0.0.9+version: 1.1.0.0 synopsis: Handle POSIX cron schedules. description: Saturn handles POSIX cron schedules. build-type: Simple@@ -22,7 +22,7 @@ manual: True common library- build-depends: base ^>=4.19.0.0 || ^>=4.20.0.0 || ^>=4.21.0.0+ build-depends: base ^>=4.19 || ^>=4.20 || ^>=4.21 default-language: Haskell2010 ghc-options: -Weverything@@ -40,89 +40,71 @@ if flag(pedantic) ghc-options: -Werror -library unstable+library import: library build-depends:+ QuickCheck ^>=2.14.3 || ^>=2.15 || ^>=2.16, containers ^>=0.6.7 || ^>=0.7,+ heck ^>=0.2025.5.22,+ hspec ^>=2.11.8, parsec ^>=3.1.16.1, text ^>=2.0.2 || ^>=2.1, time ^>=1.12.2 || ^>=1.14, - -- cabal-gild: discover source/libraries/unstable+ -- cabal-gild: discover source/library exposed-modules:+ Saturn Saturn.Unstable.Constant- Saturn.Unstable.Extra.Int- Saturn.Unstable.Extra.Ord- Saturn.Unstable.Extra.Parsec- Saturn.Unstable.Extra.Time- Saturn.Unstable.Extra.Tuple- Saturn.Unstable.Match- Saturn.Unstable.Parse- Saturn.Unstable.Render- Saturn.Unstable.Type.Day- Saturn.Unstable.Type.Element- Saturn.Unstable.Type.Field- Saturn.Unstable.Type.Hour- Saturn.Unstable.Type.Minute- Saturn.Unstable.Type.Month- Saturn.Unstable.Type.Number- Saturn.Unstable.Type.Range- Saturn.Unstable.Type.Schedule- Saturn.Unstable.Type.Weekday- Saturn.Unstable.Type.Wildcard-- hs-source-dirs: source/libraries/unstable- visibility: public--library- import: library- build-depends: saturn:unstable- -- cabal-gild: discover source/libraries/saturn- exposed-modules: Saturn- hs-source-dirs: source/libraries/saturn--library spec- import: library- build-depends:- QuickCheck ^>=2.14.3 || ^>=2.15 || ^>=2.16,- hspec ^>=2.11.8,- parsec,- saturn:unstable,- text,- time,-- -- cabal-gild: discover source/libraries/spec- exposed-modules: Saturn.Unstable.ConstantSpec+ Saturn.Unstable.Extra.Int Saturn.Unstable.Extra.IntSpec+ Saturn.Unstable.Extra.Ord Saturn.Unstable.Extra.OrdSpec+ Saturn.Unstable.Extra.Parsec Saturn.Unstable.Extra.ParsecSpec+ Saturn.Unstable.Extra.Time Saturn.Unstable.Extra.TimeSpec+ Saturn.Unstable.Extra.Tuple Saturn.Unstable.Extra.TupleSpec+ Saturn.Unstable.Match Saturn.Unstable.MatchSpec+ Saturn.Unstable.Parse Saturn.Unstable.ParseSpec+ Saturn.Unstable.Render Saturn.Unstable.RenderSpec+ Saturn.Unstable.Type.Day Saturn.Unstable.Type.DaySpec+ Saturn.Unstable.Type.Element Saturn.Unstable.Type.ElementSpec+ Saturn.Unstable.Type.Field Saturn.Unstable.Type.FieldSpec+ Saturn.Unstable.Type.Hour Saturn.Unstable.Type.HourSpec+ Saturn.Unstable.Type.Minute Saturn.Unstable.Type.MinuteSpec+ Saturn.Unstable.Type.Month Saturn.Unstable.Type.MonthSpec+ Saturn.Unstable.Type.Number Saturn.Unstable.Type.NumberSpec+ Saturn.Unstable.Type.Range Saturn.Unstable.Type.RangeSpec+ Saturn.Unstable.Type.Schedule Saturn.Unstable.Type.ScheduleSpec+ Saturn.Unstable.Type.Weekday Saturn.Unstable.Type.WeekdaySpec+ Saturn.Unstable.Type.Wildcard Saturn.Unstable.Type.WildcardSpec SaturnSpec - hs-source-dirs: source/libraries/spec- visibility: public+ hs-source-dirs: source/library test-suite saturn-test-suite import: library build-depends:+ heck, hspec,- saturn:spec,+ hspec-core,+ saturn, ghc-options: -rtsopts
− source/libraries/saturn/Saturn.hs
@@ -1,71 +0,0 @@--- | Saturn handles POSIX cron schedules, which are defined here:--- <https://pubs.opengroup.org/onlinepubs/9699919799/utilities/crontab.html#tag_20_25_07>.------ A cron schedule is specified with five fields, each separated with at least--- one space. Each field can either be a wildcard (represented by an asterisk),--- or it can be one or more elements separated by commas. Each element can--- either be a number or a range, which is two numbers separated by a hyphen.------ In order, the fields represent:------ 1. Minute, between 0 and 59.--- 2. Hour, between 0 and 23.--- 3. Day, between 1 and 31.--- 4. Month, between 1 and 12.--- 5. Weekday, between 0 and 6 where 0 represents Sunday.------ Here is a more graphical representation of the fields:------ > +--------- Minute--- > | +------- Hour--- > | | +----- Day--- > | | | +--- Month--- > | | | | +- Weekday--- > | | | | |--- > "* * * * *"------ To get started, use 'Parse.fromText' to parse a 'Schedule.Schedule'. Then--- use 'Render.toText' to render it again. To see if the 'Schedule.Schedule'--- matches a certain time, use 'Match.isMatch'. To get the next time that--- matches a schedule, use 'Match.nextMatch'.------ >>> :set -XOverloadedStrings--- >>> let Right schedule = fromText "* * * * *"--- >>> toText schedule--- "* * * * *"--- >>> let utcTime = Data.Time.UTCTime (Data.Time.fromGregorian 1970 1 1) 0--- >>> isMatch utcTime schedule--- True--- >>> nextMatch utcTime schedule--- Just 1970-01-01 00:01:00 UTC-module Saturn- ( -- * Types- Schedule.Schedule,- Constant.everyMinute,- Constant.hourly,- Constant.daily,- Constant.weekly,- Constant.monthly,- Constant.yearly,-- -- * Parsing- Parse.fromText,- Parse.fromLazyText,- Parse.fromString,-- -- * Rendering- Render.toText,- Render.toLazyText,- Render.toString,-- -- * Matching- Match.isMatch,- Match.nextMatch,- )-where--import qualified Saturn.Unstable.Constant as Constant-import qualified Saturn.Unstable.Match as Match-import qualified Saturn.Unstable.Parse as Parse-import qualified Saturn.Unstable.Render as Render-import qualified Saturn.Unstable.Type.Schedule as Schedule
− source/libraries/spec/Saturn/Unstable/ConstantSpec.hs
@@ -1,31 +0,0 @@-module Saturn.Unstable.ConstantSpec where--import qualified Saturn.Unstable.Constant as Constant-import qualified Saturn.Unstable.Render as Render-import qualified Test.Hspec as Hspec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Constant" $ do- Hspec.describe "everyMinute" $ do- Hspec.it "renders correctly" $ do- Render.toString Constant.everyMinute `Hspec.shouldBe` "* * * * *"-- Hspec.describe "hourly" $ do- Hspec.it "renders correctly" $ do- Render.toString Constant.hourly `Hspec.shouldBe` "0 * * * *"-- Hspec.describe "daily" $ do- Hspec.it "renders correctly" $ do- Render.toString Constant.daily `Hspec.shouldBe` "0 0 * * *"-- Hspec.describe "weekly" $ do- Hspec.it "renders correctly" $ do- Render.toString Constant.weekly `Hspec.shouldBe` "0 0 * * 0"-- Hspec.describe "monthly" $ do- Hspec.it "renders correctly" $ do- Render.toString Constant.monthly `Hspec.shouldBe` "0 0 1 * *"-- Hspec.describe "yearly" $ do- Hspec.it "renders correctly" $ do- Render.toString Constant.yearly `Hspec.shouldBe` "0 0 1 1 *"
− source/libraries/spec/Saturn/Unstable/Extra/IntSpec.hs
@@ -1,23 +0,0 @@-module Saturn.Unstable.Extra.IntSpec where--import qualified Saturn.Unstable.Extra.Int as Int-import qualified Test.Hspec as Hspec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Extra.Int" $ do- Hspec.describe "fromWord8" $ do- Hspec.it "works" $ do- Int.fromWord8 0 `Hspec.shouldBe` 0-- Hspec.describe "toWord8" $ do- Hspec.it "succeeds with minimum" $ do- Int.toWord8 0 `Hspec.shouldBe` Just 0-- Hspec.it "succeeds with maximum" $ do- Int.toWord8 255 `Hspec.shouldBe` Just 255-- Hspec.it "fails below minimum" $ do- Int.toWord8 (-1) `Hspec.shouldBe` Nothing-- Hspec.it "fails above maximum" $ do- Int.toWord8 256 `Hspec.shouldBe` Nothing
− source/libraries/spec/Saturn/Unstable/Extra/OrdSpec.hs
@@ -1,22 +0,0 @@-module Saturn.Unstable.Extra.OrdSpec where--import qualified Saturn.Unstable.Extra.Ord as Ord-import qualified Test.Hspec as Hspec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Extra.Ord" $ do- Hspec.describe "within" $ do- Hspec.it "fails below lower bound" $ do- 'a' `Hspec.shouldNotSatisfy` Ord.within ('b', 'd')-- Hspec.it "succeeds at lower bound" $ do- 'b' `Hspec.shouldSatisfy` Ord.within ('b', 'd')-- Hspec.it "succeeds within bounds" $ do- 'c' `Hspec.shouldSatisfy` Ord.within ('b', 'd')-- Hspec.it "succeeds at upper bound" $ do- 'd' `Hspec.shouldSatisfy` Ord.within ('b', 'd')-- Hspec.it "fails above upper bound" $ do- 'e' `Hspec.shouldNotSatisfy` Ord.within ('b', 'd')
− source/libraries/spec/Saturn/Unstable/Extra/ParsecSpec.hs
@@ -1,37 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Extra.ParsecSpec where--import qualified Data.Either as Either-import qualified Data.List.NonEmpty as NonEmpty-import qualified Saturn.Unstable.Extra.Parsec as Parsec-import qualified Test.Hspec as Hspec-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Extra.Parsec" $ do- Hspec.describe "either" $ do- let parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m (Either Char Char)- parsec = Parsec.either (Parsec.char 'a') (Parsec.char 'b')-- Hspec.it "succeeds with left" $ do- Parsec.parse parsec "" "a" `Hspec.shouldBe` Right (Left 'a')-- Hspec.it "succeeds with right" $ do- Parsec.parse parsec "" "b" `Hspec.shouldBe` Right (Right 'b')-- Hspec.it "fails with neither" $ do- Parsec.parse parsec "" "c" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.describe "sepByNE" $ do- let parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m (NonEmpty.NonEmpty Char)- parsec = Parsec.sepByNE (Parsec.char 'a') (Parsec.char ' ')-- Hspec.it "succeeds with one" $ do- Parsec.parse parsec "" "a" `Hspec.shouldBe` Right ('a' NonEmpty.:| [])-- Hspec.it "succeeds with many" $ do- Parsec.parse parsec "" "a a" `Hspec.shouldBe` Right ('a' NonEmpty.:| "a")-- Hspec.it "fails with none" $ do- Parsec.parse parsec "" "" `Hspec.shouldSatisfy` Either.isLeft
− source/libraries/spec/Saturn/Unstable/Extra/TimeSpec.hs
@@ -1,29 +0,0 @@-module Saturn.Unstable.Extra.TimeSpec where--import qualified Data.Time as Time-import qualified Saturn.Unstable.Extra.Time as Time-import qualified Test.Hspec as Hspec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Extra.Time" $ do- Hspec.describe "dayOfWeekToWord8" $ do- Hspec.it "works with Sunday" $ do- Time.dayOfWeekToWord8 Time.Sunday `Hspec.shouldBe` 0-- Hspec.it "works with Monday" $ do- Time.dayOfWeekToWord8 Time.Monday `Hspec.shouldBe` 1-- Hspec.it "works with Tuesday" $ do- Time.dayOfWeekToWord8 Time.Tuesday `Hspec.shouldBe` 2-- Hspec.it "works with Wednesday" $ do- Time.dayOfWeekToWord8 Time.Wednesday `Hspec.shouldBe` 3-- Hspec.it "works with Thursday" $ do- Time.dayOfWeekToWord8 Time.Thursday `Hspec.shouldBe` 4-- Hspec.it "works with Friday" $ do- Time.dayOfWeekToWord8 Time.Friday `Hspec.shouldBe` 5-- Hspec.it "works with Saturday" $ do- Time.dayOfWeekToWord8 Time.Saturday `Hspec.shouldBe` 6
− source/libraries/spec/Saturn/Unstable/Extra/TupleSpec.hs
@@ -1,20 +0,0 @@-module Saturn.Unstable.Extra.TupleSpec where--import qualified Saturn.Unstable.Extra.Tuple as Tuple-import qualified Test.Hspec as Hspec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Extra.Tuple" $ do- Hspec.describe "mapBoth" $ do- Hspec.it "works" $ do- Tuple.mapBoth succ ('A', 'a') `Hspec.shouldBe` ('B', 'b')-- Hspec.describe "toSequence" $ do- Hspec.it "works" $ do- Tuple.toSequence ('b', 'd') `Hspec.shouldBe` "bcd"-- Hspec.it "works with singleton" $ do- Tuple.toSequence ('a', 'a') `Hspec.shouldBe` "a"-- Hspec.it "works with empty" $ do- Tuple.toSequence ('b', 'a') `Hspec.shouldBe` ""
− source/libraries/spec/Saturn/Unstable/MatchSpec.hs
@@ -1,484 +0,0 @@-module Saturn.Unstable.MatchSpec where--import qualified Data.Fixed as Fixed-import qualified Data.Time as Time-import qualified Data.Time.Calendar.WeekDate as Time-import qualified Saturn.Unstable.Match as Match-import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Match" $ do- Hspec.describe "isMatch" $ do- Hspec.it "is always true with all wildcards"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch utcTime-- Hspec.it "is true when day or weekday matches" $ do- s <- ScheduleSpec.new [] [] [[5]] [] [[5]]- t1 <- newUtcTime 1970 1 5 0 0 0- s `Hspec.shouldSatisfy` Match.isMatch t1- t2 <- newUtcTime 1970 1 2 0 0 0- s `Hspec.shouldSatisfy` Match.isMatch t2-- Hspec.describe "minute" $ do- Hspec.it "is always true when a number matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [[5]] [] [] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withMinute 5 utcTime)-- Hspec.it "is always true when a range matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [[4, 5]] [] [] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withMinute 5 utcTime)-- Hspec.it "is always true when a choice matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [[4], [5]] [] [] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withMinute 5 utcTime)-- Hspec.it "is true when a number matches" $ do- t <- newUtcTime 1970 1 1 0 5 0- s <- ScheduleSpec.new [[5]] [] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a number does not match" $ do- t <- newUtcTime 1970 1 1 0 6 0- s <- ScheduleSpec.new [[5]] [] [] [] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a range matches" $ do- t <- newUtcTime 1970 1 1 0 5 0- s <- ScheduleSpec.new [[4, 5]] [] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a range does not match" $ do- t <- newUtcTime 1970 1 1 0 6 0- s <- ScheduleSpec.new [[4, 5]] [] [] [] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a choice matches" $ do- t <- newUtcTime 1970 1 1 0 5 0- s <- ScheduleSpec.new [[4], [5]] [] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a choice does not match" $ do- t <- newUtcTime 1970 1 1 0 6 0- s <- ScheduleSpec.new [[4], [5]] [] [] [] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "accepts any second" $ do- t <- newUtcTime 1970 1 1 0 5 6- s <- ScheduleSpec.new [[5]] [] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any hour" $ do- t <- newUtcTime 1970 1 1 6 5 0- s <- ScheduleSpec.new [[5]] [] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any day" $ do- t <- newUtcTime 1970 1 6 0 5 0- s <- ScheduleSpec.new [[5]] [] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any month" $ do- t <- newUtcTime 1970 6 1 0 5 0- s <- ScheduleSpec.new [[5]] [] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.describe "hour" $ do- Hspec.it "is always true when a number matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [[5]] [] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withHour 5 utcTime)-- Hspec.it "is always true when a range matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [[4, 5]] [] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withHour 5 utcTime)-- Hspec.it "is always true when a choice matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [[4], [5]] [] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withHour 5 utcTime)-- Hspec.it "is true when a number matches" $ do- t <- newUtcTime 1970 1 1 5 0 0- s <- ScheduleSpec.new [] [[5]] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a number does not match" $ do- t <- newUtcTime 1970 1 1 6 0 0- s <- ScheduleSpec.new [] [[5]] [] [] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a range matches" $ do- t <- newUtcTime 1970 1 1 5 0 0- s <- ScheduleSpec.new [] [[4, 5]] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a range does not match" $ do- t <- newUtcTime 1970 1 1 6 0 0- s <- ScheduleSpec.new [] [[4, 5]] [] [] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a choice matches" $ do- t <- newUtcTime 1970 1 1 5 0 0- s <- ScheduleSpec.new [] [[4], [5]] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a choice does not match" $ do- t <- newUtcTime 1970 1 1 6 0 0- s <- ScheduleSpec.new [] [[4], [5]] [] [] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "accepts any second" $ do- t <- newUtcTime 1970 1 1 5 0 6- s <- ScheduleSpec.new [] [[5]] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any minute" $ do- t <- newUtcTime 1970 1 1 5 6 0- s <- ScheduleSpec.new [] [[5]] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any day" $ do- t <- newUtcTime 1970 1 6 5 0 0- s <- ScheduleSpec.new [] [[5]] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any month" $ do- t <- newUtcTime 1970 6 1 5 0 0- s <- ScheduleSpec.new [] [[5]] [] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.describe "day" $ do- Hspec.it "is always true when a number matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [[5]] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfMonth 5 utcTime)-- Hspec.it "is always true when a range matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [[4, 5]] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfMonth 5 utcTime)-- Hspec.it "is always true when a choice matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [[4], [5]] [] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfMonth 5 utcTime)-- Hspec.it "is true when a number matches" $ do- t <- newUtcTime 1970 1 5 0 0 0- s <- ScheduleSpec.new [] [] [[5]] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a number does not match" $ do- t <- newUtcTime 1970 1 6 0 0 0- s <- ScheduleSpec.new [] [] [[5]] [] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a range matches" $ do- t <- newUtcTime 1970 1 5 0 0 0- s <- ScheduleSpec.new [] [] [[4, 5]] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a range does not match" $ do- t <- newUtcTime 1970 1 6 0 0 0- s <- ScheduleSpec.new [] [] [[4, 5]] [] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a choice matches" $ do- t <- newUtcTime 1970 1 5 0 0 0- s <- ScheduleSpec.new [] [] [[4], [5]] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a choice does not match" $ do- t <- newUtcTime 1970 1 6 0 0 0- s <- ScheduleSpec.new [] [] [[4], [5]] [] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "accepts any second" $ do- t <- newUtcTime 1970 1 5 0 0 6- s <- ScheduleSpec.new [] [] [[5]] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any minute" $ do- t <- newUtcTime 1970 1 5 0 6 0- s <- ScheduleSpec.new [] [] [[5]] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any hour" $ do- t <- newUtcTime 1970 1 5 6 0 0- s <- ScheduleSpec.new [] [] [[5]] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any month" $ do- t <- newUtcTime 1970 6 5 0 0 0- s <- ScheduleSpec.new [] [] [[5]] [] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.describe "month" $ do- Hspec.it "is always true when a number matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [] [[5]] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withMonthOfYear 5 utcTime)-- Hspec.it "is always true when a range matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [] [[4, 5]] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withMonthOfYear 5 utcTime)-- Hspec.it "is always true when a choice matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [] [[4], [5]] []- schedule `Hspec.shouldSatisfy` Match.isMatch (withMonthOfYear 5 utcTime)-- Hspec.it "is true when a number matches" $ do- t <- newUtcTime 1970 5 1 0 0 0- s <- ScheduleSpec.new [] [] [] [[5]] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a number does not match" $ do- t <- newUtcTime 1970 6 1 0 0 0- s <- ScheduleSpec.new [] [] [] [[5]] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a range matches" $ do- t <- newUtcTime 1970 5 1 0 0 0- s <- ScheduleSpec.new [] [] [] [[4, 5]] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a range does not match" $ do- t <- newUtcTime 1970 6 1 0 0 0- s <- ScheduleSpec.new [] [] [] [[4, 5]] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a choice matches" $ do- t <- newUtcTime 1970 5 1 0 0 0- s <- ScheduleSpec.new [] [] [] [[4], [5]] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a choice does not match" $ do- t <- newUtcTime 1970 6 1 0 0 0- s <- ScheduleSpec.new [] [] [] [[4], [5]] []- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "accepts any second" $ do- t <- newUtcTime 1970 5 1 0 0 6- s <- ScheduleSpec.new [] [] [] [[5]] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any minute" $ do- t <- newUtcTime 1970 5 1 0 6 0- s <- ScheduleSpec.new [] [] [] [[5]] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any hour" $ do- t <- newUtcTime 1970 5 1 6 0 0- s <- ScheduleSpec.new [] [] [] [[5]] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any day" $ do- t <- newUtcTime 1970 5 6 0 0 0- s <- ScheduleSpec.new [] [] [] [[5]] []- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.describe "weekday" $ do- Hspec.it "is always true when a number matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [] [] [[5]]- schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfWeek Time.Friday utcTime)-- Hspec.it "is always true when a range matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [] [] [[4, 5]]- schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfWeek Time.Friday utcTime)-- Hspec.it "is always true when a choice matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \utcTime -> do- schedule <- ScheduleSpec.new [] [] [] [] [[4], [5]]- schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfWeek Time.Friday utcTime)-- Hspec.it "is true when a number matches" $ do- t <- newUtcTime 1970 1 2 0 0 0- s <- ScheduleSpec.new [] [] [] [] [[5]]- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a number does not match" $ do- t <- newUtcTime 1970 1 3 0 0 0- s <- ScheduleSpec.new [] [] [] [] [[5]]- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a range matches" $ do- t <- newUtcTime 1970 1 2 0 0 0- s <- ScheduleSpec.new [] [] [] [] [[4, 5]]- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a range does not match" $ do- t <- newUtcTime 1970 1 3 0 0 0- s <- ScheduleSpec.new [] [] [] [] [[4, 5]]- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "is true when a choice matches" $ do- t <- newUtcTime 1970 1 2 0 0 0- s <- ScheduleSpec.new [] [] [] [] [[4], [5]]- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "is false when a choice does not match" $ do- t <- newUtcTime 1970 1 3 0 0 0- s <- ScheduleSpec.new [] [] [] [] [[4], [5]]- s `Hspec.shouldNotSatisfy` Match.isMatch t-- Hspec.it "accepts any second" $ do- t <- newUtcTime 1970 1 2 0 0 6- s <- ScheduleSpec.new [] [] [] [] [[5]]- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any minute" $ do- t <- newUtcTime 1970 1 2 0 6 0- s <- ScheduleSpec.new [] [] [] [] [[5]]- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any hour" $ do- t <- newUtcTime 1970 1 2 6 0 0- s <- ScheduleSpec.new [] [] [] [] [[5]]- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.it "accepts any day" $ do- t <- newUtcTime 1970 1 9 0 0 0- s <- ScheduleSpec.new [] [] [] [] [[5]]- s `Hspec.shouldSatisfy` Match.isMatch t-- Hspec.describe "nextMatch" $ do- Hspec.it "succeeds with a leap day" $ do- s <- ScheduleSpec.new [[0]] [[0]] [[29]] [[2]] []- t1 <- newUtcTime 1970 1 1 0 0 0- t2 <- newUtcTime 1972 2 29 0 0 0- Match.nextMatch t1 s `Hspec.shouldBe` Just t2-- Hspec.it "succeeds with the next leap day" $ do- s <- ScheduleSpec.new [[0]] [[0]] [[29]] [[2]] []- t1 <- newUtcTime 1972 2 29 0 0 0- t2 <- newUtcTime 1976 2 29 0 0 0- Match.nextMatch t1 s `Hspec.shouldBe` Just t2-- Hspec.it "succeeds with the furthest leap day" $ do- s <- ScheduleSpec.new [[0]] [[0]] [[29]] [[2]] []- t1 <- newUtcTime 1896 2 29 0 0 0- t2 <- newUtcTime 1904 2 29 0 0 0- Match.nextMatch t1 s `Hspec.shouldBe` Just t2-- Hspec.it "fails with an impossible date" $ do- s <- ScheduleSpec.new [[0]] [[0]] [[30]] [[2]] []- t <- newUtcTime 1970 1 1 0 0 0- Match.nextMatch t s `Hspec.shouldBe` Nothing-- Hspec.it "is always in the future"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \t1 -> do- schedule <- ScheduleSpec.new [] [] [] [] []- t2 <- maybe (fail "impossible") pure $ Match.nextMatch t1 schedule- t2 `Hspec.shouldSatisfy` (>= t1)-- Hspec.it "always matches"- . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime- $ \t1 -> do- schedule <- ScheduleSpec.new [] [] [] [] []- t2 <- maybe (fail "impossible") pure $ Match.nextMatch t1 schedule- schedule `Hspec.shouldSatisfy` Match.isMatch t2--withMinute :: Int -> Time.UTCTime -> Time.UTCTime-withMinute minute = overTimeOfDay $ \timeOfDay -> timeOfDay {Time.todMin = minute}--withHour :: Int -> Time.UTCTime -> Time.UTCTime-withHour hour = overTimeOfDay $ \timeOfDay -> timeOfDay {Time.todHour = hour}--overTimeOfDay :: (Time.TimeOfDay -> Time.TimeOfDay) -> Time.UTCTime -> Time.UTCTime-overTimeOfDay f utcTime =- utcTime- { Time.utctDayTime =- Time.sinceMidnight . f . Time.pastMidnight $ Time.utctDayTime utcTime- }--withDayOfMonth :: Time.DayOfMonth -> Time.UTCTime -> Time.UTCTime-withDayOfMonth dayOfMonth = overDay $ \day ->- let (year, monthOfYear, _) = Time.toGregorian day- in Time.fromGregorian year monthOfYear dayOfMonth--withMonthOfYear :: Time.MonthOfYear -> Time.UTCTime -> Time.UTCTime-withMonthOfYear monthOfYear = overDay $ \day ->- let (year, _, dayOfMonth) = Time.toGregorian day- in Time.fromGregorian year monthOfYear dayOfMonth--withDayOfWeek :: Time.DayOfWeek -> Time.UTCTime -> Time.UTCTime-withDayOfWeek dayOfWeek = overDay $ \day ->- let fwt = Time.FirstWholeWeek- dow = Time.Sunday- (year, weekOfYear, _) = Time.toWeekCalendar fwt dow day- in Time.fromWeekCalendar fwt dow year weekOfYear dayOfWeek--overDay :: (Time.Day -> Time.Day) -> Time.UTCTime -> Time.UTCTime-overDay f utcTime = utcTime {Time.utctDay = f $ Time.utctDay utcTime}--newUtcTime ::- (MonadFail m) =>- Time.Year ->- Time.MonthOfYear ->- Time.DayOfMonth ->- Int ->- Int ->- Fixed.Pico ->- m Time.UTCTime-newUtcTime year monthOfYear dayOfMonth hour minute second = do- day <-- maybe (fail "invalid Day") pure $- Time.fromGregorianValid year monthOfYear dayOfMonth- timeOfDay <-- maybe (fail "invalid TimeOfDay") pure $- Time.makeTimeOfDayValid hour minute second- pure- Time.UTCTime- { Time.utctDay = day,- Time.utctDayTime = Time.sinceMidnight timeOfDay- }--arbitraryUtcTime :: QuickCheck.Gen Time.UTCTime-arbitraryUtcTime =- Time.UTCTime- <$> fmap Time.ModifiedJulianDay QuickCheck.arbitrary- <*> fmap Time.picosecondsToDiffTime (QuickCheck.chooseInteger (0, 86400000000000000 - 1))--shrinkUtcTime :: Time.UTCTime -> [Time.UTCTime]-shrinkUtcTime =- QuickCheck.shrinkMap- ( \(d, t) ->- Time.UTCTime- { Time.utctDay = Time.ModifiedJulianDay d,- Time.utctDayTime = Time.picosecondsToDiffTime t- }- )- ( \x ->- ( Time.toModifiedJulianDay $ Time.utctDay x,- Time.diffTimeToPicoseconds $ Time.utctDayTime x- )- )
− source/libraries/spec/Saturn/Unstable/ParseSpec.hs
@@ -1,214 +0,0 @@-module Saturn.Unstable.ParseSpec where--import qualified Data.Either as Either-import qualified Saturn.Unstable.Parse as Parse-import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec-import qualified Test.Hspec as Hspec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Parse" $ do- Hspec.describe "fromString" $ do- Hspec.it "accepts wildcards" $ do- schedule <- ScheduleSpec.new [] [] [] [] []- Parse.fromString "* * * * *" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts extra spaces" $ do- schedule <- ScheduleSpec.new [] [] [] [] []- Parse.fromString " * * * * * " `Hspec.shouldBe` Right schedule-- Hspec.it "accepts numbers" $ do- schedule <- ScheduleSpec.new [[4]] [[3]] [[2]] [[1]] [[0]]- Parse.fromString "4 3 2 1 0" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts ranges" $ do- schedule <- ScheduleSpec.new [[8, 9]] [[6, 7]] [[4, 5]] [[2, 3]] [[0, 1]]- Parse.fromString "8-9 6-7 4-5 2-3 0-1" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts choices" $ do- schedule <- ScheduleSpec.new [[8], [9]] [[6], [7]] [[4], [5]] [[2], [3]] [[0], [1]]- Parse.fromString "8,9 6,7 4,5 2,3 0,1" `Hspec.shouldBe` Right schedule-- Hspec.describe "minute" $ do- Hspec.it "accepts a number" $ do- schedule <- ScheduleSpec.new [[0]] [] [] [] []- Parse.fromString "0 * * * *" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a range" $ do- schedule <- ScheduleSpec.new [[0, 1]] [] [] [] []- Parse.fromString "0-1 * * * *" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a choice" $ do- schedule <- ScheduleSpec.new [[0], [1]] [] [] [] []- Parse.fromString "0,1 * * * *" `Hspec.shouldBe` Right schedule-- Hspec.it "rejects two wildcards" $ do- Parse.fromString "*,* * * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a number" $ do- Parse.fromString "*,0 * * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a range" $ do- Parse.fromString "*,0-0 * * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number" $ do- Parse.fromString "60 * * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number as part of a choice" $ do- Parse.fromString "0,60 * * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds range" $ do- Parse.fromString "60-61 * * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a half out of bounds range" $ do- Parse.fromString "0-60 * * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a backwards range" $ do- Parse.fromString "1-0 * * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.describe "hour" $ do- Hspec.it "accepts a number" $ do- schedule <- ScheduleSpec.new [] [[0]] [] [] []- Parse.fromString "* 0 * * *" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a range" $ do- schedule <- ScheduleSpec.new [] [[0, 1]] [] [] []- Parse.fromString "* 0-1 * * *" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a choice" $ do- schedule <- ScheduleSpec.new [] [[0], [1]] [] [] []- Parse.fromString "* 0,1 * * *" `Hspec.shouldBe` Right schedule-- Hspec.it "rejects two wildcards" $ do- Parse.fromString "* *,* * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a number" $ do- Parse.fromString "* *,0 * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a range" $ do- Parse.fromString "* *,0-0 * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number" $ do- Parse.fromString "* 24 * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number as part of a choice" $ do- Parse.fromString "* 0,24 * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds range" $ do- Parse.fromString "* 24-25 * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a half out of bounds range" $ do- Parse.fromString "* 0-24 * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a backwards range" $ do- Parse.fromString "* 1-0 * * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.describe "day" $ do- Hspec.it "accepts a number" $ do- schedule <- ScheduleSpec.new [] [] [[1]] [] []- Parse.fromString "* * 1 * *" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a range" $ do- schedule <- ScheduleSpec.new [] [] [[1, 2]] [] []- Parse.fromString "* * 1-2 * *" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a choice" $ do- schedule <- ScheduleSpec.new [] [] [[1], [2]] [] []- Parse.fromString "* * 1,2 * *" `Hspec.shouldBe` Right schedule-- Hspec.it "rejects two wildcards" $ do- Parse.fromString "* * *,* * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a number" $ do- Parse.fromString "* * *,1 * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a range" $ do- Parse.fromString "* * *,1-1 * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number" $ do- Parse.fromString "* * 32 * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number as part of a choice" $ do- Parse.fromString "* * 1,32 * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds range" $ do- Parse.fromString "* * 32-33 * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a half out of bounds range" $ do- Parse.fromString "* * 1-32 * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a backwards range" $ do- Parse.fromString "* * 2-1 * *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.describe "month" $ do- Hspec.it "accepts a number" $ do- schedule <- ScheduleSpec.new [] [] [] [[1]] []- Parse.fromString "* * * 1 *" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a range" $ do- schedule <- ScheduleSpec.new [] [] [] [[1, 2]] []- Parse.fromString "* * * 1-2 *" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a choice" $ do- schedule <- ScheduleSpec.new [] [] [] [[1], [2]] []- Parse.fromString "* * * 1,2 *" `Hspec.shouldBe` Right schedule-- Hspec.it "rejects two wildcards" $ do- Parse.fromString "* * * *,* *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a number" $ do- Parse.fromString "* * * *,1 *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a range" $ do- Parse.fromString "* * * *,1-1 *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number" $ do- Parse.fromString "* * * 13 *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number as part of a choice" $ do- Parse.fromString "* * * 1,13 *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds range" $ do- Parse.fromString "* * * 13-14 *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a half out of bounds range" $ do- Parse.fromString "* * * 1-13 *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a backwards range" $ do- Parse.fromString "* * * 2-1 *" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.describe "weekday" $ do- Hspec.it "accepts a number" $ do- schedule <- ScheduleSpec.new [] [] [] [] [[0]]- Parse.fromString "* * * * 0" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a range" $ do- schedule <- ScheduleSpec.new [] [] [] [] [[0, 1]]- Parse.fromString "* * * * 0-1" `Hspec.shouldBe` Right schedule-- Hspec.it "accepts a choice" $ do- schedule <- ScheduleSpec.new [] [] [] [] [[0], [1]]- Parse.fromString "* * * * 0,1" `Hspec.shouldBe` Right schedule-- Hspec.it "rejects two wildcards" $ do- Parse.fromString "* * * * *,*" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a number" $ do- Parse.fromString "* * * * *,0" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a wildcard and a range" $ do- Parse.fromString "* * * * *,0-0" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number" $ do- Parse.fromString "* * * * 7" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds number as part of a choice" $ do- Parse.fromString "* * * * 0,7" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects an out of bounds range" $ do- Parse.fromString "* * * * 7-8" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a half out of bounds range" $ do- Parse.fromString "* * * * 0-7" `Hspec.shouldSatisfy` Either.isLeft-- Hspec.it "rejects a backwards range" $ do- Parse.fromString "* * * * 1-0" `Hspec.shouldSatisfy` Either.isLeft
− source/libraries/spec/Saturn/Unstable/RenderSpec.hs
@@ -1,24 +0,0 @@-module Saturn.Unstable.RenderSpec where--import qualified Saturn.Unstable.Render as Render-import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec-import qualified Test.Hspec as Hspec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Render" $ do- Hspec.describe "toString" $ do- Hspec.it "works with wildcards" $ do- schedule <- ScheduleSpec.new [] [] [] [] []- Render.toString schedule `Hspec.shouldBe` "* * * * *"-- Hspec.it "works with numbers" $ do- schedule <- ScheduleSpec.new [[4]] [[3]] [[2]] [[1]] [[0]]- Render.toString schedule `Hspec.shouldBe` "4 3 2 1 0"-- Hspec.it "works with ranges" $ do- schedule <- ScheduleSpec.new [[8, 9]] [[6, 7]] [[4, 5]] [[2, 3]] [[0, 1]]- Render.toString schedule `Hspec.shouldBe` "8-9 6-7 4-5 2-3 0-1"-- Hspec.it "works with choices" $ do- schedule <- ScheduleSpec.new [[8], [9]] [[6], [7]] [[4], [5]] [[2], [3]] [[0], [1]]- Render.toString schedule `Hspec.shouldBe` "8,9 6,7 4,5 2,3 0,1"
− source/libraries/spec/Saturn/Unstable/Type/DaySpec.hs
@@ -1,29 +0,0 @@-module Saturn.Unstable.Type.DaySpec where--import qualified Data.Maybe as Maybe-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.Day as Day-import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Day" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Day.parsec "" (Builder.toLazyText $ Day.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Day.Day-arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Day.fromField--shrink :: Day.Day -> [Day.Day]-shrink = Maybe.mapMaybe Day.fromField . FieldSpec.shrink . Day.toField--new :: (MonadFail m) => [[Word.Word8]] -> m Day.Day-new xs = do- field <- FieldSpec.new xs- maybe (fail $ "invalid Day: " <> show xs) pure $ Day.fromField field
− source/libraries/spec/Saturn/Unstable/Type/ElementSpec.hs
@@ -1,45 +0,0 @@-module Saturn.Unstable.Type.ElementSpec where--import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.Element as Element-import qualified Saturn.Unstable.Type.Number as Number-import qualified Saturn.Unstable.Type.NumberSpec as NumberSpec-import qualified Saturn.Unstable.Type.Range as Range-import qualified Saturn.Unstable.Type.RangeSpec as RangeSpec-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Element" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Element.parsec "" (Builder.toLazyText $ Element.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Element.Element-arbitrary =- Element.fromEither- <$> QuickCheck.liftArbitrary2- RangeSpec.arbitrary- NumberSpec.arbitrary--shrink :: Element.Element -> [Element.Element]-shrink element =- let xs = case Element.toEither element of- Left range ->- let (lo, hi) = Range.toTuple range- in fmap (Element.fromEither . Right) [lo, hi]- Right _ -> []- in mappend xs- . fmap Element.fromEither- . QuickCheck.liftShrink2 RangeSpec.shrink NumberSpec.shrink- $ Element.toEither element--new :: (MonadFail m) => [Word.Word8] -> m Element.Element-new xs = case xs of- [x] -> pure . Element.fromEither . Right $ Number.fromWord8 x- [x, y] -> Element.fromEither . Left <$> RangeSpec.new (x, y)- _ -> fail $ "invalid Element: " <> show xs
− source/libraries/spec/Saturn/Unstable/Type/FieldSpec.hs
@@ -1,53 +0,0 @@-module Saturn.Unstable.Type.FieldSpec where--import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Maybe as Maybe-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.ElementSpec as ElementSpec-import qualified Saturn.Unstable.Type.Field as Field-import qualified Saturn.Unstable.Type.Wildcard as Wildcard-import qualified Saturn.Unstable.Type.WildcardSpec as WildcardSpec-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Field" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Field.parsec "" (Builder.toLazyText $ Field.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Field.Field-arbitrary =- Field.fromEither- <$> QuickCheck.liftArbitrary2- WildcardSpec.arbitrary- (arbitraryNonEmpty ElementSpec.arbitrary)--arbitraryNonEmpty :: QuickCheck.Gen a -> QuickCheck.Gen (NonEmpty.NonEmpty a)-arbitraryNonEmpty g = (NonEmpty.:|) <$> g <*> QuickCheck.listOf g--shrink :: Field.Field -> [Field.Field]-shrink field =- let xs = case Field.toEither field of- Left _ -> []- Right _ -> [Field.fromEither . Left $ Wildcard.fromUnit ()]- in mappend xs- . fmap Field.fromEither- . QuickCheck.liftShrink2 WildcardSpec.shrink (shrinkNonEmpty ElementSpec.shrink)- $ Field.toEither field--shrinkNonEmpty :: (a -> [a]) -> NonEmpty.NonEmpty a -> [NonEmpty.NonEmpty a]-shrinkNonEmpty f = Maybe.mapMaybe (NonEmpty.nonEmpty . f) . NonEmpty.toList--new :: (MonadFail m) => [[Word.Word8]] -> m Field.Field-new =- fmap- ( Field.fromEither- . maybe (Left $ Wildcard.fromUnit ()) Right- . NonEmpty.nonEmpty- )- . mapM ElementSpec.new
− source/libraries/spec/Saturn/Unstable/Type/HourSpec.hs
@@ -1,29 +0,0 @@-module Saturn.Unstable.Type.HourSpec where--import qualified Data.Maybe as Maybe-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec-import qualified Saturn.Unstable.Type.Hour as Hour-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Hour" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Hour.parsec "" (Builder.toLazyText $ Hour.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Hour.Hour-arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Hour.fromField--shrink :: Hour.Hour -> [Hour.Hour]-shrink = Maybe.mapMaybe Hour.fromField . FieldSpec.shrink . Hour.toField--new :: (MonadFail m) => [[Word.Word8]] -> m Hour.Hour-new xs = do- field <- FieldSpec.new xs- maybe (fail $ "invalid Hour: " <> show xs) pure $ Hour.fromField field
− source/libraries/spec/Saturn/Unstable/Type/MinuteSpec.hs
@@ -1,29 +0,0 @@-module Saturn.Unstable.Type.MinuteSpec where--import qualified Data.Maybe as Maybe-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec-import qualified Saturn.Unstable.Type.Minute as Minute-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Minute" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Minute.parsec "" (Builder.toLazyText $ Minute.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Minute.Minute-arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Minute.fromField--shrink :: Minute.Minute -> [Minute.Minute]-shrink = Maybe.mapMaybe Minute.fromField . FieldSpec.shrink . Minute.toField--new :: (MonadFail m) => [[Word.Word8]] -> m Minute.Minute-new xs = do- field <- FieldSpec.new xs- maybe (fail $ "invalid Minute: " <> show xs) pure $ Minute.fromField field
− source/libraries/spec/Saturn/Unstable/Type/MonthSpec.hs
@@ -1,29 +0,0 @@-module Saturn.Unstable.Type.MonthSpec where--import qualified Data.Maybe as Maybe-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec-import qualified Saturn.Unstable.Type.Month as Month-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Month" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Month.parsec "" (Builder.toLazyText $ Month.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Month.Month-arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Month.fromField--shrink :: Month.Month -> [Month.Month]-shrink = Maybe.mapMaybe Month.fromField . FieldSpec.shrink . Month.toField--new :: (MonadFail m) => [[Word.Word8]] -> m Month.Month-new xs = do- field <- FieldSpec.new xs- maybe (fail $ "invalid Month: " <> show xs) pure $ Month.fromField field
− source/libraries/spec/Saturn/Unstable/Type/NumberSpec.hs
@@ -1,21 +0,0 @@-module Saturn.Unstable.Type.NumberSpec where--import qualified Data.Text.Lazy.Builder as Builder-import qualified Saturn.Unstable.Type.Number as Number-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Number" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Number.parsec "" (Builder.toLazyText $ Number.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Number.Number-arbitrary = Number.fromWord8 <$> QuickCheck.arbitrary--shrink :: Number.Number -> [Number.Number]-shrink = fmap Number.fromWord8 . QuickCheck.shrink . Number.toWord8
− source/libraries/spec/Saturn/Unstable/Type/RangeSpec.hs
@@ -1,38 +0,0 @@-module Saturn.Unstable.Type.RangeSpec where--import qualified Data.Maybe as Maybe-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Extra.Tuple as Tuple-import qualified Saturn.Unstable.Type.Number as Number-import qualified Saturn.Unstable.Type.NumberSpec as NumberSpec-import qualified Saturn.Unstable.Type.Range as Range-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Range" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Range.parsec "" (Builder.toLazyText $ Range.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Range.Range-arbitrary =- QuickCheck.suchThatMap- (QuickCheck.liftArbitrary2 NumberSpec.arbitrary NumberSpec.arbitrary)- Range.fromTuple--shrink :: Range.Range -> [Range.Range]-shrink =- Maybe.mapMaybe Range.fromTuple- . QuickCheck.liftShrink2 NumberSpec.shrink NumberSpec.shrink- . Range.toTuple--new :: (MonadFail m) => (Word.Word8, Word.Word8) -> m Range.Range-new tuple =- maybe (fail $ "invalid Range: " <> show tuple) pure- . Range.fromTuple- $ Tuple.mapBoth Number.fromWord8 tuple
− source/libraries/spec/Saturn/Unstable/Type/ScheduleSpec.hs
@@ -1,85 +0,0 @@-module Saturn.Unstable.Type.ScheduleSpec where--import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.DaySpec as DaySpec-import qualified Saturn.Unstable.Type.HourSpec as HourSpec-import qualified Saturn.Unstable.Type.MinuteSpec as MinuteSpec-import qualified Saturn.Unstable.Type.MonthSpec as MonthSpec-import qualified Saturn.Unstable.Type.Schedule as Schedule-import qualified Saturn.Unstable.Type.WeekdaySpec as WeekdaySpec-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Schedule" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Schedule.parsec "" (Builder.toLazyText $ Schedule.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Schedule.Schedule-arbitrary =- Schedule.Schedule- <$> MinuteSpec.arbitrary- <*> HourSpec.arbitrary- <*> DaySpec.arbitrary- <*> MonthSpec.arbitrary- <*> WeekdaySpec.arbitrary--shrink :: Schedule.Schedule -> [Schedule.Schedule]-shrink schedule =- ( \(minute, hour, day, month, weekday) ->- Schedule.Schedule- { Schedule.minute = minute,- Schedule.hour = hour,- Schedule.day = day,- Schedule.month = month,- Schedule.weekday = weekday- }- )- <$> liftShrink5- MinuteSpec.shrink- HourSpec.shrink- DaySpec.shrink- MonthSpec.shrink- WeekdaySpec.shrink- ( Schedule.minute schedule,- Schedule.hour schedule,- Schedule.day schedule,- Schedule.month schedule,- Schedule.weekday schedule- )--liftShrink5 ::- (t1 -> [t1]) ->- (t2 -> [t2]) ->- (t3 -> [t3]) ->- (t4 -> [t4]) ->- (t5 -> [t5]) ->- (t1, t2, t3, t4, t5) ->- [(t1, t2, t3, t4, t5)]-liftShrink5 f1 f2 f3 f4 f5 (x1, x2, x3, x4, x5) =- (\((y1, y2), (y3, (y4, y5))) -> (y1, y2, y3, y4, y5))- <$> QuickCheck.liftShrink2- (QuickCheck.liftShrink2 f1 f2)- (QuickCheck.liftShrink2 f3 (QuickCheck.liftShrink2 f4 f5))- ((x1, x2), (x3, (x4, x5)))--new ::- (MonadFail m) =>- [[Word.Word8]] ->- [[Word.Word8]] ->- [[Word.Word8]] ->- [[Word.Word8]] ->- [[Word.Word8]] ->- m Schedule.Schedule-new minutes hours days months weekdays =- Schedule.Schedule- <$> MinuteSpec.new minutes- <*> HourSpec.new hours- <*> DaySpec.new days- <*> MonthSpec.new months- <*> WeekdaySpec.new weekdays
− source/libraries/spec/Saturn/Unstable/Type/WeekdaySpec.hs
@@ -1,29 +0,0 @@-module Saturn.Unstable.Type.WeekdaySpec where--import qualified Data.Maybe as Maybe-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec-import qualified Saturn.Unstable.Type.Weekday as Weekday-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Weekday" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Weekday.parsec "" (Builder.toLazyText $ Weekday.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Weekday.Weekday-arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Weekday.fromField--shrink :: Weekday.Weekday -> [Weekday.Weekday]-shrink = Maybe.mapMaybe Weekday.fromField . FieldSpec.shrink . Weekday.toField--new :: (MonadFail m) => [[Word.Word8]] -> m Weekday.Weekday-new xs = do- field <- FieldSpec.new xs- maybe (fail $ "invalid Weekday: " <> show xs) pure $ Weekday.fromField field
− source/libraries/spec/Saturn/Unstable/Type/WildcardSpec.hs
@@ -1,21 +0,0 @@-module Saturn.Unstable.Type.WildcardSpec where--import qualified Data.Text.Lazy.Builder as Builder-import qualified Saturn.Unstable.Type.Wildcard as Wildcard-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck-import qualified Text.Parsec as Parsec--spec :: Hspec.Spec-spec = Hspec.describe "Saturn.Unstable.Type.Wildcard" $ do- Hspec.it "round trips"- . QuickCheck.forAllShrink arbitrary shrink- $ \x -> do- Parsec.parse Wildcard.parsec "" (Builder.toLazyText $ Wildcard.toBuilder x)- `Hspec.shouldBe` Right x--arbitrary :: QuickCheck.Gen Wildcard.Wildcard-arbitrary = Wildcard.fromUnit <$> QuickCheck.arbitrary--shrink :: Wildcard.Wildcard -> [Wildcard.Wildcard]-shrink = fmap Wildcard.fromUnit . QuickCheck.shrink . Wildcard.toUnit
− source/libraries/spec/SaturnSpec.hs
@@ -1,25 +0,0 @@-module SaturnSpec where--import qualified Saturn.Unstable.Parse as Parse-import qualified Saturn.Unstable.Render as Render-import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec-import qualified Test.Hspec as Hspec-import qualified Test.QuickCheck as QuickCheck--spec :: Hspec.Spec-spec = Hspec.describe "Saturn" $ do- Hspec.describe "round trips" $ do- Hspec.it "through string"- . QuickCheck.forAllShrink ScheduleSpec.arbitrary ScheduleSpec.shrink- $ \schedule ->- Parse.fromString (Render.toString schedule) `Hspec.shouldBe` Right schedule-- Hspec.it "through strict text"- . QuickCheck.forAllShrink ScheduleSpec.arbitrary ScheduleSpec.shrink- $ \schedule ->- Parse.fromText (Render.toText schedule) `Hspec.shouldBe` Right schedule-- Hspec.it "through lazy text"- . QuickCheck.forAllShrink ScheduleSpec.arbitrary ScheduleSpec.shrink- $ \schedule ->- Parse.fromLazyText (Render.toLazyText schedule) `Hspec.shouldBe` Right schedule
− source/libraries/unstable/Saturn/Unstable/Constant.hs
@@ -1,96 +0,0 @@-module Saturn.Unstable.Constant where--import qualified Data.Maybe as Maybe-import qualified Saturn.Unstable.Type.Day as Day-import qualified Saturn.Unstable.Type.Element as Element-import qualified Saturn.Unstable.Type.Field as Field-import qualified Saturn.Unstable.Type.Hour as Hour-import qualified Saturn.Unstable.Type.Minute as Minute-import qualified Saturn.Unstable.Type.Month as Month-import qualified Saturn.Unstable.Type.Number as Number-import qualified Saturn.Unstable.Type.Schedule as Schedule-import qualified Saturn.Unstable.Type.Weekday as Weekday-import qualified Saturn.Unstable.Type.Wildcard as Wildcard---- | > "* * * * *"-everyMinute :: Schedule.Schedule-everyMinute = Maybe.fromMaybe (error "Saturn.Unstable.Constant.everyMinute") $ do- let wildcard = Field.fromEither . Left $ Wildcard.fromUnit ()- minute <- Minute.fromField wildcard- hour <- Hour.fromField wildcard- day <- Day.fromField wildcard- month <- Month.fromField wildcard- weekday <- Weekday.fromField wildcard- pure- Schedule.Schedule- { Schedule.minute = minute,- Schedule.hour = hour,- Schedule.day = day,- Schedule.month = month,- Schedule.weekday = weekday- }---- | > "0 * * * *"-hourly :: Schedule.Schedule-hourly = Maybe.fromMaybe (error "Saturn.Unstable.Constant.hourly") $ do- minute <-- Minute.fromField- . Field.fromEither- . Right- . pure- . Element.fromEither- . Right- $ Number.fromWord8 0- pure everyMinute {Schedule.minute = minute}---- | > "0 0 * * *"-daily :: Schedule.Schedule-daily = Maybe.fromMaybe (error "Saturn.Unstable.Constant.daily") $ do- hour <-- Hour.fromField- . Field.fromEither- . Right- . pure- . Element.fromEither- . Right- $ Number.fromWord8 0- pure hourly {Schedule.hour = hour}---- | > "0 0 * * 0"-weekly :: Schedule.Schedule-weekly = Maybe.fromMaybe (error "Saturn.Unstable.Constant.weekly") $ do- weekday <-- Weekday.fromField- . Field.fromEither- . Right- . pure- . Element.fromEither- . Right- $ Number.fromWord8 0- pure daily {Schedule.weekday = weekday}---- | > "0 0 1 * *"-monthly :: Schedule.Schedule-monthly = Maybe.fromMaybe (error "Saturn.Unstable.Constant.monthly") $ do- day <-- Day.fromField- . Field.fromEither- . Right- . pure- . Element.fromEither- . Right- $ Number.fromWord8 1- pure daily {Schedule.day = day}---- | > "0 0 1 1 *"-yearly :: Schedule.Schedule-yearly = Maybe.fromMaybe (error "Saturn.Unstable.Constant.yearly") $ do- month <-- Month.fromField- . Field.fromEither- . Right- . pure- . Element.fromEither- . Right- $ Number.fromWord8 1- pure monthly {Schedule.month = month}
− source/libraries/unstable/Saturn/Unstable/Extra/Int.hs
@@ -1,10 +0,0 @@-module Saturn.Unstable.Extra.Int where--import qualified Data.Bits as Bits-import qualified Data.Word as Word--fromWord8 :: Word.Word8 -> Int-fromWord8 = fromIntegral--toWord8 :: Int -> Maybe Word.Word8-toWord8 = Bits.toIntegralSized
− source/libraries/unstable/Saturn/Unstable/Extra/Ord.hs
@@ -1,4 +0,0 @@-module Saturn.Unstable.Extra.Ord where--within :: (Ord a) => (a, a) -> a -> Bool-within (lo, hi) x = lo <= x && x <= hi
− source/libraries/unstable/Saturn/Unstable/Extra/Parsec.hs
@@ -1,16 +0,0 @@-module Saturn.Unstable.Extra.Parsec where--import qualified Data.List.NonEmpty as NonEmpty-import qualified Text.Parsec as Parsec--either ::- Parsec.ParsecT s u m a ->- Parsec.ParsecT s u m b ->- Parsec.ParsecT s u m (Either a b)-either l r = fmap Left l Parsec.<|> fmap Right r--sepByNE ::- Parsec.ParsecT s u m a ->- Parsec.ParsecT s u m sep ->- Parsec.ParsecT s u m (NonEmpty.NonEmpty a)-sepByNE p s = (NonEmpty.:|) <$> p <*> Parsec.many (s *> p)
− source/libraries/unstable/Saturn/Unstable/Extra/Time.hs
@@ -1,14 +0,0 @@-module Saturn.Unstable.Extra.Time where--import qualified Data.Time as Time-import qualified Data.Word as Word--dayOfWeekToWord8 :: Time.DayOfWeek -> Word.Word8-dayOfWeekToWord8 dayOfWeek = case dayOfWeek of- Time.Sunday -> 0- Time.Monday -> 1- Time.Tuesday -> 2- Time.Wednesday -> 3- Time.Thursday -> 4- Time.Friday -> 5- Time.Saturday -> 6
− source/libraries/unstable/Saturn/Unstable/Extra/Tuple.hs
@@ -1,9 +0,0 @@-module Saturn.Unstable.Extra.Tuple where--import qualified Data.Bifunctor as Bifunctor--mapBoth :: (a -> b) -> (a, a) -> (b, b)-mapBoth f = Bifunctor.bimap f f--toSequence :: (Enum a) => (a, a) -> [a]-toSequence = uncurry enumFromTo
− source/libraries/unstable/Saturn/Unstable/Match.hs
@@ -1,89 +0,0 @@-module Saturn.Unstable.Match where--import qualified Control.Monad as Monad-import qualified Data.List as List-import qualified Data.Maybe as Maybe-import qualified Data.Set as Set-import qualified Data.Time as Time-import qualified Saturn.Unstable.Extra.Int as Int-import qualified Saturn.Unstable.Extra.Time as Time-import qualified Saturn.Unstable.Type.Day as Day-import qualified Saturn.Unstable.Type.Field as Field-import qualified Saturn.Unstable.Type.Hour as Hour-import qualified Saturn.Unstable.Type.Minute as Minute-import qualified Saturn.Unstable.Type.Month as Month-import qualified Saturn.Unstable.Type.Schedule as Schedule-import qualified Saturn.Unstable.Type.Weekday as Weekday-import qualified Saturn.Unstable.Type.Wildcard as Wildcard---- | Returns 'True' if the given 'Time.UTCTime' matches the given--- 'Schedule.Schedule', otherwise returns 'False'.-isMatch :: Time.UTCTime -> Schedule.Schedule -> Bool-isMatch utcTime schedule = Maybe.fromMaybe False $ do- let time = Time.pastMidnight $ Time.utctDayTime utcTime- minute <- Int.toWord8 $ Time.todMin time- Monad.guard . Minute.isMatch minute $ Schedule.minute schedule-- hour <- Int.toWord8 $ Time.todHour time- Monad.guard . Hour.isMatch hour $ Schedule.hour schedule-- let date = Time.utctDay utcTime- let (_, monthOfYear, dayOfMonth) = Time.toGregorian date- month <- Int.toWord8 monthOfYear- Monad.guard . Month.isMatch month $ Schedule.month schedule-- day <- Int.toWord8 dayOfMonth- let dayMatches = Day.isMatch day $ Schedule.day schedule- let weekday = Time.dayOfWeekToWord8 $ Time.dayOfWeek date- let weekdayMatches = Weekday.isMatch weekday $ Schedule.weekday schedule- Monad.guard $- if dayIsWildcard schedule || weekdayIsWildcard schedule- then dayMatches && weekdayMatches- else dayMatches || weekdayMatches-- pure True--dayIsWildcard :: Schedule.Schedule -> Bool-dayIsWildcard = Field.isWildcard . Day.toField . Schedule.day--weekdayIsWildcard :: Schedule.Schedule -> Bool-weekdayIsWildcard = Field.isWildcard . Weekday.toField . Schedule.weekday---- | Looks for the first time after the given 'Time.UTCTime' that matches the--- given 'Schedule.Schedule'. Returns 'Nothing' if the 'Schedule.Schedule' only--- matches dates that cannot happen, like February 30th.-nextMatch :: Time.UTCTime -> Schedule.Schedule -> Maybe Time.UTCTime-nextMatch utcTime schedule =- if dayIsWildcard schedule || weekdayIsWildcard schedule- then incompleteNextMatch utcTime schedule- else do- let wildcard = Field.fromEither . Left $ Wildcard.fromUnit ()- day <- Day.fromField wildcard- weekday <- Weekday.fromField wildcard- Maybe.listToMaybe . List.sort $- Maybe.catMaybes- [ incompleteNextMatch utcTime schedule {Schedule.day = day},- incompleteNextMatch utcTime schedule {Schedule.weekday = weekday}- ]--incompleteNextMatch :: Time.UTCTime -> Schedule.Schedule -> Maybe Time.UTCTime-incompleteNextMatch utcTime schedule = Maybe.listToMaybe $ do- let oldDate = Time.utctDay utcTime- let (oldYear, _, _) = Time.toGregorian oldDate- year <- [oldYear .. oldYear + 8]- month <- fmap Int.fromWord8 . Set.toAscList . Month.expand $ Schedule.month schedule- day <- fmap Int.fromWord8 . Set.toAscList . Day.expand $ Schedule.day schedule- date <- Maybe.maybeToList $ Time.fromGregorianValid year month day- Monad.guard $ date >= oldDate- Monad.guard- . Set.member (Time.dayOfWeekToWord8 $ Time.dayOfWeek date)- . Weekday.expand- $ Schedule.weekday schedule- hour <- fmap Int.fromWord8 . Set.toAscList . Hour.expand $ Schedule.hour schedule- minute <- fmap Int.fromWord8 . Set.toAscList . Minute.expand $ Schedule.minute schedule- time <-- fmap Time.sinceMidnight- . Maybe.maybeToList- $ Time.makeTimeOfDayValid hour minute 0- Monad.when (date == oldDate) . Monad.guard $ time > Time.utctDayTime utcTime- pure Time.UTCTime {Time.utctDay = date, Time.utctDayTime = time}
− source/libraries/unstable/Saturn/Unstable/Parse.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Parse where--import qualified Data.Text as Text-import qualified Data.Text.Lazy as LazyText-import qualified Saturn.Unstable.Type.Schedule as Schedule-import qualified Text.Parsec as Parsec---- | Parses a lazy 'LazyText.Text' value into a 'Schedule.Schedule'. See--- 'fromText' for details.-fromLazyText :: LazyText.Text -> Either Parsec.ParseError Schedule.Schedule-fromLazyText = Parsec.parse parsec ""---- | Parses a 'String' into a 'Schedule.Schedule'. See 'fromText' for details.-fromString :: String -> Either Parsec.ParseError Schedule.Schedule-fromString = Parsec.parse parsec ""---- | Parses a strict 'Text.Text' value into a 'Schedule.Schedule'. The input--- should have five fields, each separated by at least one space. Leading and--- trailing spaces are allowed.-fromText :: Text.Text -> Either Parsec.ParseError Schedule.Schedule-fromText = Parsec.parse parsec ""--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Schedule.Schedule-parsec =- Parsec.skipMany (Parsec.char ' ')- *> Schedule.parsec- <* Parsec.skipMany (Parsec.char ' ')- <* Parsec.eof
− source/libraries/unstable/Saturn/Unstable/Render.hs
@@ -1,21 +0,0 @@-module Saturn.Unstable.Render where--import qualified Data.Text as Text-import qualified Data.Text.Lazy as LazyText-import qualified Data.Text.Lazy.Builder as Builder-import qualified Saturn.Unstable.Type.Schedule as Schedule---- | Renders a 'Schedule.Schedule' into a lazy 'LazyText.Text' value. See--- 'toText' for details.-toLazyText :: Schedule.Schedule -> LazyText.Text-toLazyText = Builder.toLazyText . Schedule.toBuilder---- | Renders a 'Schedule.Schedule' into a 'String' value. See 'toText' for--- details.-toString :: Schedule.Schedule -> String-toString = LazyText.unpack . toLazyText---- | Renders a 'Schedule.Schedule' into a strict 'Text.Text' value. The output--- will have five fields, each separated by a single space.-toText :: Schedule.Schedule -> Text.Text-toText = LazyText.toStrict . toLazyText
− source/libraries/unstable/Saturn/Unstable/Type/Day.hs
@@ -1,38 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Day where--import qualified Data.Coerce as Coerce-import qualified Data.Set as Set-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.Field as Field-import qualified Text.Parsec as Parsec--newtype Day- = Day Field.Field- deriving (Eq, Show)--bounds :: (Word.Word8, Word.Word8)-bounds = (1, 31)--fromField :: Field.Field -> Maybe Day-fromField field =- if Field.isValid bounds field then Just $ Day field else Nothing--toField :: Day -> Field.Field-toField = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Day-parsec = do- field <- Field.parsec- maybe (fail "invalid Day") pure $ fromField field--toBuilder :: Day -> Builder.Builder-toBuilder = Field.toBuilder . toField--expand :: Day -> Set.Set Word.Word8-expand = Field.expand bounds . toField--isMatch :: Word.Word8 -> Day -> Bool-isMatch word8 = Set.member word8 . expand
− source/libraries/unstable/Saturn/Unstable/Type/Element.hs
@@ -1,34 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Element where--import qualified Data.Coerce as Coerce-import qualified Data.Set as Set-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Extra.Parsec as Parsec-import qualified Saturn.Unstable.Type.Number as Number-import qualified Saturn.Unstable.Type.Range as Range-import qualified Text.Parsec as Parsec--newtype Element- = Element (Either Range.Range Number.Number)- deriving (Eq, Show)--fromEither :: Either Range.Range Number.Number -> Element-fromEither = Coerce.coerce--toEither :: Element -> Either Range.Range Number.Number-toEither = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Element-parsec = fromEither <$> Parsec.either (Parsec.try Range.parsec) Number.parsec--toBuilder :: Element -> Builder.Builder-toBuilder = either Range.toBuilder Number.toBuilder . toEither--isValid :: (Word.Word8, Word.Word8) -> Element -> Bool-isValid tuple = either (Range.isValid tuple) (Number.isValid tuple) . toEither--expand :: Element -> Set.Set Word.Word8-expand = either Range.expand (Set.singleton . Number.toWord8) . toEither
− source/libraries/unstable/Saturn/Unstable/Type/Field.hs
@@ -1,58 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Field where--import qualified Data.Coerce as Coerce-import qualified Data.Either as Either-import qualified Data.Foldable as Foldable-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Set as Set-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Extra.Parsec as Parsec-import qualified Saturn.Unstable.Extra.Tuple as Tuple-import qualified Saturn.Unstable.Type.Element as Element-import qualified Saturn.Unstable.Type.Wildcard as Wildcard-import qualified Text.Parsec as Parsec--newtype Field- = Field (Either Wildcard.Wildcard (NonEmpty.NonEmpty Element.Element))- deriving (Eq, Show)--fromEither ::- Either Wildcard.Wildcard (NonEmpty.NonEmpty Element.Element) -> Field-fromEither = Coerce.coerce--toEither ::- Field -> Either Wildcard.Wildcard (NonEmpty.NonEmpty Element.Element)-toEither = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Field-parsec =- fromEither- <$> Parsec.either- Wildcard.parsec- (Parsec.sepByNE Element.parsec $ Parsec.char ',')--toBuilder :: Field -> Builder.Builder-toBuilder =- either- Wildcard.toBuilder- ( Foldable.fold- . NonEmpty.intersperse (Builder.singleton ',')- . fmap Element.toBuilder- )- . toEither--isValid :: (Word.Word8, Word.Word8) -> Field -> Bool-isValid tuple = either (const True) (all $ Element.isValid tuple) . toEither--expand :: (Word.Word8, Word.Word8) -> Field -> Set.Set Word.Word8-expand tuple =- either- (const . Set.fromList $ Tuple.toSequence tuple)- (Set.unions . fmap Element.expand)- . toEither--isWildcard :: Field -> Bool-isWildcard = Either.isLeft . toEither
− source/libraries/unstable/Saturn/Unstable/Type/Hour.hs
@@ -1,38 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Hour where--import qualified Data.Coerce as Coerce-import qualified Data.Set as Set-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.Field as Field-import qualified Text.Parsec as Parsec--newtype Hour- = Hour Field.Field- deriving (Eq, Show)--bounds :: (Word.Word8, Word.Word8)-bounds = (0, 23)--fromField :: Field.Field -> Maybe Hour-fromField field =- if Field.isValid bounds field then Just $ Hour field else Nothing--toField :: Hour -> Field.Field-toField = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Hour-parsec = do- field <- Field.parsec- maybe (fail "invalid Hour") pure $ fromField field--toBuilder :: Hour -> Builder.Builder-toBuilder = Field.toBuilder . toField--expand :: Hour -> Set.Set Word.Word8-expand = Field.expand bounds . toField--isMatch :: Word.Word8 -> Hour -> Bool-isMatch word8 = Set.member word8 . expand
− source/libraries/unstable/Saturn/Unstable/Type/Minute.hs
@@ -1,38 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Minute where--import qualified Data.Coerce as Coerce-import qualified Data.Set as Set-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.Field as Field-import qualified Text.Parsec as Parsec--newtype Minute- = Minute Field.Field- deriving (Eq, Show)--bounds :: (Word.Word8, Word.Word8)-bounds = (0, 59)--fromField :: Field.Field -> Maybe Minute-fromField field =- if Field.isValid bounds field then Just $ Minute field else Nothing--toField :: Minute -> Field.Field-toField = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Minute-parsec = do- field <- Field.parsec- maybe (fail "invalid Minute") pure $ fromField field--toBuilder :: Minute -> Builder.Builder-toBuilder = Field.toBuilder . toField--expand :: Minute -> Set.Set Word.Word8-expand = Field.expand bounds . toField--isMatch :: Word.Word8 -> Minute -> Bool-isMatch word8 = Set.member word8 . expand
− source/libraries/unstable/Saturn/Unstable/Type/Month.hs
@@ -1,38 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Month where--import qualified Data.Coerce as Coerce-import qualified Data.Set as Set-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.Field as Field-import qualified Text.Parsec as Parsec--newtype Month- = Month Field.Field- deriving (Eq, Show)--bounds :: (Word.Word8, Word.Word8)-bounds = (1, 12)--fromField :: Field.Field -> Maybe Month-fromField field =- if Field.isValid bounds field then Just $ Month field else Nothing--toField :: Month -> Field.Field-toField = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Month-parsec = do- field <- Field.parsec- maybe (fail "invalid Month") pure $ fromField field--toBuilder :: Month -> Builder.Builder-toBuilder = Field.toBuilder . toField--expand :: Month -> Set.Set Word.Word8-expand = Field.expand bounds . toField--isMatch :: Word.Word8 -> Month -> Bool-isMatch word8 = Set.member word8 . expand
− source/libraries/unstable/Saturn/Unstable/Type/Number.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Number where--import qualified Data.Bits as Bits-import qualified Data.Coerce as Coerce-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Text.Lazy.Builder.Int as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Extra.Ord as Ord-import qualified Text.Parsec as Parsec-import qualified Text.Read as Read--newtype Number- = Number Word.Word8- deriving (Eq, Show)--fromWord8 :: Word.Word8 -> Number-fromWord8 = Coerce.coerce--toWord8 :: Number -> Word.Word8-toWord8 = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Number-parsec = do- string <- Parsec.many1 Parsec.digit- integer <- maybe (fail "invalidNumber") pure $ Read.readMaybe string- maybe (fail "invalidNumber") (pure . fromWord8) $- Bits.toIntegralSized (integer :: Integer)--toBuilder :: Number -> Builder.Builder-toBuilder = Builder.decimal . toWord8--isValid :: (Word.Word8, Word.Word8) -> Number -> Bool-isValid tuple = Ord.within tuple . toWord8
− source/libraries/unstable/Saturn/Unstable/Type/Range.hs
@@ -1,47 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Range where--import qualified Control.Monad as Monad-import qualified Data.Coerce as Coerce-import qualified Data.Set as Set-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Extra.Tuple as Tuple-import qualified Saturn.Unstable.Type.Number as Number-import qualified Text.Parsec as Parsec--newtype Range- = Range (Number.Number, Number.Number)- deriving (Eq, Show)--fromTuple :: (Number.Number, Number.Number) -> Maybe Range-fromTuple (lo, hi) =- if Number.toWord8 lo > Number.toWord8 hi- then Nothing- else Just $ Range (lo, hi)--toTuple :: Range -> (Number.Number, Number.Number)-toTuple = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Range-parsec = do- lo <- Number.parsec- Monad.void $ Parsec.char '-'- hi <- Number.parsec- maybe (fail "invalid Range") pure $ fromTuple (lo, hi)--toBuilder :: Range -> Builder.Builder-toBuilder range =- let (lo, hi) = toTuple range- in Number.toBuilder lo <> Builder.singleton '-' <> Number.toBuilder hi--isValid :: (Word.Word8, Word.Word8) -> Range -> Bool-isValid tuple = uncurry (&&) . Tuple.mapBoth (Number.isValid tuple) . toTuple--expand :: Range -> Set.Set Word.Word8-expand =- Set.fromList- . Tuple.toSequence- . Tuple.mapBoth Number.toWord8- . toTuple
− source/libraries/unstable/Saturn/Unstable/Type/Schedule.hs
@@ -1,45 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Schedule where--import qualified Data.Text.Lazy.Builder as Builder-import qualified Saturn.Unstable.Type.Day as Day-import qualified Saturn.Unstable.Type.Hour as Hour-import qualified Saturn.Unstable.Type.Minute as Minute-import qualified Saturn.Unstable.Type.Month as Month-import qualified Saturn.Unstable.Type.Weekday as Weekday-import qualified Text.Parsec as Parsec--data Schedule = Schedule- { minute :: Minute.Minute,- hour :: Hour.Hour,- day :: Day.Day,- month :: Month.Month,- weekday :: Weekday.Weekday- }- deriving (Eq, Show)--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Schedule-parsec =- Schedule- <$> Minute.parsec- <* Parsec.skipMany1 (Parsec.char ' ')- <*> Hour.parsec- <* Parsec.skipMany1 (Parsec.char ' ')- <*> Day.parsec- <* Parsec.skipMany1 (Parsec.char ' ')- <*> Month.parsec- <* Parsec.skipMany1 (Parsec.char ' ')- <*> Weekday.parsec--toBuilder :: Schedule -> Builder.Builder-toBuilder schedule =- Minute.toBuilder (minute schedule)- <> Builder.singleton ' '- <> Hour.toBuilder (hour schedule)- <> Builder.singleton ' '- <> Day.toBuilder (day schedule)- <> Builder.singleton ' '- <> Month.toBuilder (month schedule)- <> Builder.singleton ' '- <> Weekday.toBuilder (weekday schedule)
− source/libraries/unstable/Saturn/Unstable/Type/Weekday.hs
@@ -1,38 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Weekday where--import qualified Data.Coerce as Coerce-import qualified Data.Set as Set-import qualified Data.Text.Lazy.Builder as Builder-import qualified Data.Word as Word-import qualified Saturn.Unstable.Type.Field as Field-import qualified Text.Parsec as Parsec--newtype Weekday- = Weekday Field.Field- deriving (Eq, Show)--bounds :: (Word.Word8, Word.Word8)-bounds = (0, 6)--fromField :: Field.Field -> Maybe Weekday-fromField field =- if Field.isValid bounds field then Just $ Weekday field else Nothing--toField :: Weekday -> Field.Field-toField = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Weekday-parsec = do- field <- Field.parsec- maybe (fail "invalid Weekday") pure $ fromField field--toBuilder :: Weekday -> Builder.Builder-toBuilder = Field.toBuilder . toField--expand :: Weekday -> Set.Set Word.Word8-expand = Field.expand bounds . toField--isMatch :: Word.Word8 -> Weekday -> Bool-isMatch word8 = Set.member word8 . expand
− source/libraries/unstable/Saturn/Unstable/Type/Wildcard.hs
@@ -1,24 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--module Saturn.Unstable.Type.Wildcard where--import qualified Control.Monad as Monad-import qualified Data.Coerce as Coerce-import qualified Data.Text.Lazy.Builder as Builder-import qualified Text.Parsec as Parsec--newtype Wildcard- = Wildcard ()- deriving (Eq, Show)--fromUnit :: () -> Wildcard-fromUnit = Coerce.coerce--toUnit :: Wildcard -> ()-toUnit = Coerce.coerce--parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Wildcard-parsec = fmap fromUnit . Monad.void $ Parsec.char '*'--toBuilder :: Wildcard -> Builder.Builder-toBuilder = const $ Builder.singleton '*'
+ source/library/Saturn.hs view
@@ -0,0 +1,71 @@+-- | Saturn handles POSIX cron schedules, which are defined here:+-- <https://pubs.opengroup.org/onlinepubs/9699919799/utilities/crontab.html#tag_20_25_07>.+--+-- A cron schedule is specified with five fields, each separated with at least+-- one space. Each field can either be a wildcard (represented by an asterisk),+-- or it can be one or more elements separated by commas. Each element can+-- either be a number or a range, which is two numbers separated by a hyphen.+--+-- In order, the fields represent:+--+-- 1. Minute, between 0 and 59.+-- 2. Hour, between 0 and 23.+-- 3. Day, between 1 and 31.+-- 4. Month, between 1 and 12.+-- 5. Weekday, between 0 and 6 where 0 represents Sunday.+--+-- Here is a more graphical representation of the fields:+--+-- > +--------- Minute+-- > | +------- Hour+-- > | | +----- Day+-- > | | | +--- Month+-- > | | | | +- Weekday+-- > | | | | |+-- > "* * * * *"+--+-- To get started, use 'Parse.fromText' to parse a 'Schedule.Schedule'. Then+-- use 'Render.toText' to render it again. To see if the 'Schedule.Schedule'+-- matches a certain time, use 'Match.isMatch'. To get the next time that+-- matches a schedule, use 'Match.nextMatch'.+--+-- >>> :set -XOverloadedStrings+-- >>> let Right schedule = fromText "* * * * *"+-- >>> toText schedule+-- "* * * * *"+-- >>> let utcTime = Data.Time.UTCTime (Data.Time.fromGregorian 1970 1 1) 0+-- >>> isMatch utcTime schedule+-- True+-- >>> nextMatch utcTime schedule+-- Just 1970-01-01 00:01:00 UTC+module Saturn+ ( -- * Types+ Schedule.Schedule,+ Constant.everyMinute,+ Constant.hourly,+ Constant.daily,+ Constant.weekly,+ Constant.monthly,+ Constant.yearly,++ -- * Parsing+ Parse.fromText,+ Parse.fromLazyText,+ Parse.fromString,++ -- * Rendering+ Render.toText,+ Render.toLazyText,+ Render.toString,++ -- * Matching+ Match.isMatch,+ Match.nextMatch,+ )+where++import qualified Saturn.Unstable.Constant as Constant+import qualified Saturn.Unstable.Match as Match+import qualified Saturn.Unstable.Parse as Parse+import qualified Saturn.Unstable.Render as Render+import qualified Saturn.Unstable.Type.Schedule as Schedule
+ source/library/Saturn/Unstable/Constant.hs view
@@ -0,0 +1,96 @@+module Saturn.Unstable.Constant where++import qualified Data.Maybe as Maybe+import qualified Saturn.Unstable.Type.Day as Day+import qualified Saturn.Unstable.Type.Element as Element+import qualified Saturn.Unstable.Type.Field as Field+import qualified Saturn.Unstable.Type.Hour as Hour+import qualified Saturn.Unstable.Type.Minute as Minute+import qualified Saturn.Unstable.Type.Month as Month+import qualified Saturn.Unstable.Type.Number as Number+import qualified Saturn.Unstable.Type.Schedule as Schedule+import qualified Saturn.Unstable.Type.Weekday as Weekday+import qualified Saturn.Unstable.Type.Wildcard as Wildcard++-- | > "* * * * *"+everyMinute :: Schedule.Schedule+everyMinute = Maybe.fromMaybe (error "Saturn.Unstable.Constant.everyMinute") $ do+ let wildcard = Field.fromEither . Left $ Wildcard.fromUnit ()+ minute <- Minute.fromField wildcard+ hour <- Hour.fromField wildcard+ day <- Day.fromField wildcard+ month <- Month.fromField wildcard+ weekday <- Weekday.fromField wildcard+ pure+ Schedule.Schedule+ { Schedule.minute = minute,+ Schedule.hour = hour,+ Schedule.day = day,+ Schedule.month = month,+ Schedule.weekday = weekday+ }++-- | > "0 * * * *"+hourly :: Schedule.Schedule+hourly = Maybe.fromMaybe (error "Saturn.Unstable.Constant.hourly") $ do+ minute <-+ Minute.fromField+ . Field.fromEither+ . Right+ . pure+ . Element.fromEither+ . Right+ $ Number.fromWord8 0+ pure everyMinute {Schedule.minute = minute}++-- | > "0 0 * * *"+daily :: Schedule.Schedule+daily = Maybe.fromMaybe (error "Saturn.Unstable.Constant.daily") $ do+ hour <-+ Hour.fromField+ . Field.fromEither+ . Right+ . pure+ . Element.fromEither+ . Right+ $ Number.fromWord8 0+ pure hourly {Schedule.hour = hour}++-- | > "0 0 * * 0"+weekly :: Schedule.Schedule+weekly = Maybe.fromMaybe (error "Saturn.Unstable.Constant.weekly") $ do+ weekday <-+ Weekday.fromField+ . Field.fromEither+ . Right+ . pure+ . Element.fromEither+ . Right+ $ Number.fromWord8 0+ pure daily {Schedule.weekday = weekday}++-- | > "0 0 1 * *"+monthly :: Schedule.Schedule+monthly = Maybe.fromMaybe (error "Saturn.Unstable.Constant.monthly") $ do+ day <-+ Day.fromField+ . Field.fromEither+ . Right+ . pure+ . Element.fromEither+ . Right+ $ Number.fromWord8 1+ pure daily {Schedule.day = day}++-- | > "0 0 1 1 *"+yearly :: Schedule.Schedule+yearly = Maybe.fromMaybe (error "Saturn.Unstable.Constant.yearly") $ do+ month <-+ Month.fromField+ . Field.fromEither+ . Right+ . pure+ . Element.fromEither+ . Right+ $ Number.fromWord8 1+ pure monthly {Schedule.month = month}
+ source/library/Saturn/Unstable/ConstantSpec.hs view
@@ -0,0 +1,31 @@+module Saturn.Unstable.ConstantSpec where++import qualified Heck+import qualified Saturn.Unstable.Constant as Constant+import qualified Saturn.Unstable.Render as Render++spec :: (Applicative m, Monad n) => Heck.Test m n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Constant" $ do+ Heck.describe t "everyMinute" $ do+ Heck.it t "renders correctly" $ do+ Heck.assertEq t "* * * * *" (Render.toString Constant.everyMinute)++ Heck.describe t "hourly" $ do+ Heck.it t "renders correctly" $ do+ Heck.assertEq t "0 * * * *" (Render.toString Constant.hourly)++ Heck.describe t "daily" $ do+ Heck.it t "renders correctly" $ do+ Heck.assertEq t "0 0 * * *" (Render.toString Constant.daily)++ Heck.describe t "weekly" $ do+ Heck.it t "renders correctly" $ do+ Heck.assertEq t "0 0 * * 0" (Render.toString Constant.weekly)++ Heck.describe t "monthly" $ do+ Heck.it t "renders correctly" $ do+ Heck.assertEq t "0 0 1 * *" (Render.toString Constant.monthly)++ Heck.describe t "yearly" $ do+ Heck.it t "renders correctly" $ do+ Heck.assertEq t "0 0 1 1 *" (Render.toString Constant.yearly)
+ source/library/Saturn/Unstable/Extra/Int.hs view
@@ -0,0 +1,10 @@+module Saturn.Unstable.Extra.Int where++import qualified Data.Bits as Bits+import qualified Data.Word as Word++fromWord8 :: Word.Word8 -> Int+fromWord8 = fromIntegral++toWord8 :: Int -> Maybe Word.Word8+toWord8 = Bits.toIntegralSized
+ source/library/Saturn/Unstable/Extra/IntSpec.hs view
@@ -0,0 +1,23 @@+module Saturn.Unstable.Extra.IntSpec where++import qualified Heck+import qualified Saturn.Unstable.Extra.Int as Int++spec :: (Applicative m, Monad n) => Heck.Test m n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Extra.Int" $ do+ Heck.describe t "fromWord8" $ do+ Heck.it t "works" $ do+ Heck.assertEq t (Int.fromWord8 0) 0++ Heck.describe t "toWord8" $ do+ Heck.it t "succeeds with minimum" $ do+ Heck.assertEq t (Int.toWord8 0) (Just 0)++ Heck.it t "succeeds with maximum" $ do+ Heck.assertEq t (Int.toWord8 255) (Just 255)++ Heck.it t "fails below minimum" $ do+ Heck.assertEq t (Int.toWord8 (-1)) Nothing++ Heck.it t "fails above maximum" $ do+ Heck.assertEq t (Int.toWord8 256) Nothing
+ source/library/Saturn/Unstable/Extra/Ord.hs view
@@ -0,0 +1,4 @@+module Saturn.Unstable.Extra.Ord where++within :: (Ord a) => (a, a) -> a -> Bool+within (lo, hi) x = lo <= x && x <= hi
+ source/library/Saturn/Unstable/Extra/OrdSpec.hs view
@@ -0,0 +1,22 @@+module Saturn.Unstable.Extra.OrdSpec where++import qualified Heck+import qualified Saturn.Unstable.Extra.Ord as Ord++spec :: (Applicative m, Monad n) => Heck.Test m n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Extra.Ord" $ do+ Heck.describe t "within" $ do+ Heck.it t "fails below lower bound" $ do+ Heck.assertEq t False (Ord.within ('b', 'd') 'a')++ Heck.it t "succeeds at lower bound" $ do+ Heck.assertEq t True (Ord.within ('b', 'd') 'b')++ Heck.it t "succeeds within bounds" $ do+ Heck.assertEq t True (Ord.within ('b', 'd') 'c')++ Heck.it t "succeeds at upper bound" $ do+ Heck.assertEq t True (Ord.within ('b', 'd') 'd')++ Heck.it t "fails above upper bound" $ do+ Heck.assertEq t False (Ord.within ('b', 'd') 'e')
+ source/library/Saturn/Unstable/Extra/Parsec.hs view
@@ -0,0 +1,16 @@+module Saturn.Unstable.Extra.Parsec where++import qualified Data.List.NonEmpty as NonEmpty+import qualified Text.Parsec as Parsec++either ::+ Parsec.ParsecT s u m a ->+ Parsec.ParsecT s u m b ->+ Parsec.ParsecT s u m (Either a b)+either l r = fmap Left l Parsec.<|> fmap Right r++sepByNE ::+ Parsec.ParsecT s u m a ->+ Parsec.ParsecT s u m sep ->+ Parsec.ParsecT s u m (NonEmpty.NonEmpty a)+sepByNE p s = (NonEmpty.:|) <$> p <*> Parsec.many (s *> p)
+ source/library/Saturn/Unstable/Extra/ParsecSpec.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Extra.ParsecSpec where++import qualified Data.Either as Either+import qualified Data.List.NonEmpty as NonEmpty+import qualified Heck+import qualified Saturn.Unstable.Extra.Parsec as Parsec+import qualified Text.Parsec as Parsec++spec :: (Applicative m, Monad n) => Heck.Test m n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Extra.Parsec" $ do+ Heck.describe t "either" $ do+ let parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m (Either Char Char)+ parsec = Parsec.either (Parsec.char 'a') (Parsec.char 'b')++ Heck.it t "succeeds with left" $ do+ Heck.assertEq t (Right (Left 'a')) (Parsec.parse parsec "" "a")++ Heck.it t "succeeds with right" $ do+ Heck.assertEq t (Right (Right 'b')) (Parsec.parse parsec "" "b")++ Heck.it t "fails with neither" $ do+ Heck.assertEq t True (Either.isLeft (Parsec.parse parsec "" "c"))++ Heck.describe t "sepByNE" $ do+ let parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m (NonEmpty.NonEmpty Char)+ parsec = Parsec.sepByNE (Parsec.char 'a') (Parsec.char ' ')++ Heck.it t "succeeds with one" $ do+ Heck.assertEq t (Right ('a' NonEmpty.:| [])) (Parsec.parse parsec "" "a")++ Heck.it t "succeeds with many" $ do+ Heck.assertEq t (Right ('a' NonEmpty.:| "a")) (Parsec.parse parsec "" "a a")++ Heck.it t "fails with none" $ do+ Heck.assertEq t True (Either.isLeft (Parsec.parse parsec "" ""))
+ source/library/Saturn/Unstable/Extra/Time.hs view
@@ -0,0 +1,14 @@+module Saturn.Unstable.Extra.Time where++import qualified Data.Time as Time+import qualified Data.Word as Word++dayOfWeekToWord8 :: Time.DayOfWeek -> Word.Word8+dayOfWeekToWord8 dayOfWeek = case dayOfWeek of+ Time.Sunday -> 0+ Time.Monday -> 1+ Time.Tuesday -> 2+ Time.Wednesday -> 3+ Time.Thursday -> 4+ Time.Friday -> 5+ Time.Saturday -> 6
+ source/library/Saturn/Unstable/Extra/TimeSpec.hs view
@@ -0,0 +1,29 @@+module Saturn.Unstable.Extra.TimeSpec where++import qualified Data.Time as Time+import qualified Heck+import qualified Saturn.Unstable.Extra.Time as Time++spec :: (Applicative m, Monad n) => Heck.Test m n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Extra.Time" $ do+ Heck.describe t "dayOfWeekToWord8" $ do+ Heck.it t "works with Sunday" $ do+ Heck.assertEq t 0 (Time.dayOfWeekToWord8 Time.Sunday)++ Heck.it t "works with Monday" $ do+ Heck.assertEq t 1 (Time.dayOfWeekToWord8 Time.Monday)++ Heck.it t "works with Tuesday" $ do+ Heck.assertEq t 2 (Time.dayOfWeekToWord8 Time.Tuesday)++ Heck.it t "works with Wednesday" $ do+ Heck.assertEq t 3 (Time.dayOfWeekToWord8 Time.Wednesday)++ Heck.it t "works with Thursday" $ do+ Heck.assertEq t 4 (Time.dayOfWeekToWord8 Time.Thursday)++ Heck.it t "works with Friday" $ do+ Heck.assertEq t 5 (Time.dayOfWeekToWord8 Time.Friday)++ Heck.it t "works with Saturday" $ do+ Heck.assertEq t 6 (Time.dayOfWeekToWord8 Time.Saturday)
+ source/library/Saturn/Unstable/Extra/Tuple.hs view
@@ -0,0 +1,9 @@+module Saturn.Unstable.Extra.Tuple where++import qualified Data.Bifunctor as Bifunctor++mapBoth :: (a -> b) -> (a, a) -> (b, b)+mapBoth f = Bifunctor.bimap f f++toSequence :: (Enum a) => (a, a) -> [a]+toSequence = uncurry enumFromTo
+ source/library/Saturn/Unstable/Extra/TupleSpec.hs view
@@ -0,0 +1,20 @@+module Saturn.Unstable.Extra.TupleSpec where++import qualified Heck+import qualified Saturn.Unstable.Extra.Tuple as Tuple++spec :: (Applicative m, Monad n) => Heck.Test m n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Extra.Tuple" $ do+ Heck.describe t "mapBoth" $ do+ Heck.it t "works" $ do+ Heck.assertEq t ('B', 'b') (Tuple.mapBoth succ ('A', 'a'))++ Heck.describe t "toSequence" $ do+ Heck.it t "works" $ do+ Heck.assertEq t "bcd" (Tuple.toSequence ('b', 'd'))++ Heck.it t "works with singleton" $ do+ Heck.assertEq t "a" (Tuple.toSequence ('a', 'a'))++ Heck.it t "works with empty" $ do+ Heck.assertEq t "" (Tuple.toSequence ('b', 'a'))
+ source/library/Saturn/Unstable/Match.hs view
@@ -0,0 +1,89 @@+module Saturn.Unstable.Match where++import qualified Control.Monad as Monad+import qualified Data.List as List+import qualified Data.Maybe as Maybe+import qualified Data.Set as Set+import qualified Data.Time as Time+import qualified Saturn.Unstable.Extra.Int as Int+import qualified Saturn.Unstable.Extra.Time as Time+import qualified Saturn.Unstable.Type.Day as Day+import qualified Saturn.Unstable.Type.Field as Field+import qualified Saturn.Unstable.Type.Hour as Hour+import qualified Saturn.Unstable.Type.Minute as Minute+import qualified Saturn.Unstable.Type.Month as Month+import qualified Saturn.Unstable.Type.Schedule as Schedule+import qualified Saturn.Unstable.Type.Weekday as Weekday+import qualified Saturn.Unstable.Type.Wildcard as Wildcard++-- | Returns 'True' if the given 'Time.UTCTime' matches the given+-- 'Schedule.Schedule', otherwise returns 'False'.+isMatch :: Time.UTCTime -> Schedule.Schedule -> Bool+isMatch utcTime schedule = Maybe.fromMaybe False $ do+ let time = Time.pastMidnight $ Time.utctDayTime utcTime+ minute <- Int.toWord8 $ Time.todMin time+ Monad.guard . Minute.isMatch minute $ Schedule.minute schedule++ hour <- Int.toWord8 $ Time.todHour time+ Monad.guard . Hour.isMatch hour $ Schedule.hour schedule++ let date = Time.utctDay utcTime+ let (_, monthOfYear, dayOfMonth) = Time.toGregorian date+ month <- Int.toWord8 monthOfYear+ Monad.guard . Month.isMatch month $ Schedule.month schedule++ day <- Int.toWord8 dayOfMonth+ let dayMatches = Day.isMatch day $ Schedule.day schedule+ let weekday = Time.dayOfWeekToWord8 $ Time.dayOfWeek date+ let weekdayMatches = Weekday.isMatch weekday $ Schedule.weekday schedule+ Monad.guard $+ if dayIsWildcard schedule || weekdayIsWildcard schedule+ then dayMatches && weekdayMatches+ else dayMatches || weekdayMatches++ pure True++dayIsWildcard :: Schedule.Schedule -> Bool+dayIsWildcard = Field.isWildcard . Day.toField . Schedule.day++weekdayIsWildcard :: Schedule.Schedule -> Bool+weekdayIsWildcard = Field.isWildcard . Weekday.toField . Schedule.weekday++-- | Looks for the first time after the given 'Time.UTCTime' that matches the+-- given 'Schedule.Schedule'. Returns 'Nothing' if the 'Schedule.Schedule' only+-- matches dates that cannot happen, like February 30th.+nextMatch :: Time.UTCTime -> Schedule.Schedule -> Maybe Time.UTCTime+nextMatch utcTime schedule =+ if dayIsWildcard schedule || weekdayIsWildcard schedule+ then incompleteNextMatch utcTime schedule+ else do+ let wildcard = Field.fromEither . Left $ Wildcard.fromUnit ()+ day <- Day.fromField wildcard+ weekday <- Weekday.fromField wildcard+ Maybe.listToMaybe . List.sort $+ Maybe.catMaybes+ [ incompleteNextMatch utcTime schedule {Schedule.day = day},+ incompleteNextMatch utcTime schedule {Schedule.weekday = weekday}+ ]++incompleteNextMatch :: Time.UTCTime -> Schedule.Schedule -> Maybe Time.UTCTime+incompleteNextMatch utcTime schedule = Maybe.listToMaybe $ do+ let oldDate = Time.utctDay utcTime+ let (oldYear, _, _) = Time.toGregorian oldDate+ year <- [oldYear .. oldYear + 8]+ month <- fmap Int.fromWord8 . Set.toAscList . Month.expand $ Schedule.month schedule+ day <- fmap Int.fromWord8 . Set.toAscList . Day.expand $ Schedule.day schedule+ date <- Maybe.maybeToList $ Time.fromGregorianValid year month day+ Monad.guard $ date >= oldDate+ Monad.guard+ . Set.member (Time.dayOfWeekToWord8 $ Time.dayOfWeek date)+ . Weekday.expand+ $ Schedule.weekday schedule+ hour <- fmap Int.fromWord8 . Set.toAscList . Hour.expand $ Schedule.hour schedule+ minute <- fmap Int.fromWord8 . Set.toAscList . Minute.expand $ Schedule.minute schedule+ time <-+ fmap Time.sinceMidnight+ . Maybe.maybeToList+ $ Time.makeTimeOfDayValid hour minute 0+ Monad.when (date == oldDate) . Monad.guard $ time > Time.utctDayTime utcTime+ pure Time.UTCTime {Time.utctDay = date, Time.utctDayTime = time}
+ source/library/Saturn/Unstable/MatchSpec.hs view
@@ -0,0 +1,503 @@+module Saturn.Unstable.MatchSpec where++import qualified Data.Fixed as Fixed+import qualified Data.Time as Time+import qualified Data.Time.Calendar.WeekDate as Time+import qualified Heck+import qualified Saturn.Unstable.Match as Match+import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck++spec :: (Monad n) => Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Match" $ do+ Heck.describe t "isMatch" $ do+ Heck.it t "is always true with all wildcards"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch utcTime++ Heck.it t "is true when day or weekday matches" $ do+ s <- ScheduleSpec.new [] [] [[5]] [] [[5]]+ t1 <- newUtcTime 1970 1 5 0 0 0+ s `Hspec.shouldSatisfy` Match.isMatch t1+ t2 <- newUtcTime 1970 1 2 0 0 0+ s `Hspec.shouldSatisfy` Match.isMatch t2++ Heck.describe t "minute" $ do+ Heck.it t "is always true when a number matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [[5]] [] [] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withMinute 5 utcTime)++ Heck.it t "is always true when a range matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [[4, 5]] [] [] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withMinute 5 utcTime)++ Heck.it t "is always true when a choice matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [[4], [5]] [] [] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withMinute 5 utcTime)++ Heck.it t "is true when a number matches" $ do+ x <- newUtcTime 1970 1 1 0 5 0+ s <- ScheduleSpec.new [[5]] [] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a number does not match" $ do+ x <- newUtcTime 1970 1 1 0 6 0+ s <- ScheduleSpec.new [[5]] [] [] [] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a range matches" $ do+ x <- newUtcTime 1970 1 1 0 5 0+ s <- ScheduleSpec.new [[4, 5]] [] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a range does not match" $ do+ x <- newUtcTime 1970 1 1 0 6 0+ s <- ScheduleSpec.new [[4, 5]] [] [] [] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a choice matches" $ do+ x <- newUtcTime 1970 1 1 0 5 0+ s <- ScheduleSpec.new [[4], [5]] [] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a choice does not match" $ do+ x <- newUtcTime 1970 1 1 0 6 0+ s <- ScheduleSpec.new [[4], [5]] [] [] [] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "accepts any second" $ do+ x <- newUtcTime 1970 1 1 0 5 6+ s <- ScheduleSpec.new [[5]] [] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any hour" $ do+ x <- newUtcTime 1970 1 1 6 5 0+ s <- ScheduleSpec.new [[5]] [] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any day" $ do+ x <- newUtcTime 1970 1 6 0 5 0+ s <- ScheduleSpec.new [[5]] [] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any month" $ do+ x <- newUtcTime 1970 6 1 0 5 0+ s <- ScheduleSpec.new [[5]] [] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.describe t "hour" $ do+ Heck.it t "is always true when a number matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [[5]] [] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withHour 5 utcTime)++ Heck.it t "is always true when a range matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [[4, 5]] [] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withHour 5 utcTime)++ Heck.it t "is always true when a choice matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [[4], [5]] [] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withHour 5 utcTime)++ Heck.it t "is true when a number matches" $ do+ x <- newUtcTime 1970 1 1 5 0 0+ s <- ScheduleSpec.new [] [[5]] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a number does not match" $ do+ x <- newUtcTime 1970 1 1 6 0 0+ s <- ScheduleSpec.new [] [[5]] [] [] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a range matches" $ do+ x <- newUtcTime 1970 1 1 5 0 0+ s <- ScheduleSpec.new [] [[4, 5]] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a range does not match" $ do+ x <- newUtcTime 1970 1 1 6 0 0+ s <- ScheduleSpec.new [] [[4, 5]] [] [] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a choice matches" $ do+ x <- newUtcTime 1970 1 1 5 0 0+ s <- ScheduleSpec.new [] [[4], [5]] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a choice does not match" $ do+ x <- newUtcTime 1970 1 1 6 0 0+ s <- ScheduleSpec.new [] [[4], [5]] [] [] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "accepts any second" $ do+ x <- newUtcTime 1970 1 1 5 0 6+ s <- ScheduleSpec.new [] [[5]] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any minute" $ do+ x <- newUtcTime 1970 1 1 5 6 0+ s <- ScheduleSpec.new [] [[5]] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any day" $ do+ x <- newUtcTime 1970 1 6 5 0 0+ s <- ScheduleSpec.new [] [[5]] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any month" $ do+ x <- newUtcTime 1970 6 1 5 0 0+ s <- ScheduleSpec.new [] [[5]] [] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.describe t "day" $ do+ Heck.it t "is always true when a number matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [[5]] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfMonth 5 utcTime)++ Heck.it t "is always true when a range matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [[4, 5]] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfMonth 5 utcTime)++ Heck.it t "is always true when a choice matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [[4], [5]] [] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfMonth 5 utcTime)++ Heck.it t "is true when a number matches" $ do+ x <- newUtcTime 1970 1 5 0 0 0+ s <- ScheduleSpec.new [] [] [[5]] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a number does not match" $ do+ x <- newUtcTime 1970 1 6 0 0 0+ s <- ScheduleSpec.new [] [] [[5]] [] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a range matches" $ do+ x <- newUtcTime 1970 1 5 0 0 0+ s <- ScheduleSpec.new [] [] [[4, 5]] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a range does not match" $ do+ x <- newUtcTime 1970 1 6 0 0 0+ s <- ScheduleSpec.new [] [] [[4, 5]] [] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a choice matches" $ do+ x <- newUtcTime 1970 1 5 0 0 0+ s <- ScheduleSpec.new [] [] [[4], [5]] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a choice does not match" $ do+ x <- newUtcTime 1970 1 6 0 0 0+ s <- ScheduleSpec.new [] [] [[4], [5]] [] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "accepts any second" $ do+ x <- newUtcTime 1970 1 5 0 0 6+ s <- ScheduleSpec.new [] [] [[5]] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any minute" $ do+ x <- newUtcTime 1970 1 5 0 6 0+ s <- ScheduleSpec.new [] [] [[5]] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any hour" $ do+ x <- newUtcTime 1970 1 5 6 0 0+ s <- ScheduleSpec.new [] [] [[5]] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any month" $ do+ x <- newUtcTime 1970 6 5 0 0 0+ s <- ScheduleSpec.new [] [] [[5]] [] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.describe t "month" $ do+ Heck.it t "is always true when a number matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [] [[5]] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withMonthOfYear 5 utcTime)++ Heck.it t "is always true when a range matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [] [[4, 5]] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withMonthOfYear 5 utcTime)++ Heck.it t "is always true when a choice matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [] [[4], [5]] []+ schedule `Hspec.shouldSatisfy` Match.isMatch (withMonthOfYear 5 utcTime)++ Heck.it t "is true when a number matches" $ do+ x <- newUtcTime 1970 5 1 0 0 0+ s <- ScheduleSpec.new [] [] [] [[5]] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a number does not match" $ do+ x <- newUtcTime 1970 6 1 0 0 0+ s <- ScheduleSpec.new [] [] [] [[5]] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a range matches" $ do+ x <- newUtcTime 1970 5 1 0 0 0+ s <- ScheduleSpec.new [] [] [] [[4, 5]] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a range does not match" $ do+ x <- newUtcTime 1970 6 1 0 0 0+ s <- ScheduleSpec.new [] [] [] [[4, 5]] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a choice matches" $ do+ x <- newUtcTime 1970 5 1 0 0 0+ s <- ScheduleSpec.new [] [] [] [[4], [5]] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a choice does not match" $ do+ x <- newUtcTime 1970 6 1 0 0 0+ s <- ScheduleSpec.new [] [] [] [[4], [5]] []+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "accepts any second" $ do+ x <- newUtcTime 1970 5 1 0 0 6+ s <- ScheduleSpec.new [] [] [] [[5]] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any minute" $ do+ x <- newUtcTime 1970 5 1 0 6 0+ s <- ScheduleSpec.new [] [] [] [[5]] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any hour" $ do+ x <- newUtcTime 1970 5 1 6 0 0+ s <- ScheduleSpec.new [] [] [] [[5]] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any day" $ do+ x <- newUtcTime 1970 5 6 0 0 0+ s <- ScheduleSpec.new [] [] [] [[5]] []+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.describe t "weekday" $ do+ Heck.it t "is always true when a number matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [] [] [[5]]+ schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfWeek Time.Friday utcTime)++ Heck.it t "is always true when a range matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [] [] [[4, 5]]+ schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfWeek Time.Friday utcTime)++ Heck.it t "is always true when a choice matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \utcTime -> do+ schedule <- ScheduleSpec.new [] [] [] [] [[4], [5]]+ schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfWeek Time.Friday utcTime)++ Heck.it t "is true when a number matches" $ do+ x <- newUtcTime 1970 1 2 0 0 0+ s <- ScheduleSpec.new [] [] [] [] [[5]]+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a number does not match" $ do+ x <- newUtcTime 1970 1 3 0 0 0+ s <- ScheduleSpec.new [] [] [] [] [[5]]+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a range matches" $ do+ x <- newUtcTime 1970 1 2 0 0 0+ s <- ScheduleSpec.new [] [] [] [] [[4, 5]]+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a range does not match" $ do+ x <- newUtcTime 1970 1 3 0 0 0+ s <- ScheduleSpec.new [] [] [] [] [[4, 5]]+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "is true when a choice matches" $ do+ x <- newUtcTime 1970 1 2 0 0 0+ s <- ScheduleSpec.new [] [] [] [] [[4], [5]]+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "is false when a choice does not match" $ do+ x <- newUtcTime 1970 1 3 0 0 0+ s <- ScheduleSpec.new [] [] [] [] [[4], [5]]+ s `Hspec.shouldNotSatisfy` Match.isMatch x++ Heck.it t "accepts any second" $ do+ x <- newUtcTime 1970 1 2 0 0 6+ s <- ScheduleSpec.new [] [] [] [] [[5]]+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any minute" $ do+ x <- newUtcTime 1970 1 2 0 6 0+ s <- ScheduleSpec.new [] [] [] [] [[5]]+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any hour" $ do+ x <- newUtcTime 1970 1 2 6 0 0+ s <- ScheduleSpec.new [] [] [] [] [[5]]+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.it t "accepts any day" $ do+ x <- newUtcTime 1970 1 9 0 0 0+ s <- ScheduleSpec.new [] [] [] [] [[5]]+ s `Hspec.shouldSatisfy` Match.isMatch x++ Heck.describe t "nextMatch" $ do+ Heck.it t "succeeds with a leap day" $ do+ s <- ScheduleSpec.new [[0]] [[0]] [[29]] [[2]] []+ t1 <- newUtcTime 1970 1 1 0 0 0+ t2 <- newUtcTime 1972 2 29 0 0 0+ Match.nextMatch t1 s `Hspec.shouldBe` Just t2++ Heck.it t "succeeds with the next leap day" $ do+ s <- ScheduleSpec.new [[0]] [[0]] [[29]] [[2]] []+ t1 <- newUtcTime 1972 2 29 0 0 0+ t2 <- newUtcTime 1976 2 29 0 0 0+ Match.nextMatch t1 s `Hspec.shouldBe` Just t2++ Heck.it t "succeeds with the furthest leap day" $ do+ s <- ScheduleSpec.new [[0]] [[0]] [[29]] [[2]] []+ t1 <- newUtcTime 1896 2 29 0 0 0+ t2 <- newUtcTime 1904 2 29 0 0 0+ Match.nextMatch t1 s `Hspec.shouldBe` Just t2++ Heck.it t "fails with an impossible date" $ do+ s <- ScheduleSpec.new [[0]] [[0]] [[30]] [[2]] []+ x <- newUtcTime 1970 1 1 0 0 0+ Match.nextMatch x s `Hspec.shouldBe` Nothing++ Heck.it t "is always in the future"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \t1 -> do+ schedule <- ScheduleSpec.new [] [] [] [] []+ t2 <- maybe (fail "impossible") pure $ Match.nextMatch t1 schedule+ t2 `Hspec.shouldSatisfy` (>= t1)++ Heck.it t "always matches"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime+ $ \t1 -> do+ schedule <- ScheduleSpec.new [] [] [] [] []+ t2 <- maybe (fail "impossible") pure $ Match.nextMatch t1 schedule+ schedule `Hspec.shouldSatisfy` Match.isMatch t2++withMinute :: Int -> Time.UTCTime -> Time.UTCTime+withMinute minute = overTimeOfDay $ \timeOfDay -> timeOfDay {Time.todMin = minute}++withHour :: Int -> Time.UTCTime -> Time.UTCTime+withHour hour = overTimeOfDay $ \timeOfDay -> timeOfDay {Time.todHour = hour}++overTimeOfDay :: (Time.TimeOfDay -> Time.TimeOfDay) -> Time.UTCTime -> Time.UTCTime+overTimeOfDay f utcTime =+ utcTime+ { Time.utctDayTime =+ Time.sinceMidnight . f . Time.pastMidnight $ Time.utctDayTime utcTime+ }++withDayOfMonth :: Time.DayOfMonth -> Time.UTCTime -> Time.UTCTime+withDayOfMonth dayOfMonth = overDay $ \day ->+ let (year, monthOfYear, _) = Time.toGregorian day+ in Time.fromGregorian year monthOfYear dayOfMonth++withMonthOfYear :: Time.MonthOfYear -> Time.UTCTime -> Time.UTCTime+withMonthOfYear monthOfYear = overDay $ \day ->+ let (year, _, dayOfMonth) = Time.toGregorian day+ in Time.fromGregorian year monthOfYear dayOfMonth++withDayOfWeek :: Time.DayOfWeek -> Time.UTCTime -> Time.UTCTime+withDayOfWeek dayOfWeek = overDay $ \day ->+ let fwt = Time.FirstWholeWeek+ dow = Time.Sunday+ (year, weekOfYear, _) = Time.toWeekCalendar fwt dow day+ in Time.fromWeekCalendar fwt dow year weekOfYear dayOfWeek++overDay :: (Time.Day -> Time.Day) -> Time.UTCTime -> Time.UTCTime+overDay f utcTime = utcTime {Time.utctDay = f $ Time.utctDay utcTime}++newUtcTime ::+ (MonadFail m) =>+ Time.Year ->+ Time.MonthOfYear ->+ Time.DayOfMonth ->+ Int ->+ Int ->+ Fixed.Pico ->+ m Time.UTCTime+newUtcTime year monthOfYear dayOfMonth hour minute second = do+ day <-+ maybe (fail "invalid Day") pure $+ Time.fromGregorianValid year monthOfYear dayOfMonth+ timeOfDay <-+ maybe (fail "invalid TimeOfDay") pure $+ Time.makeTimeOfDayValid hour minute second+ pure+ Time.UTCTime+ { Time.utctDay = day,+ Time.utctDayTime = Time.sinceMidnight timeOfDay+ }++arbitraryUtcTime :: QuickCheck.Gen Time.UTCTime+arbitraryUtcTime =+ Time.UTCTime+ <$> fmap Time.ModifiedJulianDay QuickCheck.arbitrary+ <*> fmap Time.picosecondsToDiffTime (QuickCheck.chooseInteger (0, 86400000000000000 - 1))++shrinkUtcTime :: Time.UTCTime -> [Time.UTCTime]+shrinkUtcTime =+ QuickCheck.shrinkMap+ ( \(d, t) ->+ Time.UTCTime+ { Time.utctDay = Time.ModifiedJulianDay d,+ Time.utctDayTime = Time.picosecondsToDiffTime t+ }+ )+ ( \x ->+ ( Time.toModifiedJulianDay $ Time.utctDay x,+ Time.diffTimeToPicoseconds $ Time.utctDayTime x+ )+ )
+ source/library/Saturn/Unstable/Parse.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Parse where++import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import qualified Saturn.Unstable.Type.Schedule as Schedule+import qualified Text.Parsec as Parsec++-- | Parses a lazy 'LazyText.Text' value into a 'Schedule.Schedule'. See+-- 'fromText' for details.+fromLazyText :: LazyText.Text -> Either Parsec.ParseError Schedule.Schedule+fromLazyText = Parsec.parse parsec ""++-- | Parses a 'String' into a 'Schedule.Schedule'. See 'fromText' for details.+fromString :: String -> Either Parsec.ParseError Schedule.Schedule+fromString = Parsec.parse parsec ""++-- | Parses a strict 'Text.Text' value into a 'Schedule.Schedule'. The input+-- should have five fields, each separated by at least one space. Leading and+-- trailing spaces are allowed.+fromText :: Text.Text -> Either Parsec.ParseError Schedule.Schedule+fromText = Parsec.parse parsec ""++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Schedule.Schedule+parsec =+ Parsec.skipMany (Parsec.char ' ')+ *> Schedule.parsec+ <* Parsec.skipMany (Parsec.char ' ')+ <* Parsec.eof
+ source/library/Saturn/Unstable/ParseSpec.hs view
@@ -0,0 +1,214 @@+module Saturn.Unstable.ParseSpec where++import qualified Data.Either as Either+import qualified Heck+import qualified Saturn.Unstable.Parse as Parse+import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec++spec :: (MonadFail m, Monad n) => Heck.Test m n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Parse" $ do+ Heck.describe t "fromString" $ do+ Heck.it t "accepts wildcards" $ do+ schedule <- ScheduleSpec.new [] [] [] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* * * * *")++ Heck.it t "accepts extra spaces" $ do+ schedule <- ScheduleSpec.new [] [] [] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString " * * * * * ")++ Heck.it t "accepts numbers" $ do+ schedule <- ScheduleSpec.new [[4]] [[3]] [[2]] [[1]] [[0]]+ Heck.assertEq t (Right schedule) (Parse.fromString "4 3 2 1 0")++ Heck.it t "accepts ranges" $ do+ schedule <- ScheduleSpec.new [[8, 9]] [[6, 7]] [[4, 5]] [[2, 3]] [[0, 1]]+ Heck.assertEq t (Right schedule) (Parse.fromString "8-9 6-7 4-5 2-3 0-1")++ Heck.it t "accepts choices" $ do+ schedule <- ScheduleSpec.new [[8], [9]] [[6], [7]] [[4], [5]] [[2], [3]] [[0], [1]]+ Heck.assertEq t (Right schedule) (Parse.fromString "8,9 6,7 4,5 2,3 0,1")++ Heck.describe t "minute" $ do+ Heck.it t "accepts a number" $ do+ schedule <- ScheduleSpec.new [[0]] [] [] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "0 * * * *")++ Heck.it t "accepts a range" $ do+ schedule <- ScheduleSpec.new [[0, 1]] [] [] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "0-1 * * * *")++ Heck.it t "accepts a choice" $ do+ schedule <- ScheduleSpec.new [[0], [1]] [] [] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "0,1 * * * *")++ Heck.it t "rejects two wildcards" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "*,* * * * *"))++ Heck.it t "rejects a wildcard and a number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "*,0 * * * *"))++ Heck.it t "rejects a wildcard and a range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "*,0-0 * * * *"))++ Heck.it t "rejects an out of bounds number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "60 * * * *"))++ Heck.it t "rejects an out of bounds number as part of a choice" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "0,60 * * * *"))++ Heck.it t "rejects an out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "60-61 * * * *"))++ Heck.it t "rejects a half out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "0-60 * * * *"))++ Heck.it t "rejects a backwards range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "1-0 * * * *"))++ Heck.describe t "hour" $ do+ Heck.it t "accepts a number" $ do+ schedule <- ScheduleSpec.new [] [[0]] [] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* 0 * * *")++ Heck.it t "accepts a range" $ do+ schedule <- ScheduleSpec.new [] [[0, 1]] [] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* 0-1 * * *")++ Heck.it t "accepts a choice" $ do+ schedule <- ScheduleSpec.new [] [[0], [1]] [] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* 0,1 * * *")++ Heck.it t "rejects two wildcards" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* *,* * * *"))++ Heck.it t "rejects a wildcard and a number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* *,0 * * *"))++ Heck.it t "rejects a wildcard and a range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* *,0-0 * * *"))++ Heck.it t "rejects an out of bounds number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* 24 * * *"))++ Heck.it t "rejects an out of bounds number as part of a choice" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* 0,24 * * *"))++ Heck.it t "rejects an out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* 24-25 * * *"))++ Heck.it t "rejects a half out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* 0-24 * * *"))++ Heck.it t "rejects a backwards range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* 1-0 * * *"))++ Heck.describe t "day" $ do+ Heck.it t "accepts a number" $ do+ schedule <- ScheduleSpec.new [] [] [[1]] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* * 1 * *")++ Heck.it t "accepts a range" $ do+ schedule <- ScheduleSpec.new [] [] [[1, 2]] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* * 1-2 * *")++ Heck.it t "accepts a choice" $ do+ schedule <- ScheduleSpec.new [] [] [[1], [2]] [] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* * 1,2 * *")++ Heck.it t "rejects two wildcards" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * *,* * *"))++ Heck.it t "rejects a wildcard and a number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * *,1 * *"))++ Heck.it t "rejects a wildcard and a range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * *,1-1 * *"))++ Heck.it t "rejects an out of bounds number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * 32 * *"))++ Heck.it t "rejects an out of bounds number as part of a choice" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * 1,32 * *"))++ Heck.it t "rejects an out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * 32-33 * *"))++ Heck.it t "rejects a half out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * 1-32 * *"))++ Heck.it t "rejects a backwards range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * 2-1 * *"))++ Heck.describe t "month" $ do+ Heck.it t "accepts a number" $ do+ schedule <- ScheduleSpec.new [] [] [] [[1]] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* * * 1 *")++ Heck.it t "accepts a range" $ do+ schedule <- ScheduleSpec.new [] [] [] [[1, 2]] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* * * 1-2 *")++ Heck.it t "accepts a choice" $ do+ schedule <- ScheduleSpec.new [] [] [] [[1], [2]] []+ Heck.assertEq t (Right schedule) (Parse.fromString "* * * 1,2 *")++ Heck.it t "rejects two wildcards" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * *,* *"))++ Heck.it t "rejects a wildcard and a number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * *,1 *"))++ Heck.it t "rejects a wildcard and a range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * *,1-1 *"))++ Heck.it t "rejects an out of bounds number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * 13 *"))++ Heck.it t "rejects an out of bounds number as part of a choice" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * 1,13 *"))++ Heck.it t "rejects an out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * 13-14 *"))++ Heck.it t "rejects a half out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * 1-13 *"))++ Heck.it t "rejects a backwards range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * 2-1 *"))++ Heck.describe t "weekday" $ do+ Heck.it t "accepts a number" $ do+ schedule <- ScheduleSpec.new [] [] [] [] [[0]]+ Heck.assertEq t (Right schedule) (Parse.fromString "* * * * 0")++ Heck.it t "accepts a range" $ do+ schedule <- ScheduleSpec.new [] [] [] [] [[0, 1]]+ Heck.assertEq t (Right schedule) (Parse.fromString "* * * * 0-1")++ Heck.it t "accepts a choice" $ do+ schedule <- ScheduleSpec.new [] [] [] [] [[0], [1]]+ Heck.assertEq t (Right schedule) (Parse.fromString "* * * * 0,1")++ Heck.it t "rejects two wildcards" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * * *,*"))++ Heck.it t "rejects a wildcard and a number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * * *,0"))++ Heck.it t "rejects a wildcard and a range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * * *,0-0"))++ Heck.it t "rejects an out of bounds number" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * * 7"))++ Heck.it t "rejects an out of bounds number as part of a choice" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * * 0,7"))++ Heck.it t "rejects an out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * * 7-8"))++ Heck.it t "rejects a half out of bounds range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * * 0-7"))++ Heck.it t "rejects a backwards range" $ do+ Heck.assertEq t True (Either.isLeft (Parse.fromString "* * * * 1-0"))
+ source/library/Saturn/Unstable/Render.hs view
@@ -0,0 +1,21 @@+module Saturn.Unstable.Render where++import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import qualified Data.Text.Lazy.Builder as Builder+import qualified Saturn.Unstable.Type.Schedule as Schedule++-- | Renders a 'Schedule.Schedule' into a lazy 'LazyText.Text' value. See+-- 'toText' for details.+toLazyText :: Schedule.Schedule -> LazyText.Text+toLazyText = Builder.toLazyText . Schedule.toBuilder++-- | Renders a 'Schedule.Schedule' into a 'String' value. See 'toText' for+-- details.+toString :: Schedule.Schedule -> String+toString = LazyText.unpack . toLazyText++-- | Renders a 'Schedule.Schedule' into a strict 'Text.Text' value. The output+-- will have five fields, each separated by a single space.+toText :: Schedule.Schedule -> Text.Text+toText = LazyText.toStrict . toLazyText
+ source/library/Saturn/Unstable/RenderSpec.hs view
@@ -0,0 +1,24 @@+module Saturn.Unstable.RenderSpec where++import qualified Heck+import qualified Saturn.Unstable.Render as Render+import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec++spec :: (MonadFail m, Monad n) => Heck.Test m n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Render" $ do+ Heck.describe t "toString" $ do+ Heck.it t "works with wildcards" $ do+ schedule <- ScheduleSpec.new [] [] [] [] []+ Heck.assertEq t "* * * * *" (Render.toString schedule)++ Heck.it t "works with numbers" $ do+ schedule <- ScheduleSpec.new [[4]] [[3]] [[2]] [[1]] [[0]]+ Heck.assertEq t "4 3 2 1 0" (Render.toString schedule)++ Heck.it t "works with ranges" $ do+ schedule <- ScheduleSpec.new [[8, 9]] [[6, 7]] [[4, 5]] [[2, 3]] [[0, 1]]+ Heck.assertEq t "8-9 6-7 4-5 2-3 0-1" (Render.toString schedule)++ Heck.it t "works with choices" $ do+ schedule <- ScheduleSpec.new [[8], [9]] [[6], [7]] [[4], [5]] [[2], [3]] [[0], [1]]+ Heck.assertEq t "8,9 6,7 4,5 2,3 0,1" (Render.toString schedule)
+ source/library/Saturn/Unstable/Type/Day.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Day where++import qualified Data.Coerce as Coerce+import qualified Data.Set as Set+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Saturn.Unstable.Type.Field as Field+import qualified Text.Parsec as Parsec++newtype Day+ = Day Field.Field+ deriving (Eq, Show)++bounds :: (Word.Word8, Word.Word8)+bounds = (1, 31)++fromField :: Field.Field -> Maybe Day+fromField field =+ if Field.isValid bounds field then Just $ Day field else Nothing++toField :: Day -> Field.Field+toField = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Day+parsec = do+ field <- Field.parsec+ maybe (fail "invalid Day") pure $ fromField field++toBuilder :: Day -> Builder.Builder+toBuilder = Field.toBuilder . toField++expand :: Day -> Set.Set Word.Word8+expand = Field.expand bounds . toField++isMatch :: Word.Word8 -> Day -> Bool+isMatch word8 = Set.member word8 . expand
+ source/library/Saturn/Unstable/Type/DaySpec.hs view
@@ -0,0 +1,31 @@+module Saturn.Unstable.Type.DaySpec where++import qualified Data.Maybe as Maybe+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Heck+import qualified Saturn.Unstable.Type.Day as Day+import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Day" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Day.parsec "" (Builder.toLazyText $ Day.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Day.Day+arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Day.fromField++shrink :: Day.Day -> [Day.Day]+shrink = Maybe.mapMaybe Day.fromField . FieldSpec.shrink . Day.toField++new :: (MonadFail m) => [[Word.Word8]] -> m Day.Day+new xs = do+ field <- FieldSpec.new xs+ maybe (fail $ "invalid Day: " <> show xs) pure $ Day.fromField field
+ source/library/Saturn/Unstable/Type/Element.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Element where++import qualified Data.Coerce as Coerce+import qualified Data.Set as Set+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Saturn.Unstable.Extra.Parsec as Parsec+import qualified Saturn.Unstable.Type.Number as Number+import qualified Saturn.Unstable.Type.Range as Range+import qualified Text.Parsec as Parsec++newtype Element+ = Element (Either Range.Range Number.Number)+ deriving (Eq, Show)++fromEither :: Either Range.Range Number.Number -> Element+fromEither = Coerce.coerce++toEither :: Element -> Either Range.Range Number.Number+toEither = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Element+parsec = fromEither <$> Parsec.either (Parsec.try Range.parsec) Number.parsec++toBuilder :: Element -> Builder.Builder+toBuilder = either Range.toBuilder Number.toBuilder . toEither++isValid :: (Word.Word8, Word.Word8) -> Element -> Bool+isValid tuple = either (Range.isValid tuple) (Number.isValid tuple) . toEither++expand :: Element -> Set.Set Word.Word8+expand = either Range.expand (Set.singleton . Number.toWord8) . toEither
+ source/library/Saturn/Unstable/Type/ElementSpec.hs view
@@ -0,0 +1,47 @@+module Saturn.Unstable.Type.ElementSpec where++import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Heck+import qualified Saturn.Unstable.Type.Element as Element+import qualified Saturn.Unstable.Type.Number as Number+import qualified Saturn.Unstable.Type.NumberSpec as NumberSpec+import qualified Saturn.Unstable.Type.Range as Range+import qualified Saturn.Unstable.Type.RangeSpec as RangeSpec+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Element" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Element.parsec "" (Builder.toLazyText $ Element.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Element.Element+arbitrary =+ Element.fromEither+ <$> QuickCheck.liftArbitrary2+ RangeSpec.arbitrary+ NumberSpec.arbitrary++shrink :: Element.Element -> [Element.Element]+shrink element =+ let xs = case Element.toEither element of+ Left range ->+ let (lo, hi) = Range.toTuple range+ in fmap (Element.fromEither . Right) [lo, hi]+ Right _ -> []+ in mappend xs+ . fmap Element.fromEither+ . QuickCheck.liftShrink2 RangeSpec.shrink NumberSpec.shrink+ $ Element.toEither element++new :: (MonadFail m) => [Word.Word8] -> m Element.Element+new xs = case xs of+ [x] -> pure . Element.fromEither . Right $ Number.fromWord8 x+ [x, y] -> Element.fromEither . Left <$> RangeSpec.new (x, y)+ _ -> fail $ "invalid Element: " <> show xs
+ source/library/Saturn/Unstable/Type/Field.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Field where++import qualified Data.Coerce as Coerce+import qualified Data.Either as Either+import qualified Data.Foldable as Foldable+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Set as Set+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Saturn.Unstable.Extra.Parsec as Parsec+import qualified Saturn.Unstable.Extra.Tuple as Tuple+import qualified Saturn.Unstable.Type.Element as Element+import qualified Saturn.Unstable.Type.Wildcard as Wildcard+import qualified Text.Parsec as Parsec++newtype Field+ = Field (Either Wildcard.Wildcard (NonEmpty.NonEmpty Element.Element))+ deriving (Eq, Show)++fromEither ::+ Either Wildcard.Wildcard (NonEmpty.NonEmpty Element.Element) -> Field+fromEither = Coerce.coerce++toEither ::+ Field -> Either Wildcard.Wildcard (NonEmpty.NonEmpty Element.Element)+toEither = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Field+parsec =+ fromEither+ <$> Parsec.either+ Wildcard.parsec+ (Parsec.sepByNE Element.parsec $ Parsec.char ',')++toBuilder :: Field -> Builder.Builder+toBuilder =+ either+ Wildcard.toBuilder+ ( Foldable.fold+ . NonEmpty.intersperse (Builder.singleton ',')+ . fmap Element.toBuilder+ )+ . toEither++isValid :: (Word.Word8, Word.Word8) -> Field -> Bool+isValid tuple = either (const True) (all $ Element.isValid tuple) . toEither++expand :: (Word.Word8, Word.Word8) -> Field -> Set.Set Word.Word8+expand tuple =+ either+ (const . Set.fromList $ Tuple.toSequence tuple)+ (Set.unions . fmap Element.expand)+ . toEither++isWildcard :: Field -> Bool+isWildcard = Either.isLeft . toEither
+ source/library/Saturn/Unstable/Type/FieldSpec.hs view
@@ -0,0 +1,55 @@+module Saturn.Unstable.Type.FieldSpec where++import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Maybe as Maybe+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Heck+import qualified Saturn.Unstable.Type.ElementSpec as ElementSpec+import qualified Saturn.Unstable.Type.Field as Field+import qualified Saturn.Unstable.Type.Wildcard as Wildcard+import qualified Saturn.Unstable.Type.WildcardSpec as WildcardSpec+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Field" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Field.parsec "" (Builder.toLazyText $ Field.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Field.Field+arbitrary =+ Field.fromEither+ <$> QuickCheck.liftArbitrary2+ WildcardSpec.arbitrary+ (arbitraryNonEmpty ElementSpec.arbitrary)++arbitraryNonEmpty :: QuickCheck.Gen a -> QuickCheck.Gen (NonEmpty.NonEmpty a)+arbitraryNonEmpty g = (NonEmpty.:|) <$> g <*> QuickCheck.listOf g++shrink :: Field.Field -> [Field.Field]+shrink field =+ let xs = case Field.toEither field of+ Left _ -> []+ Right _ -> [Field.fromEither . Left $ Wildcard.fromUnit ()]+ in mappend xs+ . fmap Field.fromEither+ . QuickCheck.liftShrink2 WildcardSpec.shrink (shrinkNonEmpty ElementSpec.shrink)+ $ Field.toEither field++shrinkNonEmpty :: (a -> [a]) -> NonEmpty.NonEmpty a -> [NonEmpty.NonEmpty a]+shrinkNonEmpty f = Maybe.mapMaybe (NonEmpty.nonEmpty . f) . NonEmpty.toList++new :: (MonadFail m) => [[Word.Word8]] -> m Field.Field+new =+ fmap+ ( Field.fromEither+ . maybe (Left $ Wildcard.fromUnit ()) Right+ . NonEmpty.nonEmpty+ )+ . mapM ElementSpec.new
+ source/library/Saturn/Unstable/Type/Hour.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Hour where++import qualified Data.Coerce as Coerce+import qualified Data.Set as Set+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Saturn.Unstable.Type.Field as Field+import qualified Text.Parsec as Parsec++newtype Hour+ = Hour Field.Field+ deriving (Eq, Show)++bounds :: (Word.Word8, Word.Word8)+bounds = (0, 23)++fromField :: Field.Field -> Maybe Hour+fromField field =+ if Field.isValid bounds field then Just $ Hour field else Nothing++toField :: Hour -> Field.Field+toField = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Hour+parsec = do+ field <- Field.parsec+ maybe (fail "invalid Hour") pure $ fromField field++toBuilder :: Hour -> Builder.Builder+toBuilder = Field.toBuilder . toField++expand :: Hour -> Set.Set Word.Word8+expand = Field.expand bounds . toField++isMatch :: Word.Word8 -> Hour -> Bool+isMatch word8 = Set.member word8 . expand
+ source/library/Saturn/Unstable/Type/HourSpec.hs view
@@ -0,0 +1,31 @@+module Saturn.Unstable.Type.HourSpec where++import qualified Data.Maybe as Maybe+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Heck+import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec+import qualified Saturn.Unstable.Type.Hour as Hour+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Hour" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Hour.parsec "" (Builder.toLazyText $ Hour.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Hour.Hour+arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Hour.fromField++shrink :: Hour.Hour -> [Hour.Hour]+shrink = Maybe.mapMaybe Hour.fromField . FieldSpec.shrink . Hour.toField++new :: (MonadFail m) => [[Word.Word8]] -> m Hour.Hour+new xs = do+ field <- FieldSpec.new xs+ maybe (fail $ "invalid Hour: " <> show xs) pure $ Hour.fromField field
+ source/library/Saturn/Unstable/Type/Minute.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Minute where++import qualified Data.Coerce as Coerce+import qualified Data.Set as Set+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Saturn.Unstable.Type.Field as Field+import qualified Text.Parsec as Parsec++newtype Minute+ = Minute Field.Field+ deriving (Eq, Show)++bounds :: (Word.Word8, Word.Word8)+bounds = (0, 59)++fromField :: Field.Field -> Maybe Minute+fromField field =+ if Field.isValid bounds field then Just $ Minute field else Nothing++toField :: Minute -> Field.Field+toField = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Minute+parsec = do+ field <- Field.parsec+ maybe (fail "invalid Minute") pure $ fromField field++toBuilder :: Minute -> Builder.Builder+toBuilder = Field.toBuilder . toField++expand :: Minute -> Set.Set Word.Word8+expand = Field.expand bounds . toField++isMatch :: Word.Word8 -> Minute -> Bool+isMatch word8 = Set.member word8 . expand
+ source/library/Saturn/Unstable/Type/MinuteSpec.hs view
@@ -0,0 +1,31 @@+module Saturn.Unstable.Type.MinuteSpec where++import qualified Data.Maybe as Maybe+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Heck+import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec+import qualified Saturn.Unstable.Type.Minute as Minute+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Minute" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Minute.parsec "" (Builder.toLazyText $ Minute.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Minute.Minute+arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Minute.fromField++shrink :: Minute.Minute -> [Minute.Minute]+shrink = Maybe.mapMaybe Minute.fromField . FieldSpec.shrink . Minute.toField++new :: (MonadFail m) => [[Word.Word8]] -> m Minute.Minute+new xs = do+ field <- FieldSpec.new xs+ maybe (fail $ "invalid Minute: " <> show xs) pure $ Minute.fromField field
+ source/library/Saturn/Unstable/Type/Month.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Month where++import qualified Data.Coerce as Coerce+import qualified Data.Set as Set+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Saturn.Unstable.Type.Field as Field+import qualified Text.Parsec as Parsec++newtype Month+ = Month Field.Field+ deriving (Eq, Show)++bounds :: (Word.Word8, Word.Word8)+bounds = (1, 12)++fromField :: Field.Field -> Maybe Month+fromField field =+ if Field.isValid bounds field then Just $ Month field else Nothing++toField :: Month -> Field.Field+toField = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Month+parsec = do+ field <- Field.parsec+ maybe (fail "invalid Month") pure $ fromField field++toBuilder :: Month -> Builder.Builder+toBuilder = Field.toBuilder . toField++expand :: Month -> Set.Set Word.Word8+expand = Field.expand bounds . toField++isMatch :: Word.Word8 -> Month -> Bool+isMatch word8 = Set.member word8 . expand
+ source/library/Saturn/Unstable/Type/MonthSpec.hs view
@@ -0,0 +1,31 @@+module Saturn.Unstable.Type.MonthSpec where++import qualified Data.Maybe as Maybe+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Heck+import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec+import qualified Saturn.Unstable.Type.Month as Month+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Month" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Month.parsec "" (Builder.toLazyText $ Month.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Month.Month+arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Month.fromField++shrink :: Month.Month -> [Month.Month]+shrink = Maybe.mapMaybe Month.fromField . FieldSpec.shrink . Month.toField++new :: (MonadFail m) => [[Word.Word8]] -> m Month.Month+new xs = do+ field <- FieldSpec.new xs+ maybe (fail $ "invalid Month: " <> show xs) pure $ Month.fromField field
+ source/library/Saturn/Unstable/Type/Number.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Number where++import qualified Data.Bits as Bits+import qualified Data.Coerce as Coerce+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Text.Lazy.Builder.Int as Builder+import qualified Data.Word as Word+import qualified Saturn.Unstable.Extra.Ord as Ord+import qualified Text.Parsec as Parsec+import qualified Text.Read as Read++newtype Number+ = Number Word.Word8+ deriving (Eq, Show)++fromWord8 :: Word.Word8 -> Number+fromWord8 = Coerce.coerce++toWord8 :: Number -> Word.Word8+toWord8 = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Number+parsec = do+ string <- Parsec.many1 Parsec.digit+ integer <- maybe (fail "invalidNumber") pure $ Read.readMaybe string+ maybe (fail "invalidNumber") (pure . fromWord8) $+ Bits.toIntegralSized (integer :: Integer)++toBuilder :: Number -> Builder.Builder+toBuilder = Builder.decimal . toWord8++isValid :: (Word.Word8, Word.Word8) -> Number -> Bool+isValid tuple = Ord.within tuple . toWord8
+ source/library/Saturn/Unstable/Type/NumberSpec.hs view
@@ -0,0 +1,23 @@+module Saturn.Unstable.Type.NumberSpec where++import qualified Data.Text.Lazy.Builder as Builder+import qualified Heck+import qualified Saturn.Unstable.Type.Number as Number+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Number" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Number.parsec "" (Builder.toLazyText $ Number.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Number.Number+arbitrary = Number.fromWord8 <$> QuickCheck.arbitrary++shrink :: Number.Number -> [Number.Number]+shrink = fmap Number.fromWord8 . QuickCheck.shrink . Number.toWord8
+ source/library/Saturn/Unstable/Type/Range.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Range where++import qualified Control.Monad as Monad+import qualified Data.Coerce as Coerce+import qualified Data.Set as Set+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Saturn.Unstable.Extra.Tuple as Tuple+import qualified Saturn.Unstable.Type.Number as Number+import qualified Text.Parsec as Parsec++newtype Range+ = Range (Number.Number, Number.Number)+ deriving (Eq, Show)++fromTuple :: (Number.Number, Number.Number) -> Maybe Range+fromTuple (lo, hi) =+ if Number.toWord8 lo > Number.toWord8 hi+ then Nothing+ else Just $ Range (lo, hi)++toTuple :: Range -> (Number.Number, Number.Number)+toTuple = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Range+parsec = do+ lo <- Number.parsec+ Monad.void $ Parsec.char '-'+ hi <- Number.parsec+ maybe (fail "invalid Range") pure $ fromTuple (lo, hi)++toBuilder :: Range -> Builder.Builder+toBuilder range =+ let (lo, hi) = toTuple range+ in Number.toBuilder lo <> Builder.singleton '-' <> Number.toBuilder hi++isValid :: (Word.Word8, Word.Word8) -> Range -> Bool+isValid tuple = uncurry (&&) . Tuple.mapBoth (Number.isValid tuple) . toTuple++expand :: Range -> Set.Set Word.Word8+expand =+ Set.fromList+ . Tuple.toSequence+ . Tuple.mapBoth Number.toWord8+ . toTuple
+ source/library/Saturn/Unstable/Type/RangeSpec.hs view
@@ -0,0 +1,40 @@+module Saturn.Unstable.Type.RangeSpec where++import qualified Data.Maybe as Maybe+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Heck+import qualified Saturn.Unstable.Extra.Tuple as Tuple+import qualified Saturn.Unstable.Type.Number as Number+import qualified Saturn.Unstable.Type.NumberSpec as NumberSpec+import qualified Saturn.Unstable.Type.Range as Range+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Range" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Range.parsec "" (Builder.toLazyText $ Range.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Range.Range+arbitrary =+ QuickCheck.suchThatMap+ (QuickCheck.liftArbitrary2 NumberSpec.arbitrary NumberSpec.arbitrary)+ Range.fromTuple++shrink :: Range.Range -> [Range.Range]+shrink =+ Maybe.mapMaybe Range.fromTuple+ . QuickCheck.liftShrink2 NumberSpec.shrink NumberSpec.shrink+ . Range.toTuple++new :: (MonadFail m) => (Word.Word8, Word.Word8) -> m Range.Range+new tuple =+ maybe (fail $ "invalid Range: " <> show tuple) pure+ . Range.fromTuple+ $ Tuple.mapBoth Number.fromWord8 tuple
+ source/library/Saturn/Unstable/Type/Schedule.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Schedule where++import qualified Data.Text.Lazy.Builder as Builder+import qualified Saturn.Unstable.Type.Day as Day+import qualified Saturn.Unstable.Type.Hour as Hour+import qualified Saturn.Unstable.Type.Minute as Minute+import qualified Saturn.Unstable.Type.Month as Month+import qualified Saturn.Unstable.Type.Weekday as Weekday+import qualified Text.Parsec as Parsec++data Schedule = Schedule+ { minute :: Minute.Minute,+ hour :: Hour.Hour,+ day :: Day.Day,+ month :: Month.Month,+ weekday :: Weekday.Weekday+ }+ deriving (Eq, Show)++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Schedule+parsec =+ Schedule+ <$> Minute.parsec+ <* Parsec.skipMany1 (Parsec.char ' ')+ <*> Hour.parsec+ <* Parsec.skipMany1 (Parsec.char ' ')+ <*> Day.parsec+ <* Parsec.skipMany1 (Parsec.char ' ')+ <*> Month.parsec+ <* Parsec.skipMany1 (Parsec.char ' ')+ <*> Weekday.parsec++toBuilder :: Schedule -> Builder.Builder+toBuilder schedule =+ Minute.toBuilder (minute schedule)+ <> Builder.singleton ' '+ <> Hour.toBuilder (hour schedule)+ <> Builder.singleton ' '+ <> Day.toBuilder (day schedule)+ <> Builder.singleton ' '+ <> Month.toBuilder (month schedule)+ <> Builder.singleton ' '+ <> Weekday.toBuilder (weekday schedule)
+ source/library/Saturn/Unstable/Type/ScheduleSpec.hs view
@@ -0,0 +1,87 @@+module Saturn.Unstable.Type.ScheduleSpec where++import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Heck+import qualified Saturn.Unstable.Type.DaySpec as DaySpec+import qualified Saturn.Unstable.Type.HourSpec as HourSpec+import qualified Saturn.Unstable.Type.MinuteSpec as MinuteSpec+import qualified Saturn.Unstable.Type.MonthSpec as MonthSpec+import qualified Saturn.Unstable.Type.Schedule as Schedule+import qualified Saturn.Unstable.Type.WeekdaySpec as WeekdaySpec+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Schedule" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Schedule.parsec "" (Builder.toLazyText $ Schedule.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Schedule.Schedule+arbitrary =+ Schedule.Schedule+ <$> MinuteSpec.arbitrary+ <*> HourSpec.arbitrary+ <*> DaySpec.arbitrary+ <*> MonthSpec.arbitrary+ <*> WeekdaySpec.arbitrary++shrink :: Schedule.Schedule -> [Schedule.Schedule]+shrink schedule =+ ( \(minute, hour, day, month, weekday) ->+ Schedule.Schedule+ { Schedule.minute = minute,+ Schedule.hour = hour,+ Schedule.day = day,+ Schedule.month = month,+ Schedule.weekday = weekday+ }+ )+ <$> liftShrink5+ MinuteSpec.shrink+ HourSpec.shrink+ DaySpec.shrink+ MonthSpec.shrink+ WeekdaySpec.shrink+ ( Schedule.minute schedule,+ Schedule.hour schedule,+ Schedule.day schedule,+ Schedule.month schedule,+ Schedule.weekday schedule+ )++liftShrink5 ::+ (t1 -> [t1]) ->+ (t2 -> [t2]) ->+ (t3 -> [t3]) ->+ (t4 -> [t4]) ->+ (t5 -> [t5]) ->+ (t1, t2, t3, t4, t5) ->+ [(t1, t2, t3, t4, t5)]+liftShrink5 f1 f2 f3 f4 f5 (x1, x2, x3, x4, x5) =+ (\((y1, y2), (y3, (y4, y5))) -> (y1, y2, y3, y4, y5))+ <$> QuickCheck.liftShrink2+ (QuickCheck.liftShrink2 f1 f2)+ (QuickCheck.liftShrink2 f3 (QuickCheck.liftShrink2 f4 f5))+ ((x1, x2), (x3, (x4, x5)))++new ::+ (MonadFail m) =>+ [[Word.Word8]] ->+ [[Word.Word8]] ->+ [[Word.Word8]] ->+ [[Word.Word8]] ->+ [[Word.Word8]] ->+ m Schedule.Schedule+new minutes hours days months weekdays =+ Schedule.Schedule+ <$> MinuteSpec.new minutes+ <*> HourSpec.new hours+ <*> DaySpec.new days+ <*> MonthSpec.new months+ <*> WeekdaySpec.new weekdays
+ source/library/Saturn/Unstable/Type/Weekday.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Weekday where++import qualified Data.Coerce as Coerce+import qualified Data.Set as Set+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Saturn.Unstable.Type.Field as Field+import qualified Text.Parsec as Parsec++newtype Weekday+ = Weekday Field.Field+ deriving (Eq, Show)++bounds :: (Word.Word8, Word.Word8)+bounds = (0, 6)++fromField :: Field.Field -> Maybe Weekday+fromField field =+ if Field.isValid bounds field then Just $ Weekday field else Nothing++toField :: Weekday -> Field.Field+toField = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Weekday+parsec = do+ field <- Field.parsec+ maybe (fail "invalid Weekday") pure $ fromField field++toBuilder :: Weekday -> Builder.Builder+toBuilder = Field.toBuilder . toField++expand :: Weekday -> Set.Set Word.Word8+expand = Field.expand bounds . toField++isMatch :: Word.Word8 -> Weekday -> Bool+isMatch word8 = Set.member word8 . expand
+ source/library/Saturn/Unstable/Type/WeekdaySpec.hs view
@@ -0,0 +1,31 @@+module Saturn.Unstable.Type.WeekdaySpec where++import qualified Data.Maybe as Maybe+import qualified Data.Text.Lazy.Builder as Builder+import qualified Data.Word as Word+import qualified Heck+import qualified Saturn.Unstable.Type.FieldSpec as FieldSpec+import qualified Saturn.Unstable.Type.Weekday as Weekday+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Weekday" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Weekday.parsec "" (Builder.toLazyText $ Weekday.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Weekday.Weekday+arbitrary = QuickCheck.suchThatMap FieldSpec.arbitrary Weekday.fromField++shrink :: Weekday.Weekday -> [Weekday.Weekday]+shrink = Maybe.mapMaybe Weekday.fromField . FieldSpec.shrink . Weekday.toField++new :: (MonadFail m) => [[Word.Word8]] -> m Weekday.Weekday+new xs = do+ field <- FieldSpec.new xs+ maybe (fail $ "invalid Weekday: " <> show xs) pure $ Weekday.fromField field
+ source/library/Saturn/Unstable/Type/Wildcard.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE FlexibleContexts #-}++module Saturn.Unstable.Type.Wildcard where++import qualified Control.Monad as Monad+import qualified Data.Coerce as Coerce+import qualified Data.Text.Lazy.Builder as Builder+import qualified Text.Parsec as Parsec++newtype Wildcard+ = Wildcard ()+ deriving (Eq, Show)++fromUnit :: () -> Wildcard+fromUnit = Coerce.coerce++toUnit :: Wildcard -> ()+toUnit = Coerce.coerce++parsec :: (Parsec.Stream s m Char) => Parsec.ParsecT s u m Wildcard+parsec = fmap fromUnit . Monad.void $ Parsec.char '*'++toBuilder :: Wildcard -> Builder.Builder+toBuilder = const $ Builder.singleton '*'
+ source/library/Saturn/Unstable/Type/WildcardSpec.hs view
@@ -0,0 +1,23 @@+module Saturn.Unstable.Type.WildcardSpec where++import qualified Data.Text.Lazy.Builder as Builder+import qualified Heck+import qualified Saturn.Unstable.Type.Wildcard as Wildcard+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck+import qualified Text.Parsec as Parsec++spec :: Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn.Unstable.Type.Wildcard" $ do+ Heck.it t "round trips"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink arbitrary shrink+ $ \x -> do+ Parsec.parse Wildcard.parsec "" (Builder.toLazyText $ Wildcard.toBuilder x)+ `Hspec.shouldBe` Right x++arbitrary :: QuickCheck.Gen Wildcard.Wildcard+arbitrary = Wildcard.fromUnit <$> QuickCheck.arbitrary++shrink :: Wildcard.Wildcard -> [Wildcard.Wildcard]+shrink = fmap Wildcard.fromUnit . QuickCheck.shrink . Wildcard.toUnit
+ source/library/SaturnSpec.hs view
@@ -0,0 +1,29 @@+module SaturnSpec where++import qualified Heck+import qualified Saturn.Unstable.Parse as Parse+import qualified Saturn.Unstable.Render as Render+import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec+import qualified Test.Hspec as Hspec+import qualified Test.QuickCheck as QuickCheck++spec :: (Monad n) => Heck.Test IO n -> n ()+spec t = Heck.describe t "Saturn" $ do+ Heck.describe t "round trips" $ do+ Heck.it t "through string"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink ScheduleSpec.arbitrary ScheduleSpec.shrink+ $ \schedule ->+ Parse.fromString (Render.toString schedule) `Hspec.shouldBe` Right schedule++ Heck.it t "through strict text"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink ScheduleSpec.arbitrary ScheduleSpec.shrink+ $ \schedule ->+ Parse.fromText (Render.toText schedule) `Hspec.shouldBe` Right schedule++ Heck.it t "through lazy text"+ . QuickCheck.quickCheck+ . QuickCheck.forAllShrink ScheduleSpec.arbitrary ScheduleSpec.shrink+ $ \schedule ->+ Parse.fromLazyText (Render.toLazyText schedule) `Hspec.shouldBe` Right schedule
source/test-suite/Main.hs view
@@ -1,3 +1,4 @@+import qualified Heck import qualified Saturn.Unstable.ConstantSpec import qualified Saturn.Unstable.Extra.IntSpec import qualified Saturn.Unstable.Extra.OrdSpec@@ -20,27 +21,36 @@ import qualified Saturn.Unstable.Type.WildcardSpec import qualified SaturnSpec import qualified Test.Hspec as Hspec+import qualified Test.Hspec.Core.Spec as Hspec main :: IO () main = Hspec.hspec . Hspec.parallel $ do- Saturn.Unstable.ConstantSpec.spec- Saturn.Unstable.Extra.IntSpec.spec- Saturn.Unstable.Extra.OrdSpec.spec- Saturn.Unstable.Extra.ParsecSpec.spec- Saturn.Unstable.Extra.TimeSpec.spec- Saturn.Unstable.Extra.TupleSpec.spec- Saturn.Unstable.MatchSpec.spec- Saturn.Unstable.ParseSpec.spec- Saturn.Unstable.RenderSpec.spec- Saturn.Unstable.Type.DaySpec.spec- Saturn.Unstable.Type.ElementSpec.spec- Saturn.Unstable.Type.FieldSpec.spec- Saturn.Unstable.Type.HourSpec.spec- Saturn.Unstable.Type.MinuteSpec.spec- Saturn.Unstable.Type.MonthSpec.spec- Saturn.Unstable.Type.NumberSpec.spec- Saturn.Unstable.Type.RangeSpec.spec- Saturn.Unstable.Type.ScheduleSpec.spec- Saturn.Unstable.Type.WeekdaySpec.spec- Saturn.Unstable.Type.WildcardSpec.spec- SaturnSpec.spec+ Saturn.Unstable.ConstantSpec.spec heck+ Saturn.Unstable.Extra.IntSpec.spec heck+ Saturn.Unstable.Extra.OrdSpec.spec heck+ Saturn.Unstable.Extra.ParsecSpec.spec heck+ Saturn.Unstable.Extra.TimeSpec.spec heck+ Saturn.Unstable.Extra.TupleSpec.spec heck+ Saturn.Unstable.MatchSpec.spec heck+ Saturn.Unstable.ParseSpec.spec heck+ Saturn.Unstable.RenderSpec.spec heck+ Saturn.Unstable.Type.DaySpec.spec heck+ Saturn.Unstable.Type.ElementSpec.spec heck+ Saturn.Unstable.Type.FieldSpec.spec heck+ Saturn.Unstable.Type.HourSpec.spec heck+ Saturn.Unstable.Type.MinuteSpec.spec heck+ Saturn.Unstable.Type.MonthSpec.spec heck+ Saturn.Unstable.Type.NumberSpec.spec heck+ Saturn.Unstable.Type.RangeSpec.spec heck+ Saturn.Unstable.Type.ScheduleSpec.spec heck+ Saturn.Unstable.Type.WeekdaySpec.spec heck+ Saturn.Unstable.Type.WildcardSpec.spec heck+ SaturnSpec.spec heck++heck :: Heck.Test IO (Hspec.SpecM ())+heck =+ Heck.MkTest+ { Heck.assertFailure = fmap (\() -> error "impossible") . Hspec.expectationFailure,+ Heck.describe = Hspec.describe,+ Heck.it = Hspec.it+ }