cron 0.6.0 → 0.6.1
raw patch · 5 files changed
+99/−42 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ System.Cron.Parser: instance GHC.Classes.Eq System.Cron.Parser.StringSupport
Files
- README.md +1/−0
- changelog +2/−0
- cron.cabal +1/−1
- src/System/Cron/Parser.hs +91/−39
- test/SpecHelper.hs +4/−2
README.md view
@@ -71,3 +71,4 @@ * [Andrew Rademacher](https://github.com/AndrewRademacher) * [Peter Simons](https://github.com/peti) * [Joseph Canero](https://github.com/caneroj1)+* [Ahti Katiska](https://github.com/HariGyogu)
changelog view
@@ -1,3 +1,5 @@+# 0.6.1+* Add support for day and month literals, Ahti Katiska (@HariGyogu). # 0.6.0 * Use Text instead of String in Cron.Schedule # 0.5.0
cron.cabal view
@@ -1,5 +1,5 @@ Name: cron-Version: 0.6.0+Version: 0.6.1 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
src/System/Cron/Parser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------- -- |@@ -32,12 +33,13 @@ ) where --------------------------------------------------------------------------------import Control.Applicative as Ap-import Data.Attoparsec.Text (Parser)-import qualified Data.Attoparsec.Text as A-import Data.Char (isSpace)-import Data.List.NonEmpty (NonEmpty (..))-import Data.Text (Text)+import Control.Applicative as Ap+import Data.Attoparsec.Combinator (choice)+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A+import Data.Char (isSpace)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text, toLower) ------------------------------------------------------------------------------- import System.Cron.Types -------------------------------------------------------------------------------@@ -97,7 +99,7 @@ parseCronSchedule :: Text -> Either String CronSchedule-parseCronSchedule = A.parseOnly cronSchedule+parseCronSchedule = A.parseOnly cronSchedule . toLower -------------------------------------------------------------------------------@@ -135,21 +137,21 @@ --------------------------------------------------------------------------------cronFieldP :: Parser CronField-cronFieldP = stepP <|>- listP <|>- fieldP-+cronFieldP :: StringSupport -> Parser CronField+cronFieldP stringSupport =+ stepP <|>+ listP <|>+ fieldP where- fieldP = Field <$> baseFieldP- listP = ListField <$> neListP baseFieldP- stepP = StepField' <$> stepFieldP+ fieldP = Field <$> baseFieldP stringSupport+ listP = ListField <$> neListP (baseFieldP stringSupport)+ stepP = StepField' <$> stepFieldP stringSupport --------------------------------------------------------------------------------stepFieldP :: Parser StepField-stepFieldP = do- f <- baseFieldP+stepFieldP :: StringSupport -> Parser StepField+stepFieldP ss = do+ f <- baseFieldP ss _ <- A.char '/' mParse (mkStepField f) "invalid stepping" =<< parseInt @@ -164,29 +166,27 @@ --------------------------------------------------------------------------------baseFieldP :: Parser BaseField-baseFieldP = rangeP <|>- starP <|>- specificP+baseFieldP :: StringSupport -> Parser BaseField+baseFieldP ss = rangeP <|>+ starP <|>+ specificP where starP = A.char '*' *> Ap.pure Star- rangeP = RangeField' <$> rangeFieldP- specificP = SpecificField' <$> specificFieldP+ rangeP = RangeField' <$> rangeFieldP ss+ specificP = SpecificField' <$> specificFieldP ss --------------------------------------------------------------------------------specificFieldP :: Parser SpecificField-specificFieldP =- mParse mkSpecificField "specific field value out of range" =<< parseInt-+specificFieldP :: StringSupport -> Parser SpecificField+specificFieldP ss =+ mParse mkSpecificField "specific field value out of range"+ =<< supportParser ss --------------------------------------------------------------------------------rangeFieldP :: Parser RangeField-rangeFieldP = do- begin <- parseInt--+rangeFieldP :: StringSupport -> Parser RangeField+rangeFieldP ss = do+ begin <- supportParser ss _ <- A.char '-'- end <- parseInt+ end <- supportParser ss mParse (mkRangeField begin) "start of range must be less than or equal to end" end @@ -217,33 +217,85 @@ ------------------------------------------------------------------------------- minutesP :: Parser MinuteSpec-minutesP = mParse mkMinuteSpec "minutes out of range" =<< cronFieldP+minutesP = mParse mkMinuteSpec "minutes out of range" =<< cronFieldP NoString ------------------------------------------------------------------------------- hoursP :: Parser HourSpec-hoursP = mParse mkHourSpec "hours out of range" =<< cronFieldP+hoursP = mParse mkHourSpec "hours out of range" =<< cronFieldP NoString ------------------------------------------------------------------------------- dayOfMonthP :: Parser DayOfMonthSpec-dayOfMonthP = mParse mkDayOfMonthSpec "day of month out of range" =<< cronFieldP+dayOfMonthP = mParse mkDayOfMonthSpec "day of month out of range" =<< cronFieldP NoString ------------------------------------------------------------------------------- monthP :: Parser MonthSpec-monthP = mParse mkMonthSpec "month out of range" =<< cronFieldP+monthP = mParse mkMonthSpec "month out of range" =<< cronFieldP MonthString ------------------------------------------------------------------------------- dayOfWeekP :: Parser DayOfWeekSpec-dayOfWeekP = mParse mkDayOfWeekSpec "day of week out of range" =<< cronFieldP+dayOfWeekP = mParse mkDayOfWeekSpec "day of week out of range" =<< cronFieldP DayString ------------------------------------------------------------------------------- parseInt :: Parser Int parseInt = A.decimal +-------------------------------------------------------------------------------+data StringSupport+ = MonthString+ | DayString+ | NoString+ deriving Eq++-------------------------------------------------------------------------------+supportParser :: StringSupport -> Parser Int+supportParser = \case+ MonthString -> choice [parseMonth, parseInt]+ DayString -> choice [parseDay, parseInt]+ NoString -> parseInt++-------------------------------------------------------------------------------++toI :: Int -> Text -> Parser Int+toI int str = const int <$> A.string str++-------------------------------------------------------------------------------+parseDay :: Parser Int+parseDay =+ choice $+ zipWith toI+ [1 .. 7]+ [ "mon"+ , "tue"+ , "wed"+ , "thu"+ , "fri"+ , "sat"+ , "sun"+ ]++-------------------------------------------------------------------------------+parseMonth :: Parser Int+parseMonth =+ choice $+ zipWith toI+ [1 .. 12]+ [ "jan"+ , "feb"+ , "mar"+ , "apr"+ , "may"+ , "jun"+ , "jul"+ , "aug"+ , "sep"+ , "oct"+ , "nov"+ , "dec"] ------------------------------------------------------------------------------- mParse :: (Monad m) => (a -> Maybe b) -> String -> a -> m b
test/SpecHelper.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-}@@ -22,6 +23,7 @@ import Data.Time.LocalTime as X import Debug.Trace as X import qualified Generics.SOP as SOP+import qualified Generics.SOP.Constraint as SOP import qualified Generics.SOP.GGP as SOP import GHC.Generics (Generic) import Test.QuickCheck.Instances ()@@ -36,11 +38,11 @@ -- this workaround is in place until we successfully beat down the -- doors of castle QuickCheck and get generic deriving through. See -- <https://github.com/nick8325/quickcheck/pull/40>-sopArbitrary :: (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a+sopArbitrary :: (SOP.GTo b, SOP.SListI (SOP.GCode b), Generic b, SOP.AllF (SOP.All Arbitrary) (SOP.GCode b), SOP.AllF SOP.SListI (SOP.GCode b)) => Gen b sopArbitrary = fmap SOP.gto sopArbitrary' -sopArbitrary' :: (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)+sopArbitrary' :: (SOP.SListI xss, SOP.AllF SOP.SListI xss, SOP.AllF (SOP.All Arbitrary) xss) => Gen (SOP.SOP SOP.I xss) sopArbitrary' = oneof (map SOP.hsequence $ SOP.apInjs_POP $ SOP.hcpure p arbitrary) where p :: Proxy Arbitrary