MkShowSpec.hs

{-# LANGUAGE CPP             #-}
{-# LANGUAGE TemplateHaskell #-}

#if __GLASGOW_HASKELL__ < 706
-- Template Haskell's name generation didn't name-mangle very well prior to GHC
-- 7.6 and can cause name shadowing warnings, so suppress them.
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
#endif
{-|
Module:      Spec.MkShowSpec
Copyright:   (C) 2014-2015 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Experimental
Portability: GHC

@hspec@ test for 'mkShowbPrec' in "Text.Show.Text.TH".
-}
module Spec.MkShowSpec (main, spec) where

-- #if !(MIN_VERSION_base(4,8,0))
-- import           Control.Applicative ((*>), pure)
-- #endif

-- import           Debug.Trace (traceShow)

import           Derived (AllAtOnce)
#if MIN_VERSION_template_haskell(2,7,0)
import           Derived (NotAllShow(..), OneDataInstance)
#endif

import           Instances.Derived ()

-- import           Spec.Utils (ioProperty)

-- import           System.IO (hFlush, stdout, stderr)
-- import           System.IO.Silently (capture_, hCapture_)

import           Test.Hspec (Spec, describe, hspec, parallel)
import           Test.Hspec.QuickCheck (prop)

import qualified Text.Show as S (Show)
import           Text.Show.Text (Builder, FromStringShow(..), showbPrec)
-- import           Text.Show.Text.Debug.Trace.TH (mkTraceShow)
import           Text.Show.Text.TH (mkShowbPrec)

main :: IO ()
main = hspec spec

-- | Verifies 'mkShowbPrec' produces the same output as 'showsPrec'.
prop_mkShowbPrec :: S.Show a
                 => (Int -> a -> Builder) -- ^ TH-generated 'mkShowbPrec' function
                 -> Int -> a -> Bool
prop_mkShowbPrec sf p x = showbPrec p (FromStringShow x) == sf p x

-- -- | Verifies 'mkPrint' produces the same output as 'print'.
-- prop_mkPrint :: S.Show a
--              => (a -> IO ()) -- ^ TH-generated 'mkPrint' function
--              -> a -> Property
-- prop_mkPrint pf x = ioProperty $ do
--     sRes <- capture_ $ print x *> hFlush stdout
--     tRes <- capture_ $ pf    x *> hFlush stdout
--     pure $ sRes == tRes
-- 
-- -- | Verifies 'mkTraceShow' produces the same output as 'traceShow'.
-- prop_mkTraceShow :: S.Show a
--                  => (a -> IO () -> IO ()) -- ^ TH-generated 'mkTraceShow' function
--                  -> a -> Property
-- prop_mkTraceShow tsf x = ioProperty $ do
--     let handles = [stdout, stderr]
--     sRes <- hCapture_ handles $ traceShow x (pure ()) *> mapM_ hFlush handles
--     tRes <- hCapture_ handles $ tsf       x (pure ()) *> mapM_ hFlush handles
--     pure $ sRes == tRes

-- | Verifies 'mkShowbPrec' produces the same output as 'showsPrec' .
-- This uses a plain type constructor.
prop_mkShowbPrecTyCon :: Int -> AllAtOnce Int Int Int Int -> Bool
prop_mkShowbPrecTyCon = prop_mkShowbPrec $(mkShowbPrec ''AllAtOnce)

-- -- | Verifies 'mkPrint' produces the same output as 'print'.
-- -- This uses a plain type constructor.
-- prop_mkPrintTyCon :: AllAtOnce Int Int Int Int -> Property
-- prop_mkPrintTyCon = prop_mkPrint $(mkPrint ''AllAtOnce)
-- 
-- -- | Verifies 'mkTraceShow' produces the same output as 'traceShow'.
-- -- This uses a plain type constructor.
-- prop_mkTraceShowTyCon :: AllAtOnce Int Int Int Int -> Property
-- prop_mkTraceShowTyCon = prop_mkTraceShow $(mkTraceShow ''AllAtOnce)

#if MIN_VERSION_template_haskell(2,7,0)
-- | Verifies 'mkShowbPrec' produces the same output as 'showsPrec'.
-- This uses a data family name.
prop_mkShowbPrecDataFam :: Int -> OneDataInstance Int Int Int Int -> Bool
prop_mkShowbPrecDataFam = prop_mkShowbPrec $(mkShowbPrec ''OneDataInstance)

-- -- | Verifies 'mkPrint' produces the same output as 'print'.
-- -- This uses a data family name.
-- prop_mkPrintDataFam :: OneDataInstance Int Int Int Int -> Property
-- prop_mkPrintDataFam = prop_mkPrint $(mkPrint ''OneDataInstance)
-- 
-- -- | Verifies 'mkTraceShow' produces the same output as 'traceShow'.
-- -- This uses a data family name.
-- prop_mkTraceShowDataFam :: OneDataInstance Int Int Int Int -> Property
-- prop_mkTraceShowDataFam = prop_mkTraceShow $(mkTraceShow ''OneDataInstance)

-- | Verifies 'mkShowbPrec' produces the same output as 'showsPrec'.
-- This uses a data family instance constructor.
prop_mkShowbPrecDataFamInstCon :: Int -> NotAllShow Int Int Int Int -> Bool
prop_mkShowbPrecDataFamInstCon = prop_mkShowbPrec $(mkShowbPrec 'NASShow1)

-- -- | Verifies 'mkPrint' produces the same output as 'print'.
-- -- This uses a data family instance constructor.
-- prop_mkPrintDataFamInstCon :: NotAllShow Int Int Int Int -> Property
-- prop_mkPrintDataFamInstCon = prop_mkPrint $(mkPrint 'NASShow1)
-- 
-- -- | Verifies 'mkTraceShow' produces the same output as 'traceShow'.
-- -- This uses a data family instance constructor.
-- prop_mkTraceShowDataFamInstCon :: NotAllShow Int Int Int Int -> Property
-- prop_mkTraceShowDataFamInstCon = prop_mkTraceShow $(mkTraceShow 'NASShow1)
#endif

spec :: Spec
spec = parallel . describe "mkShow and related functions" $ do
    prop "$(mkShowbPrec ''AllAtOnce) (a plain type constructor)"            prop_mkShowbPrecTyCon
--     prop "$(mkPrint ''AllAtOnce) (a plain type constructor)"                prop_mkPrintTyCon
--     prop "$(mkTraceShow ''AllAtOnce) (a plain type constructor)"            prop_mkTraceShowTyCon
#if MIN_VERSION_template_haskell(2,7,0)
    prop "$(mkShowbPrec ''NotAllShow) (a data family instance constructor)" prop_mkShowbPrecDataFamInstCon
--     prop "$(mkPrint ''NotAllShow) (a data family instance constructor)"     prop_mkPrintDataFamInstCon
--     prop "$(mkTraceShow ''NotAllShow) (a data family instance constructor)" prop_mkTraceShowDataFamInstCon
    prop "$(mkShowbPrec ''OneDataInstance) (a data family name)"            prop_mkShowbPrecDataFam
--     prop "$(mkPrint ''OneDataInstance) (a data family name)"                prop_mkPrintDataFam
--     prop "$(mkTraceShow ''OneDataInstance) (a data family name)"            prop_mkTraceShowDataFam
#endif