diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +### 3.10.5 [2024.04.20] +* Support building with GHC 9.10. +* Ensure that the `TextShow` instance for `TypeRep` properly displays unboxed + tuple `TypeRep` values. +* Add a `TextShow` instance for `HpcFlags` (in `TextShow.GHC.RTS.Flags`) when + building with GHC 9.10 or later. + ### 3.10.4 [2023.08.06] * Support building with GHC 9.8. * Ensure that the `TextShow` instance for `TypeRep` properly displays diff --git a/benchmarks/Bench.hs b/benchmarks/Bench.hs --- a/benchmarks/Bench.hs +++ b/benchmarks/Bench.hs @@ -18,7 +18,7 @@ import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf) -import Data.List (foldl') +import qualified Data.Foldable as F import qualified Data.Text as T import GHC.Generics (Generic) @@ -121,12 +121,12 @@ mediumSample :: Sample mediumSample (leaf, branch, empty, showFun) = - showFun . foldl' branch empty . replicate 1000 $ sampleTree leaf branch + showFun . F.foldl' branch empty . replicate 1000 $ sampleTree leaf branch {-# NOINLINE mediumSample #-} largeSample :: Sample largeSample (leaf, branch, empty, showFun) = - showFun . foldl' branch empty . replicate 100000 $ sampleTree leaf branch + showFun . F.foldl' branch empty . replicate 100000 $ sampleTree leaf branch {-# NOINLINE largeSample #-} sampleTree :: (Int -> a) -> (a -> a -> a) -> a diff --git a/shared/TextShow/TH/Names.hs b/shared/TextShow/TH/Names.hs --- a/shared/TextShow/TH/Names.hs +++ b/shared/TextShow/TH/Names.hs @@ -35,7 +35,9 @@ -- | Creates a 'Name' for a value from the "GHC.Event.Internal" module. mkEventName_v :: String -> Name -#if MIN_VERSION_base(4,15,0) +#if MIN_VERSION_base(4,20,0) +mkEventName_v = mkNameG_v "ghc-internal" "GHC.Internal.Event.Internal.Types" +#elif MIN_VERSION_base(4,15,0) mkEventName_v = mkNameG_v "base" "GHC.Event.Internal.Types" #else mkEventName_v = mkNameG_v "base" "GHC.Event.Internal" @@ -51,15 +53,25 @@ -- | The 'Name' of 'FdKey'. fdKeyTypeName :: Name +#if MIN_VERSION_base(4,20,0) +fdKeyTypeName = mkNameG_tc "ghc-internal" "GHC.Internal.Event.Manager" "FdKey" +#else fdKeyTypeName = mkNameG_tc "base" "GHC.Event.Manager" "FdKey" +#endif -- | The 'Name' of 'Unique'. uniqueTypeName :: Name +#if MIN_VERSION_base(4,20,0) +uniqueTypeName = mkNameG_tc "ghc-internal" "GHC.Internal.Event.Unique" "Unique" +#else uniqueTypeName = mkNameG_tc "base" "GHC.Event.Unique" "Unique" +#endif -- | The 'Name' of 'asInt64' (or, 'asInt' on @base-4.10.0.0@ or later). asInt64ValName :: Name -#if MIN_VERSION_base(4,19,0) +#if MIN_VERSION_base(4,20,0) +asInt64ValName = mkNameG_fld "ghc-internal" "GHC.Internal.Event.Unique" "Unique" "asInt" +#elif MIN_VERSION_base(4,19,0) asInt64ValName = mkNameG_fld "base" "GHC.Event.Unique" "Unique" "asInt" #elif MIN_VERSION_base(4,10,0) asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt" diff --git a/src/TextShow/Data/Typeable.hs b/src/TextShow/Data/Typeable.hs --- a/src/TextShow/Data/Typeable.hs +++ b/src/TextShow/Data/Typeable.hs @@ -38,7 +38,10 @@ import GHC.Types (Module(..), TrName(..), TyCon(..), isTrue#) import TextShow.Classes (TextShow(..), TextShow1(..), showbParen, showbSpace) -import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) +import TextShow.Data.Typeable.Utils (showbArgs) +# if !(MIN_VERSION_base(4,20,0)) +import TextShow.Data.Typeable.Utils (showbTuple) +#endif import Type.Reflection (pattern App, pattern Con, pattern Con', pattern Fun, SomeTypeRep(..), TypeRep, @@ -113,7 +116,35 @@ #endif -- | Does the 'TyCon' represent a tuple type constructor? -#if MIN_VERSION_base(4,19,0) +#if MIN_VERSION_base(4,20,0) +isTupleTyCon :: TyCon -> Maybe (Bool, Int) +isTupleTyCon tc + | tyConPackage tc == "ghc-prim" + , tyConModule tc == "GHC.Tuple" || tyConModule tc == "GHC.Types" + = case tyConName tc of + "Unit" -> Just (True, 0) + "Unit#" -> Just (False, 0) + 'T' : 'u' : 'p' : 'l' : 'e' : arity -> readTwoDigits arity + _ -> Nothing + | otherwise = Nothing + +readTwoDigits :: String -> Maybe (Bool, Int) +readTwoDigits s = case s of + c1 : t1 | isDigit c1 -> case t1 of + [] -> Just (True, digit_to_int c1) + ['#'] -> Just (False, digit_to_int c1) + c2 : t2 | isDigit c2 -> + let ar = digit_to_int c1 * 10 + digit_to_int c2 + in case t2 of + [] -> Just (True, ar) + ['#'] -> Just (False, ar) + _ -> Nothing + _ -> Nothing + _ -> Nothing + where + digit_to_int :: Char -> Int + digit_to_int c = ord c - ord '0' +#elif MIN_VERSION_base(4,19,0) isTupleTyCon :: TyCon -> Maybe Int isTupleTyCon tc | tyConPackage tc == "ghc-prim" @@ -166,7 +197,11 @@ fromString "[]" | isListTyCon tc, [ty] <- tys = singleton '[' <> showb ty <> singleton ']' -# if MIN_VERSION_base(4,19,0) +# if MIN_VERSION_base(4,20,0) + | Just (boxed, n) <- isTupleTyCon tc, + Just sat <- plainOrSaturated boxed n = + tuple n boxed sat +# elif MIN_VERSION_base(4,19,0) | Just _ <- isTupleTyCon tc, Just _ <- typeRep @Type `eqTypeRep` typeRepKind rep = showbTuple tys @@ -180,7 +215,28 @@ # endif = showbTuple tys # endif - where (tc, tys) = splitApps rep + where + (tc, tys) = splitApps rep + +# if MIN_VERSION_base(4,20,0) + plainOrSaturated True _ | Just _ <- typeRep @Type `eqTypeRep` typeRepKind rep = Just True + plainOrSaturated False n | n == length tys = Just True + plainOrSaturated _ _ | [] <- tys = Just False + plainOrSaturated _ _ | otherwise = Nothing + + tuple n boxed sat = + let + (lpar, rpar) = case boxed of + True -> ("(", ")") + False -> ("(#", "#)") + commas = fromString (replicate (n-1) ',') + args = showbArgs (fromString ",") tys + args' = case (boxed, sat) of + (True, True) -> args + (False, True) -> singleton ' ' <> args <> singleton ' ' + (_, False) -> commas + in fromString lpar <> args' <> fromString rpar +# endif showbTypeable p (Con' tycon []) = showbPrec p tycon showbTypeable p (Con' tycon args) diff --git a/src/TextShow/GHC/RTS/Flags.hs b/src/TextShow/GHC/RTS/Flags.hs --- a/src/TextShow/GHC/RTS/Flags.hs +++ b/src/TextShow/GHC/RTS/Flags.hs @@ -67,6 +67,12 @@ -- /Since: 3.3/ $(deriveTextShow ''ParFlags) # endif +# if MIN_VERSION_base(4,20,0) +-- | Only available with @base-4.20.0.0@ or later. +-- +-- /Since: 3.10.5/ +$(deriveTextShow ''HpcFlags) +# endif -- | /Since: 2/ $(deriveTextShow ''RTSFlags) #endif diff --git a/tests/Instances/GHC/RTS/Flags.hs b/tests/Instances/GHC/RTS/Flags.hs --- a/tests/Instances/GHC/RTS/Flags.hs +++ b/tests/Instances/GHC/RTS/Flags.hs @@ -101,6 +101,11 @@ arbitrary = genericArbitrary # endif +# if MIN_VERSION_base(4,20,0) +instance Arbitrary HpcFlags where + arbitrary = genericArbitrary +# endif + type GiveGCStats' = $(conT giveGCStatsTypeName) type DoCostCentres' = $(conT doCostCentresTypeName) type DoHeapProfile' = $(conT doHeapProfileTypeName) diff --git a/text-show.cabal b/text-show.cabal --- a/text-show.cabal +++ b/text-show.cabal @@ -1,5 +1,5 @@ name: text-show -version: 3.10.4 +version: 3.10.5 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 @@ -62,8 +62,10 @@ , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8 - , GHC == 9.4.5 - , GHC == 9.6.2 + , GHC == 9.4.8 + , GHC == 9.6.5 + , GHC == 9.8.2 + , GHC == 9.10.1 extra-source-files: CHANGELOG.md, README.md, include/*.h cabal-version: >=1.10 @@ -178,22 +180,22 @@ , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.13 , bytestring-builder - , containers >= 0.1 && < 0.7 + , containers >= 0.1 && < 0.8 , generic-deriving >= 1.14.1 && < 2 , ghc-prim - , text >= 0.11.1 && < 2.1 - , th-abstraction >= 0.4 && < 0.7 + , text >= 0.11.1 && < 2.2 + , th-abstraction >= 0.4 && < 0.8 , th-lift >= 0.7.6 && < 1 if flag(base-4-9) - build-depends: base >= 4.9 && < 4.20 + build-depends: base >= 4.9 && < 4.21 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.22 - , ghc-boot-th >= 8.0 && < 9.9 + build-depends: template-haskell >= 2.11 && < 2.23 + , ghc-boot-th >= 8.0 && < 9.11 else build-depends: template-haskell >= 2.9 && < 2.11 @@ -375,14 +377,14 @@ , hspec >= 2 && < 3 , QuickCheck >= 2.14.3 && < 2.15 , quickcheck-instances >= 0.3.28 && < 0.4 - , template-haskell >= 2.9 && < 2.22 - , text >= 0.11.1 && < 2.1 + , template-haskell >= 2.9 && < 2.23 + , text >= 0.11.1 && < 2.2 , 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.20 + build-depends: base >= 4.9 && < 4.21 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.7 && < 4.9 @@ -407,12 +409,12 @@ benchmark bench type: exitcode-stdio-1.0 main-is: Bench.hs - build-depends: base >= 4.5 && < 4.20 + build-depends: base >= 4.5 && < 4.21 , criterion >= 1.1.4 && < 2 , deepseq >= 1.3 && < 2 , ghc-prim , text-show - , text >= 0.11.1 && < 2.1 + , text >= 0.11.1 && < 2.2 hs-source-dirs: benchmarks default-language: Haskell2010