module SaturnSpec where

import qualified Saturn.Unstable.Parse as Parse
import qualified Saturn.Unstable.Render as Render
import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec
import qualified Test.Hspec as Hspec
import qualified Test.QuickCheck as QuickCheck

spec :: Hspec.Spec
spec :: Spec
spec = forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"Saturn" forall a b. (a -> b) -> a -> b
$ do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"round trips" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"through string"
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QuickCheck.forAllShrink Gen Schedule
ScheduleSpec.arbitrary Schedule -> [Schedule]
ScheduleSpec.shrink
      forall a b. (a -> b) -> a -> b
$ \Schedule
schedule ->
        String -> Either ParseError Schedule
Parse.fromString (Schedule -> String
Render.toString Schedule
schedule) forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`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
"through strict text"
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QuickCheck.forAllShrink Gen Schedule
ScheduleSpec.arbitrary Schedule -> [Schedule]
ScheduleSpec.shrink
      forall a b. (a -> b) -> a -> b
$ \Schedule
schedule ->
        Text -> Either ParseError Schedule
Parse.fromText (Schedule -> Text
Render.toText Schedule
schedule) forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`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
"through lazy text"
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QuickCheck.forAllShrink Gen Schedule
ScheduleSpec.arbitrary Schedule -> [Schedule]
ScheduleSpec.shrink
      forall a b. (a -> b) -> a -> b
$ \Schedule
schedule ->
        Text -> Either ParseError Schedule
Parse.fromLazyText (Schedule -> Text
Render.toLazyText Schedule
schedule) forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`Hspec.shouldBe` forall a b. b -> Either a b
Right Schedule
schedule