{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------
-- |
-- Module      : System.Cron.Parser
-- Description : Attoparsec parser for cron formatted intervals
-- Copyright   : (c) Michael Xavier 2012
-- License     : MIT
--
-- Maintainer: Michael Xavier <michael@michaelxavier.net>
-- Portability: portable
--
-- Attoparsec parser combinator for cron schedules. See cron documentation for
-- how those are formatted.
--
-- > import System.Cron.Parser
-- >
-- > main :: IO ()
-- > main = do
-- >   print $ parseCronSchedule "*/2 * 3 * 4,5,6"
--
--------------------------------------------------------------------
module System.Cron.Parser
    ( -- * Parsers
      cronSchedule
    , cronScheduleLoose
    , crontab
    , crontabEntry
    -- * Convenience Functions
    , parseCronSchedule
    , parseCrontab
    , parseCrontabEntry
    ) where

-------------------------------------------------------------------------------
import           Control.Applicative        as Ap
import           Control.Monad.Fail         as F
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
-------------------------------------------------------------------------------


-- | Attoparsec Parser for a cron schedule. Complies fully with the standard
-- cron format.  Also includes the following shorthand formats which cron also
-- supports: \@yearly, \@monthly, \@weekly, \@daily, \@hourly. Note that this
-- parser will fail if there is extraneous input. This is to prevent things
-- like extra fields. If you want a more lax parser, use 'cronScheduleLoose',
-- which is fine with extra input.
cronSchedule :: Parser CronSchedule
cronSchedule :: Parser CronSchedule
cronSchedule = Parser CronSchedule
cronScheduleLoose Parser CronSchedule -> Parser Text () -> Parser CronSchedule
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput


-------------------------------------------------------------------------------
-- | Same as 'cronSchedule' but does not fail on extraneous input.
cronScheduleLoose :: Parser CronSchedule
cronScheduleLoose :: Parser CronSchedule
cronScheduleLoose = Parser CronSchedule
yearlyP  Parser CronSchedule -> Parser CronSchedule -> Parser CronSchedule
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    Parser CronSchedule
monthlyP Parser CronSchedule -> Parser CronSchedule -> Parser CronSchedule
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    Parser CronSchedule
weeklyP  Parser CronSchedule -> Parser CronSchedule -> Parser CronSchedule
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    Parser CronSchedule
dailyP   Parser CronSchedule -> Parser CronSchedule -> Parser CronSchedule
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    Parser CronSchedule
hourlyP  Parser CronSchedule -> Parser CronSchedule -> Parser CronSchedule
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    Parser CronSchedule
classicP


-------------------------------------------------------------------------------
-- | Parses a full crontab file, omitting comments and including environment
-- variable sets (e.g FOO=BAR).
crontab :: Parser Crontab
crontab :: Parser Crontab
crontab = [CrontabEntry] -> Crontab
Crontab ([CrontabEntry] -> Crontab)
-> Parser Text [CrontabEntry] -> Parser Crontab
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text CrontabEntry
-> Parser Text Char -> Parser Text [CrontabEntry]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy Parser Text CrontabEntry
lineP (Char -> Parser Text Char
A.char Char
'\n')
  where lineP :: Parser Text CrontabEntry
lineP    = Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany Parser Text ()
commentP Parser Text ()
-> Parser Text CrontabEntry -> Parser Text CrontabEntry
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text CrontabEntry
crontabEntry
        commentP :: Parser Text ()
commentP = Parser Text ()
A.skipSpace Parser Text () -> Parser Text Char -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
A.char Char
'#' Parser Text Char -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
skipToEOL


-------------------------------------------------------------------------------
-- | Parses an individual crontab line, which is either a scheduled command or
-- an environmental variable set.
crontabEntry :: Parser CrontabEntry
crontabEntry :: Parser Text CrontabEntry
crontabEntry = Parser Text ()
A.skipSpace Parser Text ()
-> Parser Text CrontabEntry -> Parser Text CrontabEntry
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text CrontabEntry
parser
  where parser :: Parser Text CrontabEntry
parser = Parser Text CrontabEntry
envVariableP Parser Text CrontabEntry
-> Parser Text CrontabEntry -> Parser Text CrontabEntry
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 Parser Text CrontabEntry
commandEntryP
        envVariableP :: Parser Text CrontabEntry
envVariableP = do Text
var <- (Char -> Bool) -> Parser Text
A.takeWhile1 (String -> Char -> Bool
A.notInClass String
" =")
                          Parser Text ()
A.skipSpace
                          Char
_   <- Char -> Parser Text Char
A.char Char
'='
                          Parser Text ()
A.skipSpace
                          Text
val <- (Char -> Bool) -> Parser Text
A.takeWhile1 ((Char -> Bool) -> Parser Text) -> (Char -> Bool) -> Parser Text
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace
                          (Char -> Bool) -> Parser Text ()
A.skipWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')
                          CrontabEntry -> Parser Text CrontabEntry
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (CrontabEntry -> Parser Text CrontabEntry)
-> CrontabEntry -> Parser Text CrontabEntry
forall a b. (a -> b) -> a -> b
$ Text -> Text -> CrontabEntry
EnvVariable Text
var Text
val
        commandEntryP :: Parser Text CrontabEntry
commandEntryP = CronSchedule -> CronCommand -> CrontabEntry
CommandEntry (CronSchedule -> CronCommand -> CrontabEntry)
-> Parser CronSchedule -> Parser Text (CronCommand -> CrontabEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CronSchedule
cronScheduleLoose
                                     Parser Text (CronCommand -> CrontabEntry)
-> Parser Text CronCommand -> Parser Text CrontabEntry
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text ()
A.skipSpace Parser Text ()
-> Parser Text CronCommand -> Parser Text CronCommand
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> CronCommand
CronCommand (Text -> CronCommand) -> Parser Text -> Parser Text CronCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeToEOL))


-------------------------------------------------------------------------------
-- Convenience functions
-------------------------------------------------------------------------------


parseCronSchedule :: Text -> Either String CronSchedule
parseCronSchedule :: Text -> Either String CronSchedule
parseCronSchedule = Parser CronSchedule -> Text -> Either String CronSchedule
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser CronSchedule
cronSchedule (Text -> Either String CronSchedule)
-> (Text -> Text) -> Text -> Either String CronSchedule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toLower


-------------------------------------------------------------------------------
parseCrontab :: Text -> Either String Crontab
parseCrontab :: Text -> Either String Crontab
parseCrontab = Parser Crontab -> Text -> Either String Crontab
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser Crontab
crontab


-------------------------------------------------------------------------------
parseCrontabEntry :: Text -> Either String CrontabEntry
parseCrontabEntry :: Text -> Either String CrontabEntry
parseCrontabEntry = Parser Text CrontabEntry -> Text -> Either String CrontabEntry
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser Text CrontabEntry
crontabEntry


-------------------------------------------------------------------------------
-- Internals
-------------------------------------------------------------------------------


takeToEOL :: Parser Text
takeToEOL :: Parser Text
takeToEOL = (Char -> Bool) -> Parser Text
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') -- <* A.skip (== '\n')


-------------------------------------------------------------------------------
skipToEOL :: Parser ()
skipToEOL :: Parser Text ()
skipToEOL = (Char -> Bool) -> Parser Text ()
A.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')


-------------------------------------------------------------------------------
classicP :: Parser CronSchedule
classicP :: Parser CronSchedule
classicP = MinuteSpec
-> HourSpec
-> DayOfMonthSpec
-> MonthSpec
-> DayOfWeekSpec
-> CronSchedule
CronSchedule (MinuteSpec
 -> HourSpec
 -> DayOfMonthSpec
 -> MonthSpec
 -> DayOfWeekSpec
 -> CronSchedule)
-> Parser Text MinuteSpec
-> Parser
     Text
     (HourSpec
      -> DayOfMonthSpec -> MonthSpec -> DayOfWeekSpec -> CronSchedule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text MinuteSpec
minutesP    Parser Text MinuteSpec
-> Parser Text Char -> Parser Text MinuteSpec
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char
space)
                        Parser
  Text
  (HourSpec
   -> DayOfMonthSpec -> MonthSpec -> DayOfWeekSpec -> CronSchedule)
-> Parser Text HourSpec
-> Parser
     Text (DayOfMonthSpec -> MonthSpec -> DayOfWeekSpec -> CronSchedule)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text HourSpec
hoursP      Parser Text HourSpec -> Parser Text Char -> Parser Text HourSpec
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char
space)
                        Parser
  Text (DayOfMonthSpec -> MonthSpec -> DayOfWeekSpec -> CronSchedule)
-> Parser Text DayOfMonthSpec
-> Parser Text (MonthSpec -> DayOfWeekSpec -> CronSchedule)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text DayOfMonthSpec
dayOfMonthP Parser Text DayOfMonthSpec
-> Parser Text Char -> Parser Text DayOfMonthSpec
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char
space)
                        Parser Text (MonthSpec -> DayOfWeekSpec -> CronSchedule)
-> Parser Text MonthSpec
-> Parser Text (DayOfWeekSpec -> CronSchedule)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text MonthSpec
monthP      Parser Text MonthSpec -> Parser Text Char -> Parser Text MonthSpec
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char
space)
                        Parser Text (DayOfWeekSpec -> CronSchedule)
-> Parser Text DayOfWeekSpec -> Parser CronSchedule
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text DayOfWeekSpec
dayOfWeekP
  where space :: Parser Text Char
space = Char -> Parser Text Char
A.char Char
' '


-------------------------------------------------------------------------------
cronFieldP :: StringSupport -> Parser CronField
cronFieldP :: StringSupport -> Parser CronField
cronFieldP StringSupport
stringSupport =
    Parser CronField
stepP  Parser CronField -> Parser CronField -> Parser CronField
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Parser CronField
listP  Parser CronField -> Parser CronField -> Parser CronField
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Parser CronField
fieldP
  where
    fieldP :: Parser CronField
fieldP        = BaseField -> CronField
Field (BaseField -> CronField)
-> Parser Text BaseField -> Parser CronField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringSupport -> Parser Text BaseField
baseFieldP StringSupport
stringSupport
    listP :: Parser CronField
listP         = NonEmpty BaseField -> CronField
ListField (NonEmpty BaseField -> CronField)
-> Parser Text (NonEmpty BaseField) -> Parser CronField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text BaseField -> Parser Text (NonEmpty BaseField)
forall a. Parser a -> Parser (NonEmpty a)
neListP (StringSupport -> Parser Text BaseField
baseFieldP StringSupport
stringSupport)
    stepP :: Parser CronField
stepP         = StepField -> CronField
StepField' (StepField -> CronField)
-> Parser Text StepField -> Parser CronField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringSupport -> Parser Text StepField
stepFieldP StringSupport
stringSupport


-------------------------------------------------------------------------------
stepFieldP :: StringSupport -> Parser StepField
stepFieldP :: StringSupport -> Parser Text StepField
stepFieldP StringSupport
ss = do
  BaseField
f <- StringSupport -> Parser Text BaseField
baseFieldP StringSupport
ss
  Char
_ <- Char -> Parser Text Char
A.char Char
'/'
  (Int -> Maybe StepField) -> String -> Int -> Parser Text StepField
forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
(a -> Maybe b) -> String -> a -> m b
mParse (BaseField -> Int -> Maybe StepField
mkStepField BaseField
f) String
"invalid stepping" (Int -> Parser Text StepField)
-> Parser Text Int -> Parser Text StepField
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Int
parseInt


-------------------------------------------------------------------------------
neListP :: Parser a -> Parser (NonEmpty a)
neListP :: forall a. Parser a -> Parser (NonEmpty a)
neListP Parser a
p = [a] -> Parser Text (NonEmpty a)
forall {m :: * -> *} {a}. MonadFail m => [a] -> m (NonEmpty a)
coerceNE ([a] -> Parser Text (NonEmpty a))
-> Parser Text [a] -> Parser Text (NonEmpty a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser a -> Parser Text Char -> Parser Text [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy1 Parser a
p (Char -> Parser Text Char
A.char Char
',')
  where
    coerceNE :: [a] -> m (NonEmpty a)
coerceNE []     = String -> m (NonEmpty a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail String
"expected non-empty list"
    coerceNE [a
_]    = String -> m (NonEmpty a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail String
"invalid singleton list"
    coerceNE (a
x:[a]
xs) = NonEmpty a -> m (NonEmpty a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty a -> m (NonEmpty a)) -> NonEmpty a -> m (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs


-------------------------------------------------------------------------------
baseFieldP :: StringSupport -> Parser BaseField
baseFieldP :: StringSupport -> Parser Text BaseField
baseFieldP StringSupport
ss = Parser Text BaseField
rangeP Parser Text BaseField
-> Parser Text BaseField -> Parser Text BaseField
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                Parser Text BaseField
starP  Parser Text BaseField
-> Parser Text BaseField -> Parser Text BaseField
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                Parser Text BaseField
specificP
  where starP :: Parser Text BaseField
starP         = Char -> Parser Text Char
A.char Char
'*' Parser Text Char -> Parser Text BaseField -> Parser Text BaseField
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BaseField -> Parser Text BaseField
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
Ap.pure BaseField
Star
        rangeP :: Parser Text BaseField
rangeP        = RangeField -> BaseField
RangeField' (RangeField -> BaseField)
-> Parser Text RangeField -> Parser Text BaseField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringSupport -> Parser Text RangeField
rangeFieldP StringSupport
ss
        specificP :: Parser Text BaseField
specificP     = SpecificField -> BaseField
SpecificField' (SpecificField -> BaseField)
-> Parser Text SpecificField -> Parser Text BaseField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringSupport -> Parser Text SpecificField
specificFieldP StringSupport
ss


-------------------------------------------------------------------------------
specificFieldP :: StringSupport -> Parser SpecificField
specificFieldP :: StringSupport -> Parser Text SpecificField
specificFieldP StringSupport
ss =
  (Int -> Maybe SpecificField)
-> String -> Int -> Parser Text SpecificField
forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
(a -> Maybe b) -> String -> a -> m b
mParse Int -> Maybe SpecificField
mkSpecificField String
"specific field value out of range"
    (Int -> Parser Text SpecificField)
-> Parser Text Int -> Parser Text SpecificField
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StringSupport -> Parser Text Int
supportParser StringSupport
ss

-------------------------------------------------------------------------------
rangeFieldP :: StringSupport -> Parser RangeField
rangeFieldP :: StringSupport -> Parser Text RangeField
rangeFieldP StringSupport
ss = do
  Int
begin <- StringSupport -> Parser Text Int
supportParser StringSupport
ss
  Char
_ <- Char -> Parser Text Char
A.char Char
'-'
  Int
end <- StringSupport -> Parser Text Int
supportParser StringSupport
ss
  (Int -> Maybe RangeField)
-> String -> Int -> Parser Text RangeField
forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
(a -> Maybe b) -> String -> a -> m b
mParse (Int -> Int -> Maybe RangeField
mkRangeField Int
begin) String
"start of range must be less than or equal to end" Int
end


-------------------------------------------------------------------------------
yearlyP :: Parser CronSchedule
yearlyP :: Parser CronSchedule
yearlyP  = Text -> Parser Text
A.string Text
"@yearly"  Parser Text -> Parser CronSchedule -> Parser CronSchedule
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CronSchedule -> Parser CronSchedule
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CronSchedule
yearly


-------------------------------------------------------------------------------
monthlyP :: Parser CronSchedule
monthlyP :: Parser CronSchedule
monthlyP = Text -> Parser Text
A.string Text
"@monthly" Parser Text -> Parser CronSchedule -> Parser CronSchedule
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CronSchedule -> Parser CronSchedule
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CronSchedule
monthly


-------------------------------------------------------------------------------
weeklyP :: Parser CronSchedule
weeklyP :: Parser CronSchedule
weeklyP  = Text -> Parser Text
A.string Text
"@weekly"  Parser Text -> Parser CronSchedule -> Parser CronSchedule
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CronSchedule -> Parser CronSchedule
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CronSchedule
weekly


-------------------------------------------------------------------------------
dailyP :: Parser CronSchedule
dailyP :: Parser CronSchedule
dailyP   = Text -> Parser Text
A.string Text
"@daily"   Parser Text -> Parser CronSchedule -> Parser CronSchedule
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CronSchedule -> Parser CronSchedule
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CronSchedule
daily


-------------------------------------------------------------------------------
hourlyP :: Parser CronSchedule
hourlyP :: Parser CronSchedule
hourlyP  = Text -> Parser Text
A.string Text
"@hourly"  Parser Text -> Parser CronSchedule -> Parser CronSchedule
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CronSchedule -> Parser CronSchedule
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CronSchedule
hourly


-------------------------------------------------------------------------------
minutesP :: Parser MinuteSpec
minutesP :: Parser Text MinuteSpec
minutesP = (CronField -> Maybe MinuteSpec)
-> String -> CronField -> Parser Text MinuteSpec
forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
(a -> Maybe b) -> String -> a -> m b
mParse CronField -> Maybe MinuteSpec
mkMinuteSpec String
"minutes out of range" (CronField -> Parser Text MinuteSpec)
-> Parser CronField -> Parser Text MinuteSpec
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StringSupport -> Parser CronField
cronFieldP StringSupport
NoString


-------------------------------------------------------------------------------
hoursP :: Parser HourSpec
hoursP :: Parser Text HourSpec
hoursP = (CronField -> Maybe HourSpec)
-> String -> CronField -> Parser Text HourSpec
forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
(a -> Maybe b) -> String -> a -> m b
mParse CronField -> Maybe HourSpec
mkHourSpec String
"hours out of range" (CronField -> Parser Text HourSpec)
-> Parser CronField -> Parser Text HourSpec
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StringSupport -> Parser CronField
cronFieldP StringSupport
NoString


-------------------------------------------------------------------------------
dayOfMonthP :: Parser DayOfMonthSpec
dayOfMonthP :: Parser Text DayOfMonthSpec
dayOfMonthP = (CronField -> Maybe DayOfMonthSpec)
-> String -> CronField -> Parser Text DayOfMonthSpec
forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
(a -> Maybe b) -> String -> a -> m b
mParse CronField -> Maybe DayOfMonthSpec
mkDayOfMonthSpec String
"day of month out of range" (CronField -> Parser Text DayOfMonthSpec)
-> Parser CronField -> Parser Text DayOfMonthSpec
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StringSupport -> Parser CronField
cronFieldP StringSupport
NoString


-------------------------------------------------------------------------------
monthP :: Parser MonthSpec
monthP :: Parser Text MonthSpec
monthP = (CronField -> Maybe MonthSpec)
-> String -> CronField -> Parser Text MonthSpec
forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
(a -> Maybe b) -> String -> a -> m b
mParse CronField -> Maybe MonthSpec
mkMonthSpec String
"month out of range" (CronField -> Parser Text MonthSpec)
-> Parser CronField -> Parser Text MonthSpec
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StringSupport -> Parser CronField
cronFieldP StringSupport
MonthString


-------------------------------------------------------------------------------
dayOfWeekP :: Parser DayOfWeekSpec
dayOfWeekP :: Parser Text DayOfWeekSpec
dayOfWeekP = (CronField -> Maybe DayOfWeekSpec)
-> String -> CronField -> Parser Text DayOfWeekSpec
forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
(a -> Maybe b) -> String -> a -> m b
mParse CronField -> Maybe DayOfWeekSpec
mkDayOfWeekSpec String
"day of week out of range" (CronField -> Parser Text DayOfWeekSpec)
-> Parser CronField -> Parser Text DayOfWeekSpec
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StringSupport -> Parser CronField
cronFieldP StringSupport
DayString


-------------------------------------------------------------------------------
parseInt :: Parser Int
parseInt :: Parser Text Int
parseInt = Parser Text Int
forall a. Integral a => Parser a
A.decimal

-------------------------------------------------------------------------------
data StringSupport
    = MonthString
    | DayString
    | NoString
    deriving StringSupport -> StringSupport -> Bool
(StringSupport -> StringSupport -> Bool)
-> (StringSupport -> StringSupport -> Bool) -> Eq StringSupport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StringSupport -> StringSupport -> Bool
== :: StringSupport -> StringSupport -> Bool
$c/= :: StringSupport -> StringSupport -> Bool
/= :: StringSupport -> StringSupport -> Bool
Eq

-------------------------------------------------------------------------------
supportParser :: StringSupport -> Parser Int
supportParser :: StringSupport -> Parser Text Int
supportParser = \case
    StringSupport
MonthString -> [Parser Text Int] -> Parser Text Int
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text Int
parseMonth, Parser Text Int
parseInt]
    StringSupport
DayString -> [Parser Text Int] -> Parser Text Int
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text Int
parseDay, Parser Text Int
parseInt]
    StringSupport
NoString -> Parser Text Int
parseInt

-------------------------------------------------------------------------------

toI :: Int -> Text -> Parser Int
toI :: Int -> Text -> Parser Text Int
toI Int
int Text
str = Int -> Text -> Int
forall a b. a -> b -> a
const Int
int (Text -> Int) -> Parser Text -> Parser Text Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Text
A.string Text
str

-------------------------------------------------------------------------------
parseDay :: Parser Int
parseDay :: Parser Text Int
parseDay =
    [Parser Text Int] -> Parser Text Int
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice ([Parser Text Int] -> Parser Text Int)
-> [Parser Text Int] -> Parser Text Int
forall a b. (a -> b) -> a -> b
$
        (Int -> Text -> Parser Text Int)
-> [Int] -> [Text] -> [Parser Text Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> Parser Text Int
toI
            [Int
1 .. Int
7]
            [ Text
"mon"
            , Text
"tue"
            , Text
"wed"
            , Text
"thu"
            , Text
"fri"
            , Text
"sat"
            , Text
"sun"
            ]

-------------------------------------------------------------------------------
parseMonth :: Parser Int
parseMonth :: Parser Text Int
parseMonth =
    [Parser Text Int] -> Parser Text Int
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice ([Parser Text Int] -> Parser Text Int)
-> [Parser Text Int] -> Parser Text Int
forall a b. (a -> b) -> a -> b
$
        (Int -> Text -> Parser Text Int)
-> [Int] -> [Text] -> [Parser Text Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> Parser Text Int
toI
            [Int
1 .. Int
12]
            [ Text
"jan"
            , Text
"feb"
            , Text
"mar"
            , Text
"apr"
            , Text
"may"
            , Text
"jun"
            , Text
"jul"
            , Text
"aug"
            , Text
"sep"
            , Text
"oct"
            , Text
"nov"
            , Text
"dec"]

-------------------------------------------------------------------------------
mParse :: (Monad m, MonadFail m) => (a -> Maybe b) -> String -> a -> m b
mParse :: forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
(a -> Maybe b) -> String -> a -> m b
mParse a -> Maybe b
f String
msg = m b -> (b -> m b) -> Maybe b -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m b
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
F.fail String
msg) b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> m b) -> (a -> Maybe b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f