content: {-# LANGUAGE OverloadedStrings #-}
  module System.Test.Cron.Parser (tests) where
  
  -------------------------------------------------------------------------------
  import           Data.List.NonEmpty (NonEmpty (..))
  import           Data.Text          (Text)
  import           Hedgehog
  -------------------------------------------------------------------------------
  import           SpecHelper
  -------------------------------------------------------------------------------
  
  
  tests :: TestTree
  tests = testGroup "System.Cron.Parser"
    [ describeCronSchedule
    , describeCronScheduleLoose
    , describeCrontab
    , describeCrontabEntry
    , describeSerializeParseCronSchedule
    , describeSerializeParseCrontab
    ]
  
  
  -------------------------------------------------------------------------------
  describeCronSchedule :: TestTree
  describeCronSchedule = testGroup "cronSchedule"
    [
      testCase "parses all stars" $
      assertSuccessfulParse "* * * * *"
                            stars
  
    , testCase "parses specific values" $
      assertSuccessfulParse "1 2 3 * *"
                             stars { minute      = mkMinuteSpec' (Field (SpecificField' (mkSpecificField' 1))),
                                     hour        = mkHourSpec' (Field (SpecificField' (mkSpecificField' 2))),
                                     dayOfMonth  = mkDayOfMonthSpec' (Field (SpecificField' (mkSpecificField' 3))) }
  
    , testCase "parses list values" $
      assertSuccessfulParse "* * 3,4 * *"
                            stars { dayOfMonth  = mkDayOfMonthSpec' (ListField (SpecificField' (mkSpecificField' 3) :| [SpecificField' (mkSpecificField' 4)])) }
  
    , testCase "parses range values" $
      assertSuccessfulParse "* * 3-4 * *"
                             stars { dayOfMonth  = mkDayOfMonthSpec' (Field (RangeField' (mkRangeField' 3 4))) }
  
    , testCase "parses step values" $
      assertSuccessfulParse "*/2 * 2-10/4 * *"
                            stars { minute     = mkMinuteSpec' (StepField' (mkStepField' Star 2)),
                                    dayOfMonth  = mkDayOfMonthSpec' (StepField' (mkStepField' (RangeField' (mkRangeField' 2 10)) 4)) }
  
    , testCase "refuses to parse recursive steps" $
      assertFailedParse "*/2/3 * * * *"
  
    , testCase "refuses to parse sparse lists" $
      assertFailedParse "1,,2 * * * *"
  
    , testCase "refuses too few fields" $
      assertFailedParse "* * * *"
  
    , testCase "refuses too many fields" $
      assertFailedParse "* * * * * *"
  
    , testCase "refuses extraneous input" $
      assertFailedParse "* * * * *    wat is this"
  
    , testCase "parses @hourly" $
      assertSuccessfulParse "@hourly" hourly
  
    , testCase "parses @daily" $
      assertSuccessfulParse "@daily" daily
  
    , testCase "parses @monthly" $
      assertSuccessfulParse "@monthly" monthly
  
    , testCase "parses @yearly" $
      assertSuccessfulParse "@yearly" yearly
  
    , testCase "parses ranges at the last field" $
      assertSuccessfulParse "* * * * 3-4"
                             stars { dayOfWeek  = mkDayOfWeekSpec' (Field (RangeField' (mkRangeField' 3 4))) }
    , testCase "parses lists at the last field" $
      assertSuccessfulParse "* * * * 3,4"
                             stars { dayOfWeek  = mkDayOfWeekSpec' (ListField (SpecificField' (mkSpecificField' 3) :| [SpecificField' (mkSpecificField' 4)])) }
    , testCase "parses steps at the last field" $
      assertSuccessfulParse "* * * * */4"
                             stars { dayOfWeek  = mkDayOfWeekSpec' (StepField' (mkStepField' Star 4)) }
    , testCase "parses a sunday as 7" $
      assertSuccessfulParse "* * * * 7"
                             stars { dayOfWeek  = mkDayOfWeekSpec' (Field (SpecificField' (mkSpecificField' 7))) }
    , testCase "parses a sunday as 0" $
      assertSuccessfulParse "* * * * 0"
                             stars { dayOfWeek  = mkDayOfWeekSpec' (Field (SpecificField' (mkSpecificField' 0))) }
    , testCase "parses another example" $
      assertSuccessfulParse "1-59/2 * * * *"
                            stars { minute     = mkMinuteSpec' (StepField' (mkStepField' (RangeField' (mkRangeField' 1 59)) 2)) }
  
    ]
    where assertSuccessfulParse = assertParse cronSchedule
          assertFailedParse = assertNoParse cronSchedule
  
  
  -------------------------------------------------------------------------------
  describeCronScheduleLoose :: TestTree
  describeCronScheduleLoose = testGroup "cronScheduleLoose"
    [
      testCase "is okay with extaneous input" $
      assertSuccessfulParse "* * * * * *"
                            stars
    ]
    where assertSuccessfulParse = assertParse cronScheduleLoose
  
  
  -------------------------------------------------------------------------------
  describeCrontab :: TestTree
  describeCrontab = testGroup "crontab"
    [
      testCase "parses an empty input" $
      assertSuccessfulParse ""
                            (Crontab [])
  
    , testCase "parses whitespace" $
      assertSuccessfulParse "        "
                            (Crontab [])
  
    , testCase "parses a single line" $
      assertSuccessfulParse "        "
                            (Crontab [])
  
    , testCase "ignores comments" $
      assertSuccessfulParse "# comment"
                            (Crontab [])
  
    , testCase "ignores comments with leading whitespace" $
      assertSuccessfulParse "    # comment"
                            (Crontab [])
  
    , testCase "parses comments interspersed with actual commands" $
      assertSuccessfulParse "#comment here\nFOO=BAR\n  #another\n* * * * * do stuff"
                            (Crontab [envSet, entry])
    ]
    where assertSuccessfulParse = assertParse crontab
  
  
  -------------------------------------------------------------------------------
  describeCrontabEntry :: TestTree
  describeCrontabEntry = testGroup "crontabEntry"
    [
      testCase "parses an environment variable assignment" $
      assertSuccessfulParse "FOO=BAR"
                            envSet
  
    , testCase "parses an environment variable with whitespace at the front" $
      assertSuccessfulParse "  FOO=BAR"
                            envSet
  
    , testCase "parses an environment variable with whitespace in the middle" $
      assertSuccessfulParse "  FOO =   BAR"
                            envSet
  
    , testCase "parses a command" $
      assertSuccessfulParse "* * * * * do stuff"
                            entry
  
    , testCase "parses a command with any amount of whitespace inbetween" $
      assertSuccessfulParse "* * * * *      do stuff"
                            entry
  
    , testCase "parses a command with whitespace at the front" $
      assertSuccessfulParse "  * * * * *      do stuff"
                            entry
    ]
    where assertSuccessfulParse = assertParse crontabEntry
  
  
  -------------------------------------------------------------------------------
  describeSerializeParseCronSchedule :: TestTree
  describeSerializeParseCronSchedule = testGroup "serialize/parse CronSchedule"
    [
      testProperty "roundtrips" $ property $ do
        cs <- forAll gen
        parseCronSchedule (serializeCronSchedule cs) === Right cs
    ]
  
  
  -------------------------------------------------------------------------------
  describeSerializeParseCrontab :: TestTree
  describeSerializeParseCrontab = testGroup "serialize/parse Crontab"
    [
      testProperty "roundtrips" $ property $ do
        ct <- forAll gen
        parseCrontab (serializeCrontab ct) === Right ct
    ]
  
  
  -------------------------------------------------------------------------------
  assertParse :: (Eq a, Show a)
                 => Parser a
                 -> Text
                 -> a
                 -> Assertion
  assertParse parser txt expected = parsed @?= Right expected
    where parsed = parseOnly parser txt
  
  
  -------------------------------------------------------------------------------
  assertNoParse :: Parser a
                -> Text
                -> Assertion
  assertNoParse parser txt = isLeft (parseOnly parser txt) @?= True
  
  
  -------------------------------------------------------------------------------
  envSet :: CrontabEntry
  envSet = EnvVariable "FOO" "BAR"
  
  
  -------------------------------------------------------------------------------
  entry :: CrontabEntry
  entry = CommandEntry stars (CronCommand "do stuff")
  
  
  -------------------------------------------------------------------------------
  stars :: CronSchedule
  stars = everyMinute
  