{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}

{-| Module      : Test.QuickCheck.Classes.Show
    Description : Properties for testing the properties of the Show type class.
-}
module Test.QuickCheck.Classes.Show
  ( showLaws
  ) where

import Data.Proxy (Proxy)
import Test.QuickCheck (Arbitrary, Property, property)

import Test.QuickCheck.Classes.Internal (Laws(..), ShowReadPrecedence(..))

-- | Tests the following properties:
--
-- [/Show/]
-- @'show' a ≡ 'showsPrec' 0 a ""@
-- [/Equivariance: 'showsPrec'/]
-- @'showsPrec' p a r '++' s ≡ 'showsPrec' p a (r '++' s)@
-- [/Equivariance: 'showList'/]
-- @'showList' as r '++' s ≡ 'showList' as (r '++' s)@
--
showLaws :: (Show a, Arbitrary a) => Proxy a -> Laws
showLaws :: Proxy a -> Laws
showLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Show"
  [ (String
"Show", Proxy a -> Property
forall a. (Show a, Arbitrary a) => Proxy a -> Property
showShowsPrecZero Proxy a
p)
  , (String
"Equivariance: showsPrec", Proxy a -> Property
forall a. (Show a, Arbitrary a) => Proxy a -> Property
equivarianceShowsPrec Proxy a
p)
  , (String
"Equivariance: showList", Proxy a -> Property
forall a. (Show a, Arbitrary a) => Proxy a -> Property
equivarianceShowList Proxy a
p)
  ]

showShowsPrecZero :: forall a. (Show a, Arbitrary a) => Proxy a -> Property
showShowsPrecZero :: Proxy a -> Property
showShowsPrecZero Proxy a
_ =
  (a -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Bool) -> Property) -> (a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) ->
    a -> String
forall a. Show a => a -> String
show a
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 a
a String
""

equivarianceShowsPrec :: forall a.
  (Show a, Arbitrary a) => Proxy a -> Property
equivarianceShowsPrec :: Proxy a -> Property
equivarianceShowsPrec Proxy a
_ =
  (ShowReadPrecedence -> a -> String -> String -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((ShowReadPrecedence -> a -> String -> String -> Bool) -> Property)
-> (ShowReadPrecedence -> a -> String -> String -> Bool)
-> Property
forall a b. (a -> b) -> a -> b
$ \(ShowReadPrecedence Int
p) (a
a :: a) (String
r :: String) (String
s :: String) ->
    Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
a String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
a (String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)

equivarianceShowList :: forall a.
  (Show a, Arbitrary a) => Proxy a -> Property
equivarianceShowList :: Proxy a -> Property
equivarianceShowList Proxy a
_ =
  ([a] -> String -> String -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property (([a] -> String -> String -> Bool) -> Property)
-> ([a] -> String -> String -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \([a]
as :: [a]) (String
r :: String) (String
s :: String) ->
    [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList [a]
as String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList [a]
as (String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)