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

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

import Data.GenValidity

import Data.Data

import Text.Read

import Test.Syd
import Test.QuickCheck

import Test.Syd.Validity.Utils

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

-- | Standard test spec for properties of Show and Read instances for unchecked values
--
-- Example usage:
--
-- > showReadSpec @Int
showReadSpec ::
       forall a. (Show a, Eq a, Read a, Typeable a, GenUnchecked a)
    => Spec
showReadSpec :: Spec
showReadSpec = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Read a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
showReadSpecOnGen @a Gen a
forall a. GenUnchecked a => Gen a
genUnchecked String
"unchecked" a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked


-- | 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 :: Spec
showReadSpecOnArbitrary = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Read a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
showReadSpecOnGen @a Gen a
forall a. Arbitrary a => Gen a
arbitrary String
"arbitrary" a -> [a]
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 :: Gen a -> String -> (a -> [a]) -> Spec
showReadSpecOnGen Gen a
gen String
n a -> [a]
s =
    String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe ([String] -> String
unwords [String
"Show", Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a, String
"and Read", Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a]) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    String -> Property -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it ([String] -> String
unwords [String
"are implemented such that read . show == id for", String
n, String
"values"]) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen a -> (a -> [a]) -> Property
forall a. (Show a, Eq a, Read a) => Gen a -> (a -> [a]) -> Property
showReadRoundTripOnGen Gen a
gen a -> [a]
s

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

-- |
--
-- prop> showReadRoundTrip @Int
showReadRoundTrip ::
       forall a. (Show a, Eq a, Read a, GenUnchecked a)
    => Property
showReadRoundTrip :: Property
showReadRoundTrip =
    Gen a -> (a -> [a]) -> Property
forall a. (Show a, Eq a, Read a) => Gen a -> (a -> [a]) -> Property
showReadRoundTripOnGen (Gen a
forall a. GenUnchecked a => Gen a
genUnchecked :: Gen a) a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked

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

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