content: {-# 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 = cronScheduleLoose <* A.endOfInput
  
  
  -------------------------------------------------------------------------------
  -- | Same as 'cronSchedule' but does not fail on extraneous input.
  cronScheduleLoose :: Parser CronSchedule
  cronScheduleLoose = yearlyP  <|>
                      monthlyP <|>
                      weeklyP  <|>
                      dailyP   <|>
                      hourlyP  <|>
                      classicP
  
  
  -------------------------------------------------------------------------------
  -- | Parses a full crontab file, omitting comments and including environment
  -- variable sets (e.g FOO=BAR).
  crontab :: Parser Crontab
  crontab = Crontab <$> A.sepBy lineP (A.char '\n')
    where lineP    = A.skipMany commentP *> crontabEntry
          commentP = A.skipSpace *> A.char '#' *> skipToEOL
  
  
  -------------------------------------------------------------------------------
  -- | Parses an individual crontab line, which is either a scheduled command or
  -- an environmental variable set.
  crontabEntry :: Parser CrontabEntry
  crontabEntry = A.skipSpace *> parser
    where parser = envVariableP <|>
                   commandEntryP
          envVariableP = do var <- A.takeWhile1 (A.notInClass " =")
                            A.skipSpace
                            _   <- A.char '='
                            A.skipSpace
                            val <- A.takeWhile1 $ not . isSpace
                            A.skipWhile (\c -> c == ' ' || c == '\t')
                            return $ EnvVariable var val
          commandEntryP = CommandEntry <$> cronScheduleLoose
                                       <*> (A.skipSpace *> (CronCommand <$> takeToEOL))
  
  
  -------------------------------------------------------------------------------
  -- Convenience functions
  -------------------------------------------------------------------------------
  
  
  parseCronSchedule :: Text -> Either String CronSchedule
  parseCronSchedule = A.parseOnly cronSchedule . toLower
  
  
  -------------------------------------------------------------------------------
  parseCrontab :: Text -> Either String Crontab
  parseCrontab = A.parseOnly crontab
  
  
  -------------------------------------------------------------------------------
  parseCrontabEntry :: Text -> Either String CrontabEntry
  parseCrontabEntry = A.parseOnly crontabEntry
  
  
  -------------------------------------------------------------------------------
  -- Internals
  -------------------------------------------------------------------------------
  
  
  takeToEOL :: Parser Text
  takeToEOL = A.takeTill (== '\n') -- <* A.skip (== '\n')
  
  
  -------------------------------------------------------------------------------
  skipToEOL :: Parser ()
  skipToEOL = A.skipWhile (/= '\n')
  
  
  -------------------------------------------------------------------------------
  classicP :: Parser CronSchedule
  classicP = CronSchedule <$> (minutesP    <* space)
                          <*> (hoursP      <* space)
                          <*> (dayOfMonthP <* space)
                          <*> (monthP      <* space)
                          <*> dayOfWeekP
    where space = A.char ' '
  
  
  -------------------------------------------------------------------------------
  cronFieldP :: StringSupport -> Parser CronField
  cronFieldP stringSupport =
      stepP  <|>
      listP  <|>
      fieldP
    where
      fieldP        = Field <$> baseFieldP stringSupport
      listP         = ListField <$> neListP (baseFieldP stringSupport)
      stepP         = StepField' <$> stepFieldP stringSupport
  
  
  -------------------------------------------------------------------------------
  stepFieldP :: StringSupport -> Parser StepField
  stepFieldP ss = do
    f <- baseFieldP ss
    _ <- A.char '/'
    mParse (mkStepField f) "invalid stepping" =<< parseInt
  
  
  -------------------------------------------------------------------------------
  neListP :: Parser a -> Parser (NonEmpty a)
  neListP p = coerceNE =<< A.sepBy1 p (A.char ',')
    where
      coerceNE []     = F.fail "expected non-empty list"
      coerceNE [_]    = F.fail "invalid singleton list"
      coerceNE (x:xs) = return $ x :| xs
  
  
  -------------------------------------------------------------------------------
  baseFieldP :: StringSupport -> Parser BaseField
  baseFieldP ss = rangeP <|>
                  starP  <|>
                  specificP
    where starP         = A.char '*' *> Ap.pure Star
          rangeP        = RangeField' <$> rangeFieldP ss
          specificP     = SpecificField' <$> specificFieldP ss
  
  
  -------------------------------------------------------------------------------
  specificFieldP :: StringSupport -> Parser SpecificField
  specificFieldP ss =
    mParse mkSpecificField "specific field value out of range"
      =<< supportParser ss
  
  -------------------------------------------------------------------------------
  rangeFieldP :: StringSupport -> Parser RangeField
  rangeFieldP ss = do
    begin <- supportParser ss
    _ <- A.char '-'
    end <- supportParser ss
    mParse (mkRangeField begin) "start of range must be less than or equal to end" end
  
  
  -------------------------------------------------------------------------------
  yearlyP :: Parser CronSchedule
  yearlyP  = A.string "@yearly"  *> pure yearly
  
  
  -------------------------------------------------------------------------------
  monthlyP :: Parser CronSchedule
  monthlyP = A.string "@monthly" *> pure monthly
  
  
  -------------------------------------------------------------------------------
  weeklyP :: Parser CronSchedule
  weeklyP  = A.string "@weekly"  *> pure weekly
  
  
  -------------------------------------------------------------------------------
  dailyP :: Parser CronSchedule
  dailyP   = A.string "@daily"   *> pure daily
  
  
  -------------------------------------------------------------------------------
  hourlyP :: Parser CronSchedule
  hourlyP  = A.string "@hourly"  *> pure hourly
  
  
  -------------------------------------------------------------------------------
  minutesP :: Parser MinuteSpec
  minutesP = mParse mkMinuteSpec "minutes out of range" =<< cronFieldP NoString
  
  
  -------------------------------------------------------------------------------
  hoursP :: Parser HourSpec
  hoursP = mParse mkHourSpec "hours out of range" =<< cronFieldP NoString
  
  
  -------------------------------------------------------------------------------
  dayOfMonthP :: Parser DayOfMonthSpec
  dayOfMonthP = mParse mkDayOfMonthSpec "day of month out of range" =<< cronFieldP NoString
  
  
  -------------------------------------------------------------------------------
  monthP :: Parser MonthSpec
  monthP = mParse mkMonthSpec "month out of range" =<< cronFieldP MonthString
  
  
  -------------------------------------------------------------------------------
  dayOfWeekP :: Parser DayOfWeekSpec
  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, MonadFail m) => (a -> Maybe b) -> String -> a -> m b
  mParse f msg = maybe (F.fail msg) return . f
  