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 = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
"Saturn.Unstable.Type.Field" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
"round trips"
    (Property -> Spec)
-> ((Field -> Expectation) -> Property)
-> (Field -> Expectation)
-> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen Field
-> (Field -> [Field]) -> (Field -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QuickCheck.forAllShrink Gen Field
arbitrary Field -> [Field]
shrink
    ((Field -> Expectation) -> Spec) -> (Field -> Expectation) -> Spec
forall a b. (a -> b) -> a -> b
$ \Field
x -> do
      Parsec Text () Field -> String -> Text -> Either ParseError Field
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
Parsec.parse Parsec Text () Field
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Field
Field.parsec String
"" (Builder -> Text
Builder.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Field -> Builder
Field.toBuilder Field
x)
        Either ParseError Field -> Either ParseError Field -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`Hspec.shouldBe` Field -> Either ParseError Field
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
    (Either Wildcard (NonEmpty Element) -> Field)
-> Gen (Either Wildcard (NonEmpty Element)) -> Gen Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Wildcard
-> Gen (NonEmpty Element)
-> Gen (Either Wildcard (NonEmpty Element))
forall a b. Gen a -> Gen b -> Gen (Either a b)
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
Gen a -> Gen b -> Gen (f a b)
QuickCheck.liftArbitrary2
      Gen Wildcard
WildcardSpec.arbitrary
      (Gen Element -> Gen (NonEmpty Element)
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 = a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
(NonEmpty.:|) (a -> [a] -> NonEmpty a) -> Gen a -> Gen ([a] -> NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
g Gen ([a] -> NonEmpty a) -> Gen [a] -> Gen (NonEmpty a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a -> Gen [a]
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 (Either Wildcard (NonEmpty Element) -> Field)
-> (Wildcard -> Either Wildcard (NonEmpty Element))
-> Wildcard
-> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wildcard -> Either Wildcard (NonEmpty Element)
forall a b. a -> Either a b
Left (Wildcard -> Field) -> Wildcard -> Field
forall a b. (a -> b) -> a -> b
$ () -> Wildcard
Wildcard.fromUnit ()]
   in [Field] -> [Field] -> [Field]
forall a. Monoid a => a -> a -> a
mappend [Field]
xs
        ([Field] -> [Field])
-> (Either Wildcard (NonEmpty Element) -> [Field])
-> Either Wildcard (NonEmpty Element)
-> [Field]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Wildcard (NonEmpty Element) -> Field)
-> [Either Wildcard (NonEmpty Element)] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Wildcard (NonEmpty Element) -> Field
Field.fromEither
        ([Either Wildcard (NonEmpty Element)] -> [Field])
-> (Either Wildcard (NonEmpty Element)
    -> [Either Wildcard (NonEmpty Element)])
-> Either Wildcard (NonEmpty Element)
-> [Field]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Wildcard -> [Wildcard])
-> (NonEmpty Element -> [NonEmpty Element])
-> Either Wildcard (NonEmpty Element)
-> [Either Wildcard (NonEmpty Element)]
forall a b. (a -> [a]) -> (b -> [b]) -> Either a b -> [Either a b]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
QuickCheck.liftShrink2 Wildcard -> [Wildcard]
WildcardSpec.shrink ((Element -> [Element]) -> NonEmpty Element -> [NonEmpty Element]
forall a. (a -> [a]) -> NonEmpty a -> [NonEmpty a]
shrinkNonEmpty Element -> [Element]
ElementSpec.shrink)
        (Either Wildcard (NonEmpty Element) -> [Field])
-> Either Wildcard (NonEmpty Element) -> [Field]
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 = (a -> Maybe (NonEmpty a)) -> [a] -> [NonEmpty a]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe ([a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([a] -> Maybe (NonEmpty a))
-> (a -> [a]) -> a -> Maybe (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
f) ([a] -> [NonEmpty a])
-> (NonEmpty a -> [a]) -> NonEmpty a -> [NonEmpty a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList

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