-- |
-- Module      : Codec.Serialise.Properties
-- Copyright   : (c) Duncan Coutts 2015-2017
-- License     : BSD3-style (see LICENSE.txt)
--
-- Maintainer  : duncan@community.haskell.org
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- This module contains a set of generally useful properties, which
-- instance authors are encouraged to use in order to test their
-- instances of the @'Serialise'@ class. For example, if you have a
-- data type which you might derive or write instances for:
--
-- @
-- data Foo = Foo { fooInt :: Int, fooBool :: Bool }
--   deriving (Eq, Show, 'GHC.Generics.Generic')
-- -- or, alternatively
-- instance 'Serialise' Foo where
--   'encode' = ...
--   'decode' = ...
-- @
--
-- Then you can use this module to easily derive some quick
-- properties:
--
-- @
-- import qualified "Codec.Serialise.Properties" as Props
--
-- fooSerialiseId :: Foo -> Bool
-- fooSerialiseId = Props.'serialiseIdentity'
--
-- fooFlatTermId :: Foo -> Bool
-- fooFlatTermId = Props.'flatTermIdentity'
--
-- fooHasValidFlatTerm :: Foo -> Bool
-- fooHasValidFlatTerm = Props.'hasValidFlatTerm'
-- @
--
-- You can then conveniently use these three functions with
-- QuickCheck, for example.
--
module Codec.Serialise.Properties
  ( -- * CBOR Properties
    serialiseIdentity -- :: (Serialise a, Eq a) => a -> Bool
    -- * @'FlatTerm'@ Properties
  , flatTermIdentity  -- :: (Serialise a, Eq a) => a -> Bool
  , hasValidFlatTerm  -- ::  Serialise a        => a -> Bool
  ) where

import           Codec.CBOR.FlatTerm
import           Codec.Serialise       (deserialise, serialise)
import           Codec.Serialise.Class

--------------------------------------------------------------------------------

-- | Ensure that serializing and deserializing some value results in
-- the original value being returned.
--
-- @since 0.2.0.0
serialiseIdentity :: (Serialise a, Eq a) => a -> Bool
serialiseIdentity :: a -> Bool
serialiseIdentity a
a = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (ByteString -> a
forall a. Serialise a => ByteString -> a
deserialise (ByteString -> a) -> (a -> ByteString) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Serialise a => a -> ByteString
serialise) a
a

-- | Ensure that serializing and deserializing a value with the
-- @'FlatTerm'@ form results in the original value being returned.
--
-- @since 0.2.0.0
flatTermIdentity :: (Serialise a, Eq a) => a -> Bool
flatTermIdentity :: a -> Bool
flatTermIdentity  a
a = a -> Either String a
forall a b. b -> Either a b
Right a
a Either String a -> Either String a -> Bool
forall a. Eq a => a -> a -> Bool
== (FlatTerm -> Either String a
fromFlat (FlatTerm -> Either String a)
-> (a -> FlatTerm) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FlatTerm
toFlat) a
a
  where
    toFlat :: a -> FlatTerm
toFlat   = Encoding -> FlatTerm
toFlatTerm (Encoding -> FlatTerm) -> (a -> Encoding) -> a -> FlatTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
forall a. Serialise a => a -> Encoding
encode
    fromFlat :: FlatTerm -> Either String a
fromFlat = (forall s. Decoder s a) -> FlatTerm -> Either String a
forall a. (forall s. Decoder s a) -> FlatTerm -> Either String a
fromFlatTerm forall s. Decoder s a
forall a s. Serialise a => Decoder s a
decode

-- | Ensure that serializing a value into a @'FlatTerm'@ gives us a
-- valid @'FlatTerm'@ back.
--
-- @since 0.2.0.0
hasValidFlatTerm :: Serialise a => a -> Bool
hasValidFlatTerm :: a -> Bool
hasValidFlatTerm = FlatTerm -> Bool
validFlatTerm (FlatTerm -> Bool) -> (a -> FlatTerm) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> FlatTerm
toFlatTerm (Encoding -> FlatTerm) -> (a -> Encoding) -> a -> FlatTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
forall a. Serialise a => a -> Encoding
encode