module Saturn.Unstable.ParseSpec where

import qualified Data.Either as Either
import qualified Saturn.Unstable.Parse as Parse
import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec
import qualified Test.Hspec as Hspec

spec :: Hspec.Spec
spec :: Spec
spec = forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"Saturn.Unstable.Parse" forall a b. (a -> b) -> a -> b
$ do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"fromString" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts wildcards" forall a b. (a -> b) -> a -> b
$ do
      Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [] [] []
      String -> Either ParseError Schedule
Parse.fromString String
"* * * * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts extra spaces" forall a b. (a -> b) -> a -> b
$ do
      Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [] [] []
      String -> Either ParseError Schedule
Parse.fromString String
"  *  *  *  *  *  " forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts numbers" forall a b. (a -> b) -> a -> b
$ do
      Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [[Word8
4]] [[Word8
3]] [[Word8
2]] [[Word8
1]] [[Word8
0]]
      String -> Either ParseError Schedule
Parse.fromString String
"4 3 2 1 0" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts ranges" forall a b. (a -> b) -> a -> b
$ do
      Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [[Word8
8, Word8
9]] [[Word8
6, Word8
7]] [[Word8
4, Word8
5]] [[Word8
2, Word8
3]] [[Word8
0, Word8
1]]
      String -> Either ParseError Schedule
Parse.fromString String
"8-9 6-7 4-5 2-3 0-1" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts choices" forall a b. (a -> b) -> a -> b
$ do
      Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [[Word8
8], [Word8
9]] [[Word8
6], [Word8
7]] [[Word8
4], [Word8
5]] [[Word8
2], [Word8
3]] [[Word8
0], [Word8
1]]
      String -> Either ParseError Schedule
Parse.fromString String
"8,9 6,7 4,5 2,3 0,1" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"minute" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a number" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [[Word8
0]] [] [] [] []
        String -> Either ParseError Schedule
Parse.fromString String
"0 * * * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a range" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [[Word8
0, Word8
1]] [] [] [] []
        String -> Either ParseError Schedule
Parse.fromString String
"0-1 * * * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a choice" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [[Word8
0], [Word8
1]] [] [] [] []
        String -> Either ParseError Schedule
Parse.fromString String
"0,1 * * * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects two wildcards" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"*,* * * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"*,0 * * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"*,0-0 * * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"60 * * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number as part of a choice" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"0,60 * * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"60-61 * * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a half out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"0-60 * * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a backwards range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"1-0 * * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"hour" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a number" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [[Word8
0]] [] [] []
        String -> Either ParseError Schedule
Parse.fromString String
"* 0 * * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a range" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [[Word8
0, Word8
1]] [] [] []
        String -> Either ParseError Schedule
Parse.fromString String
"* 0-1 * * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a choice" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [[Word8
0], [Word8
1]] [] [] []
        String -> Either ParseError Schedule
Parse.fromString String
"* 0,1 * * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects two wildcards" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* *,* * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* *,0 * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* *,0-0 * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* 24 * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number as part of a choice" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* 0,24 * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* 24-25 * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a half out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* 0-24 * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a backwards range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* 1-0 * * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"day" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a number" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [[Word8
1]] [] []
        String -> Either ParseError Schedule
Parse.fromString String
"* * 1 * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a range" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [[Word8
1, Word8
2]] [] []
        String -> Either ParseError Schedule
Parse.fromString String
"* * 1-2 * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a choice" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [[Word8
1], [Word8
2]] [] []
        String -> Either ParseError Schedule
Parse.fromString String
"* * 1,2 * *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects two wildcards" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * *,* * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * *,1 * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * *,1-1 * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * 32 * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number as part of a choice" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * 1,32 * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * 32-33 * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a half out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * 1-32 * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a backwards range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * 2-1 * *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"month" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a number" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [] [[Word8
1]] []
        String -> Either ParseError Schedule
Parse.fromString String
"* * * 1 *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a range" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [] [[Word8
1, Word8
2]] []
        String -> Either ParseError Schedule
Parse.fromString String
"* * * 1-2 *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a choice" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [] [[Word8
1], [Word8
2]] []
        String -> Either ParseError Schedule
Parse.fromString String
"* * * 1,2 *" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects two wildcards" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * *,* *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * *,1 *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * *,1-1 *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * 13 *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number as part of a choice" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * 1,13 *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * 13-14 *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a half out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * 1-13 *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a backwards range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * 2-1 *" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"weekday" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a number" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [] [] [[Word8
0]]
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * 0" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a range" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [] [] [[Word8
0, Word8
1]]
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * 0-1" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"accepts a choice" forall a b. (a -> b) -> a -> b
$ do
        Schedule
schedule <- forall (m :: * -> *).
MonadFail m =>
[[Word8]]
-> [[Word8]] -> [[Word8]] -> [[Word8]] -> [[Word8]] -> m Schedule
ScheduleSpec.new [] [] [] [] [[Word8
0], [Word8
1]]
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * 0,1" forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects two wildcards" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * *,*" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * *,0" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a wildcard and a range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * *,0-0" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * 7" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds number as part of a choice" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * 0,7" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects an out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * 7-8" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a half out of bounds range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * 0-7" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft

      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"rejects a backwards range" forall a b. (a -> b) -> a -> b
$ do
        String -> Either ParseError Schedule
Parse.fromString String
"* * * * 1-0" forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`Hspec.shouldSatisfy` forall a b. Either a b -> Bool
Either.isLeft