content: {-
  stack ghci hydra:lib hydra:hydra-test
  
  Test.Hspec.hspec Hydra.CoreCodersSpec.spec
  -}
  
  module Hydra.CoreCodersSpec where
  
  import Hydra.Kernel
  import Hydra.Dsl.Terms as Terms
  import qualified Hydra.Dsl.Types as Types
  import qualified Hydra.Decode.Core as DecodeCore
  import qualified Hydra.Encode.Core as EncodeCore
  
  import Hydra.TestData
  import Hydra.TestUtils
  import Hydra.ArbitraryCore (untyped)
  
  import qualified Test.Hspec as H
  import qualified Test.QuickCheck as QC
  import qualified Data.Map as M
  
  
  individualEncoderTestCases :: H.SpecWith ()
  individualEncoderTestCases = do
    H.describe "Individual encoder test cases" $ do
  
      H.it "string literal type" $ do
        H.shouldBe
          (strip $ EncodeCore.literalType LiteralTypeString :: Term)
          (strip $ unitVariant _LiteralType _LiteralType_string)
  
      H.it "string type" $ do
        H.shouldBe
          (strip $ EncodeCore.type_ Types.string :: Term)
          (strip $ variant _Type _Type_literal (unitVariant _LiteralType _LiteralType_string))
  
      H.it "int32 type" $ do
        H.shouldBe
          (strip $ EncodeCore.type_ Types.int32 :: Term)
          (strip $ variant _Type _Type_literal (variant _LiteralType _LiteralType_integer $ unitVariant _IntegerType _IntegerType_int32))
  
      H.it "record type" $ do
        H.shouldBe
          (strip $ EncodeCore.type_ (TypeRecord $ RowType (Name "Example")
            [Types.field "something" Types.string, Types.field "nothing" Types.unit]) :: Term)
          (strip $ variant _Type _Type_record $
            record _RowType [
              Field _RowType_typeName $ wrap _Name $ string "Example",
              Field _RowType_fields $ list [
                record _FieldType [
                  Field _FieldType_name $ wrap _Name $ string "something",
                  Field _FieldType_type $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_string],
                record _FieldType [
                  Field _FieldType_name $ wrap _Name $ string "nothing",
                  Field _FieldType_type $ unitVariant _Type _Type_unit]]])
  
  individualDecoderTestCases :: H.SpecWith ()
  individualDecoderTestCases = do
    H.describe "Individual decoder test cases" $ do
  
      H.it "float32 literal type" $ do
        shouldSucceedWith
          (DecodeCore.literalType
            (variant _LiteralType _LiteralType_float $ unitVariant _FloatType _FloatType_float32))
          (LiteralTypeFloat FloatTypeFloat32)
  
      H.it "float32 type" $ do
        shouldSucceedWith
          (DecodeCore.type_
            (variant _Type _Type_literal $ variant _LiteralType _LiteralType_float $ unitVariant _FloatType _FloatType_float32))
          Types.float32
  
      H.it "union type" $ do
        shouldSucceedWith
          (DecodeCore.type_ $
            variant _Type _Type_union $ record _RowType [
              Field _RowType_typeName $ wrap _Name $ string (unName testTypeName),
              Field _RowType_fields $
                list [
                  record _FieldType [
                    Field _FieldType_name $ wrap _Name $ string "left",
                    Field _FieldType_type $ variant _Type _Type_literal $ variant _LiteralType _LiteralType_integer $
                      unitVariant _IntegerType _IntegerType_int64],
                  record _FieldType [
                    Field _FieldType_name $ wrap _Name $ string "right",
                    Field _FieldType_type $ variant _Type _Type_literal $ variant _LiteralType _LiteralType_float $
                      unitVariant _FloatType _FloatType_float64]]])
            (TypeUnion $ RowType testTypeName [
              Types.field "left" Types.int64,
              Types.field "right" Types.float64])
  
  decodeInvalidTerms :: H.SpecWith ()
  decodeInvalidTerms = do
    H.describe "Decode invalid terms" $ do
  
      H.it "Try to decode a term with wrong fields for Type" $ do
        shouldFail (DecodeCore.type_ $ variant untyped (Name "unknownField") $ list [])
  
      H.it "Try to decode an incomplete representation of a Type" $ do
        shouldFail (DecodeCore.type_ $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_integer)
  
  metadataIsPreserved :: H.SpecWith ()
  metadataIsPreserved = do
    H.describe "Check that metadata is preserved through a type-encoding round trip" $ do
  
      H.it "Basic metadata" $ do
        shouldSucceedWith
          (DecodeCore.type_ $ EncodeCore.type_ annotatedStringType)
          annotatedStringType
    where
      annotatedStringType :: Type
      annotatedStringType = TypeAnnotated $ AnnotatedType Types.string $ M.fromList [
        (key_description, Terms.string "The string literal type"),
        (key_type, EncodeCore.type_ $ TypeVariable _Type)]
  
  testRoundTripsFromType :: H.SpecWith ()
  testRoundTripsFromType = do
    H.describe "Check that encoding, then decoding random types is a no-op" $ do
  
      H.it "Try random types" $
        QC.property $ \typ ->
          shouldSucceedWith
            (DecodeCore.type_ $ EncodeCore.type_ typ)
            typ
  
  spec :: H.Spec
  spec = do
    individualEncoderTestCases
    individualDecoderTestCases
    decodeInvalidTerms
    metadataIsPreserved
    testRoundTripsFromType
  