MessagesSpec.hs

{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE TypeApplications #-}
module Antiope.Messages.MessagesSpec
where

import Antiope.Messages
import Data.Aeson       (decode, encode, (.=))
import Data.Monoid      ((<>))
import Data.Scientific  (fromFloatDigits)
import Data.Text        (Text, pack)

import qualified Data.Aeson as Aeson
import qualified Data.Text  as Text

import HaskellWorks.Hspec.Hedgehog
import Hedgehog
import Hedgehog.Gen                as Gen
import Hedgehog.Range              as Range
import Test.Hspec

{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}

jsonObject :: MonadGen m => m Aeson.Value
jsonObject = do
  fields  <- Gen.list (Range.linear 0 10) jsonField
  kvs     <- traverse (\k -> (\v -> k .= v) <$> jsonValue) fields
  pure $ Aeson.object kvs
  where
    jsonValue   = Gen.choice [jsonString, jsonNumber, jsonBool, jsonNull]
    jsonField   = Gen.text (Range.linear 0 10) Gen.alphaNum
    jsonString  = Aeson.String <$> Gen.text (Range.linear 0 50) Gen.alphaNum
    jsonNumber  = (Aeson.Number . fromFloatDigits) <$> Gen.double (Range.linearFrac (-32000.0) 32000.0)
    jsonBool    = Aeson.Bool <$> Gen.bool
    jsonNull    = pure Aeson.Null


spec :: Spec
spec = describe "Antiope.Core.MessagesSpec" $ do
  it "Can encode and decode With" $ require $ property $ do
    obj <- forAll $ jsonObject
    tripping (With @"payload" obj) encode decode

  it "Can encode and decode inner-encoded" $ require $ property $ do
    obj <- forAll $ jsonObject
    tripping (WithEncoded @"payload" obj) encode decode