{-# LANGUAGE ScopedTypeVariables #-}

module Hedgehog.Classes.Show (showLaws) where

import Hedgehog
import Hedgehog.Classes.Common

-- | Tests the following 'Show' laws:
--
-- [__ShowsPrec Zero__]: @'show' a@ ≡ @'showsPrec' 0 a \"\"@
-- [__ShowsPrec Equivariance__]: @'showsPrec' p a r '++' s@ ≡ @'showsPrec p a (r '++' s)@
-- [__ShowsPrec ShowList__]: @'showList' as r '++' s@ ≡ @'showList' as (r '++' s)@
showLaws :: (Show a) => Gen a -> Laws
showLaws :: forall a. Show a => Gen a -> Laws
showLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Show"
  [ (String
"ShowsPrec Zero", forall a. Show a => Gen a -> Property
showShowsPrecZero Gen a
gen)
  , (String
"Equivariance: showsPrec", forall a. Show a => Gen a -> Property
equivarianceShowsPrec Gen a
gen)
  , (String
"Equivariance: showList", forall a. Show a => Gen a -> Property
equivarianceShowList Gen a
gen)
  ]

showShowsPrecZero :: forall a. (Show a) => Gen a -> Property
showShowsPrecZero :: forall a. Show a => Gen a -> Property
showShowsPrecZero Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  let lhs :: String
lhs = forall a. Show a => a -> String
show a
a
  let rhs :: String
rhs = forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 a
a String
""
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"ShowsPrec Zero", lawContextTcName :: String
lawContextTcName = String
"Show"
        , lawContextLawBody :: String
lawContextLawBody = String
"show a" String -> ShowS
`congruency` String
"showsPrec 0 a \"\""
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced String
lhs String
rhs
        , lawContextTcProp :: String
lawContextTcProp =
            let showA :: String
showA = forall a. Show a => a -> String
show a
a;
            in [String] -> String
lawWhere
              [ String
"show a" String -> ShowS
`congruency` String
"showsPrec 0 a \"\", where"
              , String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
              ]
        }  
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx String
lhs String
rhs Context
ctx

equivarianceShowsPrec :: forall a. (Show a) => Gen a -> Property
equivarianceShowsPrec :: forall a. Show a => Gen a -> Property
equivarianceShowsPrec Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  Int
p <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genShowReadPrecedence
  a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  String
r <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen String
genSmallString
  String
s <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen String
genSmallString
  let lhs :: String
lhs = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
a String
r forall a. [a] -> [a] -> [a]
++ String
s
  let rhs :: String
rhs = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
a (String
r forall a. [a] -> [a] -> [a]
++ String
s)
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"ShowsPrec Equivariance", lawContextTcName :: String
lawContextTcName = String
"Show"
        , lawContextLawBody :: String
lawContextLawBody = String
"showsPrec p a r ++ s" String -> ShowS
`congruency` String
"showsPrec p a (r ++ s)"
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced String
lhs String
rhs
        , lawContextTcProp :: String
lawContextTcProp =
            let showP :: String
showP = forall a. Show a => a -> String
show Int
p; showA :: String
showA = forall a. Show a => a -> String
show a
a; showR :: String
showR = forall a. Show a => a -> String
show String
r; showS :: String
showS = forall a. Show a => a -> String
show String
s;
            in [String] -> String
lawWhere
              [ String
"showsPrec p a r ++ s" String -> ShowS
`congruency` String
"showsPrec p a (r ++ s), where"
              , String
"p = " forall a. [a] -> [a] -> [a]
++ String
showP
              , String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
              , String
"r = " forall a. [a] -> [a] -> [a]
++ String
showR
              , String
"s = " forall a. [a] -> [a] -> [a]
++ String
showS
              ]
        }  
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx String
lhs String
rhs Context
ctx

equivarianceShowList :: forall a. (Show a) => Gen a -> Property
equivarianceShowList :: forall a. Show a => Gen a -> Property
equivarianceShowList Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  [a]
as <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> Gen [a]
genSmallList Gen a
gen
  String
r <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen String
genSmallString
  String
s <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen String
genSmallString
  let lhs :: String
lhs = forall a. Show a => [a] -> ShowS
showList [a]
as String
r forall a. [a] -> [a] -> [a]
++ String
s
  let rhs :: String
rhs = forall a. Show a => [a] -> ShowS
showList [a]
as (String
r forall a. [a] -> [a] -> [a]
++ String
s)
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"ShowList Equivariance", lawContextTcName :: String
lawContextTcName = String
"Show"
        , lawContextLawBody :: String
lawContextLawBody = String
"showList as r ++ s" String -> ShowS
`congruency` String
"showList as (r ++ s)"
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced String
lhs String
rhs
        , lawContextTcProp :: String
lawContextTcProp =
            let showAS :: String
showAS = forall a. Show a => a -> String
show [a]
as; showR :: String
showR = forall a. Show a => a -> String
show String
r; showS :: String
showS = forall a. Show a => a -> String
show String
s;
            in [String] -> String
lawWhere
              [ String
"showList as r ++ s" String -> ShowS
`congruency` String
"showList as (r ++ s), where"
              , String
"as = " forall a. [a] -> [a] -> [a]
++ String
showAS
              , String
"r = " forall a. [a] -> [a] -> [a]
++ String
showR
              , String
"s = " forall a. [a] -> [a] -> [a]
++ String
showS
              ]
        }  
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx String
lhs String
rhs Context
ctx