text-show 0.6.0.1 → 0.7
raw patch · 54 files changed
+1325/−775 lines, 54 filesdep +QuickCheckdep +bytestring-builderdep +silentlydep ~text-show
Dependencies added: QuickCheck, bytestring-builder, silently
Dependency ranges changed: text-show
Files
- CHANGELOG.md +15/−0
- README.md +3/−3
- src/Text/Show/Text.hs +1/−2
- src/Text/Show/Text/Classes.hs +35/−18
- src/Text/Show/Text/Control/Applicative.hs +18/−4
- src/Text/Show/Text/Control/Concurrent.hs +2/−1
- src/Text/Show/Text/Control/Exception.hs +3/−1
- src/Text/Show/Text/Control/Monad/ST.hs +2/−1
- src/Text/Show/Text/Data/Array.hs +49/−14
- src/Text/Show/Text/Data/ByteString.hs +2/−11
- src/Text/Show/Text/Data/Char.hs +8/−161
- src/Text/Show/Text/Data/Complex.hs +2/−1
- src/Text/Show/Text/Data/Data.hs +2/−1
- src/Text/Show/Text/Data/Dynamic.hs +2/−1
- src/Text/Show/Text/Data/Either.hs +2/−1
- src/Text/Show/Text/Data/Floating.hs +2/−1
- src/Text/Show/Text/Data/Functor/Identity.hs +2/−1
- src/Text/Show/Text/Data/Integral.hs +3/−1
- src/Text/Show/Text/Data/List.hs +3/−3
- src/Text/Show/Text/Data/Maybe.hs +2/−1
- src/Text/Show/Text/Data/Monoid.hs +2/−1
- src/Text/Show/Text/Data/Ord.hs +2/−1
- src/Text/Show/Text/Data/Proxy.hs +3/−1
- src/Text/Show/Text/Data/Ratio.hs +2/−1
- src/Text/Show/Text/Data/Tuple.hs +2/−1
- src/Text/Show/Text/Data/Type/Coercion.hs +2/−1
- src/Text/Show/Text/Data/Type/Equality.hs +3/−1
- src/Text/Show/Text/Data/Typeable.hs +14/−2
- src/Text/Show/Text/Data/Version.hs +2/−1
- src/Text/Show/Text/Debug/Trace.hs +130/−54
- src/Text/Show/Text/Debug/Trace/Generic.hs +8/−11
- src/Text/Show/Text/Debug/Trace/TH.hs +11/−11
- src/Text/Show/Text/Foreign/C/Types.hs +4/−3
- src/Text/Show/Text/Foreign/Ptr.hs +2/−1
- src/Text/Show/Text/Functions.hs +2/−1
- src/Text/Show/Text/GHC/Conc/Windows.hs +1/−1
- src/Text/Show/Text/GHC/Generics.hs +3/−1
- src/Text/Show/Text/GHC/RTS/Flags.hs +2/−1
- src/Text/Show/Text/GHC/TypeLits.hs +7/−3
- src/Text/Show/Text/Generic.hs +50/−34
- src/Text/Show/Text/Numeric/Natural.hs +1/−1
- src/Text/Show/Text/System/IO.hs +3/−1
- src/Text/Show/Text/System/Posix/Types.hs +4/−2
- src/Text/Show/Text/TH/Internal.hs +95/−57
- src/Text/Show/Text/Text/Read.hs +9/−7
- src/Text/Show/Text/Utils.hs +4/−11
- tests/Derived.hs +40/−11
- tests/Instances/BaseAndFriends.hs +99/−44
- tests/Instances/Derived.hs +186/−8
- tests/Properties/BaseAndFriends.hs +339/−232
- tests/Properties/Derived.hs +5/−2
- tests/Properties/MkShow.hs +79/−17
- tests/Properties/Utils.hs +34/−14
- text-show.cabal +17/−10
CHANGELOG.md view
@@ -1,3 +1,18 @@+# 0.7+* Added `showbConstPrec` (and corresponding `Show` and `Show1` instances for `Const`) to `Text.Show.Text.Control.Applicative`+* Added `showbUArrayPrec` (and corresponding `Show` instance for `UArray`s) and `showbIArrayPrec` to `Text.Data.Text.Data.Array`.+* Renamed `showbListDefault` to `showbListWith` to match how `Text.Show` names it+* Exposed `showbShortByteString` with all versions of `bytestring` by using the `bytestring-builder` package+* Corrected the `Show` instance for `Lexeme` (in `Text.Show.Text.Text.Read.Lex`)+* Fixed `TypeRep` output on GHC 7.10 and later+* The Template Haskell deriver now handles showable unlifted types (`Char#`, `Double#`, `Float#`, `Int#`, and `Word#`) correctly on GHC 7.12 and later+* Removed `LitChar` and `LitString` from `Text.Show.Text.Data.Char`, as they were not as useful as I had imagined.+* Removed the deprecated `replicateB` function+* `Typable` instances for `Show`, `Show1`, and `GShow` (with GHC 7.8 and later)+* `Typeable` instance for `ConType`+* Only derive `Eq` and `Ord` for `ConType` if a recent-enough version of `text` is used+* Changed the implementations of some functions in `Text.Show.Text.Debug.Trace` to use `ByteString`s instead of `String`s+ ### 0.6.0.1 * Forgot to include some header files in `text-show.cabal`
README.md view
@@ -13,11 +13,11 @@ import Prelude hiding (Show(..), print) import Text.Show.Text -number :: Text-number = show (Just "Hello, World!")+hello :: Text+hello = show (Just "Hello, World!") main :: IO ()-main = print number+main = print hello ``` If you desire it, there are also monomorphic versions of the `showb` function available in the submodules of `Text.Show.Text`. A naming convention is present in which functions that show different values depending on the precedence end with `Prec`(e.g., `showbIntPrec`), whereas functions that show the same values regardless of precedence do not end with `Prec` (e.g., `showbBool`).
src/Text/Show/Text.hs view
@@ -30,7 +30,6 @@ , toString , toText , lengthB- , replicateB , unlinesB , unwordsB -- * Printing values@@ -50,4 +49,4 @@ import Text.Show.Text.Classes import Text.Show.Text.Instances () import Text.Show.Text.Utils (toString, toText, lengthB,- replicateB, unlinesB, unwordsB)+ unlinesB, unwordsB)
src/Text/Show/Text/Classes.hs view
@@ -1,10 +1,18 @@-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFoldable, DeriveFunctor,- DeriveTraversable, GeneralizedNewtypeDeriving, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+ #if MIN_VERSION_base(4,4,0)-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric #-} #endif+ #if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-} #endif {-| Module: Text.Show.Text.Classes@@ -21,6 +29,7 @@ #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative (Applicative((<*>), pure)) import Data.Foldable (Foldable)+import Data.Functor ((<$>)) import Data.Monoid (Monoid) import Data.Traversable (Traversable) #endif@@ -35,7 +44,6 @@ import Data.Bits (FiniteBits) #endif import Data.Data (Data, Typeable)-import Data.Functor ((<$>)) import Data.Ix (Ix) import Data.Semigroup (Semigroup) import Data.String (IsString)@@ -59,13 +67,13 @@ #endif import GHC.Show (appPrec, appPrec1) -import Prelude hiding (Show(show, showList))+import Prelude hiding (Show(..)) import System.IO (Handle) import Text.Printf (PrintfArg, PrintfType) import Text.Read (Read(..), readListPrecDefault)-import qualified Text.Show as S (Show(showsPrec))+import qualified Text.Show as S (Show(..)) import Text.Show.Text.Utils ((<>), s, toString) #include "inline.h"@@ -116,9 +124,11 @@ showb = showbPrec 0 - showbList = showbListDefault showb+ showbList = showbListWith showb #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL showbPrec | showb #-}++deriving instance Typeable Show #endif -- | Lifting of the 'Show' class to unary type constructors.@@ -130,6 +140,10 @@ -- /Since: 0.5/ showbPrec1 :: Show a => Int -> f a -> Builder +#if __GLASGOW_HASKELL__ >= 708+deriving instance Typeable Show1+#endif+ -- | Constructs a strict 'TS.Text' from a single value. -- -- /Since: 0.1/@@ -188,17 +202,20 @@ {-# INLINE showbSpace #-} -- | Converts a list of values into a 'Builder' in which the values are surrounded--- by square brackets and each value is separated by a comma. This is the default--- implementation of 'showbList' save for a few special cases (e.g., 'String').+-- by square brackets and each value is separated by a comma. The function argument+-- controls how each element is shown.++-- @'showbListWith' 'showb'@ is the default implementation of 'showbList' save for+-- a few special cases (e.g., 'String'). -- --- /Since: 0.3/-showbListDefault :: (a -> Builder) -> [a] -> Builder-showbListDefault _ [] = "[]"-showbListDefault showbx (x:xs) = s '[' <> showbx x <> go xs -- "[..+-- /Since: 0.7/+showbListWith :: (a -> Builder) -> [a] -> Builder+showbListWith _ [] = "[]"+showbListWith showbx (x:xs) = s '[' <> showbx x <> go xs -- "[.. where- go (y:ys) = s ',' <> showbx y <> go ys -- ..,..- go [] = s ']' -- ..]"-{-# INLINE showbListDefault #-}+ go (y:ys) = s ',' <> showbx y <> go ys -- ..,..+ go [] = s ']' -- ..]"+{-# INLINE showbListWith #-} -- | @'showbUnary' n p x@ produces the 'Builder' representation of a unary data -- constructor with name @n@ and argument @x@, in precedence context @p@.@@ -356,7 +373,7 @@ INLINE_INST_FUN(showbPrec) instance S.Show a => S.Show (FromStringShow a) where- showsPrec p (FromStringShow x) = showsPrec p x+ showsPrec p (FromStringShow x) = S.showsPrec p x INLINE_INST_FUN(showsPrec) -- | The @String@ 'S.Show' instance for 'FromTextShow' is based on its @Text@
src/Text/Show/Text/Control/Applicative.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Control.Applicative@@ -12,26 +14,38 @@ /Since: 0.3/ -}-module Text.Show.Text.Control.Applicative (showbZipListPrec) where+module Text.Show.Text.Control.Applicative (showbConstPrec, showbZipListPrec) where -import Control.Applicative (ZipList)+import Control.Applicative (Const(..), ZipList) import Data.Text.Lazy.Builder (Builder) import Prelude hiding (Show) -import Text.Show.Text.Classes (Show(showbPrec), Show1(showbPrec1))+import Text.Show.Text.Classes (Show(showbPrec), Show1(showbPrec1), showbUnary) import Text.Show.Text.Data.List () import Text.Show.Text.TH.Internal (deriveShowPragmas, defaultInlineShowbPrec) #include "inline.h" +showbConstPrec :: Show a => Int -> Const a b -> Builder+showbConstPrec p (Const x) = showbUnary "Const" p x+{-# INLINE showbConstPrec #-}+ -- | Convert a 'ZipList' to a 'Builder' with the given precedence. -- -- /Since: 0.3/ showbZipListPrec :: Show a => Int -> ZipList a -> Builder showbZipListPrec = showbPrec {-# INLINE showbZipListPrec #-}++instance Show a => Show (Const a b) where+ showbPrec = showbConstPrec+ INLINE_INST_FUN(showbPrec)++instance Show a => Show1 (Const a) where+ showbPrec1 = showbPrec+ INLINE_INST_FUN(showbPrec1) $(deriveShowPragmas defaultInlineShowbPrec ''ZipList)
src/Text/Show/Text/Control/Concurrent.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Control.Concurrent
src/Text/Show/Text/Control/Exception.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, OverloadedStrings, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Control.Exception
src/Text/Show/Text/Control/Monad/ST.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Control.Monad.ST
src/Text/Show/Text/Data/Array.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Array@@ -12,34 +14,67 @@ /Since: 0.3/ -}-module Text.Show.Text.Data.Array (showbArrayPrec) where+module Text.Show.Text.Data.Array (+ showbArrayPrec+ , showbUArrayPrec+ , showbIArrayPrec+ ) where -import Data.Array (Array, assocs, bounds)-import Data.Ix (Ix)-import Data.Text.Lazy.Builder (Builder)+import qualified Data.Array as Array (assocs, bounds)+import Data.Array (Array)+import qualified Data.Array.Base as IArray (assocs, bounds)+import Data.Array.Base (IArray)+import Data.Array.Unboxed (UArray)+import Data.Ix (Ix)+import Data.Text.Lazy.Builder (Builder) -import GHC.Show (appPrec)+import GHC.Show (appPrec) -import Prelude hiding (Show)+import Prelude hiding (Show) -import Text.Show.Text.Classes (Show(showb, showbPrec), showbParen, showbSpace)-import Text.Show.Text.Data.List ()-import Text.Show.Text.Data.Tuple ()-import Text.Show.Text.Utils ((<>))+import Text.Show.Text.Classes (Show(showb, showbPrec), showbParen, showbSpace)+import Text.Show.Text.Data.List ()+import Text.Show.Text.Data.Tuple ()+import Text.Show.Text.Utils ((<>)) #include "inline.h" --- | Convert a 'Array' value to a 'Builder' with the given precedence.+-- | Convert an 'Array' value to a 'Builder' with the given precedence. -- -- /Since: 0.3/ showbArrayPrec :: (Show i, Show e, Ix i) => Int -> Array i e -> Builder showbArrayPrec p a = showbParen (p > appPrec) $ "array "- <> showb (bounds a)+ <> showb (Array.bounds a) <> showbSpace- <> showb (assocs a)+ <> showb (Array.assocs a) {-# INLINE showbArrayPrec #-} +-- | Convert a 'UArray' value to a 'Builder' with the given precedence.+-- +-- /Since: 0.7/+showbUArrayPrec :: (IArray UArray e, Ix i, Show i, Show e) => Int -> UArray i e -> Builder+showbUArrayPrec = showbIArrayPrec+{-# INLINE showbUArrayPrec #-}++{-# SPECIALIZE+ showbIArrayPrec :: (IArray UArray e, Ix i, Show i, Show e) =>+ Int -> UArray i e -> Builder+ #-}+-- | Convert an 'IArray' instance to a 'Builder' with the given precedence.+-- +-- /Since: 0.7/+showbIArrayPrec :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> Builder+showbIArrayPrec p a = showbParen (p > 9) $+ "array "+ <> showb (IArray.bounds a)+ <> showbSpace+ <> showb (IArray.assocs a)+ instance (Show i, Show e, Ix i) => Show (Array i e) where showbPrec = showbArrayPrec+ INLINE_INST_FUN(showbPrec)++instance (IArray UArray e, Ix i, Show i, Show e) => Show (UArray i e) where+ showbPrec = showbUArrayPrec INLINE_INST_FUN(showbPrec)
src/Text/Show/Text/Data/ByteString.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} #if !(MIN_VERSION_bytestring(0,10,0)) {-# LANGUAGE TemplateHaskell #-} #endif@@ -19,16 +19,12 @@ showbByteStringStrict , showbByteStringLazy , showbByteStringLazyPrec-#if MIN_VERSION_bytestring(0,10,4) , showbShortByteString-#endif ) where import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL-#if MIN_VERSION_bytestring(0,10,4) import Data.ByteString.Short (ShortByteString)-#endif import Data.Text.Lazy.Builder (Builder) import Prelude hiding (Show(show))@@ -72,15 +68,12 @@ #endif {-# INLINE showbByteStringLazyPrec #-} -#if MIN_VERSION_bytestring(0,10,4) -- | Convert a 'ShortByteString' to a 'Builder'.--- This function is only available with @bytestring-0.10.4.0@ or later. -- --- /Since: 0.3/+-- /Since: 0.7/ showbShortByteString :: ShortByteString -> Builder showbShortByteString = showb . FromStringShow {-# INLINE showbShortByteString #-}-#endif instance Show BS.ByteString where showb = showbByteStringStrict@@ -94,8 +87,6 @@ $(deriveShowPragmas defaultInlineShowbPrec ''BL.ByteString) #endif -#if MIN_VERSION_bytestring(0,10,4) instance Show ShortByteString where showb = showbShortByteString INLINE_INST_FUN(showb)-#endif
src/Text/Show/Text/Data/Char.hs view
@@ -1,11 +1,6 @@-{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances,- GeneralizedNewtypeDeriving, OverloadedStrings, TemplateHaskell #-}-#if MIN_VERSION_base(4,4,0)-{-# LANGUAGE DeriveGeneric #-}-#endif-#if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE TypeFamilies #-}-#endif+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Char@@ -26,44 +21,17 @@ , showbLitString , showbGeneralCategory , asciiTabB- , LitChar(..)- , LitString(..) ) where import Data.Array (Array, (!), listArray) import Data.Char (GeneralCategory, isDigit, ord)-import Data.Data (Data, Typeable)-import Data.Functor ((<$>))-import Data.Ix (Ix) #if !(MIN_VERSION_base(4,8,0))-import Data.Monoid (Monoid(mempty))+import Data.Monoid (mempty) #endif-import Data.Semigroup (Semigroup)-import Data.String (IsString(..)) import Data.Text.Lazy.Builder (Builder) -import Foreign.Storable (Storable)--#if __GLASGOW_HASKELL__ >= 708-import GHC.Exts (IsList(Item, fromList, toList))-#endif-#if MIN_VERSION_base(4,4,0)-import GHC.Generics (Generic)-#endif-import GHC.Show (showLitChar)-#if MIN_VERSION_base(4,4,0)-import GHC.Show (showLitString)-#endif- import Prelude hiding (Show) -import qualified Text.ParserCombinators.ReadP as ReadP (get)-import Text.ParserCombinators.ReadP (many)-import qualified Text.ParserCombinators.ReadPrec as ReadPrec (get)-import Text.ParserCombinators.ReadPrec (ReadPrec, lift)-import Text.Printf (IsChar, PrintfArg, PrintfType)-import Text.Read (Read(..), readListPrecDefault)-import qualified Text.Show as S (Show) import Text.Show.Text.Classes (Show(..)) import Text.Show.Text.Data.Integral (showbIntPrec) import Text.Show.Text.TH.Internal (deriveShow)@@ -76,10 +44,10 @@ -- /Since: 0.5/ asciiTabB :: Array Int Builder asciiTabB = listArray (0, 32) ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",- "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",- "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",- "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",- "SP"]+ "BS" , "HT" , "LF" , "VT" , "FF" , "CR" , "SO" , "SI" ,+ "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",+ "CAN", "EM" , "SUB", "ESC", "FS" , "GS" , "RS" , "US" ,+ "SP"] -- | Convert a 'Char' to a 'Builder' (surrounded by single quotes). -- @@ -140,124 +108,3 @@ INLINE_INST_FUN(showbList) $(deriveShow ''GeneralCategory)---- | The @Text@ 'T.Show' instance for 'LitChar' is like that of a regular 'Char',--- except it is not escaped by single quotes. That is,--- --- @--- showb ('LitChar' c) = 'showbLitChar' c--- @--- --- /Since: 0.5/-newtype LitChar = LitChar { getLitChar :: Char }- deriving ( Bounded- , Data- , Enum- , Eq-#if MIN_VERSION_base(4,4,0)- , Generic-#endif- , IsChar- , Ix- , Ord- , PrintfArg- , Storable- , Typeable- )--instance IsString [LitChar] where- fromString = map LitChar--instance Read LitChar where- readPrec = LitChar <$> ReadPrec.get- INLINE_INST_FUN(readPrec)- - readListPrec = (fmap . map) LitChar (readListPrec :: ReadPrec [Char])- INLINE_INST_FUN(readListPrec)- - readList =- (fmap . map . mapFst . map) LitChar (readList :: ReadS [Char])- where- mapFst :: (a -> b) -> (a, c) -> (b, c)- mapFst f (x, y) = (f x, y)- INLINE_INST_FUN(readList)--instance Show LitChar where- showb = showbLitChar . getLitChar- INLINE_INST_FUN(showb)- - showbList = showbString . map getLitChar- INLINE_INST_FUN(showbList)--instance S.Show LitChar where- showsPrec _ = showLitChar . getLitChar- INLINE_INST_FUN(showsPrec)- - showList = showList . map getLitChar- INLINE_INST_FUN(showList)---- | The @Text@ 'T.Show' instance for 'LitString' is like that of a regular--- 'String', except it is not escaped by double quotes. That is,--- --- @--- showb ('LitString' s) = 'showbLitString' s--- @--- --- /Since: 0.5/-newtype LitString = LitString { getLitString :: String }- deriving ( Data- , Eq-#if MIN_VERSION_base(4,4,0)- , Generic-#endif- , IsString- , Monoid- , Ord- , PrintfArg- , PrintfType- , Semigroup- , Typeable- )--#if __GLASGOW_HASKELL__ >= 708-instance IsList LitString where- type Item LitString = Char- fromList = LitString- {-# INLINE fromList #-}- toList = getLitString- {-# INLINE toList #-}-#endif--instance Read LitString where- readPrec = LitString <$> (lift $ many ReadP.get)- INLINE_INST_FUN(readPrec)- - readListPrec = readListPrecDefault- INLINE_INST_FUN(readListPrec)--instance Show LitString where- showb = showbLitString . getLitString- INLINE_INST_FUN(showb)--instance S.Show LitString where- showsPrec _ = showLitString . getLitString-#if MIN_VERSION_base(4,4,0)- INLINE_INST_FUN(showsPrec)-#else- where- -- Taken directly from @GHC.Show@- showLitString :: String -> ShowS- -- Same as 'showLitChar', but for strings- -- It converts the string to a string using Haskell escape conventions- -- for non-printable characters. Does not add double-quotes around the- -- whole thing; the caller should do that.- -- The main difference from showLitChar (apart from the fact that the- -- argument is a string not a list) is that we must escape double-quotes - showLitString [] str = str- showLitString ('"' : cs) str = showString "\\\"" (showLitString cs str)- showLitString (c : cs) str = showLitChar c (showLitString cs str)- -- Making 's' an explicit parameter makes it clear to GHC that- -- showLitString has arity 2, which avoids it allocating an extra lambda- -- The sticking point is the recursive call to (showLitString cs), which- -- it can't figure out would be ok with arity 2.-#endif
src/Text/Show/Text/Data/Complex.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Ratio
src/Text/Show/Text/Data/Data.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Data
src/Text/Show/Text/Data/Dynamic.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Dynamic
src/Text/Show/Text/Data/Either.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Either
src/Text/Show/Text/Data/Floating.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Floating
src/Text/Show/Text/Data/Functor/Identity.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Functor.Identity
src/Text/Show/Text/Data/Integral.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, MagicHash, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Integral
src/Text/Show/Text/Data/List.hs view
@@ -8,14 +8,14 @@ Stability: Experimental Portability: GHC -Exports 'showbListDefault'.+Exports 'showbListWith'. -}-module Text.Show.Text.Data.List (showbListDefault) where+module Text.Show.Text.Data.List (showbListWith) where import Prelude hiding (Show) import Text.Show.Text.Classes (Show(showb, showbPrec, showbList),- Show1(showbPrec1), showbListDefault)+ Show1(showbPrec1), showbListWith) import Text.Show.Text.Data.Char () import Text.Show.Text.Data.Integral ()
src/Text/Show/Text/Data/Maybe.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Maybe
src/Text/Show/Text/Data/Monoid.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE FlexibleContexts #-} #endif
src/Text/Show/Text/Data/Ord.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Ord
src/Text/Show/Text/Data/Proxy.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, OverloadedStrings, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Proxy
src/Text/Show/Text/Data/Ratio.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Ratio
src/Text/Show/Text/Data/Tuple.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Tuple
src/Text/Show/Text/Data/Type/Coercion.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE GADTs, TemplateHaskell #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Type.Coercion
src/Text/Show/Text/Data/Type/Equality.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE GADTs, TemplateHaskell, TypeOperators #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Type.Equality
src/Text/Show/Text/Data/Typeable.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Typeable@@ -18,6 +19,9 @@ import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) #if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (TyCon(..), funTc, listTc)+# if MIN_VERSION_base(4,8,0)+import Data.Typeable.Internal (typeRepKinds)+# endif #else import Data.Typeable (TyCon, mkTyCon, tyConString, typeOf) #endif@@ -47,10 +51,18 @@ | otherwise -> showbParen (p > 9) $ showbPrec p tycon <> showbSpace- <> showbArgs showbSpace tys+ <> showbArgs showbSpace+#if MIN_VERSION_base(4,8,0)+ (kinds ++ tys)+#else+ tys+#endif where tycon = typeRepTyCon tyrep tys = typeRepArgs tyrep+#if MIN_VERSION_base(4,8,0)+ kinds = typeRepKinds tyrep+#endif #if !(MIN_VERSION_base(4,4,0)) -- | The list 'TyCon'.
src/Text/Show/Text/Data/Version.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Data.Version
src/Text/Show/Text/Debug/Trace.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-} {-| Module: Text.Show.Text.Debug.Trace Copyright: (C) 2014-2015 Ryan Scott@@ -20,26 +22,35 @@ /Since: 0.5/ -} module Text.Show.Text.Debug.Trace (- traceIO- , traceIOLazy- , trace+ -- * Tracing+ -- $tracing+ trace , traceLazy , traceId , traceIdLazy , traceShow , traceShowId+#if MIN_VERSION_base(4,5,0)+ , traceStack+ , traceStackLazy+#endif+ , traceIO+ , traceIOLazy , traceM , traceMLazy , traceShowM+ #if MIN_VERSION_base(4,5,0)- , traceStack- , traceStackLazy+ -- * Eventlog tracing+ -- $eventlog_tracing , traceEvent , traceEventLazy , traceEventIO , traceEventIOLazy #endif #if MIN_VERSION_base(4,7,0)+ -- * Execution phase markers+ -- $markers , traceMarker , traceMarkerLazy , traceMarkerIO@@ -47,39 +58,79 @@ #endif ) where -import qualified Data.Text as TS (Text, unpack)-import qualified Data.Text.Lazy as TL (Text, unpack)+import Control.Monad (when) +import qualified Data.ByteString as BS (null, partition)+import Data.ByteString (ByteString, useAsCString)+import Data.ByteString.Internal (c2w)+import qualified Data.Text as TS (Text)+import Data.Text.Encoding (encodeUtf8)+import qualified Data.Text.Lazy as TL (Text)+import Data.Text.Lazy (toStrict)++import Foreign.C.String (CString)++#if MIN_VERSION_base(4,5,0)+import qualified Data.ByteString.Char8 as BS (pack)+import qualified Data.Text as TS (unpack)+import qualified Data.Text.Lazy as TL (unpack)+ import qualified Debug.Trace as S +import GHC.Stack (currentCallStack, renderStack)+#endif+ import Prelude hiding (Show(show)) -import Text.Show.Text.Classes (Show, showLazy)+import System.IO.Unsafe (unsafePerformIO)++import Text.Show.Text.Classes (Show, show) import Text.Show.Text.Instances () +-- $tracing+-- +-- The 'trace', 'traceShow' and 'traceIO' functions print messages to an output+-- stream. They are intended for \"printf debugging\", that is: tracing the flow+-- of execution and printing interesting values.+-- +-- All these functions evaluate the message completely before printing+-- it; so if the message is not fully defined, none of it will be+-- printed.+-- +-- The usual output stream is 'System.IO.stderr'. For Windows GUI applications+-- (that have no stderr) the output is directed to the Windows debug console.+-- Some implementations of these functions may decorate the @Text@ that\'s+-- output to indicate that you\'re tracing.+ -- | The 'traceIO' function outputs the trace message from the IO monad. -- This sequences the output with respect to other IO actions. -- -- /Since: 0.5/ traceIO :: TS.Text -> IO ()-#if MIN_VERSION_base(4,5,0)-traceIO = S.traceIO . TS.unpack-#else-traceIO = S.putTraceMsg . TS.unpack-#endif-{-# INLINE traceIO #-}+traceIO = traceIOByteString . encodeUtf8 -- | Like 'traceIO' but accepts a lazy 'TL.Text' argument. -- -- /Since: 0.5/ traceIOLazy :: TL.Text -> IO ()-#if MIN_VERSION_base(4,5,0)-traceIOLazy = S.traceIO . TL.unpack-#else-traceIOLazy = S.putTraceMsg . TL.unpack-#endif-{-# INLINE traceIOLazy #-}+traceIOLazy = traceIO . toStrict +traceIOByteString :: ByteString -> IO ()+traceIOByteString msg = useAsCString "%s\n" $ \cfmt -> do+ -- NB: debugBelch can't deal with null bytes, so filter them+ -- out so we don't accidentally truncate the message. See Trac #9395+ let (nulls, msg') = BS.partition (== c2w '\0') msg+ useAsCString msg' $ \cmsg ->+ debugBelch cfmt cmsg+ when (not (BS.null nulls)) $+ useAsCString "WARNING: previous trace message had null bytes" $ \cmsg ->+ debugBelch cfmt cmsg++-- don't use debugBelch() directly, because we cannot call varargs functions+-- using the FFI.+foreign import ccall unsafe "HsBase.h debugBelch2"+ debugBelch :: CString -> CString -> IO ()+ {-| The 'trace' function outputs the trace message given as its first argument, before returning the second argument as its result.@@ -96,29 +147,31 @@ /Since: 0.5/ -} trace :: TS.Text -> a -> a-trace text = S.trace $ TS.unpack text-{-# INLINE trace #-}+trace = traceByteString . encodeUtf8 -- | Like 'trace' but accepts a lazy 'TL.Text' argument. -- -- /Since: 0.5/ traceLazy :: TL.Text -> a -> a-traceLazy text = S.trace $ TL.unpack text-{-# INLINE traceLazy #-}+traceLazy = trace . toStrict +{-# NOINLINE traceByteString #-}+traceByteString :: ByteString -> a -> a+traceByteString bs expr = unsafePerformIO $ do+ traceIOByteString bs+ return expr+ -- | Like 'trace' but returns the message instead of a third value. -- -- /Since: 0.5/ traceId :: TS.Text -> TS.Text traceId a = trace a a-{-# INLINE traceId #-} -- | Like 'traceId' but accepts a lazy 'TL.Text' argument. -- -- /Since: 0.5/ traceIdLazy :: TL.Text -> TL.Text traceIdLazy a = traceLazy a a-{-# INLINE traceIdLazy #-} {-| Like 'trace', but uses 'show' on the argument to convert it to a 'TS.Text'.@@ -136,15 +189,13 @@ /Since: 0.5/ -} traceShow :: Show a => a -> b -> b-traceShow = traceLazy . showLazy-{-# INLINE traceShow #-}+traceShow = trace . show -- | Like 'traceShow' but returns the shown value instead of a third value. -- -- /Since: 0.5/ traceShowId :: Show a => a -> a-traceShowId a = traceLazy (showLazy a) a-{-# INLINE traceShowId #-}+traceShowId a = trace (show a) a {-| Like 'trace' but returning unit in an arbitrary monad. Allows for convenient@@ -161,12 +212,10 @@ -} traceM :: Monad m => TS.Text -> m () traceM text = trace text $ return ()-{-# INLINE traceM #-} -- | Like 'traceM' but accepts a lazy 'TL.Text' argument. traceMLazy :: Monad m => TL.Text -> m () traceMLazy text = traceLazy text $ return ()-{-# INLINE traceMLazy #-} {-| Like 'traceM', but uses 'show' on the argument to convert it to a 'TS.Text'.@@ -180,13 +229,12 @@ /Since: 0.5/ -} traceShowM :: (Show a, Monad m) => a -> m ()-traceShowM = traceMLazy . showLazy-{-# INLINE traceShowM #-}+traceShowM = traceM . show #if MIN_VERSION_base(4,5,0) -- | Like 'trace' but additionally prints a call stack if one is -- available.---+-- -- In the current GHC implementation, the call stack is only -- availble if the program was compiled with @-prof@; otherwise -- 'traceStack' behaves exactly like 'trace'. Entries in the call@@ -195,16 +243,33 @@ -- -- /Since: 0.5/ traceStack :: TS.Text -> a -> a-traceStack text = S.traceStack $ TS.unpack text-{-# INLINE traceStack #-}+traceStack = traceStackByteString . encodeUtf8 -- | Like 'traceStack' but accepts a lazy 'TL.Text' argument. -- -- /Since: 0.5/ traceStackLazy :: TL.Text -> a -> a-traceStackLazy text = S.traceStack $ TL.unpack text-{-# INLINE traceStackLazy #-}+traceStackLazy = traceStack . toStrict +traceStackByteString :: ByteString -> a -> a+traceStackByteString bs expr = unsafePerformIO $ do+ traceIOByteString bs+ stack <- currentCallStack+ when (not (null stack)) . traceIOByteString . BS.pack $ renderStack stack+ return expr++-- $eventlog_tracing+-- +-- Eventlog tracing is a performance profiling system. These functions emit+-- extra events into the eventlog. In combination with eventlog profiling+-- tools these functions can be used for monitoring execution and+-- investigating performance problems.+-- +-- Currently only GHC provides eventlog profiling, see the GHC user guide for+-- details on how to use it. These function exists for other Haskell+-- implementations but no events are emitted. Note that the @Text@ message is+-- always evaluated, whether or not profiling is available or enabled.+ -- | The 'traceEvent' function behaves like 'trace' with the difference that -- the message is emitted to the eventlog, if eventlog profiling is available -- and enabled at runtime.@@ -218,44 +283,59 @@ -- -- /Since: 0.5/ traceEvent :: TS.Text -> a -> a-traceEvent msg = S.traceEvent $ TS.unpack msg-{-# INLINE traceEvent #-}+traceEvent = S.traceEvent . TS.unpack -- | Like 'traceEvent' but accepts a lazy 'TL.Text' argument. -- -- /Since: 0.5/ traceEventLazy :: TL.Text -> a -> a-traceEventLazy msg = S.traceEvent $ TL.unpack msg-{-# INLINE traceEventLazy #-}+traceEventLazy = S.traceEvent . TL.unpack -- | The 'traceEventIO' function emits a message to the eventlog, if eventlog -- profiling is available and enabled at runtime.---+-- -- Compared to 'traceEvent', 'traceEventIO' sequences the event with respect to -- other IO actions. -- -- /Since: 0.5/ traceEventIO :: TS.Text -> IO () traceEventIO = S.traceEventIO . TS.unpack-{-# INLINE traceEventIO #-} -- | Like 'traceEventIO' but accepts a lazy 'TL.Text' argument. -- -- /Since: 0.5/ traceEventIOLazy :: TL.Text -> IO () traceEventIOLazy = S.traceEventIO . TL.unpack-{-# INLINE traceEventIOLazy #-} #endif #if MIN_VERSION_base(4,7,0)+-- $markers+-- +-- When looking at a profile for the execution of a program we often want to+-- be able to mark certain points or phases in the execution and see that+-- visually in the profile.++-- For example, a program might have several distinct phases with different+-- performance or resource behaviour in each phase. To properly interpret the+-- profile graph we really want to see when each phase starts and ends.+-- +-- Markers let us do this: we can annotate the program to emit a marker at+-- an appropriate point during execution and then see that in a profile.+-- +-- Currently this feature is only supported in GHC by the eventlog tracing+-- system, but in future it may also be supported by the heap profiling or+-- other profiling tools. These function exists for other Haskell+-- implementations but they have no effect. Note that the @Text@ message is+-- always evaluated, whether or not profiling is available or enabled.+ -- | The 'traceMarker' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime. The 'TS.Text' is the name of -- the marker. The name is just used in the profiling tools to help you keep -- clear which marker is which.---+-- -- This function is suitable for use in pure code. In an IO context use -- 'traceMarkerIO' instead.---+-- -- Note that when using GHC's SMP runtime, it is possible (but rare) to get -- duplicate events emitted if two CPUs simultaneously evaluate the same thunk -- that uses 'traceMarker'.@@ -263,30 +343,26 @@ -- /Since: 0.5/ traceMarker :: TS.Text -> a -> a traceMarker msg = S.traceMarker $ TS.unpack msg-{-# INLINE traceMarker #-} -- | Like 'traceMarker' but accepts a lazy 'TL.Text' argument. -- -- /Since: 0.5/ traceMarkerLazy :: TL.Text -> a -> a traceMarkerLazy msg = S.traceMarker $ TL.unpack msg-{-# INLINE traceMarkerLazy #-} -- | The 'traceMarkerIO' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime.---+-- -- Compared to 'traceMarker', 'traceMarkerIO' sequences the event with respect to -- other IO actions. -- -- /Since: 0.5/ traceMarkerIO :: TS.Text -> IO () traceMarkerIO = S.traceMarkerIO . TS.unpack-{-# INLINE traceMarkerIO #-} -- | Like 'traceMarkerIO' but accepts a lazy 'TL.Text' argument. -- -- /Since: 0.5/ traceMarkerIOLazy :: TL.Text -> IO () traceMarkerIOLazy = S.traceMarkerIO . TL.unpack-{-# INLINE traceMarkerIOLazy #-} #endif
src/Text/Show/Text/Debug/Trace/Generic.hs view
@@ -20,26 +20,23 @@ import GHC.Generics (Generic, Rep) -import Text.Show.Text.Debug.Trace (traceLazy, traceMLazy)-import Text.Show.Text.Generic (GShow, genericShowLazy)+import Text.Show.Text.Debug.Trace+import Text.Show.Text.Generic (GShow, genericShow) --- | Outputs the shown trace message of its first argument (a 'Generic' instance)--- before returning the second argument.+-- | A 'Generic' implementation of 'traceShow'. -- -- /Since: 0.6/ genericTraceShow :: (Generic a, GShow (Rep a)) => a -> b -> b-genericTraceShow = traceLazy . genericShowLazy+genericTraceShow = trace . genericShow --- | Outputs the shown trace message of its argument (a 'Generic' instance) before--- returning that argument.+-- | A 'Generic' implementation of 'traceShowId'. -- -- /Since: 0.6/ genericTraceShowId :: (Generic a, GShow (Rep a)) => a -> a-genericTraceShowId a = traceLazy (genericShowLazy a) a+genericTraceShowId a = trace (genericShow a) a --- | Outputs the shown trace message of its argument (a 'Generic' instance) in an--- arbitrary monad.+-- | A 'Generic' implementation of 'traceShowM'. -- -- /Since: 0.6/ genericTraceShowM :: (Generic a, GShow (Rep a), Monad m) => a -> m ()-genericTraceShowM = traceMLazy . genericShowLazy+genericTraceShowM = traceM . genericShow
src/Text/Show/Text/Debug/Trace/TH.hs view
@@ -21,26 +21,26 @@ import Language.Haskell.TH.Syntax (Name, Q, Exp) -import Text.Show.Text.Debug.Trace (traceLazy, traceMLazy)-import Text.Show.Text.TH.Internal (mkShowLazy)+import Text.Show.Text.Debug.Trace+import Text.Show.Text.TH.Internal (mkShow) --- | Generates a lambda expression which outputs the shown trace message of its first--- argument before returning the second argument.+-- | Generates a lambda expression which behaves like 'traceShow' (without requiring a+-- @Show@ instance). -- -- /Since: 0.5/ mkTraceShow :: Name -> Q Exp-mkTraceShow name = [| traceLazy . $(mkShowLazy name) |]+mkTraceShow name = [| trace . $(mkShow name) |] --- | Generates a lambda expression which outputs the shown trace message of its--- argument before returning that argument.+-- | Generates a lambda expression which behaves like 'traceShowId' (without requiring a+-- @Show@ instance). -- -- /Since: 0.5/ mkTraceShowId :: Name -> Q Exp-mkTraceShowId name = [| \a -> traceLazy ($(mkShowLazy name) a) a |]+mkTraceShowId name = [| \a -> trace ($(mkShow name) a) a |] --- | Generates a lambda expression which outputs the shown trace message of its--- argument in an arbitrary monad.+-- | Generates a lambda expression which behaves like 'traceShowM' (without requiring a+-- @Show@ instance). -- -- /Since: 0.5/ mkTraceShowM :: Name -> Q Exp-mkTraceShowM name = [| traceMLazy . $(mkShowLazy name) |]+mkTraceShowM name = [| traceM . $(mkShow name) |]
src/Text/Show/Text/Foreign/C/Types.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,5,0)-{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} #else-{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MagicHash #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-|
src/Text/Show/Text/Foreign/Ptr.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, MagicHash #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Foreign.Ptr
src/Text/Show/Text/Functions.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Functions
src/Text/Show/Text/GHC/Conc/Windows.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} #if !defined(__GHCJS__) {-# LANGUAGE TemplateHaskell #-} #endif
src/Text/Show/Text/GHC/Generics.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE FlexibleContexts, TemplateHaskell, TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.GHC.Generics
src/Text/Show/Text/GHC/RTS/Flags.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.GHC.RTS.Flags
src/Text/Show/Text/GHC/TypeLits.hs view
@@ -1,7 +1,11 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} #if !(MIN_VERSION_base(4,7,0))-{-# LANGUAGE FlexibleContexts, GADTs, KindSignatures,- OverloadedStrings, PolyKinds, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE UndecidableInstances #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-|
src/Text/Show/Text/Generic.hs view
@@ -1,5 +1,14 @@-{-# LANGUAGE CPP, DeriveGeneric, FlexibleContexts, FlexibleInstances,- OverloadedStrings, ScopedTypeVariables, TypeOperators #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+#if __GLASGOW_HASKELL__ >= 708+{-# LANGUAGE StandaloneDeriving #-}+#endif {-| Module: Text.Show.Text.Generic Copyright: (C) 2014-2015 Ryan Scott@@ -50,6 +59,7 @@ import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) import qualified Data.Text.Lazy as TL (Text) import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn)+import Data.Typeable (Typeable) import GHC.Generics import GHC.Show (appPrec, appPrec1)@@ -59,7 +69,8 @@ import System.IO (Handle) import qualified Text.Show as S (Show)-import Text.Show.Text.Classes (Show(showbPrec), showbListDefault,+import qualified Text.Show.Text.Classes as T+import Text.Show.Text.Classes (Show(showbPrec), showbListWith, showbParen, showbSpace) import Text.Show.Text.Instances () import Text.Show.Text.Utils ((<>), isInfixTypeCon, isTupleString,@@ -69,7 +80,7 @@ {- $generics -'Show' instances can be easily defined for data types that are 'Generic' instances.+'T.Show' instances can be easily defined for data types that are 'Generic' instances. The easiest way to do this is to use the @DeriveGeneric@ extension. @@@ -89,14 +100,14 @@ showbPrec = 'genericShowbPrec' @ -@D@ now has a 'Show' instance analogous to what would be generated by a+@D@ now has a 'T.Show' instance analogous to what would be generated by a @deriving Show@ clause. -} {- $generic_err -Suppose you intend to tuse 'genericShowbPrec' to define a 'Show' instance.+Suppose you intend to tuse 'genericShowbPrec' to define a 'T.Show' instance. @ data Oops = Oops@@ -117,83 +128,79 @@ simply to add the missing \"@deriving 'Generic'@\" clause. -} --- | Converts a 'Generic' instance to a strict 'TS.Text'.+-- | A 'Generic' implementation of 'T.show'. -- -- /Since: 0.6/ genericShow :: (Generic a, GShow (Rep a)) => a -> TS.Text genericShow = toStrict . genericShowLazy --- | Converts a 'Generic' instance to a lazy 'TL.Text'.+-- | A 'Generic' implementation of 'T.showLazy'. -- -- /Since: 0.6/ genericShowLazy :: (Generic a, GShow (Rep a)) => a -> TL.Text genericShowLazy = toLazyText . genericShowb --- | Converts a 'Generic' instance to a strict 'TS.Text' with the given precedence.+-- | A 'Generic' implementation of 'T.showPrec'. -- -- /Since: 0.6/ genericShowPrec :: (Generic a, GShow (Rep a)) => Int -> a -> TS.Text genericShowPrec p = toStrict . genericShowPrecLazy p --- | Converts a 'Generic' instance to a lazy 'TL.Text' with the given precedence.+-- | A 'Generic' implementation of 'T.showPrecLazy'. -- -- /Since: 0.6/ genericShowPrecLazy :: (Generic a, GShow (Rep a)) => Int -> a -> TL.Text genericShowPrecLazy p = toLazyText . genericShowbPrec p --- | Converts a list of 'Generic' instances to a strict 'TS.Text'.+-- | A 'Generic' implementation of 'T.showList'. -- -- /Since: 0.6/ genericShowList :: (Generic a, GShow (Rep a)) => [a] -> TS.Text genericShowList = toStrict . genericShowListLazy --- | Converts a list of 'Generic' instances to a lazy 'TL.Text'.+-- | A 'Generic' implementation of 'T.showListLazy'. -- -- /Since: 0.6/ genericShowListLazy :: (Generic a, GShow (Rep a)) => [a] -> TL.Text genericShowListLazy = toLazyText . genericShowbList --- | Converts a 'Generic' instance to a 'Builder' with the given precedence.+-- | A 'Generic' implementation of 'T.showb'. -- -- /Since: 0.6/ genericShowb :: (Generic a, GShow (Rep a)) => a -> Builder genericShowb = genericShowbPrec 0 --- | Converts a 'Generic' instance to a 'Builder' with the given precedence.+-- | A 'Generic' implementation of 'T.showbPrec'. -- -- /Since: 0.6/ genericShowbPrec :: (Generic a, GShow (Rep a)) => Int -> a -> Builder genericShowbPrec p = gShowbPrec Pref p . from --- | Converts a list of 'Generic' instances to a 'Builder'.+-- | A 'Generic' implementation of 'T.showbList'. -- -- /Since: 0.6/ genericShowbList :: (Generic a, GShow (Rep a)) => [a] -> Builder-genericShowbList = showbListDefault genericShowb+genericShowbList = showbListWith genericShowb --- | Writes a 'Generic' instance's strict 'TS.Text' representation to the standard--- output, followed by a newline.+-- | A 'Generic' implementation of 'T.print'. -- -- /Since: 0.6/ genericPrint :: (Generic a, GShow (Rep a)) => a -> IO () genericPrint = TS.putStrLn . genericShow --- | Writes a 'Generic' instance's lazy 'TL.Text' representation to the standard--- output, followed by a newline.+-- | A 'Generic' implementation of 'T.printLazy'. -- -- /Since: 0.6/ genericPrintLazy :: (Generic a, GShow (Rep a)) => a -> IO () genericPrintLazy = TL.putStrLn . genericShowLazy --- | Writes a 'Generic' instance's strict 'TS.Text' representation to the given file--- handle, followed by a newline.+-- | A 'Generic' implementation of 'T.hPrint'. -- -- /Since: 0.6/ genericHPrint :: (Generic a, GShow (Rep a)) => Handle -> a -> IO () genericHPrint h = TS.hPutStrLn h . genericShow --- | Writes a 'Generic' instance's lazy 'TL.Text' representation to the given file--- handle, followed by a newline.+-- | A 'Generic' implementation of 'T.hPrintLazy'. -- -- /Since: 0.6/ genericHPrintLazy :: (Generic a, GShow (Rep a)) => Handle -> a -> IO ()@@ -204,9 +211,16 @@ -- -- /Since: 0.6/ data ConType = Rec | Tup | Pref | Inf Builder- deriving (Eq, Generic, Ord, S.Show)+ deriving ( Generic+ , S.Show+ , Typeable+#if MIN_VERSION_text(0,11,1)+ , Eq+ , Ord+#endif+ ) -instance Show ConType where+instance T.Show ConType where showbPrec = genericShowbPrec INLINE_INST_FUN(showbPrec) @@ -221,11 +235,15 @@ isNullary :: f a -> Bool isNullary = error "generic show (isNullary): unnecessary case" +#if __GLASGOW_HASKELL__ >= 708+deriving instance Typeable GShow+#endif+ instance GShow U1 where gShowbPrec _ _ U1 = mempty isNullary _ = True -instance Show c => GShow (K1 i c) where+instance T.Show c => GShow (K1 i c) where gShowbPrec _ n (K1 a) = showbPrec n a isNullary _ = False @@ -279,16 +297,14 @@ gShowbPrec t@(Inf o) n (a :*: b) = gShowbPrec t n a <> showbSpace- <> mBacktick- <> o- <> mBacktick+ <> infixOp <> showbSpace <> gShowbPrec t n b where- mBacktick :: Builder- mBacktick = if isInfixTypeCon (toString o)- then mempty- else s '`'+ infixOp :: Builder+ infixOp = if isInfixTypeCon (toString o)+ then o+ else s '`' <> o <> s '`' gShowbPrec t@Tup _ (a :*: b) = gShowbPrec t 0 a <> s ','
src/Text/Show/Text/Numeric/Natural.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE MagicHash #-} #endif
src/Text/Show/Text/System/IO.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, OverloadedStrings, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.System.IO
src/Text/Show/Text/System/Posix/Types.hs view
@@ -1,6 +1,8 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, StandaloneDeriving #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} #if !(MIN_VERSION_base(4,5,0))-{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MagicHash #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-|
src/Text/Show/Text/TH/Internal.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TemplateHaskell #-} {-| Module: Text.Show.Text.TH.Internal Copyright: (C) 2014-2015 Ryan Scott@@ -42,15 +44,14 @@ , defaultInlineShowbList ) where +#if !(MIN_VERSION_base(4,8,0)) import Data.Functor ((<$>))+#endif import Data.List (foldl', intersperse) #if MIN_VERSION_template_haskell(2,7,0) import Data.List (find) import Data.Maybe (fromJust) #endif-#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid (mempty)-#endif import qualified Data.Text as TS () import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import Data.Text.Lazy (toStrict)@@ -58,6 +59,8 @@ import qualified Data.Text.Lazy as TL () import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) +import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..))+import GHC.Prim (Char#, Double#, Float#, Int#, Word#) import GHC.Show (appPrec, appPrec1) import Language.Haskell.TH@@ -65,8 +68,8 @@ import Prelude hiding (Show) import qualified Text.Show as S (Show(show))-import qualified Text.Show.Text.Classes as T (Show)-import Text.Show.Text.Classes (showb, showbPrec, showbListDefault,+import qualified Text.Show.Text.Classes as T+import Text.Show.Text.Classes (showb, showbPrec, showbListWith, showbParen, showbSpace) #if __GLASGOW_HASKELL__ >= 702 import Text.Show.Text.Classes (showbList)@@ -112,12 +115,15 @@ data family DataFam a data instance DataFam Int = DataFamInt Int Int newtype instance DataFam Char = DataFamChar Char-$('deriveShow' ''DataFam) -- Two double quotes!+$('deriveShow' ''DataFam) -- Two single quotes! -- Generates Show instances for all data instances of DataFam -- (DataFamInt and DataFamChar) @ Note that at the moment, there are some limitations to this approach:++* The 'Name' argument to 'deriveShow' must not be a type synonym.+ * 'deriveShow' makes the assumption that all type variables in a data type require a 'T.Show' constraint when creating the type context. For example, if you have @data Phantom a = Phantom@, then @('deriveShow' ''Phantom)@ will generate @instance@@ -126,7 +132,8 @@ 'mkShowbPrec' (see the documentation of the 'mk' functions for more information). * 'deriveShow' lacks the ability to properly detect data types with higher-kinded- type parameters (e.g., @data HK f a = HK (f a)@). If you wish to derive 'T.Show'+ type parameters (e.g., @data HK f a = HK (f a)@) or with kinds other than @*@+ (e.g., @data List a (empty :: Bool)@). If you wish to derive 'T.Show' instances for these data types, you will need to use 'mkShowbPrec' (see the documentation of the 'mk' functions for more information). @@ -328,59 +335,57 @@ -} --- | Generates a lambda expression which converts the given data type or family--- to a strict 'TS.Text'.+-- | Generates a lambda expression which behaves like 'T.show' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.3.1/ mkShow :: Name -> Q Exp mkShow name = [| toStrict . $(mkShowLazy name) |] --- | Generates a lambda expression which converts the given data type or family--- to a lazy 'TL.Text'.+-- | Generates a lambda expression which behaves like 'T.showLazy' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.3.1/ mkShowLazy :: Name -> Q Exp mkShowLazy name = [| toLazyText . $(mkShowb name) |] --- | Generates a lambda expression which converts the given data type or family--- to a strict 'TS.Text' with the given precedence.+-- | Generates a lambda expression which behaves like 'T.showPrec' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.3.1/ mkShowPrec :: Name -> Q Exp mkShowPrec name = [| \p -> toStrict . $(mkShowPrecLazy name) p |] --- | Generates a lambda expression which converts the given data type or family--- to a lazy 'TL.Text' with the given precedence.+-- | Generates a lambda expression which behaves like 'T.showPrecLazy' (without+-- requiring a 'T.Show' instance). -- -- /Since: 0.3.1/ mkShowPrecLazy :: Name -> Q Exp mkShowPrecLazy name = [| \p -> toLazyText . $(mkShowbPrec name) p |] --- | Generates a lambda expression which converts the given list of data types or--- families to a strict 'TS.Text' in which the values are surrounded by square--- brackets and each value is separated by a comma.+-- | Generates a lambda expression which behaves like 'T.showList' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.5/ mkShowList :: Name -> Q Exp mkShowList name = [| toStrict . $(mkShowListLazy name) |] --- | Generates a lambda expression which converts the given list of data types or--- families to a lazy 'TL.Text' in which the values are surrounded by square--- brackets and each value is separated by a comma.+-- | Generates a lambda expression which behaves like 'T.showListLazy' (without+-- requiring a 'T.Show' instance). -- -- /Since: 0.5/ mkShowListLazy :: Name -> Q Exp mkShowListLazy name = [| toLazyText . $(mkShowbList name) |] --- | Generates a lambda expression which converts the given data type or family--- to a 'Builder'.+-- | Generates a lambda expression which behaves like 'T.showb' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.3.1/ mkShowb :: Name -> Q Exp mkShowb name = mkShowbPrec name `appE` [| 0 :: Int |] --- | Generates a lambda expression which converts the given data type or family--- to a 'Builder' with the given precedence.+-- | Generates a lambda expression which behaves like 'T.showPrec' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.3.1/ mkShowbPrec :: Name -> Q Exp@@ -403,37 +408,36 @@ ns :: String ns = "Text.Show.Text.TH.mk: " --- | Generates a lambda expression which converts the given list of data types or--- families to a 'Builder' in which the values are surrounded by square brackets--- and each value is separated by a comma.+-- | Generates a lambda expression which behaves like 'T.showbList' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.5/ mkShowbList :: Name -> Q Exp-mkShowbList name = [| showbListDefault $(mkShowb name) |]+mkShowbList name = [| showbListWith $(mkShowb name) |] --- | Generates a lambda expression which writes the given data type or family--- argument's strict 'TS.Text' output to the standard output, followed by a newline.+-- | Generates a lambda expression which behaves like 'T.print' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.3.1/ mkPrint :: Name -> Q Exp mkPrint name = [| TS.putStrLn . $(mkShow name) |] --- | Generates a lambda expression which writes the given data type or family--- argument's lazy 'TL.Text' output to the standard output, followed by a newline.+-- | Generates a lambda expression which behaves like 'T.printLazy' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.3.1/ mkPrintLazy :: Name -> Q Exp mkPrintLazy name = [| TL.putStrLn . $(mkShowLazy name) |] --- | Generates a lambda expression which writes the given data type or family--- argument's strict 'TS.Text' output to the given file handle, followed by a newline.+-- | Generates a lambda expression which behaves like 'T.hPrint' (without requiring a+-- 'T.Show' instance). -- -- /Since: 0.3.1/ mkHPrint :: Name -> Q Exp mkHPrint name = [| \h -> TS.hPutStrLn h . $(mkShow name) |] --- | Generates a lambda expression which writes the given data type or family--- argument's lazy 'TL.Text' output to the given file handle, followed by a newline.+-- | Generates a lambda expression which behaves like 'T.hPrintLazy' (without+-- requiring a 'T.Show' instance). -- -- /Since: 0.3.1/ mkHPrintLazy :: Name -> Q Exp@@ -492,10 +496,10 @@ = match (conP conName []) (normalB [| intConst (fromString $(stringE (nameBase conName))) $(varE p) |]) []-encodeArgs p (NormalC conName [_]) = do+encodeArgs p (NormalC conName [(_, argTy)]) = do arg <- newName "arg" - let showArg = [| showbPrec appPrec1 $(varE arg) |]+ let showArg = showbPrecPrim appPrec1 argTy arg namedArg = [| fromString $(stringE (nameBase conName)) <> showbSpace <> $(showArg) |] match (conP conName [varP arg])@@ -516,7 +520,8 @@ (normalB [| intConst $(mappendArgs) $(varE p) |]) [] else do- let showArgs = map (appE [| showbPrec appPrec1 |] . varE) args+ let showArgs = map (\(arg, (_, argTy)) -> showbPrecPrim appPrec1 argTy arg)+ (zip args ts) mappendArgs = foldr1 (\v q -> [| $(v) <> showbSpace <> $(q) |]) showArgs namedArgs = [| fromString $(stringE (nameBase conName)) <> showbSpace <> $(mappendArgs) |] @@ -527,10 +532,10 @@ encodeArgs p (RecC conName ts) = do args <- mapM newName ["arg" ++ S.show n | (_, n) <- zip ts [1 :: Int ..]] - let showArgs = concatMap (\(arg, (argName, _, _))+ let showArgs = concatMap (\(arg, (argName, _, argTy)) -> [ [| fromString $(stringE (nameBase argName)) |] , [| fromString " = " |]- , [| showb $(varE arg) |]+ , showbPrecPrim 0 argTy arg , [| fromString ", " |] ] )@@ -544,29 +549,26 @@ match (conP conName $ map varP args) (normalB [| showbParen ($(varE p) > appPrec) $(namedArgs) |]) []-encodeArgs p (InfixC _ conName _) = do+encodeArgs p (InfixC (_, alTy) conName (_, arTy)) = do al <- newName "argL" ar <- newName "argR" info <- reify conName - let conPrec = case info of- DataConI _ _ _ (Fixity prec _) -> prec- other -> error $ "Text.Show.Text.TH.encodeArgs: Unsupported type: " ++ S.show other- opNameE = stringE $ nameBase conName- mBacktickE = [| if isInfixTypeCon $(opNameE)- then mempty- else s '`'- |]+ let conPrec = case info of+ DataConI _ _ _ (Fixity prec _) -> prec+ other -> error $ "Text.Show.Text.TH.encodeArgs: Unsupported type: " ++ S.show other+ opName = nameBase conName+ infixOpE = if isInfixTypeCon opName+ then [| fromString opName |]+ else [| s '`' <> fromString opName <> s '`' |] match (infixP (varP al) conName (varP ar)) (normalB $ appE [| showbParen ($(varE p) > conPrec) |]- [| showbPrec (conPrec + 1) $(varE al)+ [| $(showbPrecPrim (conPrec + 1) alTy al) <> showbSpace- <> $(mBacktickE)- <> fromString $(opNameE)- <> $(mBacktickE)+ <> $(infixOpE) <> showbSpace- <> showbPrec (conPrec + 1) $(varE ar)+ <> $(showbPrecPrim (conPrec + 1) arTy ar) |] ) []@@ -575,6 +577,42 @@ ------------------------------------------------------------------------------- -- Utility functions -------------------------------------------------------------------------------++-- | Checks if an type variable has an unlifted type that can be shown. If so,+-- wrap it in its corresponding constructor and show it. Otherwise, only show+-- the type variable.+showbPrecPrim :: Int -> Type -> Name -> Q Exp+#if __GLASGOW_HASKELL__ >= 712+-- Starting with GHC 7.10, data types containing unlifted types with derived @Show@+-- instances show hashed literals with actual hash signs, and negative hashed+-- literals are not surrounded with parentheses.+showbPrecPrim p (ConT tyName) tyVarName = showE+ where+ tyVarE :: Q Exp+ tyVarE = varE tyVarName+ + showE :: Q Exp+ showE | tyName == ''Char# = [| showbPrec 0 (C# $(tyVarE)) <> s '#' |]+ | tyName == ''Double# = [| showbPrec 0 (D# $(tyVarE)) <> fromString "##" |]+ | tyName == ''Float# = [| showbPrec 0 (F# $(tyVarE)) <> s '#' |]+ | tyName == ''Int# = [| showbPrec 0 (I# $(tyVarE)) <> s '#' |]+ | tyName == ''Word# = [| showbPrec 0 (W# $(tyVarE)) <> fromString "##" |]+ | otherwise = [| showbPrec p $(tyVarE) |]+#else+showbPrecPrim p (ConT tyName) tyVarName = [| showbPrec p $(expr) |]+ where+ tyVarE :: Q Exp+ tyVarE = varE tyVarName+ + expr :: Q Exp+ expr | tyName == ''Char# = [| C# $(tyVarE) |]+ | tyName == ''Double# = [| D# $(tyVarE) |]+ | tyName == ''Float# = [| F# $(tyVarE) |]+ | tyName == ''Int# = [| I# $(tyVarE) |]+ | tyName == ''Word# = [| W# $(tyVarE) |]+ | otherwise = tyVarE+#endif+showbPrecPrim p _ tyVarName = [| showbPrec p $(varE tyVarName) |] -- | Checks if a 'Name' represents a tuple type constructor (other than '()') isNonUnitTuple :: Name -> Bool
src/Text/Show/Text/Text/Read.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Text.Show.Text.Text.Read@@ -35,7 +36,8 @@ import Text.Show.Text.Data.Integral () import Text.Show.Text.Data.Ratio () #endif-import Text.Show.Text.Data.Char (LitChar(..), LitString(..))+import Text.Show.Text.Data.Char ()+import Text.Show.Text.Data.List () #include "inline.h" @@ -43,11 +45,11 @@ -- -- /Since: 0.3/ showbLexemePrec :: Int -> Lexeme -> Builder-showbLexemePrec p (Char c) = showbUnary "Char" p $ LitChar c-showbLexemePrec p (String s) = showbUnary "String" p $ LitString s-showbLexemePrec p (Punc pun) = showbUnary "Punc" p $ LitString pun-showbLexemePrec p (Ident i) = showbUnary "Ident" p $ LitString i-showbLexemePrec p (Symbol s) = showbUnary "Symbol" p $ LitString s+showbLexemePrec p (Char c) = showbUnary "Char" p c+showbLexemePrec p (String s) = showbUnary "String" p s+showbLexemePrec p (Punc pun) = showbUnary "Punc" p pun+showbLexemePrec p (Ident i) = showbUnary "Ident" p i+showbLexemePrec p (Symbol s) = showbUnary "Symbol" p s #if MIN_VERSION_base(4,6,0) showbLexemePrec p (Number n) = showbUnary "Number" p $ FromStringShow n #else
src/Text/Show/Text/Utils.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, MagicHash #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-} {-| Module: Text.Show.Text.Utils Copyright: (C) 2014-2015 Ryan Scott@@ -16,8 +17,8 @@ import Data.Monoid (Monoid(mappend, mempty)) #endif import Data.Text (Text)-import Data.Text.Lazy (length, replicate, toStrict, unpack)-import Data.Text.Lazy.Builder (Builder, fromLazyText, singleton, toLazyText)+import Data.Text.Lazy (length, toStrict, unpack)+import Data.Text.Lazy.Builder (Builder, singleton, toLazyText) import GHC.Exts (Char(C#), Int(I#)) import GHC.Prim ((+#), chr#, ord#)@@ -61,14 +62,6 @@ lengthB :: Builder -> Int64 lengthB = length . toLazyText {-# INLINE lengthB #-}---- | @'replicateB' n b@ yields a 'Builder' containing @b@ repeated @n@ times.--- --- /Since: 0.3/-{-# DEPRECATED replicateB "Use @timesN@ from the @semigroups@ library instead." #-}-replicateB :: Int64 -> Builder -> Builder-replicateB n = fromLazyText . replicate n . toLazyText-{-# INLINE replicateB #-} -- | Convert a 'Builder' to a 'String' (without surrounding it with double quotes, -- as 'show' would).
tests/Derived.hs view
@@ -1,18 +1,27 @@-{-# LANGUAGE CPP, DeriveGeneric, ExistentialQuantification, FlexibleContexts,- FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses,- StandaloneDeriving, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} #if MIN_VERSION_template_haskell(2,7,0)-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies #-} #endif #if __GLASGOW_HASKELL__ >= 706 -- GHC 7.4 also supports PolyKinds, but Template Haskell doesn't seem to play -- nicely with it for some reason.-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 -- Starting with GHC 7.10, NullaryTypeClasses was deprecated in favor of -- MultiParamTypeClasses, which is already enabled-{-# LANGUAGE NullaryTypeClasses #-}+{-# LANGUAGE NullaryTypeClasses #-} #endif {-| Module: Derived@@ -40,6 +49,7 @@ , PolymorphicForall(..) , AllAtOnce(..) , GADT(..)+ , PrimADT#(..) , LeftAssocTree(..) , RightAssocTree(..) , (:?:)(..)@@ -47,6 +57,7 @@ , Restriction(..) , RestrictedContext(..) , Fix(..)+#if MIN_VERSION_template_haskell(2,7,0) , AllShow(..) , NotAllShow(..) , OneDataInstance(..)@@ -56,14 +67,16 @@ , AssocData2(..) -- , AssocClass3(..) -- , AssocData3(..)-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+# if __GLASGOW_HASKELL__ >= 708 , NullaryClass(..) , NullaryData(..)-#endif+# endif , GADTFam(..)+#endif ) where import GHC.Generics (Generic)+import GHC.Prim (Char#, Double#, Float#, Int#, Word#) import Prelude hiding (Show) @@ -103,7 +116,7 @@ data PolymorphicInfix a b c = a `PolyInf` b deriving (S.Show, Generic) -- TODO: Figure out how to create Generic instances for MonomorphicForall, PolymorphicForall,--- AllAtOnce, and GADT+-- AllAtOnce, GADT, and PrimADT data MonomorphicForall = forall a. (Arbitrary a, S.Show a, T.Show a) => MonomorphicForall a deriving instance S.Show MonomorphicForall@@ -132,6 +145,22 @@ GADTCon5 :: b -> GADT b b c deriving instance (S.Show a, S.Show b) => S.Show (GADT a b c) +infixr 5 `PrimInfixIntegral#`, `PrimInfixFloating#`, `PrimInfixChar#`+data PrimADT# a = PrimNormal# Int# Float# Double# Char# Word#+ | PrimRecord# {+ primRecordInt# :: Int#+ , primRecordFloat# :: Float#+ , primRecordDouble# :: Double#+ , primRecordChar# :: Char#+ , primRecordWord# :: Word#+ }+ | Int# `PrimInfixIntegral#` Word#+ | Float# `PrimInfixFloating#` Double#+ | Char# `PrimInfixChar#` Char#+ | forall b. (Arbitrary b, S.Show b, T.Show b)+ => PrimForall# b Int# Float# Double# Char# Word#+deriving instance S.Show (PrimADT# a)+ infixl 5 :<: data LeftAssocTree a = LeftAssocLeaf a | LeftAssocTree a :<: LeftAssocTree a@@ -249,14 +278,14 @@ -- class AssocClass3 a b c where -- data AssocData3 a b c :: * -- instance AssocClass3 () b c where--- newtype AssocData3 () b c = AssocCon2 Int deriving ( S.Show+-- newtype AssocData3 () b c = AssocCon3 Int deriving ( S.Show -- # if __GLASGOW_HASKELL__ >= 706 -- {- Woraround for a bizarre bug in older GHCs -} -- , Generic -- # endif -- ) -# if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+# if __GLASGOW_HASKELL__ >= 708 class NullaryClass where data NullaryData instance NullaryClass where
tests/Instances/BaseAndFriends.hs view
@@ -1,12 +1,15 @@-{-# LANGUAGE CPP, FlexibleContexts, GeneralizedNewtypeDeriving,- StandaloneDeriving, TypeOperators #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-} #if MIN_VERSION_base(4,7,0)-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies #-} # if !(MIN_VERSION_base(4,8,0)) {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} # endif #endif-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.BaseAndFriends Copyright: (C) 2014-2015 Ryan Scott@@ -22,22 +25,22 @@ -} module Instances.BaseAndFriends () where -import Control.Applicative (ZipList(..))+import Control.Applicative (Const(..), ZipList(..)) #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative ((<*>), pure) #endif import Control.Exception import Control.Monad.ST (ST, fixST) -#if MIN_VERSION_bytestring(0,10,4) import Data.ByteString.Short (ShortByteString, pack)-#endif import Data.Char (GeneralCategory(..)) import qualified Data.Data as D (Fixity(..)) import Data.Data (Constr, ConstrRep(..), DataRep(..), DataType, mkConstr, mkDataType) import Data.Dynamic (Dynamic, toDyn)+#if !(MIN_VERSION_base(4,8,0)) import Data.Functor ((<$>))+#endif #if defined(VERSION_transformers) # if !(MIN_VERSION_transformers(0,4,0)) import Data.Functor.Classes ()@@ -63,11 +66,6 @@ import Data.Type.Equality ((:~:)(..)) #endif import qualified Data.Typeable.Internal as NewT (TyCon(..), TypeRep(..))--#if !(MIN_VERSION_base(4,7,0))-import Data.Word (Word64)-import Numeric (showHex)-#endif import Data.Version (Version(..)) import Foreign.C.Types@@ -76,13 +74,18 @@ ptrToIntPtr, ptrToWordPtr) import GHC.Conc (BlockReason(..), ThreadStatus(..))-#if defined(mingw32_HOST_OS)+#if !(defined(__GHCJS__))+# if defined(mingw32_HOST_OS) import GHC.Conc.Windows (ConsoleEvent(..))+# else+import GHC.Event (Event, evtRead, evtWrite)+# endif #endif import GHC.Fingerprint.Type (Fingerprint(..)) import GHC.IO.Encoding.Failure (CodingFailureMode(..)) import GHC.IO.Encoding.Types (CodingProgress(..)) import GHC.IO.Exception (IOException(..), IOErrorType(..))+import GHC.IO.Handle (HandlePosn(..)) import qualified GHC.Generics as G (Fixity(..)) import GHC.Generics (U1(..), Par1(..), Rec1(..), K1(..), M1(..), (:+:)(..), (:*:)(..), (:.:)(..),@@ -91,6 +94,9 @@ import GHC.RTS.Flags import GHC.StaticPtr (StaticPtrInfo(..)) #endif+#if !(MIN_VERSION_base(4,8,0))+import GHC.Show (appPrec, appPrec1)+#endif import GHC.Stats (GCStats(..)) #if MIN_VERSION_base(4,7,0) import GHC.TypeLits (SomeNat, SomeSymbol, someNatVal, someSymbolVal)@@ -98,7 +104,10 @@ import Instances.Utils ((<@>)) +import Numeric (showHex)+#if !(MIN_VERSION_QuickCheck(2,8,0) && MIN_VERSION_base(4,8,0)) import Numeric.Natural (Natural)+#endif import System.Exit (ExitCode(..)) import System.IO (BufferMode(..), IOMode(..), Newline(..), NewlineMode(..),@@ -108,22 +117,36 @@ import Test.Tasty.QuickCheck (Arbitrary(arbitrary), Gen, arbitraryBoundedEnum, oneof, suchThat) +import Text.Read.Lex as Lex (Lexeme(..))+#if MIN_VERSION_base(4,7,0)+import Data.Fixed (Fixed, E12)+import Text.Read.Lex (Number)+#endif import Text.Show.Text (FromStringShow(..), FromTextShow(..))-import Text.Show.Text.Data.Char (LitChar(..), LitString(..)) import Text.Show.Text.Generic (ConType(..)) +#if MIN_VERSION_base(4,7,0)+import Numeric (showOct, showEFloat, showFFloat, showGFloat)+import Test.Tasty.QuickCheck (getNonNegative)+# if !(MIN_VERSION_base(4,8,0))+import Data.Word (Word)+# endif+#else+import Data.Word (Word64)+#endif+ #include "HsBaseConfig.h" +#if !(MIN_VERSION_QuickCheck(2,8,0) && MIN_VERSION_base(4,8,0)) instance Arbitrary Natural where arbitrary = fromInteger <$> arbitrary `suchThat` (>= 0)+#endif instance Arbitrary Builder where arbitrary = fromString <$> arbitrary -#if MIN_VERSION_bytestring(0,10,4) instance Arbitrary ShortByteString where arbitrary = pack <$> arbitrary-#endif instance Arbitrary (Ptr a) where arbitrary = plusPtr nullPtr <$> arbitrary@@ -137,8 +160,6 @@ instance Arbitrary WordPtr where arbitrary = ptrToWordPtr <$> arbitrary --- TODO: instance Arbitrary (ForeignPtr a)- instance Arbitrary GeneralCategory where arbitrary = arbitraryBoundedEnum @@ -225,10 +246,42 @@ instance Arbitrary MaskingState where arbitrary = arbitraryBoundedEnum --- TODO: instance Arbitrary Lexeme--- #if MIN_VERSION_base(4,7,0)--- TODO: instance Arbitrary Number--- #endif+instance Arbitrary Lexeme where+ arbitrary = oneof [ Char <$> arbitrary+ , String <$> arbitrary+ , Punc <$> arbitrary+ , Ident <$> arbitrary+ , Symbol <$> arbitrary+#if MIN_VERSION_base(4,7,0)+ , Number <$> arbitrary+#elif !(MIN_VERSION_base(4,6,0))+ , Int <$> arbitrary+ , Rat <$> arbitrary+#endif+ , pure Lex.EOF+ ]+ +#if MIN_VERSION_base(4,7,0)+instance Arbitrary Number where+ arbitrary = do+ str <- oneof [ show <$> (nonneg :: Gen Double)+ , fmap (\d -> showEFloat Nothing d "") (nonneg :: Gen Double)+ , fmap (\d -> showFFloat Nothing d "") (nonneg :: Gen Double)+ , fmap (\d -> showGFloat Nothing d "") (nonneg :: Gen Double)+ , show <$> (nonneg :: Gen Float)+ , show <$> (nonneg :: Gen Int)+ , fmap (\i -> "0x" ++ showHex i "") (nonneg :: Gen Int)+ , fmap (\i -> "0o" ++ showOct i "") (nonneg :: Gen Int)+ , show <$> (nonneg :: Gen Integer)+ , show <$> (nonneg :: Gen Word)+ , show <$> (nonneg :: Gen (Fixed E12))+ ]+ let Number num = read str+ pure num+ where+ nonneg :: (Arbitrary a, Num a, Ord a) => Gen a+ nonneg = getNonNegative <$> arbitrary+#endif instance Arbitrary (Proxy s) where arbitrary = pure Proxy@@ -243,8 +296,12 @@ #endif instance Arbitrary NewT.TypeRep where- arbitrary = NewT.TypeRep <$> arbitrary <*> arbitrary <@> []--- arbitrary = NewT.TypeRep <$> arbitrary <*> arbitrary <*> arbitrary+ arbitrary = NewT.TypeRep <$> arbitrary <*> arbitrary+#if MIN_VERSION_base(4,8,0)+ <@> [] <@> []+#else+ <@> []+#endif instance Arbitrary NewT.TyCon where arbitrary = NewT.TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary@@ -256,7 +313,7 @@ instance Show Fingerprint where show (Fingerprint w1 w2) = hex16 w1 ++ hex16 w2 where- -- | Formats a 64 bit number as 16 digits hex.+ -- Formats a 64 bit number as 16 digits hex. hex16 :: Word64 -> String hex16 i = let hex = showHex i "" in replicate (16 - length hex) '0' ++ hex@@ -304,8 +361,6 @@ instance Arbitrary BlockReason where arbitrary = arbitraryBoundedEnum --- TODO: instance Arbitrary ThreadId- instance Arbitrary ThreadStatus where arbitrary = oneof [ pure ThreadRunning , pure ThreadFinished@@ -313,10 +368,17 @@ , pure ThreadDied ] -#if defined(mingw32_HOST_OS)+#if !(defined(__GHCJS__))+# if defined(mingw32_HOST_OS) deriving instance Bounded ConsoleEvent instance Arbitrary ConsoleEvent where arbitrary = arbitraryBoundedEnum+# else+instance Arbitrary Event where+ arbitrary = oneof $ map pure [evtRead, evtWrite]++-- TODO: instance Arbitrary FdKey+# endif #endif instance Arbitrary (ST s a) where@@ -324,8 +386,10 @@ instance Arbitrary Handle where arbitrary = oneof $ map pure [stdin, stdout, stderr]--- TODO: instance Arbitrary HandlePosn +instance Arbitrary HandlePosn where+ arbitrary = HandlePosn <$> arbitrary <*> arbitrary+ deriving instance Bounded IOMode instance Arbitrary IOMode where arbitrary = arbitraryBoundedEnum@@ -348,8 +412,6 @@ instance Arbitrary NewlineMode where arbitrary = NewlineMode <$> arbitrary <*> arbitrary --- TODO: instance Arbitrary TextEncoding- deriving instance Bounded CodingProgress deriving instance Enum CodingProgress instance Arbitrary CodingProgress where@@ -368,9 +430,6 @@ <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary --- TODO: instance Arbitrary Event--- TODO: instance Arbitrary FdKey- instance Arbitrary (U1 p) where arbitrary = pure U1 @@ -428,9 +487,6 @@ #endif #if MIN_VERSION_base(4,8,0)--- TODO: instance Arbitrary RTSFlags--- TODO: instance Arbitrary GCFlags- instance Arbitrary ConcFlags where arbitrary = ConcFlags <$> arbitrary <*> arbitrary @@ -444,10 +500,6 @@ <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary --- TODO: instance Arbitrary CCFlags where--- TODO: instance Arbitrary ProfFlags where--- TODO: instance Arbitrary TraceFlags where- instance Arbitrary TickyFlags where arbitrary = TickyFlags <$> arbitrary <*> arbitrary @@ -556,6 +608,12 @@ deriving instance Arbitrary (f a) => Arbitrary (Alt f a) #endif +deriving instance Arbitrary a => Arbitrary (Const a b)+#if !(MIN_VERSION_base(4,8,0))+instance Show a => Show (Const a b) where+ showsPrec p (Const x) = showParen (p > appPrec)+ $ showString "Const " . showsPrec appPrec1 x+#endif deriving instance Arbitrary a => Arbitrary (ZipList a) #if !(MIN_VERSION_base(4,7,0)) deriving instance Show a => Show (ZipList a)@@ -572,6 +630,3 @@ deriving instance Arbitrary a => Arbitrary (FromStringShow a) deriving instance Arbitrary a => Arbitrary (FromTextShow a)--deriving instance Arbitrary LitChar-deriving instance Arbitrary LitString
tests/Instances/Derived.hs view
@@ -1,12 +1,19 @@-{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, GADTs,- GeneralizedNewtypeDeriving, StandaloneDeriving,- TemplateHaskell, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} #include "overlap.h" __LANGUAGE_OVERLAPPING_INSTANCES__ #if __GLASGOW_HASKELL__ >= 706 -- GHC 7.4 also supports PolyKinds, but Template Haskell doesn't seem to play -- -- nicely with it for some reason.-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-|@@ -20,23 +27,178 @@ Defines data types with derived 'Show' instances (using "Text.Show.Text.TH") for testing purposes, including 'Arbitrary' instances. -}-module Instances.Derived () where+module Instances.Derived (+ showbNullary+ , showbPhantomNullary+ , showbMonomorphicUnaryPrec+ , showbPolymorphicUnaryPrec+ , showbMonomorphicProductPrec+ , showbPolymorphicProductPrec+ , showbMonomorphicRecordPrec+ , showbPolymorphicRecordPrec+ , showbMonomorphicInfixPrec+ , showbPolymorphicInfixPrec+ , showbMonomorphicForallPrec+ , showbPolymorphicForallPrec+ , showbAllAtOncePrec+ , showbGADTPrec+ , showbPrimADTPrec#+ , showbLeftAssocTreePrec+ , showbRightAssocTreePrec+ , showbQuestionMarkPrec+-- , showbHigherKindedTypeParamsPrec+-- , showbRestrictionPrec+-- , showbRestrictedContextPrec+-- , showbFixPrec+#if MIN_VERSION_template_haskell(2,7,0)+ , showbASNullary+ , showbASUnaryPrec+ , showbASProductPrec+ , showbASRecordPrec+ , showbASInfixPrec+ , showbNASShowPrec+ , showbOneDataInstancePrec+ , showbAssocData1Prec+ , showbAssocData2Prec+ -- , showbAssocData3Prec+# if __GLASGOW_HASKELL__ >= 708+ , showbNullaryDataPrec+# endif+ , showbGADTFamPrec+#endif+ ) where #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative ((<*>), pure)-#endif import Data.Functor ((<$>))+#endif import Derived +import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..))+ import Prelude hiding (Show) import Test.Tasty.QuickCheck (Arbitrary(..), Gen, oneof) -import Text.Show.Text (Show(showbPrec))+import Text.Show.Text (Show(showb, showbPrec), Builder) import Text.Show.Text.TH (deriveShow, mkShowbPrec) +showbNullary :: Nullary -> Builder+showbNullary = showb++showbPhantomNullary :: Show a => PhantomNullary a -> Builder+showbPhantomNullary = showb++showbMonomorphicUnaryPrec :: Int -> MonomorphicUnary -> Builder+showbMonomorphicUnaryPrec = showbPrec++showbPolymorphicUnaryPrec :: (Show a, Show b) => Int -> PolymorphicUnary a b -> Builder+showbPolymorphicUnaryPrec = showbPrec++showbMonomorphicProductPrec :: Int -> MonomorphicProduct -> Builder+showbMonomorphicProductPrec = showbPrec++showbPolymorphicProductPrec :: (Show a, Show b, Show c, Show d)+ => Int -> PolymorphicProduct a b c d -> Builder+showbPolymorphicProductPrec = showbPrec++showbMonomorphicRecordPrec :: Int -> MonomorphicRecord -> Builder+showbMonomorphicRecordPrec = showbPrec++showbPolymorphicRecordPrec :: (Show a, Show b, Show c, Show d)+ => Int -> PolymorphicRecord a b c d -> Builder+showbPolymorphicRecordPrec = showbPrec++showbMonomorphicInfixPrec :: Int -> MonomorphicInfix -> Builder+showbMonomorphicInfixPrec = showbPrec++showbPolymorphicInfixPrec :: (Show a, Show b, Show c)+ => Int -> PolymorphicInfix a b c -> Builder+showbPolymorphicInfixPrec = showbPrec++showbMonomorphicForallPrec :: Int -> MonomorphicForall -> Builder+showbMonomorphicForallPrec = showbPrec++showbPolymorphicForallPrec :: (Show a, Show b) => Int -> PolymorphicForall a b -> Builder+showbPolymorphicForallPrec = showbPrec++showbAllAtOncePrec :: (Show a, Show b, Show c, Show d)+ => Int -> AllAtOnce a b c d -> Builder+showbAllAtOncePrec = showbPrec++showbGADTPrec :: (Show a, Show b, Show c) => Int -> GADT a b c -> Builder+showbGADTPrec = showbPrec++showbPrimADTPrec# :: Show a => Int -> PrimADT# a -> Builder+showbPrimADTPrec# = showbPrec++showbLeftAssocTreePrec :: Show a => Int -> LeftAssocTree a -> Builder+showbLeftAssocTreePrec = showbPrec++showbRightAssocTreePrec :: Show a => Int -> RightAssocTree a -> Builder+showbRightAssocTreePrec = showbPrec++showbQuestionMarkPrec :: (Show a, Show b) => Int -> a :?: b -> Builder+showbQuestionMarkPrec = showbPrec++-- showbHigherKindedTypeParamsPrec :: Show (f a)+-- => Int -> HigherKindedTypeParams f a -> Builder+-- showbHigherKindedTypeParamsPrec = showbPrec+-- +-- showbRestrictionPrec :: (Read a, Show a) => Int -> Restriction a -> Builder+-- showbRestrictionPrec = showbPrec+-- +-- showbRestrictedContextPrec :: (Read a, Show a) => Int -> RestrictedContext a -> Builder+-- showbRestrictedContextPrec = showbPrec+-- +-- showbFixPrec :: Show (f (Fix f)) => Int -> Fix f -> Builder+-- showbFixPrec = showbPrec++#if MIN_VERSION_template_haskell(2,7,0)+showbASNullary :: (Show c, Show d) => AllShow () () c d -> Builder+showbASNullary = showb++showbASUnaryPrec :: (Show b, Show c, Show d) => Int -> AllShow Int b c d -> Builder+showbASUnaryPrec = showbPrec++showbASProductPrec :: (Show c, Show d) => Int -> AllShow Bool Bool c d -> Builder+showbASProductPrec = showbPrec++showbASRecordPrec :: (Show c, Show d) => Int -> AllShow Char Double c d -> Builder+showbASRecordPrec = showbPrec++showbASInfixPrec :: (Show c, Show d) => Int -> AllShow Float Ordering c d -> Builder+showbASInfixPrec = showbPrec++showbNASShowPrec :: (Show b, Show d) => Int -> NotAllShow Int b Int d -> Builder+showbNASShowPrec = showbPrec++showbOneDataInstancePrec :: (Show a, Show b, Show c, Show d)+ => Int -> OneDataInstance a b c d -> Builder+showbOneDataInstancePrec = showbPrec++showbAssocData1Prec :: Int -> AssocData1 () -> Builder+showbAssocData1Prec = showbPrec++showbAssocData2Prec :: Int -> AssocData2 () Int Int -> Builder+showbAssocData2Prec = showbPrec++-- showbAssocData3Prec :: Int -> AssocData3 () b c -> Builder+-- showbAssocData3Prec = showbPrec++# if __GLASGOW_HASKELL__ >= 708+showbNullaryDataPrec :: Int -> NullaryData -> Builder+showbNullaryDataPrec = showbPrec+# endif++showbGADTFamPrec :: (Show a, Show b, Show c) => Int -> GADTFam a b c -> Builder+showbGADTFamPrec = showbPrec+#endif++-------------------------------------------------------------------------------+ $(deriveShow ''Nullary) instance Arbitrary Nullary where arbitrary = pure Nullary@@ -105,6 +267,22 @@ instance __OVERLAPPING__ Arbitrary b => Arbitrary (GADT b b c) where arbitrary = GADTCon5 <$> arbitrary +$(deriveShow ''PrimADT#)+instance Arbitrary (PrimADT# a) where+ arbitrary = do+ i@(I# i#) <- arbitrary+ F# f# <- arbitrary+ D# d# <- arbitrary+ C# c# <- arbitrary+ W# w# <- arbitrary+ oneof $ map pure [ PrimNormal# i# f# d# c# w#+ , PrimRecord# i# f# d# c# w#+ , i# `PrimInfixIntegral#` w#+ , f# `PrimInfixFloating#` d#+ , c# `PrimInfixChar#` c#+ , PrimForall# i i# f# d# c# w#+ ]+ $(deriveShow ''LeftAssocTree) instance Arbitrary a => Arbitrary (LeftAssocTree a) where arbitrary = oneof [ LeftAssocLeaf <$> arbitrary@@ -170,7 +348,7 @@ $(deriveShow 'AssocCon2) deriving instance Arbitrary (AssocData2 () Int Int) -#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+#if __GLASGOW_HASKELL__ >= 708 $(deriveShow 'NullaryCon) deriving instance Arbitrary NullaryData #endif
tests/Properties/BaseAndFriends.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, FlexibleContexts, TypeOperators #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-} #if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} #endif@@ -15,19 +17,22 @@ -} module Properties.BaseAndFriends (baseAndFriendsTests) where -import Control.Applicative (ZipList(..), liftA2)+import Control.Applicative (Const, ZipList, liftA2)+#if !(MIN_VERSION_base(4,8,0))+import Control.Applicative ((*>), pure)+#endif+import Control.Concurrent (myThreadId) import Control.Exception import Control.Monad.ST #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) import Data.Array (Array)+import Data.Array.Unboxed (UArray) #endif import Data.Array (elems) import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)-#if MIN_VERSION_bytestring(0,10,4) import Data.ByteString.Short (ShortByteString)-#endif import Data.Char (GeneralCategory, intToDigit) import Data.Complex (Complex) import qualified Data.Data as D (Fixity)@@ -62,12 +67,19 @@ #endif import Data.Version (Version, showVersion) +import qualified Debug.Trace as S (traceShow)+ import Foreign.C.Types+import Foreign.ForeignPtr (newForeignPtr_) import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr) import GHC.Conc (BlockReason, ThreadStatus)-#if defined(mingw32_HOST_OS)+#if !(defined(__GHCJS__))+# if defined(mingw32_HOST_OS) import GHC.Conc.Windows (ConsoleEvent)+# else+import GHC.Event (Event)+# endif #endif import GHC.Fingerprint.Type (Fingerprint) import qualified GHC.Generics as G (Fixity)@@ -80,7 +92,7 @@ import GHC.StaticPtr (StaticPtrInfo) #endif import GHC.Stats (GCStats)-import GHC.Show (asciiTab, showList__)+import GHC.Show (asciiTab) #if MIN_VERSION_base(4,7,0) import GHC.TypeLits (SomeNat, SomeSymbol) #endif@@ -95,422 +107,517 @@ import Prelude hiding (Show) -import Properties.Utils (prop_matchesShow, prop_genericShow)+import Properties.Utils import System.Exit (ExitCode)-import System.IO (BufferMode, IOMode, Newline, NewlineMode, SeekMode, Handle)+import qualified System.IO as S (print)+import System.IO (BufferMode, IOMode, HandlePosn, Newline,+ NewlineMode, SeekMode, Handle,+ hFlush, mkTextEncoding, stdout, stderr)+import System.IO.Silently (capture_, hCapture_) import System.Posix.Types import Test.QuickCheck.Instances () import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit ((@=?), testCase)-import Test.Tasty.QuickCheck (Gen, arbitrary, suchThat, testProperty)+import Test.Tasty.QuickCheck (Gen, Property, arbitrary, generate,+ oneof, suchThat, testProperty) +import Text.Read.Lex (Lexeme)+#if MIN_VERSION_base(4,7,0)+import Text.Read.Lex (Number)+#endif+import Text.Show (showListWith) import Text.Show.Functions ()-import Text.Show.Text hiding (Show)-import Text.Show.Text.Data.Char (LitChar, LitString, asciiTabB)+import qualified Text.Show.Text as T (print)+import Text.Show.Text hiding (Show, print)+import Text.Show.Text.Data.Char (asciiTabB) import Text.Show.Text.Data.Fixed (showbFixed) import Text.Show.Text.Data.Floating (showbEFloat, showbFFloat, showbGFloat) #if MIN_VERSION_base(4,7,0) import Text.Show.Text.Data.Floating (showbFFloatAlt, showbGFloatAlt) #endif import Text.Show.Text.Data.Integral (showbIntAtBase)-import Text.Show.Text.Data.List (showbListDefault)+import Text.Show.Text.Data.List (showbListWith) import Text.Show.Text.Data.Version (showbVersionConcrete)+import qualified Text.Show.Text.Debug.Trace as T (traceShow) import Text.Show.Text.Functions () import Text.Show.Text.Generic (ConType) #include "HsBaseConfig.h" +-- | Verifies the 'print' functions for 'String' and 'TS.Text' @Show@ display+-- the same output.+prop_print :: String -> Property+prop_print str = ioProperty $ do+ sRes <- capture_ $ S.print str *> hFlush stdout+ tRes <- capture_ $ T.print str *> hFlush stdout+ pure $ sRes == tRes+ -- | Verifies 'showFixed' and 'showbFixed' generate the same output. prop_showFixed :: Bool -> Fixed E12 -> Bool prop_showFixed b f = fromString (showFixed b f) == showbFixed b f +-- | Verifies the 'Show' instance for 'ForeignPtr' is accurate.+prop_showForeignPtr :: Int -> Ptr Int -> Property+prop_showForeignPtr p ptr = ioProperty $ do+ fptr <- newForeignPtr_ ptr+ pure $ prop_matchesShow p fptr+ -- | Verifies 'showIntAtBase' and 'showbIntAtBase' generate the same output. #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) prop_showIntAtBase :: Gen Bool prop_showIntAtBase = do base <- arbitrary `suchThat` (liftA2 (&&) (> 1) (<= 16)) i <- arbitrary `suchThat` (>= 0) :: Gen Int- return $ fromString (showIntAtBase base intToDigit i "") == showbIntAtBase base intToDigit i+ pure $ fromString (showIntAtBase base intToDigit i "") == showbIntAtBase base intToDigit i #endif --- | Verifies 'showList__' and 'showbListDefault' generate the same output.-prop_showListDefault :: [Char] -> Bool-prop_showListDefault str = fromString (showList__ shows str "") == showbListDefault showb str+-- | Verifies 'showListWith' and 'showbListWith' generate the same output.+prop_showListWith :: [Char] -> Bool+prop_showListWith str = fromString (showListWith shows str "") == showbListWith showb str +-- | Verifies the 'Show' instance for 'TextEncoding' is accurate.+prop_showTextEncoding :: Int -> Property+prop_showTextEncoding p = ioProperty $ do+ -- Based on this description:+ -- http://hackage.haskell.org/package/base-4.7.0.2/docs/System-IO.html#v:mkTextEncoding+ utf <- generate . oneof $ map pure [ "UTF-8"+ , "UTF-16", "UTF-16BE", "UTF-16LE"+ , "UTF-32", "UTF-32BE", "UTF-32LE"+ ]+ tenc <- mkTextEncoding utf+ pure $ prop_matchesShow p tenc++-- | Verifies the 'Show' instance for 'ThreadId' is accurate.+prop_showThreadId :: Int -> Property+prop_showThreadId p = ioProperty $ do+ tid <- myThreadId+ pure $ prop_matchesShow p tid+ -- | Verifies @showXFloat@ and @showbXFloat@ generate the same output (where @X@ -- is one of E, F, or G). prop_showXFloat :: (Maybe Int -> Double -> ShowS) -> (Maybe Int -> Double -> Builder) -> Double -> Gen Bool prop_showXFloat f1 f2 val = do digs <- arbitrary `suchThat` (<= 10)- return $ fromString (f1 (Just digs) val "") == f2 (Just digs) val+ pure $ fromString (f1 (Just digs) val "") == f2 (Just digs) val -- | Verifies 'showVersion' and 'showbVersion' generate the same output. prop_showVersion :: Version -> Bool prop_showVersion v = fromString (showVersion v) == showbVersionConcrete v +#if MIN_VERSION_base(4,8,0)+-- | Verifies that the 'Show' instance for 'RTSFlags' is accurate.+prop_showRTSFlags :: Int -> Property+prop_showRTSFlags p = ioProperty $ do+ rtsflags <- getRTSFlags+ pure $ prop_matchesShow p rtsflags++-- | Verifies that the 'Show' instance for 'GCFlags' is accurate.+prop_showGCFlags :: Int -> Property+prop_showGCFlags p = ioProperty $ do+ gcflags <- getGCFlags+ pure $ prop_matchesShow p gcflags++-- | Verifies that the 'Show' instance for 'CCFlags' is accurate.+prop_showCCFlags :: Int -> Property+prop_showCCFlags p = ioProperty $ do+ ccflags <- getCCFlags+ pure $ prop_matchesShow p ccflags++-- | Verifies that the 'Show' instance for 'ProfFlags' is accurate.+prop_showProfFlags :: Int -> Property+prop_showProfFlags p = ioProperty $ do+ profflags <- getProfFlags+ pure $ prop_matchesShow p profflags++-- | Verifies that the 'Show' instance for 'TraceFlags' is accurate.+prop_showTraceFlags :: Int -> Property+prop_showTraceFlags p = ioProperty $ do+ traceflags <- getTraceFlags+ pure $ prop_matchesShow p traceflags+#endif++-- | Verifies the 'traceShow' functions for 'String' and 'TS.Text' @Show@ display+-- the same output.+prop_traceShow :: String -> Property+prop_traceShow str = ioProperty $ do+ let handles = [stdout, stderr]+ sRes <- hCapture_ handles $ S.traceShow str (pure ()) *> mapM_ hFlush handles+ tRes <- hCapture_ handles $ T.traceShow str (pure ()) *> mapM_ hFlush handles+ pure $ sRes == tRes+ baseAndFriendsTests :: [TestTree] baseAndFriendsTests = [ testGroup "Text.Show.Text"- [ testProperty "FromStringShow Int instance" (prop_matchesShow :: Int -> FromStringShow Int -> Bool)- , testProperty "FromTextShow Int instance" (prop_matchesShow :: Int -> FromTextShow Int -> Bool)+ [ testProperty "FromStringShow Int instance" (prop_matchesShow :: Int -> FromStringShow Int -> Bool)+ , testProperty "FromStringShow Int: read . show = id" (prop_readShow :: Int -> FromStringShow Int -> Bool)+ , testProperty "FromStringShow Int = Int" $ prop_showEq (FromStringShow :: Int -> FromStringShow Int)+ , testProperty "FromStringShow [Char] instance" (prop_matchesShow :: Int -> FromStringShow [Char] -> Bool)+ , testProperty "FromStringShow [Char]: read . show = id" (prop_readShow :: Int -> FromStringShow [Char] -> Bool)+ , testProperty "FromStringShow [Char] = String" $ prop_showEq (FromStringShow :: String -> FromStringShow [Char])+ , testProperty "FromTextShow Int instance" (prop_matchesShow :: Int -> FromTextShow Int -> Bool)+ , testProperty "FromTextShow Int: read . show = id" (prop_readShow :: Int -> FromTextShow Int -> Bool)+ , testProperty "FromTextShow Int = Int" $ prop_showEq (FromTextShow :: Int -> FromTextShow Int)+ , testProperty "FromTextShow [Char] instance" (prop_matchesShow :: Int -> FromTextShow [Char] -> Bool)+ , testProperty "FromTextShow [Char]: read . show = id" (prop_readShow :: Int -> FromTextShow [Char] -> Bool)+ , testProperty "FromTextShow [Char] = String" $ prop_showEq (FromTextShow :: String -> FromTextShow [Char])+ , testProperty "print behavior" prop_print+ , testProperty "traceShow behavior" prop_traceShow ] , testGroup "Text.Show.Text.Control.Applicative"- [ testProperty "ZipList Int instance" (prop_matchesShow :: Int -> ZipList Int -> Bool)+ [ testProperty "Const Int Int instance" (prop_matchesShow :: Int -> Const Int Int -> Bool)+ , testProperty "ZipList Int instance" (prop_matchesShow :: Int -> ZipList Int -> Bool) ] , testGroup "Text.Show.Text.Control.Concurrent"- [ testProperty "BlockReason instance" (prop_matchesShow :: Int -> BlockReason -> Bool)--- , testProperty "ThreadId instance" (prop_matchesShow :: Int -> ThreadId -> Bool)- , testProperty "ThreadStatus instance" (prop_matchesShow :: Int -> ThreadStatus -> Bool)+ [ testProperty "BlockReason instance" (prop_matchesShow :: Int -> BlockReason -> Bool)+ , testProperty "ThreadId instance" prop_showThreadId+ , testProperty "ThreadStatus instance" (prop_matchesShow :: Int -> ThreadStatus -> Bool) ] , testGroup "Text.Show.Text.Control.Exception"- [ testProperty "SomeException instance" (prop_matchesShow :: Int -> SomeException -> Bool)- , testProperty "IOException instance" (prop_matchesShow :: Int -> IOException -> Bool)- , testProperty "ArithException instance" (prop_matchesShow :: Int -> ArithException -> Bool)- , testProperty "ArrayException instance" (prop_matchesShow :: Int -> ArrayException -> Bool)- , testProperty "AssertionFailed instance" (prop_matchesShow :: Int -> AssertionFailed -> Bool)+ [ testProperty "SomeException instance" (prop_matchesShow :: Int -> SomeException -> Bool)+ , testProperty "IOException instance" (prop_matchesShow :: Int -> IOException -> Bool)+ , testProperty "ArithException instance" (prop_matchesShow :: Int -> ArithException -> Bool)+ , testProperty "ArrayException instance" (prop_matchesShow :: Int -> ArrayException -> Bool)+ , testProperty "AssertionFailed instance" (prop_matchesShow :: Int -> AssertionFailed -> Bool) #if MIN_VERSION_base(4,7,0)- , testProperty "SomeAsyncException instance" (prop_matchesShow :: Int -> SomeAsyncException -> Bool)+ , testProperty "SomeAsyncException instance" (prop_matchesShow :: Int -> SomeAsyncException -> Bool) #endif- , testProperty "AsyncException instance" (prop_matchesShow :: Int -> AsyncException -> Bool)- , testProperty "NonTermination instance" (prop_matchesShow :: Int -> NonTermination -> Bool)- , testProperty "NestedAtomically instance" (prop_matchesShow :: Int -> NestedAtomically -> Bool)- , testProperty "BlockedIndefinitelyOnMVar instance" (prop_matchesShow :: Int -> BlockedIndefinitelyOnMVar -> Bool)- , testProperty "BlockedIndefinitelyOnSTM instance" (prop_matchesShow :: Int -> BlockedIndefinitelyOnSTM -> Bool)+ , testProperty "AsyncException instance" (prop_matchesShow :: Int -> AsyncException -> Bool)+ , testProperty "NonTermination instance" (prop_matchesShow :: Int -> NonTermination -> Bool)+ , testProperty "NestedAtomically instance" (prop_matchesShow :: Int -> NestedAtomically -> Bool)+ , testProperty "BlockedIndefinitelyOnMVar instance" (prop_matchesShow :: Int -> BlockedIndefinitelyOnMVar -> Bool)+ , testProperty "BlockedIndefinitelyOnSTM instance" (prop_matchesShow :: Int -> BlockedIndefinitelyOnSTM -> Bool) #if MIN_VERSION_base(4,8,0)- , testProperty "AllocationLimitExceeded instance" (prop_matchesShow :: Int -> AllocationLimitExceeded -> Bool)+ , testProperty "AllocationLimitExceeded instance" (prop_matchesShow :: Int -> AllocationLimitExceeded -> Bool) #endif- , testProperty "Deadlock instance" (prop_matchesShow :: Int -> Deadlock -> Bool)- , testProperty "NoMethodError instance" (prop_matchesShow :: Int -> NoMethodError -> Bool)- , testProperty "PatternMatchFail instance" (prop_matchesShow :: Int -> PatternMatchFail -> Bool)- , testProperty "RecConError instance" (prop_matchesShow :: Int -> RecConError -> Bool)- , testProperty "RecSelError instance" (prop_matchesShow :: Int -> RecSelError -> Bool)- , testProperty "RecUpdError instance" (prop_matchesShow :: Int -> RecUpdError -> Bool)- , testProperty "ErrorCall instance" (prop_matchesShow :: Int -> ErrorCall -> Bool)- , testProperty "MaskingState instance" (prop_matchesShow :: Int -> MaskingState -> Bool)+ , testProperty "Deadlock instance" (prop_matchesShow :: Int -> Deadlock -> Bool)+ , testProperty "NoMethodError instance" (prop_matchesShow :: Int -> NoMethodError -> Bool)+ , testProperty "PatternMatchFail instance" (prop_matchesShow :: Int -> PatternMatchFail -> Bool)+ , testProperty "RecConError instance" (prop_matchesShow :: Int -> RecConError -> Bool)+ , testProperty "RecSelError instance" (prop_matchesShow :: Int -> RecSelError -> Bool)+ , testProperty "RecUpdError instance" (prop_matchesShow :: Int -> RecUpdError -> Bool)+ , testProperty "ErrorCall instance" (prop_matchesShow :: Int -> ErrorCall -> Bool)+ , testProperty "MaskingState instance" (prop_matchesShow :: Int -> MaskingState -> Bool) ] , testGroup "Text.Show.Text.Control.Monad.ST"- [ testProperty "ST instance" (prop_matchesShow :: Int -> ST Int Int -> Bool)+ [ testProperty "ST instance" (prop_matchesShow :: Int -> ST Int Int -> Bool) ] #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) -- TODO: Figure out why this test diverges on Windows , testGroup "Text.Show.Text.Data.Array"- [ testProperty "Array Int Int instance" (prop_matchesShow :: Int -> Array Int Int -> Bool)+ [ testProperty "Array Int Int instance" (prop_matchesShow :: Int -> Array Int Int -> Bool)+ , testProperty "UArray Int Int instance" (prop_matchesShow :: Int -> UArray Int Int -> Bool) ] #endif , testGroup "Text.Show.Text.Data.Bool"- [ testProperty "Bool instance" (prop_matchesShow :: Int -> Bool -> Bool)+ [ testProperty "Bool instance" (prop_matchesShow :: Int -> Bool -> Bool) ] , testGroup "Text.Show.Text.Data.ByteString"- [ testProperty "strict ByteString instance" (prop_matchesShow :: Int -> BS.ByteString -> Bool)- , testProperty "lazy ByteString instance" (prop_matchesShow :: Int -> BL.ByteString -> Bool)-#if MIN_VERSION_bytestring(0,10,4)- , testProperty "ShortByteString instance" (prop_matchesShow :: Int -> ShortByteString -> Bool)-#endif+ [ testProperty "strict ByteString instance" (prop_matchesShow :: Int -> BS.ByteString -> Bool)+ , testProperty "lazy ByteString instance" (prop_matchesShow :: Int -> BL.ByteString -> Bool)+ , testProperty "ShortByteString instance" (prop_matchesShow :: Int -> ShortByteString -> Bool) ] , testGroup "Text.Show.Text.Data.Char"- [ testProperty "Char instance" (prop_matchesShow :: Int -> Char -> Bool)- , testProperty "GeneralCategory instance" (prop_matchesShow :: Int -> GeneralCategory -> Bool)- , testProperty "LitChar instance" (prop_matchesShow :: Int -> LitChar -> Bool)- , testCase "asciiTab = asciiTabB" $ map fromString asciiTab @=? elems (asciiTabB)+ [ testProperty "Char instance" (prop_matchesShow :: Int -> Char -> Bool)+ , testProperty "GeneralCategory instance" (prop_matchesShow :: Int -> GeneralCategory -> Bool)+ , testCase "asciiTab = asciiTabB" $ map fromString asciiTab @=? elems (asciiTabB) ] , testGroup "Text.Show.Text.Data.Complex"- [ testProperty "Complex Double instance" (prop_matchesShow :: Int -> Complex Double -> Bool)+ [ testProperty "Complex Double instance" (prop_matchesShow :: Int -> Complex Double -> Bool) ] , testGroup "Text.Show.Text.Data.Data"- [ testProperty "Constr instance" (prop_matchesShow :: Int -> Constr -> Bool)- , testProperty "ConstrRep instance" (prop_matchesShow :: Int -> ConstrRep -> Bool)- , testProperty "DataRep instance" (prop_matchesShow :: Int -> DataRep -> Bool)- , testProperty "DataType instance" (prop_matchesShow :: Int -> DataType -> Bool)- , testProperty "Fixity instance" (prop_matchesShow :: Int -> D.Fixity -> Bool)+ [ testProperty "Constr instance" (prop_matchesShow :: Int -> Constr -> Bool)+ , testProperty "ConstrRep instance" (prop_matchesShow :: Int -> ConstrRep -> Bool)+ , testProperty "DataRep instance" (prop_matchesShow :: Int -> DataRep -> Bool)+ , testProperty "DataType instance" (prop_matchesShow :: Int -> DataType -> Bool)+ , testProperty "Fixity instance" (prop_matchesShow :: Int -> D.Fixity -> Bool) ] , testGroup "Text.Show.Text.Data.Dynamic"- [ testProperty "Dynamic instance" (prop_matchesShow :: Int -> Dynamic -> Bool)+ [ testProperty "Dynamic instance" (prop_matchesShow :: Int -> Dynamic -> Bool) ] , testGroup "Text.Show.Text.Data.Either"- [ testProperty "Either Int Int instance" (prop_matchesShow :: Int -> Either Int Int -> Bool)+ [ testProperty "Either Int Int instance" (prop_matchesShow :: Int -> Either Int Int -> Bool) ] , testGroup "Text.Show.Text.Data.Fixed"- [ testProperty "Fixed E0 instance" (prop_matchesShow :: Int -> Fixed E0 -> Bool)- , testProperty "Fixed E1 instance" (prop_matchesShow :: Int -> Fixed E1 -> Bool)- , testProperty "Fixed E2 instance" (prop_matchesShow :: Int -> Fixed E2 -> Bool)- , testProperty "Fixed E3 instance" (prop_matchesShow :: Int -> Fixed E3 -> Bool)- , testProperty "Fixed E6 instance" (prop_matchesShow :: Int -> Fixed E6 -> Bool)- , testProperty "Fixed E9 instance" (prop_matchesShow :: Int -> Fixed E9 -> Bool)- , testProperty "Fixed E12 instance" (prop_matchesShow :: Int -> Fixed E12 -> Bool)- , testProperty "showFixed output" prop_showFixed+ [ testProperty "Fixed E0 instance" (prop_matchesShow :: Int -> Fixed E0 -> Bool)+ , testProperty "Fixed E1 instance" (prop_matchesShow :: Int -> Fixed E1 -> Bool)+ , testProperty "Fixed E2 instance" (prop_matchesShow :: Int -> Fixed E2 -> Bool)+ , testProperty "Fixed E3 instance" (prop_matchesShow :: Int -> Fixed E3 -> Bool)+ , testProperty "Fixed E6 instance" (prop_matchesShow :: Int -> Fixed E6 -> Bool)+ , testProperty "Fixed E9 instance" (prop_matchesShow :: Int -> Fixed E9 -> Bool)+ , testProperty "Fixed E12 instance" (prop_matchesShow :: Int -> Fixed E12 -> Bool)+ , testProperty "showFixed output" prop_showFixed ] , testGroup "Text.Show.Text.Data.Floating"- [ testProperty "Float instance" (prop_matchesShow :: Int -> Float -> Bool)- , testProperty "Double instance" (prop_matchesShow :: Int -> Double -> Bool)- , testProperty "showbEFloat output" $ prop_showXFloat showEFloat showbEFloat- , testProperty "showbFFloat output" $ prop_showXFloat showFFloat showbFFloat- , testProperty "showbGFloat output" $ prop_showXFloat showGFloat showbGFloat+ [ testProperty "Float instance" (prop_matchesShow :: Int -> Float -> Bool)+ , testProperty "Double instance" (prop_matchesShow :: Int -> Double -> Bool)+ , testProperty "showbEFloat output" $ prop_showXFloat showEFloat showbEFloat+ , testProperty "showbFFloat output" $ prop_showXFloat showFFloat showbFFloat+ , testProperty "showbGFloat output" $ prop_showXFloat showGFloat showbGFloat #if MIN_VERSION_base(4,7,0)- , testProperty "showbFFloatAlt output" $ prop_showXFloat showFFloatAlt showbFFloatAlt- , testProperty "showbGFloatAlt output" $ prop_showXFloat showGFloatAlt showbGFloatAlt+ , testProperty "showbFFloatAlt output" $ prop_showXFloat showFFloatAlt showbFFloatAlt+ , testProperty "showbGFloatAlt output" $ prop_showXFloat showGFloatAlt showbGFloatAlt #endif ] , testGroup "Text.Show.Text.Data.Functions"- [ testProperty "Int -> Int instance" (prop_matchesShow :: Int -> (Int -> Int) -> Bool)+ [ testProperty "Int -> Int instance" (prop_matchesShow :: Int -> (Int -> Int) -> Bool) ] , testGroup "Text.Show.Text.Data.Functor.Identity"- [ testProperty "Identity Int instance" (prop_matchesShow :: Int -> Identity Int -> Bool)+ [ testProperty "Identity Int instance" (prop_matchesShow :: Int -> Identity Int -> Bool) ] , testGroup "Text.Show.Text.Data.Integral"- [ testProperty "Int instance" (prop_matchesShow :: Int -> Int -> Bool)- , testProperty "Int8 instance" (prop_matchesShow :: Int -> Int8 -> Bool)- , testProperty "Int16 instance" (prop_matchesShow :: Int -> Int16 -> Bool)- , testProperty "Int32 instance" (prop_matchesShow :: Int -> Int32 -> Bool)- , testProperty "Int64 instance" (prop_matchesShow :: Int -> Int64 -> Bool)- , testProperty "Integer instance" (prop_matchesShow :: Int -> Integer -> Bool)- , testProperty "Word instance" (prop_matchesShow :: Int -> Word -> Bool)- , testProperty "Word8 instance" (prop_matchesShow :: Int -> Word8 -> Bool)- , testProperty "Word16 instance" (prop_matchesShow :: Int -> Word16 -> Bool)- , testProperty "Word32 instance" (prop_matchesShow :: Int -> Word32 -> Bool)- , testProperty "Word64 instance" (prop_matchesShow :: Int -> Word64 -> Bool)+ [ testProperty "Int instance" (prop_matchesShow :: Int -> Int -> Bool)+ , testProperty "Int8 instance" (prop_matchesShow :: Int -> Int8 -> Bool)+ , testProperty "Int16 instance" (prop_matchesShow :: Int -> Int16 -> Bool)+ , testProperty "Int32 instance" (prop_matchesShow :: Int -> Int32 -> Bool)+ , testProperty "Int64 instance" (prop_matchesShow :: Int -> Int64 -> Bool)+ , testProperty "Integer instance" (prop_matchesShow :: Int -> Integer -> Bool)+ , testProperty "Word instance" (prop_matchesShow :: Int -> Word -> Bool)+ , testProperty "Word8 instance" (prop_matchesShow :: Int -> Word8 -> Bool)+ , testProperty "Word16 instance" (prop_matchesShow :: Int -> Word16 -> Bool)+ , testProperty "Word32 instance" (prop_matchesShow :: Int -> Word32 -> Bool)+ , testProperty "Word64 instance" (prop_matchesShow :: Int -> Word64 -> Bool) #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) -- TODO: Figure out why this diverges on Windows- , testProperty "showbIntAtBase output" prop_showIntAtBase+ , testProperty "showbIntAtBase output" prop_showIntAtBase #endif ] , testGroup "Text.Show.Text.Data.List"- [ testProperty "String instance" (prop_matchesShow :: Int -> String -> Bool)- , testProperty "[String] instance" (prop_matchesShow :: Int -> [String] -> Bool)- , testProperty "[Int] instance" (prop_matchesShow :: Int -> [Int] -> Bool)- , testProperty "[LitChar] instance" (prop_matchesShow :: Int -> [LitChar] -> Bool)- , testProperty "LitString instance" (prop_matchesShow :: Int -> LitString -> Bool)- , testProperty "[LitString] instance" (prop_matchesShow :: Int -> [LitString] -> Bool)- , testProperty "showbListDefault output" prop_showListDefault+ [ testProperty "String instance" (prop_matchesShow :: Int -> String -> Bool)+ , testProperty "[String] instance" (prop_matchesShow :: Int -> [String] -> Bool)+ , testProperty "[Int] instance" (prop_matchesShow :: Int -> [Int] -> Bool)+ , testProperty "showbListWith output" prop_showListWith ] , testGroup "Text.Show.Text.Data.Maybe"- [ testProperty "Maybe Int instance" (prop_matchesShow :: Int -> Maybe Int -> Bool)+ [ testProperty "Maybe Int instance" (prop_matchesShow :: Int -> Maybe Int -> Bool) ] , testGroup "Text.Show.Text.Data.Monoid"- [ testProperty "All instance" (prop_matchesShow :: Int -> All -> Bool)- , testProperty "Any instance" (prop_matchesShow :: Int -> Any -> Bool)- , testProperty "Dual Int instance" (prop_matchesShow :: Int -> Dual Int -> Bool)- , testProperty "First (Maybe Int) instance" (prop_matchesShow :: Int -> First (Maybe Int) -> Bool)- , testProperty "Last (Maybe Int) instance" (prop_matchesShow :: Int -> Last (Maybe Int) -> Bool)- , testProperty "Product Int instance" (prop_matchesShow :: Int -> Product Int -> Bool)- , testProperty "Sum Int instance" (prop_matchesShow :: Int -> Sum Int -> Bool)+ [ testProperty "All instance" (prop_matchesShow :: Int -> All -> Bool)+ , testProperty "Any instance" (prop_matchesShow :: Int -> Any -> Bool)+ , testProperty "Dual Int instance" (prop_matchesShow :: Int -> Dual Int -> Bool)+ , testProperty "First (Maybe Int) instance" (prop_matchesShow :: Int -> First (Maybe Int) -> Bool)+ , testProperty "Last (Maybe Int) instance" (prop_matchesShow :: Int -> Last (Maybe Int) -> Bool)+ , testProperty "Product Int instance" (prop_matchesShow :: Int -> Product Int -> Bool)+ , testProperty "Sum Int instance" (prop_matchesShow :: Int -> Sum Int -> Bool) #if MIN_VERSION_base(4,8,0)- , testProperty "Alt Maybe Int instance" (prop_matchesShow :: Int -> Alt Maybe Int -> Bool)+ , testProperty "Alt Maybe Int instance" (prop_matchesShow :: Int -> Alt Maybe Int -> Bool) #endif ] #if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) , testGroup "Text.Show.Text.Data.OldTypeable"- [ testProperty "TypeRep instance" (prop_matchesShow :: Int -> OldT.TypeRep -> Bool)- , testProperty "TyCon instance" (prop_matchesShow :: Int -> OldT.TyCon -> Bool)+ [ testProperty "TypeRep instance" (prop_matchesShow :: Int -> OldT.TypeRep -> Bool)+ , testProperty "TyCon instance" (prop_matchesShow :: Int -> OldT.TyCon -> Bool) ] #endif , testGroup "Text.Show.Text.Data.Ord"- [ testProperty "Ordering instance" (prop_matchesShow :: Int -> Ordering -> Bool)+ [ testProperty "Ordering instance" (prop_matchesShow :: Int -> Ordering -> Bool) #if MIN_VERSION_base(4,6,0)- , testProperty "Down Int instance" (prop_matchesShow :: Int -> Down Int -> Bool)+ , testProperty "Down Int instance" (prop_matchesShow :: Int -> Down Int -> Bool) #endif ] , testGroup "Text.Show.Text.Data.Proxy"- [ testProperty "Proxy Int instance" (prop_matchesShow :: Int -> Proxy Int -> Bool)+ [ testProperty "Proxy Int instance" (prop_matchesShow :: Int -> Proxy Int -> Bool) ] , testGroup "Text.Show.Text.Data.Ratio"- [ testProperty "Ratio Int instance" (prop_matchesShow :: Int -> Ratio Int -> Bool)+ [ testProperty "Ratio Int instance" (prop_matchesShow :: Int -> Ratio Int -> Bool) ] , testGroup "Text.Show.Text.Data.Text"- [ testProperty "Builder instance" (prop_matchesShow :: Int -> Builder -> Bool)- , testProperty "strict Text instance" (prop_matchesShow :: Int -> TS.Text -> Bool)- , testProperty "lazy Text instance" (prop_matchesShow :: Int -> TL.Text -> Bool)+ [ testProperty "Builder instance" (prop_matchesShow :: Int -> Builder -> Bool)+ , testProperty "strict Text instance" (prop_matchesShow :: Int -> TS.Text -> Bool)+ , testProperty "lazy Text instance" (prop_matchesShow :: Int -> TL.Text -> Bool) ] , testGroup "Text.Show.Text.Data.Tuple"- [ testProperty "() instance" (prop_matchesShow :: Int -> () -> Bool)- , testProperty "(Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int) -> Bool)- , testProperty "(Int, Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int, Int) -> Bool)- , testProperty "(Int, Int, Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int, Int, Int) -> Bool)- , testProperty "(Int, Int, Int, Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int, Int, Int, Int) -> Bool)- , testProperty "() generic show" (prop_genericShow :: Int -> () -> Bool)- , testProperty "(Int, Int) generic show" (prop_genericShow :: Int -> (Int, Int) -> Bool)- , testProperty "(Int, Int, Int) generic show" (prop_genericShow :: Int -> (Int, Int, Int) -> Bool)- , testProperty "(Int, Int, Int, Int) generic show" (prop_genericShow :: Int -> (Int, Int, Int, Int) -> Bool)- , testProperty "(Int, Int, Int, Int, Int) generic show" (prop_genericShow :: Int -> (Int, Int, Int, Int, Int) -> Bool)+ [ testProperty "() instance" (prop_matchesShow :: Int -> () -> Bool)+ , testProperty "(Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int) -> Bool)+ , testProperty "(Int, Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int, Int) -> Bool)+ , testProperty "(Int, Int, Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int, Int, Int) -> Bool)+ , testProperty "(Int, Int, Int, Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int, Int, Int, Int) -> Bool)+ , testProperty "() generic show" (prop_genericShow :: Int -> () -> Bool)+ , testProperty "(Int, Int) generic show" (prop_genericShow :: Int -> (Int, Int) -> Bool)+ , testProperty "(Int, Int, Int) generic show" (prop_genericShow :: Int -> (Int, Int, Int) -> Bool)+ , testProperty "(Int, Int, Int, Int) generic show" (prop_genericShow :: Int -> (Int, Int, Int, Int) -> Bool)+ , testProperty "(Int, Int, Int, Int, Int) generic show" (prop_genericShow :: Int -> (Int, Int, Int, Int, Int) -> Bool) ] #if MIN_VERSION_base(4,7,0) , testGroup "Text.Show.Text.Data.Type.Coercion"- [ testProperty "Coercion instance" (prop_matchesShow :: Int -> Coercion All Bool -> Bool)+ [ testProperty "Coercion instance" (prop_matchesShow :: Int -> Coercion All Bool -> Bool) ] , testGroup "Text.Show.Text.Data.Type.Equality"- [ testProperty "(:~:) instance" (prop_matchesShow :: Int -> Int :~: Int -> Bool)+ [ testProperty "(:~:) instance" (prop_matchesShow :: Int -> Int :~: Int -> Bool) ] #endif , testGroup "Text.Show.Text.Data.Typeable"- [ testProperty "TypeRep instance" (prop_matchesShow :: Int -> NewT.TypeRep -> Bool)- , testProperty "TyCon instance" (prop_matchesShow :: Int -> NewT.TyCon -> Bool)+ [ testProperty "TypeRep instance" (prop_matchesShow :: Int -> NewT.TypeRep -> Bool)+ , testProperty "TyCon instance" (prop_matchesShow :: Int -> NewT.TyCon -> Bool) ] , testGroup "Text.Show.Text.Data.Version"- [ testProperty "Version instance" (prop_matchesShow :: Int -> Version -> Bool)- , testProperty "showbVersionConcrete output" prop_showVersion+ [ testProperty "Version instance" (prop_matchesShow :: Int -> Version -> Bool)+ , testProperty "showbVersionConcrete output" prop_showVersion ] , testGroup "Text.Show.Text.Foreign.C.Types"- [ testProperty "CChar" (prop_matchesShow :: Int -> CChar -> Bool)- , testProperty "CSChar instance" (prop_matchesShow :: Int -> CSChar -> Bool)- , testProperty "CUChar instance" (prop_matchesShow :: Int -> CUChar -> Bool)- , testProperty "CShort instance" (prop_matchesShow :: Int -> CShort -> Bool)- , testProperty "CUShort instance" (prop_matchesShow :: Int -> CUShort -> Bool)- , testProperty "CInt instance" (prop_matchesShow :: Int -> CInt -> Bool)- , testProperty "CUInt instance" (prop_matchesShow :: Int -> CUInt -> Bool)- , testProperty "CLong instance" (prop_matchesShow :: Int -> CLong -> Bool)- , testProperty "CULong instance" (prop_matchesShow :: Int -> CULong -> Bool)- , testProperty "CPtrdiff instance" (prop_matchesShow :: Int -> CPtrdiff -> Bool)- , testProperty "CSize instance" (prop_matchesShow :: Int -> CSize -> Bool)- , testProperty "CWchar instance" (prop_matchesShow :: Int -> CWchar -> Bool)- , testProperty "CSigAtomic instance" (prop_matchesShow :: Int -> CSigAtomic -> Bool)- , testProperty "CLLong instance" (prop_matchesShow :: Int -> CLLong -> Bool)- , testProperty "CULLong instance" (prop_matchesShow :: Int -> CULLong -> Bool)- , testProperty "CIntPtr instance" (prop_matchesShow :: Int -> CIntPtr -> Bool)- , testProperty "CUIntPtr instance" (prop_matchesShow :: Int -> CUIntPtr -> Bool)- , testProperty "CIntMax instance" (prop_matchesShow :: Int -> CIntMax -> Bool)- , testProperty "CUIntPtr instance" (prop_matchesShow :: Int -> CUIntPtr -> Bool)- , testProperty "CIntMax instance" (prop_matchesShow :: Int -> CIntMax -> Bool)- , testProperty "CUIntMax instance" (prop_matchesShow :: Int -> CUIntMax -> Bool)- , testProperty "CClock instance" (prop_matchesShow :: Int -> CClock -> Bool)- , testProperty "CTime instance" (prop_matchesShow :: Int -> CTime -> Bool)- , testProperty "CUSeconds instance" (prop_matchesShow :: Int -> CUSeconds -> Bool)- , testProperty "CSUSeconds instance" (prop_matchesShow :: Int -> CSUSeconds -> Bool)- , testProperty "CFloat instance" (prop_matchesShow :: Int -> CFloat -> Bool)- , testProperty "CDouble instance" (prop_matchesShow :: Int -> CUChar -> Bool)+ [ testProperty "CChar" (prop_matchesShow :: Int -> CChar -> Bool)+ , testProperty "CSChar instance" (prop_matchesShow :: Int -> CSChar -> Bool)+ , testProperty "CUChar instance" (prop_matchesShow :: Int -> CUChar -> Bool)+ , testProperty "CShort instance" (prop_matchesShow :: Int -> CShort -> Bool)+ , testProperty "CUShort instance" (prop_matchesShow :: Int -> CUShort -> Bool)+ , testProperty "CInt instance" (prop_matchesShow :: Int -> CInt -> Bool)+ , testProperty "CUInt instance" (prop_matchesShow :: Int -> CUInt -> Bool)+ , testProperty "CLong instance" (prop_matchesShow :: Int -> CLong -> Bool)+ , testProperty "CULong instance" (prop_matchesShow :: Int -> CULong -> Bool)+ , testProperty "CPtrdiff instance" (prop_matchesShow :: Int -> CPtrdiff -> Bool)+ , testProperty "CSize instance" (prop_matchesShow :: Int -> CSize -> Bool)+ , testProperty "CWchar instance" (prop_matchesShow :: Int -> CWchar -> Bool)+ , testProperty "CSigAtomic instance" (prop_matchesShow :: Int -> CSigAtomic -> Bool)+ , testProperty "CLLong instance" (prop_matchesShow :: Int -> CLLong -> Bool)+ , testProperty "CULLong instance" (prop_matchesShow :: Int -> CULLong -> Bool)+ , testProperty "CIntPtr instance" (prop_matchesShow :: Int -> CIntPtr -> Bool)+ , testProperty "CUIntPtr instance" (prop_matchesShow :: Int -> CUIntPtr -> Bool)+ , testProperty "CIntMax instance" (prop_matchesShow :: Int -> CIntMax -> Bool)+ , testProperty "CUIntPtr instance" (prop_matchesShow :: Int -> CUIntPtr -> Bool)+ , testProperty "CIntMax instance" (prop_matchesShow :: Int -> CIntMax -> Bool)+ , testProperty "CUIntMax instance" (prop_matchesShow :: Int -> CUIntMax -> Bool)+ , testProperty "CClock instance" (prop_matchesShow :: Int -> CClock -> Bool)+ , testProperty "CTime instance" (prop_matchesShow :: Int -> CTime -> Bool)+ , testProperty "CUSeconds instance" (prop_matchesShow :: Int -> CUSeconds -> Bool)+ , testProperty "CSUSeconds instance" (prop_matchesShow :: Int -> CSUSeconds -> Bool)+ , testProperty "CFloat instance" (prop_matchesShow :: Int -> CFloat -> Bool)+ , testProperty "CDouble instance" (prop_matchesShow :: Int -> CUChar -> Bool) ] , testGroup "Text.Show.Text.Foreign.Ptr"- [ testProperty "Ptr Int instance" (prop_matchesShow :: Int -> Ptr Int -> Bool)- , testProperty "FunPtr Int instance" (prop_matchesShow :: Int -> FunPtr Int -> Bool)- , testProperty "IntPtr instance" (prop_matchesShow :: Int -> IntPtr -> Bool)- , testProperty "WordPtr instance" (prop_matchesShow :: Int -> WordPtr -> Bool)--- , testProperty "ForeignPtr instance" (prop_matchesShow :: Int -> ForeignPtr Int -> Bool)+ [ testProperty "Ptr Int instance" (prop_matchesShow :: Int -> Ptr Int -> Bool)+ , testProperty "FunPtr Int instance" (prop_matchesShow :: Int -> FunPtr Int -> Bool)+ , testProperty "IntPtr instance" (prop_matchesShow :: Int -> IntPtr -> Bool)+ , testProperty "WordPtr instance" (prop_matchesShow :: Int -> WordPtr -> Bool)+ , testProperty "ForeignPtr instance" prop_showForeignPtr ]--- #if !defined(mingw32_HOST_OS)--- , testGroup "Text.Show.Text.GHC.Event"--- [ testProperty "Event instance" (prop_matchesShow :: Int -> Event -> Bool)--- , testProperty "FdKey instance" (prop_matchesShow :: Int -> FdKey -> Bool)--- ]--- #endif+#if !(defined(mingw32_HOST_OS) || defined(__GHCJS__))+ , testGroup "Text.Show.Text.GHC.Event"+ [ testProperty "Event instance" (prop_matchesShow :: Int -> Event -> Bool)+-- , testProperty "FdKey instance" (prop_matchesShow :: Int -> FdKey -> Bool)+ ]+#endif , testGroup "Text.Show.Text.Generic"- [ testProperty "ConType instance" (prop_matchesShow :: Int -> ConType -> Bool)- , testProperty "ConType generic show" (prop_genericShow :: Int -> ConType -> Bool)+ [ testProperty "ConType instance" (prop_matchesShow :: Int -> ConType -> Bool)+ , testProperty "ConType generic show" (prop_genericShow :: Int -> ConType -> Bool) ]-#if defined(mingw32_HOST_OS)+#if defined(mingw32_HOST_OS) && !(defined(__GHCJS__)) , testGroup "Text.Show.Text.GHC.Conc.Windows"- [ testProperty "ConsoleEvent instance" (prop_matchesShow :: Int -> ConsoleEvent -> Bool)+ [ testProperty "ConsoleEvent instance" (prop_matchesShow :: Int -> ConsoleEvent -> Bool) ] #endif , testGroup "Text.Show.Text.GHC.Fingerprint"- [ testProperty "Fingerprint instance" (prop_matchesShow :: Int -> Fingerprint -> Bool)+ [ testProperty "Fingerprint instance" (prop_matchesShow :: Int -> Fingerprint -> Bool) ] , testGroup "Text.Show.Text.GHC.Generics"- [ testProperty "U1 Int instance" (prop_matchesShow :: Int -> U1 Int -> Bool)- , testProperty "Par1 Int instance" (prop_matchesShow :: Int -> Par1 Int -> Bool)- , testProperty "Rec1 Maybe Int instance" (prop_matchesShow :: Int -> Rec1 Maybe Int -> Bool)- , testProperty "K1 () Int () instance" (prop_matchesShow :: Int -> K1 () Int () -> Bool)- , testProperty "M1 () () Maybe Int instance" (prop_matchesShow :: Int -> M1 () () Maybe Int -> Bool)- , testProperty "(Maybe :+: Maybe) Int instance" (prop_matchesShow :: Int -> (Maybe :+: Maybe) Int -> Bool)- , testProperty "(Maybe :*: Maybe) Int instance" (prop_matchesShow :: Int -> (Maybe :*: Maybe) Int -> Bool)- , testProperty "(Maybe :.: Maybe) Int instance" (prop_matchesShow :: Int -> (Maybe :.: Maybe) Int -> Bool)- , testProperty "Fixity instance" (prop_matchesShow :: Int -> G.Fixity -> Bool)- , testProperty "Associativity instance" (prop_matchesShow :: Int -> Associativity -> Bool)- , testProperty "Arity instance" (prop_matchesShow :: Int -> Arity -> Bool)+ [ testProperty "U1 Int instance" (prop_matchesShow :: Int -> U1 Int -> Bool)+ , testProperty "Par1 Int instance" (prop_matchesShow :: Int -> Par1 Int -> Bool)+ , testProperty "Rec1 Maybe Int instance" (prop_matchesShow :: Int -> Rec1 Maybe Int -> Bool)+ , testProperty "K1 () Int () instance" (prop_matchesShow :: Int -> K1 () Int () -> Bool)+ , testProperty "M1 () () Maybe Int instance" (prop_matchesShow :: Int -> M1 () () Maybe Int -> Bool)+ , testProperty "(Maybe :+: Maybe) Int instance" (prop_matchesShow :: Int -> (Maybe :+: Maybe) Int -> Bool)+ , testProperty "(Maybe :*: Maybe) Int instance" (prop_matchesShow :: Int -> (Maybe :*: Maybe) Int -> Bool)+ , testProperty "(Maybe :.: Maybe) Int instance" (prop_matchesShow :: Int -> (Maybe :.: Maybe) Int -> Bool)+ , testProperty "Fixity instance" (prop_matchesShow :: Int -> G.Fixity -> Bool)+ , testProperty "Associativity instance" (prop_matchesShow :: Int -> Associativity -> Bool)+ , testProperty "Arity instance" (prop_matchesShow :: Int -> Arity -> Bool) ] #if MIN_VERSION_base(4,8,0) , testGroup "Text.Show.Text.GHC.RTS.Flags"- [ -- testProperty "RTSFlags instance" (prop_matchesShow :: Int -> RTSFlags -> Bool)--- , testProperty "GCFlags instance" (prop_matchesShow :: Int -> GCFlags -> Bool)- testProperty "ConcFlags instance" (prop_matchesShow :: Int -> ConcFlags -> Bool)- , testProperty "MiscFlags instance" (prop_matchesShow :: Int -> MiscFlags -> Bool)- , testProperty "DebugFlags instance" (prop_matchesShow :: Int -> DebugFlags -> Bool)--- , testProperty "CCFlags instance" (prop_matchesShow :: Int -> CCFlags -> Bool)--- , testProperty "ProfFlags instance" (prop_matchesShow :: Int -> ProfFlags -> Bool)--- , testProperty "TraceFlags instance" (prop_matchesShow :: Int -> TraceFlags -> Bool)- , testProperty "TickyFlags instance" (prop_matchesShow :: Int -> TickyFlags -> Bool)+ [ testProperty "RTSFlags instance" prop_showRTSFlags+ , testProperty "GCFlags instance" prop_showGCFlags+ , testProperty "ConcFlags instance" (prop_matchesShow :: Int -> ConcFlags -> Bool)+ , testProperty "MiscFlags instance" (prop_matchesShow :: Int -> MiscFlags -> Bool)+ , testProperty "DebugFlags instance" (prop_matchesShow :: Int -> DebugFlags -> Bool)+ , testProperty "CCFlags instance" prop_showCCFlags+ , testProperty "ProfFlags instance" prop_showProfFlags+ , testProperty "TraceFlags instance" prop_showTraceFlags+ , testProperty "TickyFlags instance" (prop_matchesShow :: Int -> TickyFlags -> Bool) ] , testGroup "Text.Show.Text.GHC.StaticPtr"- [ testProperty "StaticPtrInfo instance" (prop_matchesShow :: Int -> StaticPtrInfo -> Bool)+ [ testProperty "StaticPtrInfo instance" (prop_matchesShow :: Int -> StaticPtrInfo -> Bool) ] #endif , testGroup "Text.Show.Text.GHC.Stats"- [ testProperty "GCStats instance" (prop_matchesShow :: Int -> GCStats -> Bool)+ [ testProperty "GCStats instance" (prop_matchesShow :: Int -> GCStats -> Bool) ] #if MIN_VERSION_base(4,6,0) , testGroup "Text.Show.Text.GHC.TypeLits" [ # if MIN_VERSION_base(4,7,0)- testProperty "SomeNat instance" (prop_matchesShow :: Int -> SomeNat -> Bool)- , testProperty "SomeSymbol instance" (prop_matchesShow :: Int -> SomeSymbol -> Bool)+ testProperty "SomeNat instance" (prop_matchesShow :: Int -> SomeNat -> Bool)+ , testProperty "SomeSymbol instance" (prop_matchesShow :: Int -> SomeSymbol -> Bool) -- # else--- testProperty "IsEven instance" (prop_matchesShow :: Int -> IsEven -> Bool)--- , testProperty "IsZero instance" (prop_matchesShow :: Int -> IsZero -> Bool)+-- testProperty "IsEven instance" (prop_matchesShow :: Int -> IsEven -> Bool)+-- , testProperty "IsZero instance" (prop_matchesShow :: Int -> IsZero -> Bool) # endif ] #endif , testGroup "Text.Show.Text.Numeric.Natural"- [ testProperty "Natural instance" (prop_matchesShow :: Int -> Natural -> Bool)+ [ testProperty "Natural instance" (prop_matchesShow :: Int -> Natural -> Bool) ] , testGroup "Text.Show.Text.System.Exit"- [ testProperty "ExitCode instance" (prop_matchesShow :: Int -> ExitCode -> Bool)+ [ testProperty "ExitCode instance" (prop_matchesShow :: Int -> ExitCode -> Bool) ] , testGroup "Text.Show.Text.System.IO"- [ testProperty "Handle instance" (prop_matchesShow :: Int -> Handle -> Bool)- , testProperty "IOMode instance" (prop_matchesShow :: Int -> IOMode -> Bool)- , testProperty "BufferMode instance" (prop_matchesShow :: Int -> BufferMode -> Bool)--- , testProperty "HandlePosn instance" (prop_matchesShow :: Int -> HandlePosn -> Bool)- , testProperty "SeekMode instance" (prop_matchesShow :: Int -> SeekMode -> Bool)--- , testProperty "TextEncoding" (prop_matchesShow :: Int -> TextEncoding -> Bool)- , testProperty "CodingProgress instance" (prop_matchesShow :: Int -> CodingProgress -> Bool)- , testProperty "CodingFailureMode instance" (prop_matchesShow :: Int -> CodingFailureMode -> Bool)- , testProperty "Newline instance" (prop_matchesShow :: Int -> Newline -> Bool)- , testProperty "NewlineMode instance" (prop_matchesShow :: Int -> NewlineMode -> Bool)+ [ testProperty "Handle instance" (prop_matchesShow :: Int -> Handle -> Bool)+ , testProperty "IOMode instance" (prop_matchesShow :: Int -> IOMode -> Bool)+ , testProperty "BufferMode instance" (prop_matchesShow :: Int -> BufferMode -> Bool)+ , testProperty "HandlePosn instance" (prop_matchesShow :: Int -> HandlePosn -> Bool)+ , testProperty "SeekMode instance" (prop_matchesShow :: Int -> SeekMode -> Bool)+ , testProperty "TextEncoding" prop_showTextEncoding+ , testProperty "CodingProgress instance" (prop_matchesShow :: Int -> CodingProgress -> Bool)+ , testProperty "CodingFailureMode instance" (prop_matchesShow :: Int -> CodingFailureMode -> Bool)+ , testProperty "Newline instance" (prop_matchesShow :: Int -> Newline -> Bool)+ , testProperty "NewlineMode instance" (prop_matchesShow :: Int -> NewlineMode -> Bool) ] , testGroup "Text.Show.Text.System.Posix.Types" [ #if defined(HTYPE_DEV_T)- testProperty "CDev instance" (prop_matchesShow :: Int -> CDev -> Bool)+ testProperty "CDev instance" (prop_matchesShow :: Int -> CDev -> Bool) #endif #if defined(HTYPE_INO_T)- , testProperty "CIno instance" (prop_matchesShow :: Int -> CIno -> Bool)+ , testProperty "CIno instance" (prop_matchesShow :: Int -> CIno -> Bool) #endif #if defined(HTYPE_MODE_T)- , testProperty "CMode instance" (prop_matchesShow :: Int -> CMode -> Bool)+ , testProperty "CMode instance" (prop_matchesShow :: Int -> CMode -> Bool) #endif #if defined(HTYPE_OFF_T)- , testProperty "COff instance" (prop_matchesShow :: Int -> COff -> Bool)+ , testProperty "COff instance" (prop_matchesShow :: Int -> COff -> Bool) #endif #if defined(HTYPE_PID_T)- , testProperty "CPid instance" (prop_matchesShow :: Int -> CPid -> Bool)+ , testProperty "CPid instance" (prop_matchesShow :: Int -> CPid -> Bool) #endif #if defined(HTYPE_SSIZE_T)- , testProperty "CSsize instance" (prop_matchesShow :: Int -> CSsize -> Bool)+ , testProperty "CSsize instance" (prop_matchesShow :: Int -> CSsize -> Bool) #endif #if defined(HTYPE_GID_T)- , testProperty "CGid instance" (prop_matchesShow :: Int -> CGid -> Bool)+ , testProperty "CGid instance" (prop_matchesShow :: Int -> CGid -> Bool) #endif #if defined(HTYPE_NLINK_T)- , testProperty "CNlink instance" (prop_matchesShow :: Int -> CNlink -> Bool)+ , testProperty "CNlink instance" (prop_matchesShow :: Int -> CNlink -> Bool) #endif #if defined(HTYPE_UID_T)- , testProperty "CUid instance" (prop_matchesShow :: Int -> CUid -> Bool)+ , testProperty "CUid instance" (prop_matchesShow :: Int -> CUid -> Bool) #endif #if defined(HTYPE_CC_T)- , testProperty "CCc instance" (prop_matchesShow :: Int -> CCc -> Bool)+ , testProperty "CCc instance" (prop_matchesShow :: Int -> CCc -> Bool) #endif #if defined(HTYPE_SPEED_T)- , testProperty "CSpeed instance" (prop_matchesShow :: Int -> CSpeed -> Bool)+ , testProperty "CSpeed instance" (prop_matchesShow :: Int -> CSpeed -> Bool) #endif #if defined(HTYPE_TCFLAG_T)- , testProperty "CTcflag instance" (prop_matchesShow :: Int -> CTcflag -> Bool)+ , testProperty "CTcflag instance" (prop_matchesShow :: Int -> CTcflag -> Bool) #endif #if defined(HTYPE_RLIM_T)- , testProperty "CRLim instance" (prop_matchesShow :: Int -> CRLim -> Bool)+ , testProperty "CRLim instance" (prop_matchesShow :: Int -> CRLim -> Bool) #endif- , testProperty "Fd instance" (prop_matchesShow :: Int -> Fd -> Bool)+ , testProperty "Fd instance" (prop_matchesShow :: Int -> Fd -> Bool) ]--- , testGroup "Text.Show.Text.Text.Read.Lex"--- [ testProperty "Lexeme instance" (prop_matchesShow :: Int -> Lexeme -> Bool)--- , testProperty "Number instance" (prop_matchesShow :: Int -> Number -> Bool)--- ]+ , testGroup "Text.Show.Text.Text.Read.Lex"+ [ testProperty "Lexeme instance" (prop_matchesShow :: Int -> Lexeme -> Bool)+#if MIN_VERSION_base(4,7,0)+ , testProperty "Number instance" (prop_matchesShow :: Int -> Number -> Bool)+#endif+ ] ]
tests/Properties/Derived.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, TypeOperators #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeOperators #-} {-| Module: Properties.BaseAndFriends Copyright: (C) 2014-2015 Ryan Scott@@ -42,6 +44,7 @@ , testProperty "GADT Int String Int instance" (prop_matchesShow :: Int -> GADT Int String Int -> Bool) , testProperty "GADT Ordering Int Int instance" (prop_matchesShow :: Int -> GADT Ordering Int Int -> Bool) , testProperty "GADT Int Int Int instance" (prop_matchesShow :: Int -> GADT Int Int Int -> Bool)+ , testProperty "PrimADT# Int instance" (prop_matchesShow :: Int -> PrimADT# Int -> Bool) , testProperty "LeftAssocTree Int instance" (prop_matchesShow :: Int -> LeftAssocTree Int -> Bool) , testProperty "RightAssocTree Int instance" (prop_matchesShow :: Int -> RightAssocTree Int -> Bool) , testProperty "Int :?: Int instance" (prop_matchesShow :: Int -> Int :?: Int -> Bool)@@ -101,7 +104,7 @@ , testProperty "OneDataInstance Int Int Int Int generic show" (prop_genericShow :: Int -> OneDataInstance Int Int Int Int -> Bool) , testProperty "AssocData1 () generic show" (prop_genericShow :: Int -> AssocData1 () -> Bool) , testProperty "AssocData2 () generic show" (prop_genericShow :: Int -> AssocData2 () Int Int -> Bool)-# if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+# if __GLASGOW_HASKELL__ >= 708 , testProperty "NullaryData generic show" (prop_genericShow :: Int -> NullaryData -> Bool) # endif #endif
tests/Properties/MkShow.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, TemplateHaskell #-}+{-# 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.@@ -16,6 +17,12 @@ -} module Properties.MkShow (mkShowTests) 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)@@ -23,49 +30,104 @@ import Instances.Derived () +import Properties.Utils (ioProperty)++import System.IO (hFlush, stdout, stderr)+import System.IO.Silently (capture_, hCapture_)+ import Test.Tasty (TestTree, testGroup)-import Test.Tasty.QuickCheck (Arbitrary, testProperty)+import Test.Tasty.QuickCheck (Property, testProperty) import qualified Text.Show as S (Show) import Text.Show.Text (Builder, FromStringShow(..), showbPrec)-import Text.Show.Text.TH (mkShowbPrec)+import Text.Show.Text.Debug.Trace.TH (mkTraceShow)+import Text.Show.Text.TH (mkPrint, mkShowbPrec) --- | Verifies 'mkShowbPrec' produces the same output as 'showsPrec' does.-prop_mkShowbPrec :: (Arbitrary a, S.Show a)+-- | 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 'mkShowbPrec' produces the same output as 'showsPrec' does.+-- | 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' does.+-- | 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 'mkShowbPrec' produces the same output as 'showsPrec' does.+-- | 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)-#endif --- prop_mkPrint--- prop_trace+-- | 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+ mkShowTests :: [TestTree] mkShowTests = [ testGroup "mkShow and related functions"- [ testProperty "$(mkShowbPrec ''AllAtOnce) (a plain type constructor)" prop_mkShowbPrecTyCon--- , testProperty "$(mkPrint ''AllAtOnce) (a plain type constructor)" prop_mkPrintTyCon+ [ testProperty "$(mkShowbPrec ''AllAtOnce) (a plain type constructor)" prop_mkShowbPrecTyCon+ , testProperty "$(mkPrint ''AllAtOnce) (a plain type constructor)" prop_mkPrintTyCon+ , testProperty "$(mkTraceShow ''AllAtOnce) (a plain type constructor)" prop_mkTraceShowTyCon #if MIN_VERSION_template_haskell(2,7,0)- , testProperty "$(mkShowbPrec ''NotAllShow) (a data family instance constructor)" prop_mkShowbPrecDataFamInstCon--- , testProperty "$(mkPrint ''NotAllShow) (a data family instance constructor)" prop_mkShowDataFamInstCon- , testProperty "$(mkShowbPrec ''OneDataInstance) (a data family name)" prop_mkShowbPrecDataFam--- , testProperty "$(mkPrint ''OneDataInstance) (a data family name)" prop_mkPrintDataFam+ , testProperty "$(mkShowbPrec ''NotAllShow) (a data family instance constructor)" prop_mkShowbPrecDataFamInstCon+ , testProperty "$(mkPrint ''NotAllShow) (a data family instance constructor)" prop_mkPrintDataFamInstCon+ , testProperty "$(mkTraceShow ''NotAllShow) (a data family instance constructor)" prop_mkTraceShowDataFamInstCon+ , testProperty "$(mkShowbPrec ''OneDataInstance) (a data family name)" prop_mkShowbPrecDataFam+ , testProperty "$(mkPrint ''OneDataInstance) (a data family name)" prop_mkPrintDataFam+ , testProperty "$(mkTraceShow ''OneDataInstance) (a data family name)" prop_mkTraceShowDataFam #endif ] ]
tests/Properties/Utils.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-| Module: Properties.Utils@@ -9,36 +10,55 @@ @QuickCheck@ property-related utility functions. -}-module Properties.Utils (prop_matchesShow, prop_genericShow) where+module Properties.Utils (+ ioProperty+ , prop_matchesShow+ , prop_genericShow+ , prop_readShow+ , prop_showEq+ ) where import GHC.Generics (Generic, Rep) -import Prelude hiding (Show(..))+import Prelude hiding (Show) -import Test.Tasty.QuickCheck (Arbitrary)+#if MIN_VERSION_QuickCheck(2,7,0)+import qualified Test.Tasty.QuickCheck as QC (ioProperty)+#else+import Test.Tasty.QuickCheck (morallyDubiousIOProperty)+#endif+import Test.Tasty.QuickCheck (Property, Testable) import qualified Text.Show as S (Show) import qualified Text.Show.Text as T (Show) import Text.Show.Text hiding (Show) import Text.Show.Text.Generic +ioProperty :: Testable prop => IO prop -> Property+#if MIN_VERSION_QuickCheck(2,7,0)+ioProperty = QC.ioProperty+#else+ioProperty = morallyDubiousIOProperty+#endif+ -- | Verifies that a type's @Show@ instances coincide for both 'String's and 'Text', -- irrespective of precedence.-prop_matchesShow :: (S.Show a, T.Show a, Arbitrary a) => Int -> a -> Bool+prop_matchesShow :: (S.Show a, T.Show a) => Int -> a -> Bool prop_matchesShow p x = showbPrec p (FromStringShow x) == showbPrec p x -- | Verifies that a type's @Show@ instance coincides with the output produced -- by the equivalent 'Generic' functions. -- TODO: Add other generic functions -- TODO: Put in tuples-prop_genericShow :: (S.Show a, T.Show a, Arbitrary a, Generic a, GShow (Rep a))+prop_genericShow :: (S.Show a, T.Show a, Generic a, GShow (Rep a)) => Int -> a -> Bool-prop_genericShow p x = show x == genericShow x- && showLazy x == genericShowLazy x- && showPrec p x == genericShowPrec p x- && showPrecLazy p x == genericShowPrecLazy p x- && showList [x] == genericShowList [x]- && showListLazy [x] == genericShowListLazy [x]- && showb x == genericShowb x- && showbPrec p x == genericShowbPrec p x- && showbList [x] == genericShowbList [x]+prop_genericShow p x = showbPrec p x == genericShowbPrec p x++-- | Verifies that @read . show = id@.+prop_readShow :: (Eq a, Read a, S.Show a) => Int -> a -> Bool+prop_readShow p x = read (showsPrec p x "") == x++-- | Verifies that two type's @Show@ instances produce identical output, where the first+-- type is a wrapper around the second type.+prop_showEq :: (T.Show a, T.Show b) => (a -> b) -> Int -> a -> Bool+prop_showEq f p x = showbPrec p (f x) == showbPrec p x
text-show.cabal view
@@ -1,5 +1,5 @@ name: text-show-version: 0.6.0.1+version: 0.7 synopsis: Efficient conversion of values into Text description: @text-show@ offers a replacement for the @Show@ typeclass intended for use with @Text@ instead of @String@s. This package was created@@ -25,11 +25,11 @@ import Prelude hiding (Show(..), print) import Text.Show.Text .- number :: Text- number = show (Just \"Hello, World!\")+ hello :: Text+ hello = show (Just \"Hello, World!\") . main :: IO ()- main = print number+ main = print hello @ . If you desire it, there are also monomorphic versions of the @showb@@@ -53,7 +53,7 @@ category: Text build-type: Simple extra-source-files: CHANGELOG.md, README.md, include/*.h-cabal-version: >=1.8+cabal-version: >=1.10 source-repository head type: git@@ -121,6 +121,7 @@ , text >= 0.8 && < 1.3 , template-haskell >= 2.4 && < 2.11 hs-source-dirs: src+ default-language: Haskell2010 ghc-options: -Wall include-dirs: include includes: inline.h@@ -151,6 +152,8 @@ if impl(ghc < 7.10) exposed-modules: Text.Show.Text.Data.OldTypeable+ else+ build-depends: bytestring-builder if impl(ghc < 7.9) build-depends: nats >= 0.1 && < 2@@ -181,26 +184,30 @@ build-depends: array >= 0.3 && < 0.6 , base >= 4.5 && < 5 , bytestring >= 0.9 && < 0.11+ , ghc-prim+ -- Needed to conditionally import Arbitrary Natural instance+ , QuickCheck >= 2.5 && < 3 , quickcheck-instances >= 0.1 && < 0.4+ , silently >= 1.2.4 && < 1.3 , tasty >= 0.8 && < 0.11 , tasty-hunit >= 0.8 && < 0.10 , tasty-quickcheck >= 0.8 && < 0.9 , text >= 0.8 && < 1.3- , text-show == 0.6.0.1+ , text-show == 0.7 hs-source-dirs: tests+ default-language: Haskell2010 ghc-options: -Wall include-dirs: include includes: overlap.h , utils.h install-includes: overlap.h , utils.h- - -- Prior to GHC 7.6, GHC generics lived in ghc-prim- if impl(ghc >= 7.2) && impl(ghc < 7.6)- build-depends: ghc-prim if impl(ghc < 7.7) build-depends: tagged >= 0.4.4 && < 1++ if impl(ghc < 7.8)+ build-depends: bytestring-builder if impl(ghc < 7.9) build-depends: nats >= 0.1 && < 2