text-show 3.8.1 → 3.8.2
raw patch · 7 files changed
+216/−32 lines, 7 filesdep ~basedep ~base-compat-batteriesdep ~deriving-compat
Dependency ranges changed: base, base-compat-batteries, deriving-compat, ghc-boot-th, template-haskell
Files
- CHANGELOG.md +6/−0
- src/TextShow/Data/Array.hs +9/−1
- src/TextShow/Data/Fixed.hs +8/−0
- src/TextShow/TH/Internal.hs +101/−20
- tests/Derived/MagicHash.hs +68/−1
- tests/Spec/Derived/MagicHashSpec.hs +14/−1
- text-show.cabal +10/−9
CHANGELOG.md view
@@ -1,3 +1,9 @@+### 3.8.2 [2019.05.02]+* Make the `TextShow` instances for `UArray` and `Fixed` use the correct+ precedence on `base-4.13` or later.+* Support deriving `TextShow(1)(2)` instances for data types with fields+ of type `Int8#`, `Int16#`, `Word8#`, or `Word16#` on GHC 8.8 or later.+ ### 3.8.1 [2019.04.26] * Support `th-abstraction-0.3` or later.
src/TextShow/Data/Array.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-}@@ -41,11 +42,18 @@ -- -- /Since: 2/ showbIArrayPrec :: (IArray a e, Ix i, TextShow i, TextShow e) => Int -> a i e -> Builder-showbIArrayPrec p a = showbParen (p > 9) $+showbIArrayPrec p a = showbParen (p > arrayPrec) $ "array " <> showb (IArray.bounds a) <> showbSpace <> showb (IArray.assocs a)+ where+ arrayPrec :: Int+#if MIN_VERSION_base(4,13,0)+ arrayPrec = appPrec+#else+ arrayPrec = 9+#endif -- | /Since: 2/ instance (TextShow i, TextShow e, Ix i) => TextShow (Array i e) where
src/TextShow/Data/Fixed.hs view
@@ -35,6 +35,10 @@ import Data.Text.Lazy.Builder (fromString) #endif +#if MIN_VERSION_base(4,13,0)+import TextShow.Classes (showbParen)+#endif+ -- | Convert a 'Fixed' value to a 'Builder', where the first argument indicates -- whether to chop off trailing zeroes. --@@ -87,5 +91,9 @@ -- | /Since: 2/ instance HasResolution a => TextShow (Fixed a) where+#if MIN_VERSION_base(4,13,0)+ showbPrec p n = showbParen (p > 6 && n < 0) $ showbFixed False n+#else showb = showbFixed False {-# INLINE showb #-}+#endif
src/TextShow/TH/Internal.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Internal@@ -73,7 +74,12 @@ 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.Exts ( Char(..), Double(..), Float(..), Int(..), Word(..)+#if MIN_VERSION_base(4,13,0)+ , Int8#, Int16#, Word8#, Word16#+ , extendInt8#, extendInt16#, extendWord8#, extendWord16#+#endif+ ) import GHC.Prim (Char#, Double#, Float#, Int#, Word#) import GHC.Show (appPrec, appPrec1) @@ -704,29 +710,29 @@ showPrecE = varE (showPrecName TextShow tsFun) showE :: Q Exp- showE | tyName == ''Char# = showPrimE 'C# oneHashE- | tyName == ''Double# = showPrimE 'D# twoHashE- | tyName == ''Float# = showPrimE 'F# oneHashE- | tyName == ''Int# = showPrimE 'I# oneHashE- | tyName == ''Word# = showPrimE 'W# twoHashE- | otherwise = showPrecE `appE` integerE p `appE` tyVarE+ showE =+ case Map.lookup tyName primShowTbl of+ Just ps -> showPrimE ps+ Nothing -> showPrecE `appE` integerE p `appE` tyVarE - -- 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.- showPrimE :: Name -> Q Exp -> Q Exp- showPrimE con _hashE-#if __GLASGOW_HASKELL__ >= 711- = infixApp (showPrecE `appE` integerE 0 `appE` (conE con `appE` tyVarE))- [| (<>) |]- _hashE+ showPrimE :: PrimShow -> Q Exp+ showPrimE PrimShow{ primShowBoxer+#if __GLASGOW_HASKELL__ >= 800+ , primShowPostfixMod, primShowConv+#endif+ }+#if __GLASGOW_HASKELL__ >= 800+ -- Starting with GHC 8.0, 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.+ = primShowConv tsFun $ infixApp (primE 0) [| (<>) |] (primShowPostfixMod tsFun) #else- = showPrecE `appE` integerE p `appE` (conE con `appE` tyVarE)+ = primE p #endif+ where+ primE :: Int -> Q Exp+ primE prec = showPrecE `appE` integerE prec `appE` primShowBoxer tyVarE - oneHashE, twoHashE :: Q Exp- oneHashE = varE (singletonName tsFun) `appE` charE '#'- twoHashE = varE (fromStringName tsFun) `appE` stringE "##" makeTextShowForArg p tsClass tsFun conName tvMap ty tyExpName = [| $(makeTextShowForType tsClass tsFun conName tvMap False ty) p $(varE tyExpName) |] @@ -1221,6 +1227,81 @@ -- the kind variables' Names out. catKindVarNames :: [StarKindStatus] -> [Name] catKindVarNames = mapMaybe starKindStatusToName++-------------------------------------------------------------------------------+-- PrimShow+-------------------------------------------------------------------------------++data PrimShow = PrimShow+ { primShowBoxer :: Q Exp -> Q Exp+ , primShowPostfixMod :: TextShowFun -> Q Exp+ , primShowConv :: TextShowFun -> Q Exp -> Q Exp+ }++primShowTbl :: Map Name PrimShow+primShowTbl = Map.fromList+ [ (''Char#, PrimShow+ { primShowBoxer = appE (conE 'C#)+ , primShowPostfixMod = oneHashE+ , primShowConv = \_ x -> x+ })+ , (''Double#, PrimShow+ { primShowBoxer = appE (conE 'D#)+ , primShowPostfixMod = twoHashE+ , primShowConv = \_ x -> x+ })+ , (''Float#, PrimShow+ { primShowBoxer = appE (conE 'F#)+ , primShowPostfixMod = oneHashE+ , primShowConv = \_ x -> x+ })+ , (''Int#, PrimShow+ { primShowBoxer = appE (conE 'I#)+ , primShowPostfixMod = oneHashE+ , primShowConv = \_ x -> x+ })+ , (''Word#, PrimShow+ { primShowBoxer = appE (conE 'W#)+ , primShowPostfixMod = twoHashE+ , primShowConv = \_ x -> x+ })+#if MIN_VERSION_base(4,13,0)+ , (''Int8#, PrimShow+ { primShowBoxer = appE (conE 'I#) . appE (varE 'extendInt8#)+ , primShowPostfixMod = oneHashE+ , primShowConv = mkNarrowE "narrowInt8#"+ })+ , (''Int16#, PrimShow+ { primShowBoxer = appE (conE 'I#) . appE (varE 'extendInt16#)+ , primShowPostfixMod = oneHashE+ , primShowConv = mkNarrowE "narrowInt16#"+ })+ , (''Word8#, PrimShow+ { primShowBoxer = appE (conE 'W#) . appE (varE 'extendWord8#)+ , primShowPostfixMod = twoHashE+ , primShowConv = mkNarrowE "narrowWord8#"+ })+ , (''Word16#, PrimShow+ { primShowBoxer = appE (conE 'W#) . appE (varE 'extendWord16#)+ , primShowPostfixMod = twoHashE+ , primShowConv = mkNarrowE "narrowWord16#"+ })+#endif+ ]++#if MIN_VERSION_base(4,13,0)+mkNarrowE :: String -> TextShowFun -> Q Exp -> Q Exp+mkNarrowE narrowStr tsFun e =+ foldr (`infixApp` [| (<>) |])+ (varE (singletonName tsFun) `appE` charE ')')+ [ varE (fromStringName tsFun) `appE` stringE ('(':narrowStr ++ " ")+ , e+ ]+#endif++oneHashE, twoHashE :: TextShowFun -> Q Exp+oneHashE tsFun = varE (singletonName tsFun) `appE` charE '#'+twoHashE tsFun = varE (fromStringName tsFun) `appE` stringE "##" ------------------------------------------------------------------------------- -- Assorted utilities
tests/Derived/MagicHash.hs view
@@ -18,7 +18,12 @@ Defines data types with fields that have unlifted types. -}-module Derived.MagicHash (TyCon#(..), TyFamily#(..)) where+module Derived.MagicHash (+ TyCon#(..), TyFamily#(..)+#if MIN_VERSION_base(4,13,0)+ , TyCon'#(..), TyFamily'#(..)+#endif+ ) where #if __GLASGOW_HASKELL__ < 711 import qualified Generics.Deriving.TH as Generics@@ -59,6 +64,17 @@ #endif ) +#if MIN_VERSION_base(4,13,0)+data TyCon'# a b = TyCon'# {+ tcA' :: a+ , tcB' :: b+ , tcInt8# :: Int8#+ , tcInt16# :: Int16#+ , tcWord8# :: Word8#+ , tcWord16# :: Word16#+} deriving Show+#endif+ ------------------------------------------------------------------------------- data family TyFamily# y z :: *@@ -78,6 +94,19 @@ #endif ) +#if MIN_VERSION_base(4,13,0)+data family TyFamily'# y z :: *++data instance TyFamily'# a b = TyFamily'# {+ tfA' :: a+ , tfB' :: b+ , tfInt8# :: Int8#+ , tfInt16# :: Int16#+ , tfWord8# :: Word8#+ , tfWord16# :: Word16#+} deriving Show+#endif+ ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon# a b) where@@ -86,6 +115,30 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily# a b) where arbitrary = genericArbitrary +#if MIN_VERSION_base(4,13,0)+instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon'# a b) where+ arbitrary = do+ a <- arbitrary+ b <- arbitrary+ I# i1 <- arbitrary+ I# i2 <- arbitrary+ W# w1 <- arbitrary+ W# w2 <- arbitrary+ pure $ TyCon'# a b (narrowInt8# i1) (narrowInt16# i2)+ (narrowWord8# w1) (narrowWord16# w2)++instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily'# a b) where+ arbitrary = do+ a <- arbitrary+ b <- arbitrary+ I# i1 <- arbitrary+ I# i2 <- arbitrary+ W# w1 <- arbitrary+ W# w2 <- arbitrary+ pure $ TyFamily'# a b (narrowInt8# i1) (narrowInt16# i2)+ (narrowWord8# w1) (narrowWord16# w2)+#endif+ ------------------------------------------------------------------------------- $(deriveShow1Options legacyShowOptions ''TyCon#)@@ -114,4 +167,18 @@ #if __GLASGOW_HASKELL__ < 711 $(Generics.deriveAll0And1 'TyFamily#)+#endif++#if MIN_VERSION_base(4,13,0)+$(deriveShow1Options legacyShowOptions ''TyCon'#)+$(deriveShow2Options legacyShowOptions ''TyCon'#)+$(deriveTextShow ''TyCon'#)+$(deriveTextShow1 ''TyCon'#)+$(deriveTextShow2 ''TyCon'#)++$(deriveShow1Options legacyShowOptions 'TyFamily'#)+$(deriveShow2Options legacyShowOptions 'TyFamily'#)+$(deriveTextShow 'TyFamily'#)+$(deriveTextShow1 'TyFamily'#)+$(deriveTextShow2 'TyFamily'#) #endif
tests/Spec/Derived/MagicHashSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-|@@ -14,7 +15,7 @@ import Data.Proxy (Proxy(..)) import Derived.MagicHash-import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec)+import Spec.Utils import Test.Hspec (Spec, describe, hspec, parallel) main :: IO ()@@ -34,3 +35,15 @@ matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p+#if MIN_VERSION_base(4,13,0)+ describe "TyCon'# Int Int" $ do+ let p :: Proxy (TyCon'# Int Int)+ p = Proxy+ matchesTextShowSpec p+ matchesTextShow2Spec p+ describe "TyFamily'# Int Int" $ do+ let p :: Proxy (TyFamily'# Int Int)+ p = Proxy+ matchesTextShowSpec p+ matchesTextShow2Spec p+#endif
text-show.cabal view
@@ -1,5 +1,5 @@ name: text-show-version: 3.8.1+version: 3.8.2 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@@ -50,7 +50,8 @@ , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4- , GHC == 8.6.4+ , GHC == 8.6.5+ , GHC == 8.8.1 extra-source-files: CHANGELOG.md, README.md, include/*.h cabal-version: >=1.10 @@ -171,14 +172,14 @@ , void >= 0.5 && < 1 if flag(base-4-9)- build-depends: base >= 4.9 && < 4.13+ build-depends: base >= 4.9 && < 4.14 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.5 && < 4.9 if flag(template-haskell-2-11)- build-depends: template-haskell >= 2.11 && < 2.15- , ghc-boot-th >= 8.0 && < 8.7+ build-depends: template-haskell >= 2.11 && < 2.16+ , ghc-boot-th >= 8.0 && < 8.9 else build-depends: template-haskell >= 2.5 && < 2.11 @@ -342,7 +343,7 @@ , base-orphans >= 0.6 && < 0.9 , bytestring >= 0.9 && < 0.11 , bytestring-builder- , deriving-compat >= 0.3.4 && < 1+ , deriving-compat >= 0.5.6 && < 1 , generic-deriving >= 1.11 && < 2 , ghc-prim , hspec >= 2 && < 3@@ -351,14 +352,14 @@ , quickcheck-instances >= 0.3.18 && < 0.4 , semigroups >= 0.18.3 && < 1 , tagged >= 0.8.3 && < 1- , template-haskell >= 2.5 && < 2.15+ , template-haskell >= 2.5 && < 2.16 , text >= 0.11.1 && < 1.3 , 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.13+ build-depends: base >= 4.9 && < 4.14 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.5 && < 4.9@@ -379,7 +380,7 @@ benchmark bench type: exitcode-stdio-1.0 main-is: Bench.hs- build-depends: base >= 4.5 && < 4.13+ build-depends: base >= 4.5 && < 4.14 , criterion >= 1.1.4 && < 2 , deepseq >= 1.3 && < 2 , ghc-prim