text-show 3.9.7 → 3.10
raw patch · 13 files changed
+648/−339 lines, 13 filesdep ~quickcheck-instances
Dependency ranges changed: quickcheck-instances
Files
- CHANGELOG.md +71/−0
- src/TextShow/Classes.hs +25/−2
- src/TextShow/Data/Array/Byte.hs +61/−0
- src/TextShow/Debug/Trace/Generic.hs +4/−4
- src/TextShow/FromStringTextShow.hs +67/−73
- src/TextShow/Generic.hs +350/−233
- src/TextShow/Instances.hs +1/−0
- tests/Spec/Data/Array/ByteSpec.hs +40/−0
- tests/Spec/Derived/MagicHashSpec.hs +4/−0
- tests/Spec/Derived/RecordsSpec.hs +6/−0
- tests/Spec/FromStringTextShowSpec.hs +2/−12
- tests/Spec/Utils.hs +7/−7
- text-show.cabal +10/−8
CHANGELOG.md view
@@ -1,3 +1,74 @@+## 3.10 [2022.10.05]+* The instances in `TextShow.FromStringTextShow` module have been scaled back+ somewhat for forward compatibility with Core Libraries proposal #10, which+ will add quantified `Show` superclasses to `Show1` and `Show2`:+ * `FromStringShow` and `FromTextShow` no longer have `Show1` or `TextShow1`+ instances. If you want to derive instances of `Show1` or `TextShow1` via+ a newtype, use `FromStringShow1` or `FromTextShow1` instead.+ * The `Show` instances for `FromTextShow1` and `FromTextShow2` have had their+ instance contexts changed to accommodate the new superclasses in `Show1`+ and `Show2`:++ ```diff+ -instance (TextShow1 f, TextShow a) => Show (FromTextShow1 f a)+ +instance (TextShow1 f, Show a) => Show (FromTextShow1 f a)++ -instance (TextShow2 f, TextShow a, TextShow b) => Show (FromTextShow2 f a b)+ +instance (TextShow2 f, Show a, Show b) => Show (FromTextShow2 f a b)+ ```++ While these instances do technically work, they are probably not what you+ would have in mind if you wanted to derive a `Show` instance purely in+ terms of `TextShow` classes. For this reason, if you want to derive an+ instance of `Show` via a newtype, use `FromTextShow` instead.+ * By similar reasoning, the `Show1` instance for `FromTextShow2` has had its+ instance context changed:++ ```diff+ -instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a)+ +instance (TextShow2 f, Show a) => Show1 (FromTextShow2 f a)+ ```+ * By similar reasoning, the `TextShow` instances for `FromStringShow1` and+ `FromStringShow2`, as well as the `TextShow1` instance for+ `FromStringShow2`, have had their instance contexts changed:++ ```diff+ -instance (Show1 f, Show a) => TextShow (FromStringShow1 f a)+ +instance (Show1 f, TextShow a) => TextShow (FromStringShow1 f a)++ -instance (Show2 f, Show a, Show b) => TextShow (FromStringShow2 f a b)+ +instance (Show2 f, TextShow a, TextShow b) => TextShow (FromStringShow2 f a b)++ -instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a)+ +instance (Show2 f, TextShow a) => TextShow1 (FromStringShow2 f a)+ ```+* The `TextShow{1,2}` classes now have quantified superclasses:++ ```hs+ class (forall a. TextShow a => TextShow (f a)) => TextShow1 f where ...+ class (forall a. TextShow a => TextShow1 (f a)) => TextShow2 f where ...+ ```++ This mirrors corresponding changes made to `Show1` and `Show2` in the `base`+ library. See https://github.com/haskell/core-libraries-committee/issues/10.++ Because of this change, any code that defines a `TextShow1` instance for a+ data type without a corresponding `TextShow` instance will no longer compile,+ so you may need to define more `TextShow` instances to adapt to this change.+ Similarly, `TextShow2` instances will now also require corresponding+ `TextShow` and `TextShow1` instances.+* The `GTextShow*` classes in `TextShow.Generic`, which power generic+ derivation of `TextShow` and `TextShow1` instances, have been split up to+ facilitate the addition of a quantified superclass to `TextShow1`. Moreover,+ the `ShowFuns*` data types, the `Zero` data type, and the `One data type have+ been removed, as they are no longer necessary in light of this split.++ Although this is a breaking API change, the changes should be invisible to+ most users of the module, especially if your code only uses it to derive+ `TextShow{,1}` instances.+* Add a `TextShow` instance for `ByteArray` from `Data.Array.Byte` when+ building with `base-4.17.0.0` or later.+ ### 3.9.7 [2022.05.28] * Allow the test suite to build with GHC 9.4. * Allow building with `transformers-0.6.*`.
src/TextShow/Classes.hs view
@@ -2,6 +2,11 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-}++#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-}+#endif+ {-| Module: TextShow.Classes Copyright: (C) 2014-2017 Ryan Scott@@ -392,7 +397,11 @@ -- | Lifting of the 'TextShow' class to unary type constructors. -- -- /Since: 2/-class TextShow1 f where+class+#if __GLASGOW_HASKELL__ >= 806+ (forall a. TextShow a => TextShow (f a)) =>+#endif+ TextShow1 f where -- | 'showbPrec' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument type. --@@ -457,7 +466,21 @@ -- | Lifting of the 'TextShow' class to binary type constructors. -- -- /Since: 2/-class TextShow2 f where+class+#if __GLASGOW_HASKELL__ >= 806+ ( forall a. TextShow a => TextShow1 (f a)+# if __GLASGOW_HASKELL__ < 900+ -- Sadly, pre-9.0 versions of GHC have difficulty inferring this+ -- superclass from the one above due to+ -- https://gitlab.haskell.org/ghc/ghc/-/issues/17202.+ -- As a workaround, we manually expand the superclass above to assist+ -- type inference. Without doing this, the text-show test suite would+ -- not compile on pre-9.0 versions of GHC.+ , forall a b. (TextShow a, TextShow b) => TextShow (f a b)+# endif+ ) =>+#endif+ TextShow2 f where -- | 'showbPrec' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument types. --
+ src/TextShow/Data/Array/Byte.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-|+Module: TextShow.Data.Array.Byte+Copyright: (C) 2022 Ryan Scott+License: BSD-style (see the file LICENSE)+Maintainer: Ryan Scott+Stability: Provisional+Portability: GHC++Provides a 'TextShow' instance for 'ByteArray' from the "Data.Array.Byte"+module. Only provided if using @base-4.17.0.0@ or later.++/Since: 3.10/+-}+module TextShow.Data.Array.Byte () where++#if MIN_VERSION_base(4,17,0)+import Data.Array.Byte (ByteArray(..))+import Data.Bits (Bits(..))+import Data.Char (intToDigit)+import Data.Text.Lazy.Builder (Builder, fromString, singleton)++import GHC.Exts (Int(..), indexWord8Array#, sizeofByteArray#)+import GHC.Word (Word8(..))++import Prelude ()+import Prelude.Compat++import TextShow.Classes (TextShow(..))++-- | /Since: 3.10/+instance TextShow ByteArray where+ showbPrec _ ba =+ fromString "[" <> go 0+ where+ showW8 :: Word8 -> Builder+ showW8 !w =+ singleton '0'+ <> singleton 'x'+ <> singleton (intToDigit (fromIntegral (unsafeShiftR w 4)))+ <> singleton (intToDigit (fromIntegral (w .&. 0x0F)))+ go i+ | i < sizeofByteArray ba = comma <> showW8 (indexByteArray ba i :: Word8) <> go (i+1)+ | otherwise = singleton ']'+ where+ comma | i == 0 = mempty+ | otherwise = fromString ", "++-- | Read byte at specific index.+indexByteArray :: ByteArray -> Int -> Word8+{-# INLINE indexByteArray #-}+indexByteArray (ByteArray arr#) (I# i#) = W8# (indexWord8Array# arr# i#)++-- | Size of the byte array in bytes.+sizeofByteArray :: ByteArray -> Int+{-# INLINE sizeofByteArray #-}+sizeofByteArray (ByteArray arr#) = I# (sizeofByteArray# arr#)+#endif
src/TextShow/Debug/Trace/Generic.hs view
@@ -25,22 +25,22 @@ import Prelude.Compat import TextShow.Debug.Trace-import TextShow.Generic (GTextShowT, Zero, genericShowt)+import TextShow.Generic (GTextShowT, genericShowt) -- | A 'Generic' implementation of 'traceTextShow'. -- -- /Since: 2/-genericTraceTextShow :: (Generic a, GTextShowT Zero (Rep a)) => a -> b -> b+genericTraceTextShow :: (Generic a, GTextShowT (Rep a ())) => a -> b -> b genericTraceTextShow = tracet . genericShowt -- | A 'Generic' implementation of 'traceTextShowId'. -- -- /Since: 2/-genericTraceTextShowId :: (Generic a, GTextShowT Zero (Rep a)) => a -> a+genericTraceTextShowId :: (Generic a, GTextShowT (Rep a ())) => a -> a genericTraceTextShowId a = tracet (genericShowt a) a -- | A 'Generic' implementation of 'traceShowM'. -- -- /Since: 2/-genericTraceTextShowM :: (Generic a, GTextShowT Zero (Rep a), Applicative f) => a -> f ()+genericTraceTextShowM :: (Generic a, GTextShowT (Rep a ()), Applicative f) => a -> f () genericTraceTextShowM = tracetM . genericShowt
src/TextShow/FromStringTextShow.hs view
@@ -45,7 +45,7 @@ deriveBitraversable) import Data.Coerce (coerce) import Data.Data (Data, Typeable)-import Data.Functor.Classes (Show1(..))+import Data.Functor.Classes (Show1(..), showsPrec1) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics@@ -67,7 +67,7 @@ showbToShows, showsToShowb) #if defined(NEW_FUNCTOR_CLASSES)-import Data.Functor.Classes (Show2(..), showsPrec1, showsPrec2)+import Data.Functor.Classes (Show2(..), showsPrec2) #else import Text.Show (showListWith) #endif@@ -114,26 +114,6 @@ show = coerce (show :: a -> String) showList = coerce (showList :: [a] -> ShowS) -instance Show1 FromStringShow where-#if defined(NEW_FUNCTOR_CLASSES)- liftShowList _ sl = sl . coerceList- where- coerceList :: [FromStringShow a] -> [a]- coerceList = coerce- liftShowsPrec sp _ p = sp p . fromStringShow-#else- showsPrec1 p = showsPrec p . fromStringShow-#endif--instance TextShow1 FromStringShow where- liftShowbPrec sp' _ p =- showsPrecToShowbPrec (showbPrecToShowsPrec sp') p . fromStringShow-- liftShowbList _ sl' = showsToShowb (showbToShows sl') . coerceList- where- coerceList :: [FromStringShow a] -> [a]- coerceList = coerce- ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@.@@ -172,27 +152,6 @@ show (FromTextShow x) = showbToShows showb x "" showList l = showbToShows showbList (coerce l :: [a]) -instance Show1 FromTextShow where-#if defined(NEW_FUNCTOR_CLASSES)- liftShowList _ sl = showbToShows (showsToShowb sl) . coerceList- where- coerceList :: [FromTextShow a] -> [a]- coerceList = coerce- liftShowsPrec sp _ p- = showbPrecToShowsPrec (showsPrecToShowbPrec sp) p . fromTextShow-#else- showsPrec1 p- = showbPrecToShowsPrec (showsPrecToShowbPrec showsPrec) p . fromTextShow-#endif--instance TextShow1 FromTextShow where- liftShowbPrec sp' _ p = sp' p . fromTextShow-- liftShowbList _ sl' = sl' . coerceList- where- coerceList :: [FromTextShow a] -> [a]- coerceList = coerce- ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@.@@ -244,11 +203,14 @@ #if defined(NEW_FUNCTOR_CLASSES) -- | Not available if using @transformers-0.4@-instance (Show1 f, Show a) => TextShow (FromStringShow1 f a) where- showbPrec = liftShowbPrec (showsPrecToShowbPrec showsPrec)- (showsToShowb showList)- showbList = liftShowbList (showsPrecToShowbPrec showsPrec)- (showsToShowb showList)+--+-- This instance is somewhat strange, as its instance context mixes a+-- 'Show1' constraint with a 'TextShow' constraint. This is done for+-- consistency with the 'Show' instance for 'FromTextShow1', which mixes+-- constraints in a similar way to satisfy superclass constraints. See the+-- Haddocks on the 'Show' instance for 'FromTextShow1' for more details.+instance (Show1 f, TextShow a) => TextShow (FromStringShow1 f a) where+ showbPrec = showbPrec1 -- | Not available if using @transformers-0.4@ instance Show1 f => TextShow1 (FromStringShow1 f) where@@ -318,11 +280,19 @@ #if defined(NEW_FUNCTOR_CLASSES) -- | Not available if using @transformers-0.4@-instance (TextShow1 f, TextShow a) => Show (FromTextShow1 f a) where- showsPrec = liftShowsPrec (showbPrecToShowsPrec showbPrec)- (showbToShows showbList)- showList = liftShowList (showbPrecToShowsPrec showbPrec)- (showbToShows showbList)+--+-- This instance is somewhat strange, as its instance context mixes a+-- 'TextShow1' constraint with a 'Show' constraint. The 'Show' constraint is+-- necessary to satisfy the quantified 'Show' superclass in 'Show1'. Really,+-- the 'Show' constraint ought to be a 'TextShow' constraint instead, but GHC+-- has no way of knowing that the 'TextShow' constraint can be converted to a+-- 'Show' constraint when checking superclasses.+--+-- This is all to say: this instance is almost surely not what you want if you+-- are looking to derive a 'Show' instance only via 'TextShow'-related+-- classes. If you wish to do this, derive via 'FromTextShow' instead.+instance (TextShow1 f, Show a) => Show (FromTextShow1 f a) where+ showsPrec = showsPrec1 #endif instance TextShow1 f => Show1 (FromTextShow1 f) where@@ -399,18 +369,25 @@ deriving instance Show2 f => Show2 (FromStringShow2 f) -- | Not available if using @transformers-0.4@-instance (Show2 f, Show a, Show b) => TextShow (FromStringShow2 f a b) where- showbPrec = liftShowbPrec (showsPrecToShowbPrec showsPrec)- (showsToShowb showList)- showbList = liftShowbList (showsPrecToShowbPrec showsPrec)- (showsToShowb showList)+--+-- This instance is somewhat strange, as its instance context mixes a+-- 'Show2' constraint with 'TextShow' constraints. This is done for consistency+-- with the 'Show' instance for 'FromTextShow2', which mixes constraints in a+-- similar way to satisfy superclass constraints. See the Haddocks on the+-- 'Show' instance for 'FromTextShow2' for more details.+instance (Show2 f, TextShow a, TextShow b) => TextShow (FromStringShow2 f a b) where+ showbPrec = showbPrec2 -- | Not available if using @transformers-0.4@-instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a) where- liftShowbPrec = liftShowbPrec2 (showsPrecToShowbPrec showsPrec)- (showsToShowb showList)- liftShowbList = liftShowbList2 (showsPrecToShowbPrec showsPrec)- (showsToShowb showList)+--+-- This instance is somewhat strange, as its instance context mixes a+-- 'Show2' constraint with a 'TextShow' constraint. This is done for+-- consistency with the 'Show1' instance for 'FromTextShow2', which mixes+-- constraints in a similar way to satisfy superclass constraints. See the+-- Haddocks on the 'Show1' instance for 'FromTextShow2' for more details.+instance (Show2 f, TextShow a) => TextShow1 (FromStringShow2 f a) where+ liftShowbPrec = liftShowbPrec2 showbPrec showbList+ liftShowbList = liftShowbList2 showbPrec showbList -- | Not available if using @transformers-0.4@ instance Show2 f => TextShow2 (FromStringShow2 f) where@@ -492,18 +469,35 @@ #if defined(NEW_FUNCTOR_CLASSES) -- | Not available if using @transformers-0.4@-instance (TextShow2 f, TextShow a, TextShow b) => Show (FromTextShow2 f a b) where- showsPrec = liftShowsPrec (showbPrecToShowsPrec showbPrec)- (showbToShows showbList)- showList = liftShowList (showbPrecToShowsPrec showbPrec)- (showbToShows showbList)+--+-- This instance is somewhat strange, as its instance context mixes a+-- 'TextShow2' constraint with 'Show' constraints. The 'Show' constraints are+-- necessary to satisfy the quantified 'Show' superclass in 'Show2'. Really,+-- the 'Show' constraints ought to be 'TextShow' constraints instead, but GHC+-- has no way of knowing that the 'TextShow' constraints can be converted to+-- 'Show' constraints when checking superclasses.+--+-- This is all to say: this instance is almost surely not what you want if you+-- are looking to derive a 'Show' instance only via 'TextShow'-related+-- classes. If you wish to do this, derive via 'FromTextShow' instead.+instance (TextShow2 f, Show a, Show b) => Show (FromTextShow2 f a b) where+ showsPrec = showsPrec2 -- | Not available if using @transformers-0.4@-instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a) where- liftShowsPrec = liftShowsPrec2 (showbPrecToShowsPrec showbPrec)- (showbToShows showbList)- liftShowList = liftShowList2 (showbPrecToShowsPrec showbPrec)- (showbToShows showbList)+--+-- This instance is somewhat strange, as its instance context mixes a+-- 'TextShow2' constraint with a 'Show' constraint. The 'Show' constraint is+-- necessary to satisfy the quantified 'Show' superclass in 'Show2'. Really,+-- the 'Show' constraint ought to be a 'TextShow' constraint instead, but GHC+-- has no way of knowing that the 'TextShow' constraint can be converted to a+-- 'Show' constraint when checking superclasses.+--+-- This is all to say: this instance is almost surely not what you want if you+-- are looking to derive a 'Show1' instance only via 'TextShow'-related+-- classes. If you wish to do this, derive via 'FromTextShow1' instead.+instance (TextShow2 f, Show a) => Show1 (FromTextShow2 f a) where+ liftShowsPrec = liftShowsPrec2 showsPrec showList+ liftShowList = liftShowList2 showsPrec showList -- | Not available if using @transformers-0.4@ instance TextShow2 f => Show2 (FromTextShow2 f) where
src/TextShow/Generic.hs view
@@ -24,9 +24,13 @@ {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DeriveLift #-} #endif +#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-}+#endif+ {-| Module: TextShow.Generic Copyright: (C) 2014-2017 Ryan Scott@@ -51,9 +55,6 @@ -- * Generic @show@ functions -- $generics-- -- ** Understanding a compiler error- -- $generic_err , genericShowt , genericShowtl , genericShowtPrec@@ -73,24 +74,24 @@ -- ** 'Builder' , GTextShowB(..) , GTextShowConB(..)- , ShowFunsB(..)+ , GTextShowB1(..)+ , GTextShowConB1(..) -- ** Strict 'TS.Text' , GTextShowT(..) , GTextShowConT(..)- , ShowFunsT(..)+ , GTextShowT1(..)+ , GTextShowConT1(..) -- ** Lazy 'TL.Text' , GTextShowTL(..) , GTextShowConTL(..)- , ShowFunsTL(..)+ , GTextShowTL1(..)+ , GTextShowConTL1(..) -- ** Other internals , IsNullary(..) , ConType(..)- , Zero- , One ) where import Data.Data (Data, Typeable)-import Data.Functor.Contravariant.Compat (Contravariant(..)) import qualified Data.Text as TS (Text, pack, singleton) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import qualified Data.Text.Lazy as TL (Text, pack, singleton)@@ -152,30 +153,6 @@ @ -} -{- $generic_err--Suppose you intend to define a 'TextShow' instance via 'FromGeneric':--@-data Oops = Oops- deriving 'TextShow' via 'FromGeneric' Oops- -- forgot to add \"deriving Generic\" here!-@--If you forget to add a @deriving 'Generic'@ clause to your data type, at-compile-time, you might get an error message that begins roughly as follows:--@-No instance for ('GTextShowB' 'Zero' ('Rep' Oops))-@--This error can be confusing, but don't let it intimidate you. The correct fix is-simply to add the missing \"@deriving 'Generic'@\" clause.--Similarly, if the compiler complains about not having an instance for @('GTextShowB'-'One' ('Rep1' Oops1))@, add a \"@deriving 'Generic1'@\" clause.--}- -- | An adapter newtype, suitable for @DerivingVia@. -- The 'TextShow' instance for 'FromGeneric' leverages a 'Generic'-based -- default. That is,@@ -203,7 +180,7 @@ ) -- | /Since: 3.7.4/-instance (Generic a, GTextShowB Zero (Rep a)) => TextShow (FromGeneric a) where+instance (Generic a, GTextShowB (Rep a ())) => TextShow (FromGeneric a) where showbPrec p = genericShowbPrec p . fromGeneric -- | An adapter newtype, suitable for @DerivingVia@.@@ -236,106 +213,123 @@ deriving instance ( Data (f a), Typeable f, Typeable a ) => Data (FromGeneric1 f (a :: *)) +-- | /Since: 3.10/+instance (Generic1 f, GTextShowB (Rep1 f a)) => TextShow (FromGeneric1 f a) where+ showbPrec p = gShowbPrec p . from1 . fromGeneric1+ -- | /Since: 3.7.4/-instance (Generic1 f, GTextShowB One (Rep1 f)) => TextShow1 (FromGeneric1 f) where+instance ( Generic1 f, GTextShowB1 (Rep1 f)+#if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ < 902+ -- Unfortunately, the quantified superclass for GTextShowB1 doesn't+ -- work on pre-9.2 versions of GHC, perhaps due to+ -- https://gitlab.haskell.org/ghc/ghc/-/issues/14860#note_454218.+ -- Fortunately, we can make GHC come to its senses by using an+ -- equality constraint.+ , g ~ Rep1 f, forall a. TextShow a => GTextShowB (g a)+#endif+ ) => TextShow1 (FromGeneric1 f) where liftShowbPrec sp sl p = genericLiftShowbPrec sp sl p . fromGeneric1 -- | A 'Generic' implementation of 'showt'. -- -- /Since: 2/-genericShowt :: (Generic a, GTextShowT Zero (Rep a)) => a -> TS.Text+genericShowt :: (Generic a, GTextShowT (Rep a ())) => a -> TS.Text genericShowt = genericShowtPrec 0 -- | A 'Generic' implementation of 'showtl'. -- -- /Since: 2/-genericShowtl :: (Generic a, GTextShowTL Zero (Rep a)) => a -> TL.Text+genericShowtl :: (Generic a, GTextShowTL (Rep a ())) => a -> TL.Text genericShowtl = genericShowtlPrec 0 -- | A 'Generic' implementation of 'showPrect'. -- -- /Since: 2/-genericShowtPrec :: (Generic a, GTextShowT Zero (Rep a)) => Int -> a -> TS.Text-genericShowtPrec p = gShowtPrec NoShowFunsT p . from+genericShowtPrec :: (Generic a, GTextShowT (Rep a ())) => Int -> a -> TS.Text+genericShowtPrec p = gShowtPrec p . fromRepUnit -- | A 'Generic' implementation of 'showtlPrec'. -- -- /Since: 2/-genericShowtlPrec :: (Generic a, GTextShowTL Zero (Rep a)) => Int -> a -> TL.Text-genericShowtlPrec p = gShowtlPrec NoShowFunsTL p . from+genericShowtlPrec :: (Generic a, GTextShowTL (Rep a ())) => Int -> a -> TL.Text+genericShowtlPrec p = gShowtlPrec p . fromRepUnit -- | A 'Generic' implementation of 'showtList'. -- -- /Since: 2/-genericShowtList :: (Generic a, GTextShowT Zero (Rep a)) => [a] -> TS.Text+genericShowtList :: (Generic a, GTextShowT (Rep a ())) => [a] -> TS.Text genericShowtList = showtListWith genericShowt -- | A 'Generic' implementation of 'showtlList'. -- -- /Since: 2/-genericShowtlList :: (Generic a, GTextShowTL Zero (Rep a)) => [a] -> TL.Text+genericShowtlList :: (Generic a, GTextShowTL (Rep a ())) => [a] -> TL.Text genericShowtlList = showtlListWith genericShowtl -- | A 'Generic' implementation of 'showb'. -- -- /Since: 2/-genericShowb :: (Generic a, GTextShowB Zero (Rep a)) => a -> Builder+genericShowb :: (Generic a, GTextShowB (Rep a ())) => a -> Builder genericShowb = genericShowbPrec 0 -- | A 'Generic' implementation of 'showbPrec'. -- -- /Since: 2/-genericShowbPrec :: (Generic a, GTextShowB Zero (Rep a)) => Int -> a -> Builder-genericShowbPrec p = gShowbPrec NoShowFunsB p . from+genericShowbPrec :: (Generic a, GTextShowB (Rep a ())) => Int -> a -> Builder+genericShowbPrec p = gShowbPrec p . fromRepUnit -- | A 'Generic' implementation of 'showbList'. -- -- /Since: 2/-genericShowbList :: (Generic a, GTextShowB Zero (Rep a)) => [a] -> Builder+genericShowbList :: (Generic a, GTextShowB (Rep a ())) => [a] -> Builder genericShowbList = showbListWith genericShowb -- | A 'Generic' implementation of 'printT'. -- -- /Since: 2/-genericPrintT :: (Generic a, GTextShowT Zero (Rep a)) => a -> IO ()+genericPrintT :: (Generic a, GTextShowT (Rep a ())) => a -> IO () genericPrintT = TS.putStrLn . genericShowt -- | A 'Generic' implementation of 'printTL'. -- -- /Since: 2/-genericPrintTL :: (Generic a, GTextShowTL Zero (Rep a)) => a -> IO ()+genericPrintTL :: (Generic a, GTextShowTL (Rep a ())) => a -> IO () genericPrintTL = TL.putStrLn . genericShowtl -- | A 'Generic' implementation of 'hPrintT'. -- -- /Since: 2/-genericHPrintT :: (Generic a, GTextShowT Zero (Rep a)) => Handle -> a -> IO ()+genericHPrintT :: (Generic a, GTextShowT (Rep a ())) => Handle -> a -> IO () genericHPrintT h = TS.hPutStrLn h . genericShowt -- | A 'Generic' implementation of 'hPrintTL'. -- -- /Since: 2/-genericHPrintTL :: (Generic a, GTextShowTL Zero (Rep a)) => Handle -> a -> IO ()+genericHPrintTL :: (Generic a, GTextShowTL (Rep a ())) => Handle -> a -> IO () genericHPrintTL h = TL.hPutStrLn h . genericShowtl -- | A 'Generic1' implementation of 'genericLiftShowbPrec'. -- -- /Since: 2/-genericLiftShowbPrec :: (Generic1 f, GTextShowB One (Rep1 f))+genericLiftShowbPrec :: (Generic1 f, GTextShowB1 (Rep1 f)) => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder-genericLiftShowbPrec sp sl p = gShowbPrec (Show1FunsB sp sl) p . from1+genericLiftShowbPrec sp sl p = gLiftShowbPrec sp sl p . from1 -- | A 'Generic'/'Generic1' implementation of 'showbPrec1'. -- -- /Since: 2/ genericShowbPrec1 :: ( Generic a, Generic1 f- , GTextShowB Zero (Rep a)- , GTextShowB One (Rep1 f)+ , GTextShowB (Rep a ())+ , GTextShowB1 (Rep1 f) ) => Int -> f a -> Builder genericShowbPrec1 = genericLiftShowbPrec genericShowbPrec genericShowbList +-- | A type-specialized version of 'from' used to assist type inference.+fromRepUnit :: Generic a => a -> Rep a ()+fromRepUnit = from+ ------------------------------------------------------------------------------- -- | Whether a constructor is a record ('Rec'), a tuple ('Tup'), is prefix ('Pref'),@@ -355,16 +349,6 @@ #endif ) --- | A type-level indicator that 'TextShow' is being derived generically.------ /Since: 3.2/-data Zero---- | A type-level indicator that 'TextShow1' is being derived generically.------ /Since: 3.2/-data One- {- I'm not particularly proud of the code below. The issue is that we need to be able to generically work over Builders, strict Text, and lazy Text. We could just work@@ -381,217 +365,350 @@ See #33. -} +hashPrec :: Int -> Int #if __GLASGOW_HASKELL__ >= 711-#define HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string) \+hashPrec = const 0+#else+hashPrec = id+#endif++#if __GLASGOW_HASKELL__ >= 711+#define HASH_FUNS(text_type,one_hash,two_hash,from_char,from_string) \ one_hash, two_hash :: text_type; \-hash_prec :: Int -> Int; \ one_hash = from_char '#'; \-two_hash = from_string "##"; \-hash_prec = const 0+two_hash = from_string "##"; #else-#define HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string) \+#define HASH_FUNS(text_type,one_hash,two_hash,from_char,from_string) \ one_hash, two_hash :: text_type; \-hash_prec :: Int -> Int; \ one_hash = mempty; \-two_hash = mempty; \-hash_prec = id+two_hash = mempty; #endif -#define GTEXT_SHOW(text_type,show_funs,no_show_funs,show1_funs,one_hash,two_hash,hash_prec,gtext_show,gshow_prec,gtext_show_con,gshow_prec_con,show_prec,lift_show_prec,show_space,show_paren,show_list_with,from_char,from_string) \-{- | A 'show_funs' value either stores nothing (for 'TextShow') or it stores \-the two function arguments that show occurrences of the type parameter (for \-'TextShow1'). \+-- For some mysterious reason, attaching INLINE pragmas to things in this+-- module causes GHC 8.10's simplifier to absolutely explode in terms of+-- compile times. This also affects 9.0, 8.8, and older versions of GHC to+-- varying degrees, usually adding a couple of minutes or more to the overall+-- compile times.+--+-- We'd still like to include the INLINE pragmas on 9.2 or later, however, as+-- it delivers a modest but measurable performance boost in the benchmark suite.+-- As a compromise, we use CPP to only attach INLINE annotations on 9.2 or+-- later.+#if __GLASGOW_HASKELL__ >= 902+#define INLINE_GE_902(f) {-# INLINE f #-};+#else+#define INLINE_GE_902(f)+#endif++#if __GLASGOW_HASKELL__ >= 806+#define QUANTIFIED_SUPERCLASS(class_name,f) (forall a. TextShow a => class_name (f a)) =>+#else+#define QUANTIFIED_SUPERCLASS(class_name,f)+#endif++#define GTEXT_SHOW(text_type,show_funs,one_hash,two_hash,gtext_show,gtext_show1,gshow_prec,glift_show_prec,gtext_show_con,gtext_show_con1,gshow_prec_con,glift_show_prec_con,show_prec,lift_show_prec,show_space,show_paren,show_list,show_list_with,from_char,from_string,c1_show_prec,s1_show_prec,product_show_prec,u_char_show_prec,u_double_show_prec,u_float_show_prec,u_int_show_prec,u_word_show_prec) \+{- | Class of generic representation types that can be converted to a \+'text_type'. \ \-/Since: 3.4/ \+/Since: 3.10/ \ -}; \-data show_funs arity a where { \- no_show_funs :: show_funs Zero a \- ; show1_funs :: (Int -> a -> text_type) -> ([a] -> text_type) -> show_funs One a \- } deriving Typeable; \+class gtext_show a where { \+ ; gshow_prec :: Int -> a -> text_type \+}; \+deriving instance Typeable gtext_show; \ \-instance Contravariant (show_funs arity) where { \- contramap _ no_show_funs = no_show_funs \- ; contramap f (show1_funs sp sl) = show1_funs (\p -> sp p . f) (sl . map f) \- }; \+instance gtext_show (f p) => gtext_show (D1 d f p) where { \+ ; gshow_prec p (M1 x) = gshow_prec p x \+}; \ \-{- | Class of generic representation types that can be converted to \-a 'text_type'. The @arity@ type variable indicates which type class is \-used. @'gtext_show' 'Zero'@ indicates 'TextShow' behavior, and \-@'gtext_show' 'One'@ indicates 'TextShow1' behavior. \+instance gtext_show (V1 p) where { \+ ; gshow_prec _ x = case x of {} \+}; \ \-/Since: 3.4/ \+instance (gtext_show (f p), gtext_show (g p)) \+ => gtext_show ((f :+: g) p) where { \+ ; gshow_prec p (L1 x) = gshow_prec p x \+ ; gshow_prec p (R1 x) = gshow_prec p x \+}; \+ \+instance (Constructor c, gtext_show_con (f p), IsNullary f) \+ => gtext_show (C1 c f p) where { \+ gshow_prec = c1_show_prec gshow_prec_con \+}; \+ \+{- | Class of generic representation types for which the 'ConType' has been \+determined. \+ \+/Since: 3.10/ \ -}; \-class gtext_show arity f where { \- {- | This is used as the default generic implementation of 'show_prec' (if the \- @arity@ is 'Zero') or 'lift_show_prec' (if the @arity@ is 'One'). \- -} \- ; gshow_prec :: show_funs arity a -> Int -> f a -> text_type \- }; \+class gtext_show_con a where { \+ ; gshow_prec_con :: ConType -> Int -> a -> text_type \+}; \+deriving instance Typeable gtext_show_con; \ \-deriving instance Typeable gtext_show; \+instance gtext_show_con (U1 p) where { \+ ; gshow_prec_con _ _ U1 = mempty \+}; \ \-instance gtext_show arity f => gtext_show arity (D1 d f) where { \- gshow_prec sfs p (M1 x) = gshow_prec sfs p x \- }; \+instance TextShow p => gtext_show_con (Par1 p) where { \+ ; gshow_prec_con _ p (Par1 x) = show_prec p x \+}; \ \-instance gtext_show arity V1 where { \- gshow_prec _ _ x = case x of {} \- }; \+instance TextShow c => gtext_show_con (K1 i c p) where { \+ ; gshow_prec_con _ p (K1 x) = show_prec p x \+}; \ \-instance (gtext_show arity f, gtext_show arity g) => gtext_show arity (f :+: g) where { \- gshow_prec sfs p (L1 x) = gshow_prec sfs p x \- ; gshow_prec sfs p (R1 x) = gshow_prec sfs p x \- }; \+instance (TextShow1 f, TextShow p) => gtext_show_con (Rec1 f p) where { \+ ; gshow_prec_con _ p (Rec1 x) = lift_show_prec show_prec show_list p x \+}; \ \-instance (Constructor c, gtext_show_con arity f, IsNullary f) \- => gtext_show arity (C1 c f) where { \- gshow_prec sfs p c@(M1 x) = case fixity of { \- Prefix -> show_paren ( p > appPrec \- && not (isNullary x || conIsTuple c) \- ) $ \- (if conIsTuple c \- then mempty \- else let cn = conName c \- in show_paren (isInfixDataCon cn) $ from_string cn) \- <> (if isNullary x || conIsTuple c \- then mempty \- else from_char ' ') \- <> showbBraces t (gshow_prec_con t sfs appPrec1 x) \- ; Infix _ m -> show_paren (p > m) $ gshow_prec_con t sfs (m+1) x \- } \- where { \- fixity :: Fixity \- ; fixity = conFixity c \+instance (Selector s, gtext_show_con (f p)) => gtext_show_con (S1 s f p) where { \+ ; gshow_prec_con t = s1_show_prec $ gshow_prec_con t \+}; \ \- ; t :: ConType \- ; t = if conIsRecord c \- then Rec \- else case conIsTuple c of { \- True -> Tup \- ; False -> case fixity of { \- Prefix -> Pref \- ; Infix _ _ -> Inf $ conName c \- }; \- } \+instance (gtext_show_con (f p), gtext_show_con (g p)) \+ => gtext_show_con ((f :*: g) p) where { \+ ; gshow_prec_con t = product_show_prec (gshow_prec_con t) (gshow_prec_con t) t \+}; \ \- ; showbBraces :: ConType -> text_type -> text_type \- ; showbBraces Rec b = from_char '{' <> b <> from_char '}' \- ; showbBraces Tup b = from_char '(' <> b <> from_char ')' \- ; showbBraces Pref b = b \- ; showbBraces (Inf _) b = b \+instance (TextShow1 f, gtext_show_con (g p)) => gtext_show_con ((f :.: g) p) where { \+ ; gshow_prec_con t p (Comp1 x) = \+ let gspc = gshow_prec_con t \+ in lift_show_prec gspc (show_list_with (gspc 0)) p x \+}; \ \- ; conIsTuple :: C1 c f p -> Bool \- ; conIsTuple = isTupleString . conName \- }; \- }; \+instance gtext_show_con (UChar p) where { \+ ; gshow_prec_con _ = u_char_show_prec show_prec \+}; \ \-{- | Class of generic representation types for which the 'ConType' has been \-determined. The @arity@ type variable indicates which type class is \-used. @'gtext_show_con' 'Zero'@ indicates 'TextShow' behavior, and \-@'gtext_show_con' 'One'@ indicates 'TextShow1' behavior. \+instance gtext_show_con (UDouble p) where { \+ ; gshow_prec_con _ = u_double_show_prec show_prec \+}; \+ \+instance gtext_show_con (UFloat p) where { \+ ; gshow_prec_con _ = u_float_show_prec show_prec \+}; \+ \+instance gtext_show_con (UInt p) where { \+ ; gshow_prec_con _ = u_int_show_prec show_prec \+}; \+ \+instance gtext_show_con (UWord p) where { \+ ; gshow_prec_con _ = u_word_show_prec show_prec \+}; \+ \+{- | Class of generic representation types for unary type constructors that can \+be converted to a 'text_type'. \+ \+/Since: 3.10/ \ -}; \-class gtext_show_con arity f where { \- {- | Convert value of a specific 'ConType' to a 'text_type' with the given \- precedence. \- -} \- ; gshow_prec_con :: ConType -> show_funs arity a -> Int -> f a -> text_type \- }; \+class QUANTIFIED_SUPERCLASS(gtext_show,f) \+ gtext_show1 f where { \+ ; glift_show_prec :: (Int -> a -> text_type) -> ([a] -> text_type) \+ -> Int -> f a -> text_type \+}; \+deriving instance Typeable gtext_show1; \ \-deriving instance Typeable gtext_show_con; \+instance gtext_show1 f => gtext_show1 (D1 d f) where { \+ ; glift_show_prec sp sl p (M1 x) = glift_show_prec sp sl p x \+}; \ \-instance gtext_show_con arity U1 where { \- gshow_prec_con _ _ _ U1 = mempty \- }; \+instance gtext_show1 V1 where { \+ ; glift_show_prec _ _ _ x = case x of {} \+}; \ \-instance gtext_show_con One Par1 where { \- gshow_prec_con _ (show1_funs sp _) p (Par1 x) = sp p x \- }; \+instance (gtext_show1 f, gtext_show1 g) => gtext_show1 (f :+: g) where { \+ ; glift_show_prec sp sl p (L1 x) = glift_show_prec sp sl p x \+ ; glift_show_prec sp sl p (R1 x) = glift_show_prec sp sl p x \+}; \ \-instance TextShow c => gtext_show_con arity (K1 i c) where { \- gshow_prec_con _ _ p (K1 x) = show_prec p x \- }; \+instance (Constructor c, gtext_show_con1 f, IsNullary f) \+ => gtext_show1 (C1 c f) where { \+ ; glift_show_prec sp sl = c1_show_prec $ glift_show_prec_con sp sl \+}; \ \-instance TextShow1 f => gtext_show_con One (Rec1 f) where { \- gshow_prec_con _ (show1_funs sp sl) p (Rec1 x) = lift_show_prec sp sl p x \- }; \+{- | Class of generic representation types for unary type constructors for which \+the 'ConType' has been determined. \ \-instance (Selector s, gtext_show_con arity f) => gtext_show_con arity (S1 s f) where { \- gshow_prec_con t sfs p sel@(M1 x) \- | selName sel == "" = gshow_prec_con t sfs p x \- | otherwise = infixRec \- <> " = " \- <> gshow_prec_con t sfs 0 x \- where { \- infixRec :: text_type \- ; infixRec | isSymVar selectorName \- = from_char '(' <> from_string selectorName <> from_char ')' \- | otherwise \- = from_string selectorName \+/Since: 3.10/ \+-}; \+class QUANTIFIED_SUPERCLASS(gtext_show_con,f) \+ gtext_show_con1 f where { \+ ; glift_show_prec_con :: (Int -> a -> text_type) -> ([a] -> text_type) \+ -> ConType -> Int -> f a -> text_type \+}; \+deriving instance Typeable gtext_show_con1; \ \- ; selectorName :: String \- ; selectorName = selName sel \- } \- }; \+instance gtext_show_con1 U1 where { \+ ; glift_show_prec_con _ _ _ _ U1 = mempty \+}; \ \-instance (gtext_show_con arity f, gtext_show_con arity g) \- => gtext_show_con arity (f :*: g) where { \- gshow_prec_con t@Rec sfs _ (a :*: b) = \- gshow_prec_con t sfs 0 a \+instance gtext_show_con1 Par1 where { \+ ; glift_show_prec_con sp _ _ p (Par1 x) = sp p x \+}; \+ \+instance TextShow c => gtext_show_con1 (K1 i c) where { \+ ; glift_show_prec_con _ _ _ p (K1 x) = show_prec p x \+}; \+ \+instance TextShow1 f => gtext_show_con1 (Rec1 f) where { \+ ; glift_show_prec_con sp sl _ p (Rec1 x) = lift_show_prec sp sl p x \+}; \+ \+instance (Selector s, gtext_show_con1 f) => gtext_show_con1 (S1 s f) where { \+ ; glift_show_prec_con sp sl t = s1_show_prec $ glift_show_prec_con sp sl t \+}; \+ \+instance (gtext_show_con1 f, gtext_show_con1 g) \+ => gtext_show_con1 (f :*: g) where { \+ ; glift_show_prec_con sp sl t = \+ product_show_prec (glift_show_prec_con sp sl t) (glift_show_prec_con sp sl t) t \+}; \+ \+instance (TextShow1 f, gtext_show_con1 g) => gtext_show_con1 (f :.: g) where { \+ ; glift_show_prec_con sp sl t p (Comp1 x) = \+ let gspc = glift_show_prec_con sp sl t \+ in lift_show_prec gspc (show_list_with (gspc 0)) p x \+}; \+ \+instance gtext_show_con1 UChar where { \+ ; glift_show_prec_con _ _ _ = u_char_show_prec show_prec \+}; \+ \+instance gtext_show_con1 UDouble where { \+ ; glift_show_prec_con _ _ _ = u_double_show_prec show_prec \+}; \+ \+instance gtext_show_con1 UFloat where { \+ ; glift_show_prec_con _ _ _ = u_float_show_prec show_prec \+}; \+ \+instance gtext_show_con1 UInt where { \+ ; glift_show_prec_con _ _ _ = u_int_show_prec show_prec \+}; \+ \+instance gtext_show_con1 UWord where { \+ ; glift_show_prec_con _ _ _ = u_word_show_prec show_prec \+}; \+ \+c1_show_prec :: forall c f p. \+ (Constructor c, IsNullary f) \+ => (ConType -> Int -> f p -> text_type) \+ -> Int -> C1 c f p -> text_type; \+c1_show_prec sp p c@(M1 x) = case fixity of { \+ ; Prefix -> show_paren ( p > appPrec \+ && not (isNullary x || conIsTuple c) \+ ) $ \+ (if conIsTuple c \+ then mempty \+ else let cn = conName c \+ in show_paren (isInfixDataCon cn) $ from_string cn) \+ <> (if isNullary x || conIsTuple c \+ then mempty \+ else from_char ' ') \+ <> showBraces t (sp t appPrec1 x) \+ ; Infix _ m -> show_paren (p > m) $ sp t (m+1) x \+} where { \+ ; fixity :: Fixity \+ ; fixity = conFixity c \+ \+ ; t :: ConType \+ ; t = if conIsRecord c \+ then Rec \+ else case conIsTuple c of { \+ ; True -> Tup \+ ; False -> case fixity of { \+ ; Prefix -> Pref \+ ; Infix _ _ -> Inf $ conName c \+ }; \+ }; \+ \+ ; showBraces :: ConType -> text_type -> text_type \+ ; showBraces Rec b = from_char '{' <> b <> from_char '}' \+ ; showBraces Tup b = from_char '(' <> b <> from_char ')' \+ ; showBraces Pref b = b \+ ; showBraces (Inf _) b = b \+ \+ ; conIsTuple :: C1 c f p -> Bool \+ ; conIsTuple = isTupleString . conName \+ }; \+INLINE_GE_902(c1_show_prec) \+ \+s1_show_prec :: Selector s \+ => (Int -> f p -> text_type) \+ -> Int -> S1 s f p -> text_type; \+s1_show_prec sp p sel@(M1 x) \+ | selName sel == "" = sp p x \+ | otherwise = infixRec \+ <> " = " \+ <> sp 0 x \+ where { \+ ; infixRec :: text_type \+ ; infixRec | isSymVar selectorName \+ = from_char '(' <> from_string selectorName <> from_char ')' \+ | otherwise \+ = from_string selectorName \+ \+ ; selectorName :: String \+ ; selectorName = selName sel \+ }; \+INLINE_GE_902(s1_show_prec) \+ \+product_show_prec :: (Int -> f p -> text_type) -> (Int -> g p -> text_type) \+ -> ConType -> Int -> (f :*: g) p -> text_type; \+product_show_prec spf spg t p (a :*: b) = \+ case t of { \+ ; Rec -> \+ spf 0 a \ <> ", " \- <> gshow_prec_con t sfs 0 b \- ; gshow_prec_con t@(Inf o) sfs p (a :*: b) = \- gshow_prec_con t sfs p a \+ <> spg 0 b \+ ; Inf o -> \+ spf p a \ <> show_space \- <> infixOp \+ <> infixOp o \ <> show_space \- <> gshow_prec_con t sfs p b \- where { \- infixOp :: text_type \- ; infixOp = if isInfixDataCon o \- then from_string o \- else from_char '`' <> from_string o <> from_char '`' \- } \- ; gshow_prec_con t@Tup sfs _ (a :*: b) = \- gshow_prec_con t sfs 0 a \+ <> spg p b \+ ; Tup -> \+ spf 0 a \ <> from_char ',' \- <> gshow_prec_con t sfs 0 b \- ; gshow_prec_con t@Pref sfs p (a :*: b) = \- gshow_prec_con t sfs p a \+ <> spg 0 b \+ ; Pref -> \+ spf p a \ <> show_space \- <> gshow_prec_con t sfs p b \- }; \- \-instance (TextShow1 f, gtext_show_con One g) => gtext_show_con One (f :.: g) where { \- gshow_prec_con t sfs p (Comp1 x) = \- let gspc = gshow_prec_con t sfs \- in lift_show_prec gspc (show_list_with (gspc 0)) p x \- }; \+ <> spg p b \+ } where { \+ ; infixOp :: String -> text_type \+ ; infixOp o = if isInfixDataCon o \+ then from_string o \+ else from_char '`' <> from_string o <> from_char '`' \+ }; \+INLINE_GE_902(product_show_prec) \ \-instance gtext_show_con arity UChar where { \- gshow_prec_con _ _ p (UChar c) = show_prec (hash_prec p) (C# c) <> one_hash \- }; \+u_char_show_prec :: (Int -> Char -> text_type) -> Int -> UChar p -> text_type; \+u_char_show_prec sp p (UChar c) = sp (hashPrec p) (C# c) <> one_hash; \+INLINE_GE_902(u_char_show_prec) \ \-instance gtext_show_con arity UDouble where { \- gshow_prec_con _ _ p (UDouble d) = show_prec (hash_prec p) (D# d) <> two_hash \- }; \+u_double_show_prec :: (Int -> Double -> text_type) -> Int -> UDouble p -> text_type; \+u_double_show_prec sp p (UDouble d) = sp (hashPrec p) (D# d) <> two_hash; \+INLINE_GE_902(u_double_show_prec) \ \-instance gtext_show_con arity UFloat where { \- gshow_prec_con _ _ p (UFloat f) = show_prec (hash_prec p) (F# f) <> one_hash \- }; \+u_float_show_prec :: (Int -> Float -> text_type) -> Int -> UFloat p -> text_type; \+u_float_show_prec sp p (UFloat f) = sp (hashPrec p) (F# f) <> one_hash; \+INLINE_GE_902(u_float_show_prec) \ \-instance gtext_show_con arity UInt where { \- gshow_prec_con _ _ p (UInt i) = show_prec (hash_prec p) (I# i) <> one_hash \- }; \+u_int_show_prec :: (Int -> Int -> text_type) -> Int -> UInt p -> text_type; \+u_int_show_prec sp p (UInt i) = sp (hashPrec p) (I# i) <> one_hash; \+INLINE_GE_902(u_int_show_prec) \ \-instance gtext_show_con arity UWord where { \- gshow_prec_con _ _ p (UWord w) = show_prec (hash_prec p) (W# w) <> two_hash \- }; \+u_word_show_prec :: (Int -> Word -> text_type) -> Int -> UWord p -> text_type; \+u_word_show_prec sp p (UWord w) = sp (hashPrec p) (W# w) <> two_hash; \+INLINE_GE_902(u_word_show_prec) \ \-HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string);+HASH_FUNS(text_type,one_hash,two_hash,from_char,from_string); -GTEXT_SHOW(Builder,ShowFunsB,NoShowFunsB,Show1FunsB,oneHashB,twoHashB,hashPrecB,GTextShowB,gShowbPrec,GTextShowConB,gShowbPrecCon,showbPrec,liftShowbPrec,showbSpace,showbParen,showbListWith,TB.singleton,TB.fromString)-GTEXT_SHOW(TS.Text,ShowFunsT,NoShowFunsT,Show1FunsT,oneHashT,twoHashT,hashPrecT,GTextShowT,gShowtPrec,GTextShowConT,gShowtPrecCon,showtPrec,liftShowtPrec,showtSpace,showtParen,showtListWith,TS.singleton,TS.pack)-GTEXT_SHOW(TL.Text,ShowFunsTL,NoShowFunsTL,Show1FunsTL,oneHashTL,twoHashTL,hashPrecTL,GTextShowTL,gShowtlPrec,GTextShowConTL,gShowtlPrecCon,showtlPrec,liftShowtlPrec,showtlSpace,showtlParen,showtlListWith,TL.singleton,TL.pack)+GTEXT_SHOW(Builder,ShowFunsB,oneHashB,twoHashB,GTextShowB,GTextShowB1,gShowbPrec,gLiftShowbPrec,GTextShowConB,GTextShowConB1,gShowbPrecCon,gLiftShowbPrecCon,showbPrec,liftShowbPrec,showbSpace,showbParen,showbList,showbListWith,TB.singleton,TB.fromString,c1ShowbPrec,s1ShowbPrec,productShowbPrec,uCharShowbPrec,uDoubleShowbPrec,uFloatShowbPrec,uIntShowbPrec,uWordShowbPrec)+GTEXT_SHOW(TS.Text,ShowFunsT,oneHashT,twoHashT,GTextShowT,GTextShowT1,gShowtPrec,gLiftShowtPrec,GTextShowConT,GTextShowConT1,gShowtPrecCon,gLiftShowtPrecCon,showtPrec,liftShowtPrec,showtSpace,showtParen,showtList,showtListWith,TS.singleton,TS.pack,c1ShowtPrec,s1ShowtPrec,productShowtPrec,uCharShowtPrec,uDoubleShowtPrec,uFloatShowtPrec,uIntShowtPrec,uWordShowtPrec)+GTEXT_SHOW(TL.Text,ShowFunsTL,oneHashTL,twoHashTL,GTextShowTL,GTextShowTL1,gShowtlPrec,gLiftShowtlPrec,GTextShowConTL,GTextShowConTL1,gShowtlPrecCon,gLiftShowtlPrecCon,showtlPrec,liftShowtlPrec,showtlSpace,showtlParen,showtlList,showtlListWith,TL.singleton,TL.pack,c1ShowtlPrec,s1ShowtlPrec,productShowtlPrec,uCharShowtlPrec,uDoubleShowtlPrec,uFloatShowtlPrec,uIntShowtlPrec,uWordShowtlPrec) -- | Class of generic representation types that represent a constructor with -- zero or more fields.
src/TextShow/Instances.hs view
@@ -18,6 +18,7 @@ import TextShow.Control.Monad.ST () import TextShow.Data.Array ()+import TextShow.Data.Array.Byte () import TextShow.Data.Bool () import TextShow.Data.ByteString () import TextShow.Data.Char ()
+ tests/Spec/Data/Array/ByteSpec.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE CPP #-}++{-|+Module: Spec.Data.Array.ByteSpec+Copyright: (C) 2022 Ryan Scott+License: BSD-style (see the file LICENSE)+Maintainer: Ryan Scott+Stability: Provisional+Portability: GHC++@hspec@ tests for 'ByteArray' from the "Data.Array.Byte" module.+-}+module Spec.Data.Array.ByteSpec (main, spec) where++import Prelude ()+import Prelude.Compat++import Test.Hspec (Spec, hspec, parallel)+import Test.QuickCheck.Instances ()++#if MIN_VERSION_base(4,17,0)+import Data.Array.Byte (ByteArray)+import Data.Proxy.Compat (Proxy(..))++import Spec.Utils (matchesTextShowSpec)++import Test.Hspec (describe)+#endif++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $ do+#if MIN_VERSION_base(4,17,0)+ describe "ByteArray" $+ matchesTextShowSpec (Proxy :: Proxy ByteArray)+#else+ pure ()+#endif
tests/Spec/Derived/MagicHashSpec.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}+#if __GLASGOW_HASKELL__ == 800+-- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex+{-# OPTIONS_GHC -fsimpl-tick-factor=250 #-}+#endif {-| Module: Spec.Derived.MagicHashSpec
tests/Spec/Derived/RecordsSpec.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ == 800+-- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}+#endif+ {-| Module: Spec.Derived.RecordsSpec Copyright: (C) 2014-2017 Ryan Scott
tests/Spec/FromStringTextShowSpec.hs view
@@ -14,12 +14,12 @@ import Data.Proxy.Compat (Proxy(..)) import Instances.FromStringTextShow ()-import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec)+import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import TextShow (FromStringShow(..), FromTextShow(..)) #if defined(NEW_FUNCTOR_CLASSES)-import Spec.Utils (matchesTextShow2Spec)+import Spec.Utils (matchesTextShow1Spec, matchesTextShow2Spec) import TextShow (FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..)) #endif@@ -33,43 +33,33 @@ let p :: Proxy (FromStringShow Int) p = Proxy matchesTextShowSpec p- matchesTextShow1Spec p describe "FromStringShow String" $ do let p :: Proxy (FromStringShow String) p = Proxy matchesTextShowSpec p- matchesTextShow1Spec p describe "FromTextShow Int" $ do let p :: Proxy (FromTextShow Int) p = Proxy matchesTextShowSpec p- matchesTextShow1Spec p describe "FromTextShow String" $ do let p :: Proxy (FromTextShow String) p = Proxy matchesTextShowSpec p- matchesTextShow1Spec p #if defined(NEW_FUNCTOR_CLASSES) describe "FromStringShow1 Maybe Int" $ do let p :: Proxy (FromStringShow1 Maybe Int) p = Proxy- matchesTextShowSpec p matchesTextShow1Spec p describe "FromTextShow1 Maybe Int" $ do let p :: Proxy (FromTextShow1 Maybe Int) p = Proxy- matchesTextShowSpec p matchesTextShow1Spec p describe "FromStringShow2 Either Char Int" $ do let p :: Proxy (FromStringShow2 Either Char Int) p = Proxy- matchesTextShowSpec p- matchesTextShow1Spec p matchesTextShow2Spec p describe "FromTextShow2 Either Char Int" $ do let p :: Proxy (FromTextShow2 Either Char Int) p = Proxy- matchesTextShowSpec p- matchesTextShow1Spec p matchesTextShow2Spec p #endif
tests/Spec/Utils.hs view
@@ -49,7 +49,7 @@ -- | Verifies that a type's 'Show' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow :: (Show a, TextShow a) => Int -> a -> Expectation-prop_matchesTextShow p x = fromString (showsPrec p x "") `shouldBe` showbPrec p x+prop_matchesTextShow p x = showbPrec p x `shouldBe` fromString (showsPrec p x "") -- | Expect a type's 'Show1' instances to coincide for both 'String's and 'Text', -- irrespective of precedence.@@ -61,7 +61,7 @@ -- | Verifies that a type's 'Show1' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow1 :: (Show1 f, Show a, TextShow1 f, TextShow a) => Int -> f a -> Expectation-prop_matchesTextShow1 p x = fromString (showsPrec1 p x "") `shouldBe` showbPrec1 p x+prop_matchesTextShow1 p x = showbPrec1 p x `shouldBe` fromString (showsPrec1 p x "") #if defined(NEW_FUNCTOR_CLASSES) -- | Expect a type's 'Show2' instances to coincide for both 'String's and 'Text',@@ -76,33 +76,33 @@ -- irrespective of precedence. prop_matchesTextShow2 :: (Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b) => Int -> f a b -> Expectation-prop_matchesTextShow2 p x = fromString (showsPrec2 p x "") `shouldBe` showbPrec2 p x+prop_matchesTextShow2 p x = showbPrec2 p x `shouldBe` fromString (showsPrec2 p x "") #endif -- | Expect a type's 'TextShow' instance to coincide with the output produced -- by the equivalent 'Generic' functions. genericTextShowSpec :: forall a. (Arbitrary a, Show a, TextShow a,- Generic a, GTextShowB Zero (Rep a))+ Generic a, GTextShowB (Rep a ())) => Proxy a -> Spec genericTextShowSpec _ = prop "generic TextShow" (prop_genericTextShow :: Int -> a -> Expectation) -- | Verifies that a type's 'TextShow' instance coincides with the output produced -- by the equivalent 'Generic' functions.-prop_genericTextShow :: (TextShow a, Generic a, GTextShowB Zero (Rep a))+prop_genericTextShow :: (TextShow a, Generic a, GTextShowB (Rep a ())) => Int -> a -> Expectation prop_genericTextShow p x = showbPrec p x `shouldBe` genericShowbPrec p x -- | Expect a type's 'TextShow1' instance to coincide with the output produced -- by the equivalent 'Generic1' functions. genericTextShow1Spec :: forall f a. (Arbitrary (f a), Show (f a), TextShow1 f,- Generic1 f, GTextShowB One (Rep1 f), TextShow a)+ Generic1 f, GTextShowB1 (Rep1 f), TextShow a) => Proxy (f a) -> Spec genericTextShow1Spec _ = prop "generic TextShow1" (prop_genericTextShow1 :: Int -> f a -> Expectation) -- | Verifies that a type's 'TextShow1' instance coincides with the output produced -- by the equivalent 'Generic1' functions. prop_genericTextShow1 :: ( TextShow1 f, Generic1 f- , GTextShowB One (Rep1 f), TextShow a+ , GTextShowB1 (Rep1 f), TextShow a ) => Int -> f a -> Expectation prop_genericTextShow1 p x =
text-show.cabal view
@@ -1,5 +1,5 @@ name: text-show-version: 3.9.7+version: 3.10 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@@ -89,6 +89,7 @@ TextShow.Control.Exception TextShow.Control.Monad.ST TextShow.Data.Array+ TextShow.Data.Array.Byte TextShow.Data.Bool TextShow.Data.ByteString TextShow.Data.Char@@ -174,14 +175,14 @@ , th-lift >= 0.7.6 && < 1 if flag(base-4-9)- build-depends: base >= 4.9 && < 4.17+ build-depends: base >= 4.9 && < 4.18 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.7 && < 4.9 if flag(template-haskell-2-11)- build-depends: template-haskell >= 2.11 && < 2.19- , ghc-boot-th >= 8.0 && < 9.3+ build-depends: template-haskell >= 2.11 && < 2.20+ , ghc-boot-th >= 8.0 && < 9.5 else build-depends: template-haskell >= 2.9 && < 2.11 @@ -277,6 +278,7 @@ Spec.Control.ExceptionSpec Spec.Control.Monad.STSpec Spec.Data.ArraySpec+ Spec.Data.Array.ByteSpec Spec.Data.BoolSpec Spec.Data.ByteStringSpec Spec.Data.CharSpec@@ -361,15 +363,15 @@ , ghc-prim , hspec >= 2 && < 3 , QuickCheck >= 2.12 && < 2.15- , quickcheck-instances >= 0.3.26 && < 0.4- , template-haskell >= 2.9 && < 2.19+ , quickcheck-instances >= 0.3.28 && < 0.4+ , template-haskell >= 2.9 && < 2.20 , text >= 0.11.1 && < 2.1 , text-show , transformers-compat >= 0.5 && < 1 build-tool-depends: hspec-discover:hspec-discover if flag(base-4-9)- build-depends: base >= 4.9 && < 4.17+ build-depends: base >= 4.9 && < 4.18 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.7 && < 4.9@@ -394,7 +396,7 @@ benchmark bench type: exitcode-stdio-1.0 main-is: Bench.hs- build-depends: base >= 4.5 && < 4.17+ build-depends: base >= 4.5 && < 4.18 , criterion >= 1.1.4 && < 2 , deepseq >= 1.3 && < 2 , ghc-prim