bolt-0.3.2.0: test/Spec.hs

module Main where

import Data.ByteString (ByteString)
import qualified Data.HashMap.Strict as HM
import Data.PackStream
import Data.Serialize.Get
import Data.Serialize.Put
import qualified Data.Text as Text
import qualified Data.Vector as Vec

import Test.Tasty
import Test.Tasty.QuickCheck

instance Arbitrary PackStream where
  arbitrary =
    oneof
      [ return Null
      , Bool <$> arbitrary
      , Int <$> arbitrary
      , Float <$> arbitrary
      , String <$> (Text.pack <$> arbitrary)
      , List <$> (Vec.fromList <$> scale' (listOf arbitrary))
      , Map <$> (HM.fromList <$> scale' (listOf arbitrary))
      , Struct <$> arbitrary <*> scale' (listOf arbitrary)
      ]
   where
    scale' = scale (`div` 2)

  shrink Null = []
  shrink (Bool _) = [Null]
  shrink (Int _) = [Null]
  shrink (Float _) = [Null]
  shrink (String s) = Null : ((String . Text.pack) <$> shrink (Text.unpack s))
  shrink (List xs)
    | Vec.length xs == 0 = [Null]
    | Vec.length xs == 1 = [Vec.head xs]
    | otherwise = Null : ((List . Vec.fromList) <$> shrink (Vec.toList xs))
  shrink (Map xs)
    | HM.size xs == 0 = [Null]
    | HM.size xs == 1 = let [(k, v)] = HM.toList xs in [k, v]
    | otherwise = Null : ((Map . HM.fromList) <$> shrink (HM.toList xs))
  shrink (Struct s xs) = Null : List (Vec.fromList xs) : (Struct s <$> shrink xs)

prop_decode_encode :: PackStream -> Property
prop_decode_encode a = (decode . encode) a === a
 where
  encode :: PackStream -> ByteString
  encode = runPut . pack
  decode :: ByteString -> PackStream
  decode x = case runGet unpack x of
    Left err -> error err
    Right (Left err) -> error err
    Right (Right ps) -> ps

main :: IO ()
main =
  defaultMain $
    testGroup
      "Tests"
      [ testGroup
          "(checked by QuickCheck)"
          [ testProperty "id == decode . encode" prop_decode_encode
          ]
      ]