{-# 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 :: forall a. (Show a, Eq a, Read a, Typeable a, GenValid a) => Spec
showReadSpec = forall a.
(Show a, Eq a, Read a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
showReadSpecOnGen @a forall a. GenValid a => Gen a
genValid String
"valid" forall a. GenValid a => a -> [a]
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 :: forall a. (Show a, Eq a, Read a, Typeable a, Arbitrary a) => Spec
showReadSpecOnArbitrary = forall a.
(Show a, Eq a, Read a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
showReadSpecOnGen @a forall a. Arbitrary a => Gen a
arbitrary String
"arbitrary" forall a. Arbitrary a => a -> [a]
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 :: forall a.
(Show a, Eq a, Read a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
showReadSpecOnGen Gen a
gen String
n a -> [a]
s =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe ([String] -> String
unwords [String
"Show", forall {k} (a :: k). Typeable a => String
nameOf @a, String
"and Read", forall {k} (a :: k). Typeable a => String
nameOf @a]) forall a b. (a -> b) -> a -> b
$
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it ([String] -> String
unwords [String
"are implemented such that read . show == id for", String
n, String
"values"]) forall a b. (a -> b) -> a -> b
$
      forall a. (Show a, Eq a, Read a) => Gen a -> (a -> [a]) -> Property
showReadRoundTripOnGen Gen a
gen a -> [a]
s

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

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

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