text-show 3.0.1 → 3.1
raw patch · 12 files changed
+102/−122 lines, 12 filesdep ~basedep ~base-orphansdep ~generic-deriving
Dependency ranges changed: base, base-orphans, generic-deriving, ghc-boot, text-show
Files
- CHANGELOG.md +4/−0
- src/TextShow/Data/Typeable.hs +5/−4
- src/TextShow/Generic.hs +1/−6
- src/TextShow/TH/Internal.hs +2/−8
- tests/Derived/DataFamilies.hs +35/−56
- tests/Derived/MagicHash.hs +2/−6
- tests/Derived/PolyKinds.hs +15/−2
- tests/Derived/Records.hs +2/−6
- tests/Derived/TypeSynonyms.hs +18/−10
- tests/Instances/GHC/Generics.hs +2/−8
- tests/Spec/Derived/DataFamiliesSpec.hs +12/−12
- text-show.cabal +4/−4
CHANGELOG.md view
@@ -1,3 +1,7 @@+## 3.1+* Made the derived `TextShow` output of record datatypes match that of `Show` in GHC 8.0 (now that Trac #2530 has been reverted)+* Fixed GHC 8.0 build (again)+ ### 3.0.1 * Added the `TextShow.GHC.Stack` module, which provides `TextShow` instances for `CallStack` and `SrcLoc` on `base-4.8.1` and up. * Fix Haddock rendering error
src/TextShow/Data/Typeable.hs view
@@ -2,12 +2,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif +{-# OPTIONS_GHC -fno-warn-orphans #-}+ {-| Module: TextShow.Data.Typeable Copyright: (C) 2014-2016 Ryan Scott@@ -39,7 +40,7 @@ # endif # if MIN_VERSION_base(4,9,0) import Data.Typeable.Internal (Proxy(..), Typeable, TypeRep(TypeRep), typeRep)-import GHC.Exts (Levity(..), TYPE)+import GHC.Exts (RuntimeRep(..), TYPE) # elif MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (funTc, listTc) # endif@@ -116,10 +117,10 @@ tcTYPE = tyConOf (Proxy :: Proxy TYPE) tc'Lifted :: TyCon-tc'Lifted = tyConOf (Proxy :: Proxy 'Lifted)+tc'Lifted = tyConOf (Proxy :: Proxy 'PtrRepLifted) tc'Unlifted :: TyCon-tc'Unlifted = tyConOf (Proxy :: Proxy 'Unlifted)+tc'Unlifted = tyConOf (Proxy :: Proxy 'PtrRepUnlifted) #elif MIN_VERSION_base(4,4,0) -- | The list 'TyCon'. tcList :: TyCon
src/TextShow/Generic.hs view
@@ -463,12 +463,7 @@ -> Int -> C1 c f p -> Builder gShowbConstructor gs p c@(M1 x) = case fixity of Prefix -> showbParen ( p > appPrec- && not ( isNullary x- || conIsTuple c-#if __GLASGOW_HASKELL__ >= 711- || conIsRecord c-#endif- )+ && not (isNullary x || conIsTuple c) ) $ (if conIsTuple c then mempty
src/TextShow/TH/Internal.hs view
@@ -537,7 +537,7 @@ return [m] makeTextShowForCon p tsClass spls (RecC conName []) = makeTextShowForCon p tsClass spls $ NormalC conName []-makeTextShowForCon _p tsClass spls (RecC conName ts) = do+makeTextShowForCon p tsClass spls (RecC conName ts) = do (argTys, tvMap) <- reifyConTys tsClass spls conName args <- newNameList "arg" $ length argTys @@ -556,13 +556,7 @@ m <- match (conP conName $ map varP args)- (normalB-#if __GLASGOW_HASKELL__ >= 711- namedArgs-#else- [| showbParen ($(varE _p) > $(lift appPrec)) $(namedArgs) |]-#endif- )+ (normalB [| showbParen ($(varE p) > $(lift appPrec)) $(namedArgs) |]) [] return [m] makeTextShowForCon p tsClass spls (InfixC _ conName _) = do
tests/Derived/DataFamilies.hs view
@@ -11,6 +11,7 @@ #endif #if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif @@ -66,8 +67,7 @@ #endif #if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)-import Data.Functor.Classes (Show2(..))-import GHC.Show (appPrec, appPrec1, showSpace)+import Data.Functor.Classes (Show2(..), showsUnaryWith, showsBinaryWith) #endif -------------------------------------------------------------------------------@@ -98,13 +98,10 @@ instance (Show b, Show c) => Show1 (NotAllShow Int b c) where liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show b => Show2 (NotAllShow Int b) where- liftShowsPrec2 sp1 _ _ _ p (NASShow1 c b) = showParen (p > appPrec) $- showString "NASShow1 "- . sp1 appPrec1 c . showSpace- . showsPrec appPrec1 b- liftShowsPrec2 _ _ sp2 _ p (NASShow2 d) = showParen (p > appPrec) $- showString "NASShow2 "- . sp2 appPrec1 d+ liftShowsPrec2 sp1 _ _ _ p (NASShow1 c b) =+ showsBinaryWith sp1 showsPrec "NASShow1" p c b+ liftShowsPrec2 _ _ sp2 _ p (NASShow2 d) =+ showsUnaryWith sp2 "NASShow2" p d #endif #if MIN_VERSION_template_haskell(2,7,0)@@ -127,78 +124,60 @@ #if __GLASGOW_HASKELL__ >= 706 data family KindDistinguished (x :: k) (y :: *) (z :: *) :: * -newtype instance KindDistinguished (a :: *) b c = KindDistinguished1 b- deriving ( Arbitrary- , Show+data instance KindDistinguished (a :: ()) b c = KindDistinguishedUnit b c+ deriving ( Show , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif ) -newtype instance KindDistinguished (a :: * -> *) b c = KindDistinguished2 b- deriving ( Arbitrary- , Show+data instance KindDistinguished (a :: Bool) b c = KindDistinguishedBool b c+ deriving ( Show , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif ) -newtype instance KindDistinguished Either b c = KindDistinguished3 b- deriving ( Arbitrary- , Show- , Generic-# if defined(__LANGUAGE_DERIVE_GENERIC1__)- , Generic1-# endif- )+instance (Arbitrary b, Arbitrary c)+ => Arbitrary (KindDistinguished (a :: ()) b c) where+ arbitrary = KindDistinguishedUnit <$> arbitrary <*> arbitrary +instance (Arbitrary b, Arbitrary c)+ => Arbitrary (KindDistinguished (a :: Bool) b c) where+ arbitrary = KindDistinguishedBool <$> arbitrary <*> arbitrary+ #if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-instance Show b => Show1 (KindDistinguished (a :: *) b) where- showsPrec1 = showsPrec-instance Show b => Show1 (KindDistinguished (a :: * -> *) b) where+instance Show b => Show1 (KindDistinguished (a :: ()) b) where showsPrec1 = showsPrec-instance Show b => Show1 (KindDistinguished (Either :: * -> * -> *) b) where+instance Show b => Show1 (KindDistinguished (a :: Bool) b) where showsPrec1 = showsPrec #else-instance Show b => Show1 (KindDistinguished (a :: *) b) where- liftShowsPrec = liftShowsPrec2 showsPrec showList-instance Show b => Show1 (KindDistinguished (a :: * -> *) b) where+instance Show b => Show1 (KindDistinguished (a :: ()) b) where liftShowsPrec = liftShowsPrec2 showsPrec showList-instance Show b => Show1 (KindDistinguished (Either :: * -> * -> *) b) where+instance Show b => Show1 (KindDistinguished (a :: Bool) b) where liftShowsPrec = liftShowsPrec2 showsPrec showList -instance Show2 (KindDistinguished (a :: *)) where- liftShowsPrec2 sp1 _ _ _ p (KindDistinguished1 b) = showParen (p > appPrec) $- showString "KindDistinguished1 "- . sp1 appPrec1 b-instance Show2 (KindDistinguished (a :: * -> *)) where- liftShowsPrec2 sp1 _ _ _ p (KindDistinguished2 b) = showParen (p > appPrec) $- showString "KindDistinguished2 "- . sp1 appPrec1 b-instance Show2 (KindDistinguished (Either :: * -> * -> *)) where- liftShowsPrec2 sp1 _ _ _ p (KindDistinguished3 b) = showParen (p > appPrec) $- showString "KindDistinguished3 "- . sp1 appPrec1 b+instance Show2 (KindDistinguished (a :: ())) where+ liftShowsPrec2 sp1 _ sp2 _ p (KindDistinguishedUnit b c) =+ showsBinaryWith sp1 sp2 "KindDistinguishedUnit" p b c+instance Show2 (KindDistinguished (a :: Bool)) where+ liftShowsPrec2 sp1 _ sp2 _ p (KindDistinguishedBool b c) =+ showsBinaryWith sp1 sp2 "KindDistinguishedBool" p b c #endif -$(deriveTextShow 'KindDistinguished1)-$(deriveTextShow1 'KindDistinguished1)-$(deriveTextShow2 'KindDistinguished1)--$(deriveTextShow 'KindDistinguished2)-$(deriveTextShow1 'KindDistinguished2)-$(deriveTextShow2 'KindDistinguished2)+$(deriveTextShow 'KindDistinguishedUnit)+$(deriveTextShow1 'KindDistinguishedUnit)+$(deriveTextShow2 'KindDistinguishedUnit) -$(deriveTextShow 'KindDistinguished3)-$(deriveTextShow1 'KindDistinguished3)-$(deriveTextShow2 'KindDistinguished3)+$(deriveTextShow 'KindDistinguishedBool)+$(deriveTextShow1 'KindDistinguishedBool)+$(deriveTextShow2 'KindDistinguishedBool) # if !defined(__LANGUAGE_DERIVE_GENERIC1__)-$(Generics.deriveAll1 'KindDistinguished1)-$(Generics.deriveAll1 'KindDistinguished2)-$(Generics.deriveAll1 'KindDistinguished3)+$(Generics.deriveAll1 'KindDistinguishedUnit)+$(Generics.deriveAll1 'KindDistinguishedBool) # endif #endif
tests/Derived/MagicHash.hs view
@@ -40,9 +40,7 @@ #if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0) import Data.Functor.Classes (Show2(..)) import GHC.Show (showSpace)-# if __GLASGOW_HASKELL__ < 711 import GHC.Show (appPrec)-# endif #endif -------------------------------------------------------------------------------@@ -131,10 +129,8 @@ -> String -> String -> String -> String -> String -> String -> String -> String -> Int -> a -> b -> Int# -> Float# -> Double# -> Char# -> Word# -> ShowS-showsHash sp1 sp2 con rec1 rec2 rec3 rec4 rec5 rec6 rec7 _p a b i f d c w =-# if __GLASGOW_HASKELL__ < 711- showParen (_p > appPrec) $-# endif+showsHash sp1 sp2 con rec1 rec2 rec3 rec4 rec5 rec6 rec7 p a b i f d c w =+ showParen (p > appPrec) $ showString con . showSpace . showChar '{' . showString rec1 . equals . sp1 0 a . comma
tests/Derived/PolyKinds.hs view
@@ -43,7 +43,7 @@ import Data.Functor.Classes (Show1(..)) import Generics.Deriving.Base-#if !defined(__LANGUAGE_DERIVE_GENERIC1__) || MIN_VERSION_template_haskell(2,7,0)+#if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif @@ -138,6 +138,12 @@ deriving instance Arbitrary (f (g (j a) (k a)) (h (j a) (k b))) => Arbitrary (TyFamilyCompose f g h j k a b) +#if defined(__LANGUAGE_DERIVE_GENERIC1__)+deriving instance ( Functor (f (g (j a) (k a)))+ , Functor (h (j a))+ ) => Generic1 (TyFamilyCompose f g h j k a)+#endif+ deriving instance Show (f (g (j a) (k a)) (h (j a) (k b))) => Show (TyFamilyCompose f g h j k a b) @@ -157,6 +163,9 @@ , Show #if __GLASGOW_HASKELL__ >= 706 , Generic+# if defined(__LANGUAGE_DERIVE_GENERIC1__)+ , Generic1+# endif #endif ) @@ -186,6 +195,9 @@ , Show #if __GLASGOW_HASKELL__ >= 706 , Generic+# if defined(__LANGUAGE_DERIVE_GENERIC1__)+ , Generic1+# endif #endif ) @@ -384,7 +396,7 @@ #endif #if MIN_VERSION_template_haskell(2,7,0)--- TODO: Reinstate CPP bounds once Trac #11357 is fixed+# if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamilyCompose) $(Generics.deriveRep1 'TyFamilyCompose) @@ -399,6 +411,7 @@ $(Generics.deriveRepresentable1 'TyFamilyProxy) $(Generics.deriveMeta 'TyFamilyReallyHighKinds) $(Generics.deriveRepresentable1 'TyFamilyReallyHighKinds)+# endif # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyCompose)
tests/Derived/Records.hs view
@@ -43,9 +43,7 @@ #if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0) import Data.Functor.Classes (Show2(..)) import GHC.Show (showSpace)-# if __GLASGOW_HASKELL__ < 711 import GHC.Show (appPrec)-# endif #endif -------------------------------------------------------------------------------@@ -116,10 +114,8 @@ showsRecord :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> String -> String -> String -> Int -> a -> b -> ShowS-showsRecord sp1 sp2 con rec1 rec2 _p a b =-# if __GLASGOW_HASKELL__ < 711- showParen (_p > appPrec) $-# endif+showsRecord sp1 sp2 con rec1 rec2 p a b =+ showParen (p > appPrec) $ showString con . showSpace . showChar '{' . showString rec1 . showString " = " . sp1 0 a . showString ", "
tests/Derived/TypeSynonyms.hs view
@@ -120,18 +120,26 @@ instance Show2 TyCon where liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyCon x) =- showsUnaryWith (liftShowsPrec2 (liftShowsPrec2 showsPrec showList sp1 sl1)- (liftShowList2 showsPrec showList sp1 sl1)- (liftShowsPrec2 sp1 sl1 sp2 sl2)- (liftShowList2 sp1 sl1 sp2 sl2)- ) "TyCon" p x+ showsTypeSynonym sp1 sl1 sp2 sl2 "TyCon" p x instance Show2 TyFamily where liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyFamily x) =- showsUnaryWith (liftShowsPrec2 (liftShowsPrec2 showsPrec showList sp1 sl1)- (liftShowList2 showsPrec showList sp1 sl1)- (liftShowsPrec2 sp1 sl1 sp2 sl2)- (liftShowList2 sp1 sl1 sp2 sl2)- ) "TyFamily" p x+ showsTypeSynonym sp1 sl1 sp2 sl2 "TyFamily" p x++showsTypeSynonym :: (Int -> a -> ShowS) -> ([a] -> ShowS)+ -> (Int -> b -> ShowS) -> ([b] -> ShowS)+ -> String -> Int+ -> ( Id (FakeOut (Id a))+ , Id (FakeOut (Id b))+ , Id (Flip Either (Id a) (Id Int))+ , Id (Flip Either (Id b) (Id a))+ )+ -> ShowS+showsTypeSynonym sp1 sl1 sp2 sl2 name p x =+ showsUnaryWith (liftShowsPrec2 (liftShowsPrec2 showsPrec showList sp1 sl1)+ (liftShowList2 showsPrec showList sp1 sl1)+ (liftShowsPrec2 sp1 sl1 sp2 sl2)+ (liftShowList2 sp1 sl1 sp2 sl2)+ ) name p x #endif -------------------------------------------------------------------------------
tests/Instances/GHC/Generics.hs view
@@ -20,6 +20,8 @@ -} module Instances.GHC.Generics () where +import Data.Orphans ()+ import Generics.Deriving.Base import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#))@@ -47,24 +49,16 @@ instance Arbitrary Fixity where arbitrary = oneof [pure Prefix, Infix <$> arbitrary <*> arbitrary] -deriving instance Bounded Associativity-deriving instance Enum Associativity instance Arbitrary Associativity where arbitrary = arbitraryBoundedEnum #if MIN_VERSION_base(4,9,0)-deriving instance Bounded SourceUnpackedness-deriving instance Enum SourceUnpackedness instance Arbitrary SourceUnpackedness where arbitrary = arbitraryBoundedEnum -deriving instance Bounded SourceStrictness-deriving instance Enum SourceStrictness instance Arbitrary SourceStrictness where arbitrary = arbitraryBoundedEnum -deriving instance Bounded DecidedStrictness-deriving instance Enum DecidedStrictness instance Arbitrary DecidedStrictness where arbitrary = arbitraryBoundedEnum #else
tests/Spec/Derived/DataFamiliesSpec.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE DataKinds #-}+#endif+ {-| Module: Spec.Derived.DataFamiliesSpec Copyright: (C) 2014-2016 Ryan Scott@@ -46,18 +50,14 @@ prop "generic TextShow" (prop_genericTextShow :: Int -> NotAllShow Int Int Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> NotAllShow Int Int Int Int -> Bool) # if __GLASGOW_HASKELL__ >= 706- describe "KindDistinguished Int Int Int" $ do- prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> KindDistinguished Int Int Int -> Bool)- prop "generic TextShow" (prop_genericTextShow :: Int -> KindDistinguished Int Int Int -> Bool)- prop "generic TextShow1" (prop_genericTextShow1 :: Int -> KindDistinguished Int Int Int -> Bool)- describe "KindDistinguished Maybe Int Int" $ do- prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> KindDistinguished Maybe Int Int -> Bool)- prop "generic TextShow" (prop_genericTextShow :: Int -> KindDistinguished Maybe Int Int -> Bool)- prop "generic TextShow1" (prop_genericTextShow1 :: Int -> KindDistinguished Maybe Int Int -> Bool)- describe "KindDistinguished Either Int Int" $ do- prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> KindDistinguished Either Int Int -> Bool)- prop "generic TextShow" (prop_genericTextShow :: Int -> KindDistinguished Either Int Int -> Bool)- prop "generic TextShow1" (prop_genericTextShow1 :: Int -> KindDistinguished Either Int Int -> Bool)+ describe "KindDistinguished '() Int Int" $ do+ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> KindDistinguished '() Int Int -> Bool)+ prop "generic TextShow" (prop_genericTextShow :: Int -> KindDistinguished '() Int Int -> Bool)+ prop "generic TextShow1" (prop_genericTextShow1 :: Int -> KindDistinguished '() Int Int -> Bool)+ describe "KindDistinguished 'True Int Int" $ do+ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> KindDistinguished 'True Int Int -> Bool)+ prop "generic TextShow" (prop_genericTextShow :: Int -> KindDistinguished 'True Int Int -> Bool)+ prop "generic TextShow1" (prop_genericTextShow1 :: Int -> KindDistinguished 'True Int Int -> Bool) # endif # if __GLASGOW_HASKELL__ >= 708 describe "NullaryData" $ do
text-show.cabal view
@@ -1,5 +1,5 @@ name: text-show-version: 3.0.1+version: 3.1 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@@ -332,12 +332,12 @@ build-depends: array >= 0.3 && < 0.6 , base >= 4.3 && < 5 , base-compat >= 0.8.2 && < 1- , base-orphans >= 0.4.2 && < 1+ , base-orphans >= 0.5.2 && < 1 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6- , generic-deriving >= 1.10.1 && < 2+ , generic-deriving >= 1.10.3 && < 2 , ghc-prim , hspec >= 2 && < 3 , integer-gmp@@ -355,7 +355,7 @@ if impl(ghc >= 8.0) build-depends: ghc-boot if !flag(developer)- build-depends: text-show == 3.0.1+ build-depends: text-show == 3.1 hs-source-dirs: tests if flag(developer)