module Saturn.Unstable.Type.FieldSpec where

import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Maybe as Maybe
import qualified Data.Text.Lazy.Builder as Builder
import qualified Data.Word as Word
import qualified Saturn.Unstable.Type.ElementSpec as ElementSpec
import qualified Saturn.Unstable.Type.Field as Field
import qualified Saturn.Unstable.Type.Wildcard as Wildcard
import qualified Saturn.Unstable.Type.WildcardSpec as WildcardSpec
import qualified Test.Hspec as Hspec
import qualified Test.QuickCheck as QuickCheck
import qualified Text.Parsec as Parsec

spec :: Hspec.Spec
spec :: Spec
spec = forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"Saturn.Unstable.Type.Field" forall a b. (a -> b) -> a -> b
$ do
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"round trips"
    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 Field
arbitrary Field -> [Field]
shrink
    forall a b. (a -> b) -> a -> b
$ \Field
x -> do
      forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
Parsec.parse forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Field
Field.parsec String
"" (Builder -> Text
Builder.toLazyText forall a b. (a -> b) -> a -> b
$ Field -> Builder
Field.toBuilder Field
x)
        forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`Hspec.shouldBe` forall a b. b -> Either a b
Right Field
x

arbitrary :: QuickCheck.Gen Field.Field
arbitrary :: Gen Field
arbitrary =
  Either Wildcard (NonEmpty Element) -> Field
Field.fromEither
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
Gen a -> Gen b -> Gen (f a b)
QuickCheck.liftArbitrary2
      Gen Wildcard
WildcardSpec.arbitrary
      (forall a. Gen a -> Gen (NonEmpty a)
arbitraryNonEmpty Gen Element
ElementSpec.arbitrary)

arbitraryNonEmpty :: QuickCheck.Gen a -> QuickCheck.Gen (NonEmpty.NonEmpty a)
arbitraryNonEmpty :: forall a. Gen a -> Gen (NonEmpty a)
arbitraryNonEmpty Gen a
g = forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Gen a -> Gen [a]
QuickCheck.listOf Gen a
g

shrink :: Field.Field -> [Field.Field]
shrink :: Field -> [Field]
shrink Field
field =
  let xs :: [Field]
xs = case Field -> Either Wildcard (NonEmpty Element)
Field.toEither Field
field of
        Left Wildcard
_ -> []
        Right NonEmpty Element
_ -> [Either Wildcard (NonEmpty Element) -> Field
Field.fromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ () -> Wildcard
Wildcard.fromUnit ()]
   in forall a. Monoid a => a -> a -> a
mappend [Field]
xs
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Wildcard (NonEmpty Element) -> Field
Field.fromEither
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
QuickCheck.liftShrink2 Wildcard -> [Wildcard]
WildcardSpec.shrink (forall a. (a -> [a]) -> NonEmpty a -> [NonEmpty a]
shrinkNonEmpty Element -> [Element]
ElementSpec.shrink)
        forall a b. (a -> b) -> a -> b
$ Field -> Either Wildcard (NonEmpty Element)
Field.toEither Field
field

shrinkNonEmpty :: (a -> [a]) -> NonEmpty.NonEmpty a -> [NonEmpty.NonEmpty a]
shrinkNonEmpty :: forall a. (a -> [a]) -> NonEmpty a -> [NonEmpty a]
shrinkNonEmpty a -> [a]
f = forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NonEmpty.toList

new :: (MonadFail m) => [[Word.Word8]] -> m Field.Field
new :: forall (m :: * -> *). MonadFail m => [[Word8]] -> m Field
new =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ( Either Wildcard (NonEmpty Element) -> Field
Field.fromEither
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ () -> Wildcard
Wildcard.fromUnit ()) forall a b. b -> Either a b
Right
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty
    )
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). MonadFail m => [Word8] -> m Element
ElementSpec.new