Hello community, here is the log from the commit of package ghc-cron for openSUSE:Factory checked in at 2017-03-03 17:49:15 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-cron (Old) and /work/SRC/openSUSE:Factory/.ghc-cron.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-cron" Fri Mar 3 17:49:15 2017 rev:3 rq:461620 version:0.5.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-cron/ghc-cron.changes 2017-01-12 15:48:06.425005107 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-cron.new/ghc-cron.changes 2017-03-03 17:49:16.492950341 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:11:26 UTC 2017 - [email protected] + +- Update to version 0.5.0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- cron-0.4.2.tar.gz cron.cabal New: ---- cron-0.5.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-cron.spec ++++++ --- /var/tmp/diff_new_pack.iTTPgu/_old 2017-03-03 17:49:17.388823815 +0100 +++ /var/tmp/diff_new_pack.iTTPgu/_new 2017-03-03 17:49:17.388823815 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-cron # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,16 +19,16 @@ %global pkg_name cron %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.4.2 +Version: 0.5.0 Release: 0 Summary: Cron datatypes and Attoparsec parser License: MIT Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-attoparsec-devel +BuildRequires: ghc-data-default-class-devel BuildRequires: ghc-mtl-compat-devel BuildRequires: ghc-mtl-devel BuildRequires: ghc-old-locale-devel @@ -69,7 +69,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build @@ -92,5 +91,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) +%doc README.md changelog %changelog ++++++ cron-0.4.2.tar.gz -> cron-0.5.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/README.md new/cron-0.5.0/README.md --- old/cron-0.4.2/README.md 2016-11-22 21:18:44.000000000 +0100 +++ new/cron-0.5.0/README.md 2017-01-05 03:07:47.000000000 +0100 @@ -10,7 +10,9 @@ `scheduleMatches`, which you can use to compare a time against a `CronSchedule` to see if an action needs to be performed. System.Cron.Parser is where you will find the parsers `cronSchedule`, `crontabEntry` and `cronTab`. To parse -individual schedules up to full crontab files. +individual schedules up to full crontab files. System.Cron.Descrive is where +you will find the `describe` function for creating human-readable strings from +cron schedules, as well as any options to control how the description is created. To do anything, you'll need to install cabal-dev with cabal. @@ -51,9 +53,21 @@ job2 = putStrLn "Job 2" ``` +#### Describe +```haskell +main :: IO () +main = do + let Right cs1 = parseCronSchedule "*/2 * 3 * 4,5,6" + print $ describe defaultOpts cs1 + + let Right cs2 = parseCronSchedule "*/2 12 3 * 4,5,6" + print $ describe (twentyFourHourFormat <> verbose) cs2 +``` + ## Contributors * [Simon Hengel](https://github.com/sol) * [Alberto Valverde](https://github.com/albertov) * [Andrew Rademacher](https://github.com/AndrewRademacher) * [Peter Simons](https://github.com/peti) +* [Joseph Canero](https://github.com/caneroj1) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/bench/Main.hs new/cron-0.5.0/bench/Main.hs --- old/cron-0.4.2/bench/Main.hs 2016-11-22 21:18:44.000000000 +0100 +++ new/cron-0.5.0/bench/Main.hs 2017-01-05 03:07:47.000000000 +0100 @@ -22,6 +22,7 @@ , scheduleMatchesBenchmarks , nextMatchBenchmarks , serializeBenchmarks + , describeBenchmarks ] @@ -67,6 +68,21 @@ ------------------------------------------------------------------------------- +describeBenchmarks :: Benchmark +describeBenchmarks = bgroup "description" + [ + bgroup "verbose" [ + bench "simple" (whnf (describe verbose) simpleCronSchedule) + , bench "complicated" (whnf (describe verbose) complexCronSchedule) + ] + , bgroup "non-verbose" [ + bench "simple" (whnf (describe notVerbose) simpleCronSchedule) + , bench "complicated" (whnf (describe notVerbose) complexCronSchedule) + ] + ] + + +------------------------------------------------------------------------------- parserBench :: String -> Parser a -> Text -> Benchmark parserBench n parser txt = bench n (whnf (parseOnly parser) txt) @@ -86,9 +102,24 @@ ------------------------------------------------------------------------------- +mkCronSchedule :: Text -> CronSchedule +mkCronSchedule t = let (Right cs) = parseCronSchedule t in cs + + +------------------------------------------------------------------------------- +simpleCronSchedule :: CronSchedule +simpleCronSchedule = mkCronSchedule "1 2 3 * *" + + +------------------------------------------------------------------------------- +complexCronSchedule :: CronSchedule +complexCronSchedule = mkCronSchedule "1-10 3 1-20/2 * 3,5" + + +------------------------------------------------------------------------------- exampleCrontab :: Crontab exampleCrontab = Crontab (concat (zipWith (\x y -> [x,y]) (replicate 50 cmd) (repeat envSet))) - where + where cmd = CommandEntry weekly (CronCommand "do something") envSet = EnvVariable "FOO" "BAR" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/changelog new/cron-0.5.0/changelog --- old/cron-0.4.2/changelog 2016-11-22 21:18:44.000000000 +0100 +++ new/cron-0.5.0/changelog 2017-01-05 03:07:47.000000000 +0100 @@ -1,3 +1,5 @@ +# 0.5.0 +* Add System.Cron.Describe which describes cron schedules in words (English only for now). Big thanks to Joe Canero for this feature! # 0.4.2 * Drop dependency on derive in tests. * Add some Generic and Typeable instances. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/cron.cabal new/cron-0.5.0/cron.cabal --- old/cron-0.4.2/cron.cabal 2016-11-22 21:18:44.000000000 +0100 +++ new/cron-0.5.0/cron.cabal 2017-01-05 03:07:47.000000000 +0100 @@ -1,5 +1,5 @@ Name: cron -Version: 0.4.2 +Version: 0.5.0 Description: Cron data structure and Attoparsec parser. The idea is to embed it in larger systems which want to roll their own scheduled tasks in a format that people @@ -32,6 +32,7 @@ test/Main.hs test/SpecHelper.hs test/System/Test/Cron.hs + test/System/Test/Cron/Describe.hs test/System/Test/Cron/Parser.hs test/System/Test/Cron/Schedule.hs Homepage: http://github.com/michaelxavier/cron @@ -43,7 +44,13 @@ library Exposed-modules: System.Cron + , System.Cron.Internal.Describe.Descriptors + , System.Cron.Internal.Describe.Options + , System.Cron.Internal.Describe.Time + , System.Cron.Internal.Describe.Types + , System.Cron.Internal.Describe.Utils , System.Cron.Internal.Check + , System.Cron.Describe , System.Cron.Parser , System.Cron.Schedule , System.Cron.Types @@ -57,6 +64,7 @@ , mtl >= 2.0.1 , mtl-compat >= 0.2.1 , semigroups + , data-default-class >= 0.0.1 if flag(lib-Werror) ghc-options: -Werror @@ -70,6 +78,7 @@ default-language: Haskell2010 other-modules: SpecHelper , System.Test.Cron + , System.Test.Cron.Describe , System.Test.Cron.Parser , System.Test.Cron.Schedule Build-Depends: base diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/src/System/Cron/Describe.hs new/cron-0.5.0/src/System/Cron/Describe.hs --- old/cron-0.4.2/src/System/Cron/Describe.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cron-0.5.0/src/System/Cron/Describe.hs 2017-01-05 03:07:47.000000000 +0100 @@ -0,0 +1,190 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +-------------------------------------------------------------------- +-- | +-- Module : System.Cron.Describe +-- Description : Turn a cron schedule into a human-readable string +-- Copyright : (c) Joseph Canero 2016 +-- License : MIT +-- +-- Maintainer: Joseph Canero <[email protected]> +-- Portability: portable +-- +-- +-- > import System.Cron +-- > +-- > main :: IO () +-- > main = do +-- > let Right cs1 = parseCronSchedule "*/2 * 3 * 4,5,6" +-- > print $ describe defaultOpts cs1 +-- > +-- > let Right cs2 = parseCronSchedule "*/2 12 3 * 4,5,6" +-- > print $ describe (twentyFourHourFormat <> verbose) cs2 +-------------------------------------------------------------------- +module System.Cron.Describe + ( + -- * Options handling + defaultOpts + , twentyFourHourFormat + , twelveHourFormat + , verbose + , notVerbose + , OptionBuilder + -- * Describe a CronSchedule + , describe + ) where + +------------------------------------------------------------------------------- +import Control.Monad +import Data.List.NonEmpty (NonEmpty (..), toList) +import Data.Maybe (fromJust) +#if !MIN_VERSION_base(4,8,0) +import Data.Traversable (traverse) +#endif +------------------------------------------------------------------------------- +import System.Cron.Internal.Describe.Descriptors +import System.Cron.Internal.Describe.Options +import System.Cron.Internal.Describe.Time +import System.Cron.Internal.Describe.Types +import System.Cron.Internal.Describe.Utils +import System.Cron.Types +------------------------------------------------------------------------------- + + +-- | Given an 'OptionBuilder' and a 'CronSchedule' parsed with +-- 'System.Cron.Parser.parseCronSchedule', return a human-readable string +-- describing when that schedule will match. +describe :: OptionBuilder -> CronSchedule -> String +describe ob = cap . + show . + matchVerbosity verbosity . + description timeFormat + where Opts{..} = getOpts ob + + +------------------------------------------------------------------------------- +-- Internals +------------------------------------------------------------------------------- + + +describeRange :: RangeField -> Descriptor -> String +describeRange rf d = allWords [rangePrefix d, + displayItem d (rfBegin rf), + rangeJoiner d, + displayItem d (rfEnd rf), + rangeSuffix d] + + +describeBaseField :: Descriptor -> BaseField -> DescribedValue +describeBaseField d (RangeField' rf) = Concrete $ describeRange rf d +describeBaseField d Star = Every $ "every " ++ singularDesc d +describeBaseField d (SpecificField' s) = + Concrete $ allWords [specificPrefix d, + displayItem d (specificField s), + specificSuffix d] + + +type StarOrDesc = Either String String + + +describeListFields :: (BaseField -> String) -> NonEmpty BaseField -> StarOrDesc +describeListFields f (l :| ls) = + fmap joinWords . foldM describeF [] $ reverse (l:ls) + where describeF _ Star = Left $ f Star + describeF e bf = Right $ f bf : e + + + +describeCronField :: Descriptor -> CronField -> DescribedValue +describeCronField d (Field f) = describeBaseField d f + + +describeCronField d (StepField' sf) = Concrete $ + stepPrefix ++ maybe "" (", " ++) (stepSuffix $ sfField sf) + where + stepPrefix = unwords ["every", show (sfStepping sf), pluralDesc d] + stepSuffix Star = Nothing + stepSuffix (RangeField' rf) = Just $ describeRange rf d + stepSuffix (SpecificField' s) = stepSpecificSuffix d $ specificField s + + +describeCronField d (ListField ls) = + case describeListFields describeBF ls of + Left s -> Every s + Right s -> Concrete $ unwords [listPrefix d, + maybe s ((s ++ " ") ++) (listSuffix d)] + where + describeBF Star = "every " ++ singularDesc d + describeBF (SpecificField' s) = displayItem d $ specificField s + describeBF (RangeField' rf) = unwords [displayItem d (rfBegin rf), + "through", + displayItem d (rfEnd rf)] + +-- There are a few special cases to handle when describing the minute and hour +-- fields that will make the cron description easier to read. +-- For the most part, these are pretty straight forward. The first three +-- pattern matches look for specific patterns in the minute and hour fields that +-- can be formatted differently. The last pattern match just defaults +-- to describing the fields using existing rules. +describeTime :: TimeFormat -> MinuteSpec -> HourSpec -> Time +describeTime tf (viewMinute -> Just m) (viewHour -> Just h) = + ConcreteTime $ "at " ++ format tf m h +describeTime tf (viewMinuteRange -> Just (m1, m2)) (viewHour -> Just h) = + ConcreteTime $ unwords ["every minute between", + format tf m1 h, + "and", + format tf m2 h] +describeTime tf (viewMinute -> Just m) (viewHourList -> Just hs) = + describeMultHours tf m hs +describeTime tf (minuteSpec -> m) (hourSpec -> h) = + Other (return $ describeCronField minuteDescriptor m) + (return $ describeCronField (hourDescriptor tf) h) + +-- We want to create a description for multiple hours given a concrete minute. +-- This is rather ugly, as the ListField type allows for any BaseField, so +-- we can potentially have a '*' within the list. In that case, we don't need +-- to describe the rest of the BaseFields for hour list, since we will just be +-- firing each hour. +describeMultHours :: TimeFormat -> Minute -> NonEmpty BaseField -> Time +describeMultHours t mn@(Minute m) ls = + maybe mkOther (formatAllFields . toList) $ traverse formatBaseField ls + where hourCF = ListField ls + minuteCF = Field (SpecificField' (fromJust $ mkSpecificField m)) + + formatAllFields = ConcreteTime . ("at " ++) . joinWords + + formatBaseField (SpecificField' s) = + Just $ format t mn (Hour (specificField s)) + formatBaseField Star = Nothing + formatBaseField f@(RangeField' _) = + Just $ unwords [show describedMinute, + show $ describeCronField (hourDescriptor t) (Field f)] + + mkOther = Other (return describedMinute) + (return $ describeCronField (hourDescriptor t) hourCF) + describedMinute = describeCronField minuteDescriptor minuteCF + + +description :: TimeFormat -> CronSchedule -> Description +description t c = Desc (describeTime t (minute c) (hour c)) + (return ddom) + (return dm) + (return ddow) + where ddom = describeCronField domDescriptor $ dayOfMonthSpec (dayOfMonth c) + dm = describeCronField monthDescriptor $ monthSpec (month c) + ddow = describeCronField dowDescriptor $ dayOfWeekSpec (dayOfWeek c) + + +matchVerbosity :: Verbosity -> Description -> Description +matchVerbosity v d@Desc{..} = d{ _dom = stripEvery v =<< _dom + , _dow = stripEvery v =<< _dow + , _time = stripTime _time + , _month = stripEvery NotVerbose =<< _month} + where stripTime t@(ConcreteTime _) = t + stripTime (Other mbMin mbHour) = Other mbMin (stripEvery v =<< mbHour) + + +stripEvery :: Verbosity -> DescribedValue -> Maybe DescribedValue +stripEvery NotVerbose (Every _) = Nothing +stripEvery _ c = Just c diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/src/System/Cron/Internal/Describe/Descriptors.hs new/cron-0.5.0/src/System/Cron/Internal/Describe/Descriptors.hs --- old/cron-0.4.2/src/System/Cron/Internal/Describe/Descriptors.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cron-0.5.0/src/System/Cron/Internal/Describe/Descriptors.hs 2017-01-05 03:07:47.000000000 +0100 @@ -0,0 +1,98 @@ +module System.Cron.Internal.Describe.Descriptors where + +import System.Cron.Internal.Describe.Time +import System.Cron.Internal.Describe.Types + +minuteDescriptor :: Descriptor +minuteDescriptor = Descriptor { + pluralDesc = "minutes" + , singularDesc = "minute" + , rangePrefix = "minutes" + , rangeSuffix = "past the hour" + , rangeJoiner = "through" + , displayItem = show + , specificPrefix = "at" + , specificSuffix = "minutes past the hour" + , stepSpecificSuffix = sss + , listPrefix = "at" + , listSuffix = Nothing + } + where + sss n + | n == 0 = Nothing + | otherwise = Just $ "starting at " ++ show n ++ " minutes past the hour" + + +hourDescriptor :: TimeFormat -> Descriptor +hourDescriptor tf = Descriptor { + pluralDesc = "hours" + , singularDesc = "hour" + , rangePrefix = "between" + , rangeSuffix = "" + , rangeJoiner = "and" + , displayItem = toHour + , specificPrefix = "at" + , specificSuffix = "" + , stepSpecificSuffix = sss + , listPrefix = "at" + , listSuffix = Nothing + } + where toHour h = format tf (Minute 0) (Hour h) + sss n + | n == 0 = Nothing + | otherwise = Just $ "starting at " ++ toHour n + + +domDescriptor :: Descriptor +domDescriptor = Descriptor { + pluralDesc = "days" + , singularDesc = "day" + , rangePrefix = "between days" + , rangeSuffix = "of the month" + , rangeJoiner = "and" + , displayItem = show + , specificPrefix = "on day" + , specificSuffix = "of the month" + , stepSpecificSuffix = sss + , listPrefix = "on days" + , listSuffix = Just "of the month" + } + where sss n = Just $ "starting on day " ++ show n ++ " of the month" + + +monthDescriptor :: Descriptor +monthDescriptor = Descriptor { + pluralDesc = "months" + , singularDesc = "month" + , rangePrefix = "" + , rangeSuffix = "" + , rangeJoiner = "through" + , displayItem = toMonth + , specificPrefix = "only in" + , specificSuffix = "" + , stepSpecificSuffix = sss + , listPrefix = "only in" + , listSuffix = Nothing + } + where toMonth = show . safeIntToMonth + sss n + | n == 1 = Nothing + | otherwise = Just $ toMonth n ++ " through " ++ toMonth 12 + + +dowDescriptor :: Descriptor +dowDescriptor = Descriptor { + pluralDesc = "days of the week" + , singularDesc = "day of the week" + , rangePrefix = "" + , rangeSuffix = "" + , rangeJoiner = "through" + , displayItem = toWeekday + , specificPrefix = "only on" + , specificSuffix = "" + , stepSpecificSuffix = sss + , listPrefix = "only on" + , listSuffix = Nothing + } + where toWeekday = show . safeIntToWeekDay + sss n = Just $ toWeekday n ++ " through " ++ show Saturday diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/src/System/Cron/Internal/Describe/Options.hs new/cron-0.5.0/src/System/Cron/Internal/Describe/Options.hs --- old/cron-0.4.2/src/System/Cron/Internal/Describe/Options.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cron-0.5.0/src/System/Cron/Internal/Describe/Options.hs 2017-01-05 03:07:47.000000000 +0100 @@ -0,0 +1,85 @@ +-------------------------------------------------------------------- +-- | +-- Module : System.Cron.Internal.Describe.Optons +-- Description : Functions for constructing the options that control how +-- cron schedules are described +-- Copyright : (c) Joseph Canero 2016 +-- License : MIT +-- +-- Maintainer: Joseph Canero <[email protected]> +-- Portability: portable +-------------------------------------------------------------------- +module System.Cron.Internal.Describe.Options where + +------------------------------------------------------------------------------- +import Data.Default.Class +import Data.Semigroup +------------------------------------------------------------------------------- +import System.Cron.Internal.Describe.Types +------------------------------------------------------------------------------- + + +-- | Type that holds onto information for constructing options for +-- 'System.Cron.Describe.describe'. +data OptionBuilder = Builder (Options -> Options) + + +-- | Return a builder that creates the default options for +-- 'System.Cron.Describe.describe'. The default options are: +-- 'System.Cron.Describe.notVerbose' and 'System.Cron.Describe.twelveHourFormat'. +defaultOpts :: OptionBuilder +defaultOpts = Builder (const def) + + +-- | Return a builder that sets the options to use a 24-hour time format. +-- This changes how hours are described. Using the 24-hour format, +-- all hours are returned as their left-padded numeric value (01:00, 22:00, etc) +twentyFourHourFormat :: OptionBuilder +twentyFourHourFormat = Builder (\o -> o {timeFormat = Hour24} ) + + +-- | Return a builder that sets the options to use a 12-hour time format. +-- This changes how hours are described. Using the 12-hour format, +-- all hours are returned as their left-padded numeric value with their period +-- (01:00 AM, 10:00 PM, etc) +twelveHourFormat :: OptionBuilder +twelveHourFormat = Builder (\o -> o {timeFormat = Hour12} ) + + +-- | Return a builder that sets the options to be verbose. A verbose description +-- doesn't eliminate unnecessary information. The only caveat being that month +-- information is only ever displayed if it isn't "*". +verbose :: OptionBuilder +verbose = Builder (\o -> o {verbosity = Verbose}) + + +-- | Return a builder that sets the options to not be verbose. All information +-- about the described cron schedule is returned. The only caveat being that +-- month information is only ever displayed if it isn't "*". +notVerbose :: OptionBuilder +notVerbose = Builder (\o -> o {verbosity = NotVerbose}) + + +------------------------------------------------------------------------------- +-- Internals +------------------------------------------------------------------------------- + + +getOpts :: OptionBuilder -> Options +getOpts (Builder f) = f def + + +data Options = Opts { + timeFormat :: TimeFormat + , verbosity :: Verbosity + } + +instance Default Options where + def = Opts {timeFormat = Hour12, verbosity = NotVerbose} + +instance Semigroup OptionBuilder where + (Builder f) <> (Builder a) = Builder (a . f) + +instance Monoid OptionBuilder where + mempty = Builder (const def) + mappend = (<>) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/src/System/Cron/Internal/Describe/Time.hs new/cron-0.5.0/src/System/Cron/Internal/Describe/Time.hs --- old/cron-0.4.2/src/System/Cron/Internal/Describe/Time.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cron-0.5.0/src/System/Cron/Internal/Describe/Time.hs 2017-01-05 03:07:47.000000000 +0100 @@ -0,0 +1,20 @@ +module System.Cron.Internal.Describe.Time where + +import System.Cron.Internal.Describe.Types + +newtype Minute = Minute Int +newtype Hour = Hour Int + +format :: TimeFormat -> Minute -> Hour -> String +format t (Minute m) (Hour h) = leftPad (hour t) ++ ":" ++ leftPad m ++ suffix t + where leftPad n + | n < 10 = "0" ++ show n + | otherwise = show n + suffix Hour24 = "" + suffix Hour12 + | h < 12 = " AM" + | otherwise = " PM" + hour Hour24 = h + hour Hour12 + | h > 12 = h `mod` 12 + | otherwise = h diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/src/System/Cron/Internal/Describe/Types.hs new/cron-0.5.0/src/System/Cron/Internal/Describe/Types.hs --- old/cron-0.4.2/src/System/Cron/Internal/Describe/Types.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cron-0.5.0/src/System/Cron/Internal/Describe/Types.hs 2017-01-05 03:07:47.000000000 +0100 @@ -0,0 +1,80 @@ +{-# LANGUAGE RecordWildCards #-} + +module System.Cron.Internal.Describe.Types where + +import Data.List (intercalate) +import Data.Maybe (catMaybes) + + +data Descriptor = Descriptor { + pluralDesc :: String + , singularDesc :: String + , rangePrefix :: String + , rangeSuffix :: String + , rangeJoiner :: String + , displayItem :: Int -> String + , specificPrefix :: String + , specificSuffix :: String + , stepSpecificSuffix :: Int -> Maybe String + , listPrefix :: String + , listSuffix :: Maybe String + } + + +data Month = January | February | March | April | May | June | + July | August | September | October | November | December + deriving (Enum, Bounded, Show) + + +safeIntToMonth :: Int -> Month +safeIntToMonth = toEnum . subtract 1 . min 12 . max 1 + + +data Weekday = Sunday | Monday | Tuesday | Wednesday | + Thursday | Friday | Saturday | Sunday2 + deriving (Enum, Bounded, Show) + + +safeIntToWeekDay :: Int -> Weekday +safeIntToWeekDay n + | n == 7 = Sunday + | otherwise = toEnum . min 6 $ max 0 n + + +data Verbosity = Verbose | NotVerbose + + +data TimeFormat = Hour24 | Hour12 + + +data DescribedValue = Concrete String + | Every String + + +instance Show DescribedValue where + show (Concrete s) = s + show (Every s) = s + + +data Time = ConcreteTime String + | Other (Maybe DescribedValue) (Maybe DescribedValue) + + +instance Show Time where + show (ConcreteTime s) = s + show (Other md1 md2) = intercalate ", " . + map show $ catMaybes [md1, md2] + + +data Description = Desc { + _time :: Time + , _dom :: Maybe DescribedValue + , _month :: Maybe DescribedValue + , _dow :: Maybe DescribedValue + } + + +instance Show Description where + show Desc{..} = intercalate ", " . + (:) (show _time) . + map show $ catMaybes [_dom, _dow, _month] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/src/System/Cron/Internal/Describe/Utils.hs new/cron-0.5.0/src/System/Cron/Internal/Describe/Utils.hs --- old/cron-0.4.2/src/System/Cron/Internal/Describe/Utils.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cron-0.5.0/src/System/Cron/Internal/Describe/Utils.hs 2017-01-05 03:07:47.000000000 +0100 @@ -0,0 +1,56 @@ +module System.Cron.Internal.Describe.Utils +( + viewHour +, viewMinute +, viewMinuteRange +, viewHourList +, allWords +, cap +, joinWords +) where + +import Data.Char (toUpper) +import Data.List.NonEmpty (NonEmpty) +import System.Cron.Types +import System.Cron.Internal.Describe.Time + +viewHour :: HourSpec -> Maybe Hour +viewHour = viewSpecificTime Hour . hourSpec + + +viewMinute :: MinuteSpec -> Maybe Minute +viewMinute = viewSpecificTime Minute . minuteSpec + + +viewMinuteRange :: MinuteSpec -> Maybe (Minute, Minute) +viewMinuteRange = viewRange . minuteSpec + where viewRange (Field (RangeField' rf)) = Just (Minute $ rfBegin rf, + Minute $ rfEnd rf) + viewRange _ = Nothing + + +viewHourList :: HourSpec -> Maybe (NonEmpty BaseField) +viewHourList = viewList . hourSpec + where viewList (ListField ne) = Just ne + viewList _ = Nothing + + +viewSpecificTime :: (Int -> a) -> CronField -> Maybe a +viewSpecificTime f (Field (SpecificField' s)) = Just . f $ specificField s +viewSpecificTime _ _ = Nothing + + +allWords :: [String] -> String +allWords = unwords . filter (not . null) + + +cap :: String -> String +cap [] = [] +cap (x:xs) = toUpper x : xs + + +joinWords :: [String] -> String +joinWords [] = [] +joinWords [x] = x +joinWords [x, y] = x ++ " and " ++ y +joinWords (x:xs) = x ++ ", " ++ joinWords xs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/src/System/Cron/Parser.hs new/cron-0.5.0/src/System/Cron/Parser.hs --- old/cron-0.4.2/src/System/Cron/Parser.hs 2016-11-22 21:18:44.000000000 +0100 +++ new/cron-0.5.0/src/System/Cron/Parser.hs 2017-01-05 03:07:47.000000000 +0100 @@ -15,7 +15,7 @@ -- > import System.Cron.Parser -- > -- > main :: IO () --- > main = don +-- > main = do -- > print $ parseCronSchedule "*/2 * 3 * 4,5,6" -- -------------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/src/System/Cron/Types.hs new/cron-0.5.0/src/System/Cron/Types.hs --- old/cron-0.4.2/src/System/Cron/Types.hs 2016-11-22 21:18:44.000000000 +0100 +++ new/cron-0.5.0/src/System/Cron/Types.hs 2017-01-05 03:07:47.000000000 +0100 @@ -46,6 +46,10 @@ -- * Rendering , serializeCronSchedule , serializeCrontab + + -- * Converting to human-readable string + -- , displayCronField + -- , Display(..) ) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/src/System/Cron.hs new/cron-0.5.0/src/System/Cron.hs --- old/cron-0.4.2/src/System/Cron.hs 2016-11-22 21:18:44.000000000 +0100 +++ new/cron-0.5.0/src/System/Cron.hs 2017-01-05 03:07:47.000000000 +0100 @@ -4,6 +4,7 @@ ( module System.Cron.Types , module System.Cron.Parser , module System.Cron.Schedule + , module System.Cron.Describe , scheduleMatches , nextMatch ) where @@ -11,6 +12,7 @@ ------------------------------------------------------------------------------- import System.Cron.Internal.Check +import System.Cron.Describe import System.Cron.Parser import System.Cron.Schedule import System.Cron.Types diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/test/Main.hs new/cron-0.5.0/test/Main.hs --- old/cron-0.4.2/test/Main.hs 2016-11-22 21:18:44.000000000 +0100 +++ new/cron-0.5.0/test/Main.hs 2017-01-05 03:07:47.000000000 +0100 @@ -7,6 +7,7 @@ ------------------------------------------------------------------------------- import SpecHelper import qualified System.Test.Cron +import qualified System.Test.Cron.Describe import qualified System.Test.Cron.Parser import qualified System.Test.Cron.Schedule ------------------------------------------------------------------------------- @@ -15,6 +16,7 @@ main :: IO () main = defaultMain $ testGroup "cron" [ System.Test.Cron.tests + , System.Test.Cron.Describe.tests , System.Test.Cron.Parser.tests , System.Test.Cron.Schedule.tests ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/cron-0.4.2/test/System/Test/Cron/Describe.hs new/cron-0.5.0/test/System/Test/Cron/Describe.hs --- old/cron-0.4.2/test/System/Test/Cron/Describe.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/cron-0.5.0/test/System/Test/Cron/Describe.hs 2017-01-05 03:07:47.000000000 +0100 @@ -0,0 +1,132 @@ +{-# LANGUAGE OverloadedStrings #-} + +module System.Test.Cron.Describe (tests) where + +import SpecHelper +------------------------------------------------------------------------------- + + +tests :: TestTree +tests = testGroup "System.Cron.Describe" + [ describeDisplayCronSchedule + ] + + +------------------------------------------------------------------------------- +describeDisplayCronSchedule :: TestTree +describeDisplayCronSchedule = testGroup "describeCronSchedule" + [ + testGroup "describes all stars" [ + testCase "verbose" $ + "Every minute, every hour, every day, every day of the week" @=? describeV "* * * * *" + + , testCase "non-verbose" $ + "Every minute" @=? describeNV "* * * * *" + ] + , testGroup "describes specific values" [ + testCase "verbose" $ + "At 02:01, on day 3 of the month, every day of the week" @=? describeV "1 2 3 * *" + + , testCase "non-verbose" $ + "At 02:01, on day 3 of the month" @=? describeNV "1 2 3 * *" + + , testCase "12-hour (verbose)" $ + "At 02:01 AM, on day 3 of the month, every day of the week" @=? describe12 "1 2 3 * *" + ] + , testGroup "describes list values" [ + testCase "verbose" $ + "Every minute, every hour, on days 3 and 5 of the month, every day of the week" @=? describeV "* * 3,5 * *" + + , testCase "non-verbose" $ + "Every minute, on days 3 and 5 of the month" @=? describeNV "* * 3,5 * *" + ] + , testGroup "describes range values" [ + testCase "verbose" $ + "Every minute, every hour, between days 3 and 4 of the month, every day of the week" @=? describeV "* * 3-4 * *" + + , testCase "non-verbose" $ + "Every minute, between days 3 and 4 of the month" @=? describeNV "* * 3-4 * *" + ] + , testGroup "describes step values" [ + testCase "verbose" $ + "Every 2 minutes, every hour, every 4 days, between days 2 and 10 of the month, every day of the week" @=? describeV "*/2 * 2-10/4 * *" + + , testCase "non-verbose" $ + "Every 2 minutes, every 4 days, between days 2 and 10 of the month" @=? describeNV "*/2 * 2-10/4 * *" + ] + , testGroup "describes other values" [ + testCase "verbose" $ + "Every 2 minutes, minutes 1 through 59 past the hour, every hour, every day, Wednesday through Friday, only in February" @=? describeV "1-59/2 * * 2 3-5" + + , testCase "non-verbose" $ + "Every 2 minutes, minutes 1 through 59 past the hour, Wednesday through Friday, only in February" @=? describeNV "1-59/2 * * 2 3-5" + ] + , testGroup "handles Sunday weirdness" [ + testCase "range of values (Sunday at 0)" $ + "Every minute, every hour, every day, Sunday through Friday" @=? describeV "* * * * 0-5" + + , testCase "range of values (Sunday at 7)" $ + "Every minute, every hour, every day, Friday through Sunday" @=? describeV "* * * * 5-7" + + , testCase "range of values" $ + "Every minute, every hour, every day, Sunday through Sunday" @=? describeV "* * * * 0-7" + ] + , testGroup "describes complicated times" [ + testCase "describes specific times - twenty four hour" $ + "At 13:01, every day, every day of the week" @=? describeV "1 13 * * *" + + , testCase "describes specific times - twelve hour" $ + "At 01:01 PM, every day, every day of the week" @=? describe12 "1 13 * * *" + + , testCase "describes a range of minutes - twenty four hour" $ + "Every minute between 12:01 and 12:10, every day, every day of the week" @=? describeV "1-10 12 * * *" + + , testCase "describes a range of minutes - twelve hour" $ + "Every minute between 12:01 PM and 12:10 PM, every day, every day of the week" @=? describe12 "1-10 12 * * *" + + , testGroup "describes times for lists of hours" [ + testCase "simple list of hours - twenty four hour" $ + "At 02:01 and 03:01, every day, every day of the week" @=? describeV "1 2,3 * * *" + + , testCase "simple list of hours - twelve hour" $ + "At 02:01 AM and 03:01 AM, every day, every day of the week" @=? describe12 "1 2,3 * * *" + + , testCase "list of hours, and range - twenty four hour" $ + "At 02:01, 03:01 and at 1 minutes past the hour between 04:00 and 13:00, every day, every day of the week" @=? + describeV "1 2,3,4-13 * * *" + + , testCase "list of hours, and range - twelve hour" $ + "At 02:01 AM, 03:01 AM and at 1 minutes past the hour between 04:00 AM and 01:00 PM, every day, every day of the week" @=? + describe12 "1 2,3,4-13 * * *" + + , testCase "list of hours, and star" $ + "At 1 minutes past the hour, every hour, every day, every day of the week" @=? describeV "1 2,* * * *" + ] + , testGroup "describes other times" [ + testCase "range of minutes, range of hours" $ + "Minutes 10 through 15 past the hour, between 01:00 and 03:00, every day, every day of the week" @=? + describeV "10-15 1-3 * * *" + + , testCase "range of minutes, every hour" $ + "Minutes 10 through 15 past the hour, every hour, every day, every day of the week" @=? + describeV "10-15 * * * *" + + , testCase "range of minutes, interval of hours" $ + "Minutes 10 through 15 past the hour, every 3 hours, starting at 03:00, every day, every day of the week" @=? + describeV "10-15 3/3 * * *" + + , testCase "list of minutes, at an hour" $ + "Every minute, at 03:00, every day, every day of the week" @=? + describeV "2,* 3 * * *" + + , testCase "step minutes, step hours" $ + "Every 3 minutes, minutes 10 through 15 past the hour, every 5 hours, starting at 10:00, every day, every day of the week" @=? + describeV "10-15/3 10/5 * * *" + ] + ] + ] + where + mkCronSchedule t = let (Right cs) = parseCronSchedule t in cs + describeNV = describe (twentyFourHourFormat <> notVerbose) . mkCronSchedule + describeV = describe (twentyFourHourFormat <> verbose) . mkCronSchedule + describe12 = describe verbose . mkCronSchedule
