Show.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | 'Show' and 'Read' properties
module Test.Validity.Show
  ( showReadSpec,
    showReadSpecOnArbitrary,
    showReadSpecOnGen,
    showReadRoundTrip,
    showReadRoundTripOnArbitrary,
    showReadRoundTripOnGen,
  )
where

import Data.Data
import Data.GenValidity
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Utils
import Text.Read

-- | Standard test spec for properties of Show and Read instances for valid values
--
-- Example usage:
--
-- > showReadSpec @Int
showReadSpec ::
  forall a.
  (Show a, Eq a, Read a, Typeable a, GenValid a) =>
  Spec
showReadSpec = showReadSpecOnGen @a genValid "valid" shrinkValid

-- | Standard test spec for properties of Show and Read instances for arbitrary values
--
-- Example usage:
--
-- > showReadSpecOnArbitrary @Double
showReadSpecOnArbitrary ::
  forall a.
  (Show a, Eq a, Read a, Typeable a, Arbitrary a) =>
  Spec
showReadSpecOnArbitrary = showReadSpecOnGen @a arbitrary "arbitrary" shrink

-- | Standard test spec for properties of Show and Read instances for values generated by a custom generator
--
-- Example usage:
--
-- > showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])
showReadSpecOnGen ::
  forall a.
  (Show a, Eq a, Read a, Typeable a) =>
  Gen a ->
  String ->
  (a -> [a]) ->
  Spec
showReadSpecOnGen gen n s =
  describe (unwords ["Show", nameOf @a, "and Read", nameOf @a]) $
    it (unwords ["are implemented such that read . show == id for", n, "values"]) $
      showReadRoundTripOnGen gen s

-- |
--
-- prop> showReadRoundTrip @Int
showReadRoundTrip ::
  forall a.
  (Show a, Eq a, Read a, GenValid a) =>
  Property
showReadRoundTrip =
  showReadRoundTripOnGen (genValid :: Gen a) shrinkValid

-- |
--
-- prop> showReadRoundTripOnArbitrary @Double
showReadRoundTripOnArbitrary ::
  forall a.
  (Show a, Eq a, Read a, Arbitrary a) =>
  Property
showReadRoundTripOnArbitrary =
  showReadRoundTripOnGen (arbitrary :: Gen a) shrink

-- |
--
-- prop> showReadRoundTripOnGen (abs <$> genValid :: Gen Int) (const [])
showReadRoundTripOnGen ::
  (Show a, Eq a, Read a) => Gen a -> (a -> [a]) -> Property
showReadRoundTripOnGen gen s =
  forAllShrink gen s $ \v -> readMaybe (show v) `shouldBe` Just v