LiteralsSpec.hs

{-
stack ghci hydra:lib hydra:hydra-test

Test.Hspec.hspec Hydra.Adapt.LiteralsSpec.spec
-}

module Hydra.Adapt.LiteralsSpec where

import Hydra.Kernel
import qualified Hydra.Lib.Literals as Literals

import Hydra.TestUtils

import qualified Test.Hspec as H
import qualified Test.QuickCheck as QC


testFloatAdapter :: H.SpecWith ()
testFloatAdapter = H.describe "Test floating-point adapter" $ do

  H.it "upgrade float32 to bigfloat, since float32 and float64 are unsupported" $
    QC.property $ \f -> checkFloatAdapter
      [FloatTypeBigfloat]
      FloatTypeFloat32 FloatTypeBigfloat False
      (FloatValueFloat32 f) (FloatValueBigfloat $ realToFrac f)

  H.it "downgrade bigfloat to float64" $
    QC.property $ \d -> checkFloatAdapter
      [FloatTypeFloat32, FloatTypeFloat64]
      FloatTypeBigfloat FloatTypeFloat64 True
      (FloatValueBigfloat d) (FloatValueFloat64 $ realToFrac d)

  H.it "downgrade bigfloat to float32, since float64 is unsupported" $
    QC.property $ \d -> checkFloatAdapter
      [FloatTypeFloat32]
      FloatTypeBigfloat FloatTypeFloat32 True
      (FloatValueBigfloat d) (FloatValueFloat32 $ realToFrac d)

  H.it "bigfloat is supported and remains unchanged" $
    QC.property $ \d -> checkFloatAdapter
      [FloatTypeFloat32, FloatTypeBigfloat]
      FloatTypeBigfloat FloatTypeBigfloat False
      (FloatValueBigfloat d) (FloatValueBigfloat d)

testIntegerAdapter :: H.SpecWith ()
testIntegerAdapter = H.describe "Test integer adapter" $ do

  H.it "upgrade uint8 to uint16, not int16" $
    QC.property $ \b -> checkIntegerAdapter
      [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]
      IntegerTypeUint8 IntegerTypeUint16 False
      (IntegerValueUint8 b) (IntegerValueUint16 $ fromIntegral b)

  H.it "upgrade int8 to int16, not uint16" $
    QC.property $ \b -> checkIntegerAdapter
      [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]
      IntegerTypeInt8 IntegerTypeInt16 False
      (IntegerValueInt8 b) (IntegerValueInt16 $ fromIntegral b)

  H.it "upgrade uint8 to int16 when uint16 is not supported" $
    QC.property $ \b -> checkIntegerAdapter
      [IntegerTypeInt16, IntegerTypeInt32, IntegerTypeBigint]
      IntegerTypeUint8 IntegerTypeInt16 False
      (IntegerValueUint8 b) (IntegerValueInt16 $ fromIntegral b)

  H.it "cross-convert uint32 to int32, even when uint16 is supported" $
    QC.property $ \b -> checkIntegerAdapter
      [IntegerTypeUint16, IntegerTypeInt32]
      IntegerTypeUint32 IntegerTypeInt32 True
      (IntegerValueUint32 b) (IntegerValueInt32 $ fromIntegral b)

  H.it "downgrade bigint to int32, not uint32" $
    QC.property $ \b -> checkIntegerAdapter
      [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeInt32, IntegerTypeUint32]
      IntegerTypeBigint IntegerTypeInt32 True
      (IntegerValueBigint b) (IntegerValueInt32 $ fromIntegral b)

  H.it "upgrade uint64 to bigint when supported" $
    QC.property $ \i -> checkIntegerAdapter
      [IntegerTypeInt32, IntegerTypeUint32, IntegerTypeBigint]
      IntegerTypeUint64 IntegerTypeBigint False
      (IntegerValueUint64 i) (IntegerValueBigint $ fromIntegral i)

  H.it "downgrade uint64 to uint32 when bigint is unsupported" $
    QC.property $ \i -> checkIntegerAdapter
      [IntegerTypeInt32, IntegerTypeUint32]
      IntegerTypeUint64 IntegerTypeUint32 True
      (IntegerValueUint64 i) (IntegerValueUint32 $ fromIntegral i)

  H.it "upgrade int64 to bigint when supported" $
    QC.property $ \i -> checkIntegerAdapter
      [IntegerTypeBigint]
      IntegerTypeInt64 IntegerTypeBigint False
      (IntegerValueInt64 i) (IntegerValueBigint $ fromIntegral i)

testLiteralAdapter :: H.SpecWith ()
testLiteralAdapter = H.describe "Test literal adapter" $ do

  H.it "encode binary data as strings (base64)" $
    QC.property $ \b -> checkLiteralAdapter
      [LiteralVariantString]
      LiteralTypeBinary LiteralTypeString False
      (LiteralBinary b) (LiteralString $ Literals.binaryToStringBS b)

  H.it "encode booleans as strings" $
    QC.property $ \b -> checkLiteralAdapter
      [LiteralVariantString]
      LiteralTypeBoolean LiteralTypeString False
      (LiteralBoolean b) (LiteralString $ if b then "true" else "false")

  H.it "encode booleans as integers" $
    QC.property $ \b -> checkLiteralAdapter
      [LiteralVariantInteger]
      LiteralTypeBoolean (LiteralTypeInteger IntegerTypeInt16) False
      (LiteralBoolean b) (LiteralInteger $ IntegerValueInt16 $ if b then 1 else 0)

  H.it "floating-point encoding is delegated to the float adapter" $
    QC.property $ \f -> checkLiteralAdapter
      [LiteralVariantFloat]
      (LiteralTypeFloat FloatTypeBigfloat) (LiteralTypeFloat FloatTypeFloat32) True
      (LiteralFloat $ FloatValueBigfloat f) (LiteralFloat $ FloatValueFloat32 $ realToFrac f)

  H.it "integer encoding is delegated to the integer adapter" $
    QC.property $ \i -> checkLiteralAdapter
      [LiteralVariantInteger]
      (LiteralTypeInteger IntegerTypeBigint) (LiteralTypeInteger IntegerTypeInt32) True
      (LiteralInteger $ IntegerValueBigint i) (LiteralInteger $ IntegerValueInt32 $ fromIntegral i)

  H.it "strings are unchanged" $
    QC.property $ \s -> checkLiteralAdapter
      [LiteralVariantString]
      LiteralTypeString LiteralTypeString False
      (LiteralString s) (LiteralString s)

spec :: H.Spec
spec = do
  testFloatAdapter
  testIntegerAdapter
  testLiteralAdapter