{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module: Spec.Utils Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Testing-related utility functions. -} module Spec.Utils ( matchesTextShowSpec , matchesTextShow1Spec #if defined(NEW_FUNCTOR_CLASSES) , matchesTextShow2Spec #endif , genericTextShowSpec , genericTextShow1Spec ) where import Data.Functor.Classes (Show1, showsPrec1) import Data.Proxy (Proxy(..)) import Generics.Deriving.Base import Test.Hspec (Spec) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Arbitrary) import TextShow (TextShow(..), TextShow1(..), showbPrec1, fromString) import TextShow.Generic #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2, showsPrec2) import TextShow (TextShow2(..), showbPrec2) #endif -- | Expect a type's 'Show' instances to coincide for both 'String's and 'Text', -- irrespective of precedence. matchesTextShowSpec :: forall a. (Arbitrary a, Show a, TextShow a) => Proxy a -> Spec matchesTextShowSpec _ = prop "TextShow instance" (prop_matchesTextShow :: Int -> a -> Bool) -- | Verifies that a type's 'Show' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow :: (Show a, TextShow a) => Int -> a -> Bool prop_matchesTextShow p x = fromString (showsPrec p x "") == showbPrec p x -- | Expect a type's 'Show1' instances to coincide for both 'String's and 'Text', -- irrespective of precedence. matchesTextShow1Spec :: forall f a. (Arbitrary (f a), Show1 f, Show a, Show (f a), TextShow1 f, TextShow a) => Proxy (f a) -> Spec matchesTextShow1Spec _ = prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> f a -> Bool) -- | Verifies that a type's 'Show1' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow1 :: (Show1 f, Show a, TextShow1 f, TextShow a) => Int -> f a -> Bool prop_matchesTextShow1 p x = fromString (showsPrec1 p x "") == showbPrec1 p x #if defined(NEW_FUNCTOR_CLASSES) -- | Expect a type's 'Show2' instances to coincide for both 'String's and 'Text', -- irrespective of precedence. matchesTextShow2Spec :: forall f a b. (Arbitrary (f a b), Show2 f, Show a, Show b, Show (f a b), TextShow2 f, TextShow a, TextShow b) => Proxy (f a b) -> Spec matchesTextShow2Spec _ = prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> f a b -> Bool) -- | Verifies that a type's 'Show2' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow2 :: (Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b) => Int -> f a b -> Bool prop_matchesTextShow2 p x = fromString (showsPrec2 p x "") == showbPrec2 p x #endif -- | Expect a type's 'TextShow' instance to coincide with the output produced -- by the equivalent 'Generic' functions. genericTextShowSpec :: forall a. (Arbitrary a, Show a, TextShow a, Generic a, GTextShowB Zero (Rep a)) => Proxy a -> Spec genericTextShowSpec _ = prop "generic TextShow" (prop_genericTextShow :: Int -> a -> Bool) -- | Verifies that a type's 'TextShow' instance coincides with the output produced -- by the equivalent 'Generic' functions. prop_genericTextShow :: (TextShow a, Generic a, GTextShowB Zero (Rep a)) => Int -> a -> Bool prop_genericTextShow p x = showbPrec p x == genericShowbPrec p x -- | Expect a type's 'TextShow1' instance to coincide with the output produced -- by the equivalent 'Generic1' functions. genericTextShow1Spec :: forall f a. (Arbitrary (f a), Show (f a), TextShow1 f, Generic1 f, GTextShowB One (Rep1 f), TextShow a) => Proxy (f a) -> Spec genericTextShow1Spec _ = prop "generic TextShow1" (prop_genericTextShow1 :: Int -> f a -> Bool) -- | Verifies that a type's 'TextShow1' instance coincides with the output produced -- by the equivalent 'Generic1' functions. prop_genericTextShow1 :: ( TextShow1 f, Generic1 f , GTextShowB One (Rep1 f), TextShow a ) => Int -> f a -> Bool prop_genericTextShow1 p x = showbPrec1 p x == genericLiftShowbPrec showbPrec showbList p x