text-show 3.2.2 → 3.3
raw patch · 27 files changed
+609/−431 lines, 27 filesdep +contravariantdep +deriving-compatdep +ghc-boot-thdep −ghc-bootdep ~QuickCheckdep ~basedep ~template-haskell
Dependencies added: contravariant, deriving-compat, ghc-boot-th
Dependencies removed: ghc-boot
Dependency ranges changed: QuickCheck, base, template-haskell, text-show, transformers
Files
- CHANGELOG.md +7/−0
- benchmarks/Bench.hs +69/−35
- src/TextShow/FromStringTextShow.hs +11/−11
- src/TextShow/GHC/RTS/Flags.hs +16/−0
- src/TextShow/Generic.hs +58/−47
- src/TextShow/TH/Internal.hs +6/−4
- tests/Derived/DataFamilies.hs +23/−12
- tests/Derived/DatatypeContexts.hs +29/−13
- tests/Derived/ExistentialQuantification.hs +23/−30
- tests/Derived/Infix.hs +31/−45
- tests/Derived/MagicHash.hs +20/−20
- tests/Derived/PolyKinds.hs +80/−78
- tests/Derived/RankNTypes.hs +36/−24
- tests/Derived/Records.hs +29/−33
- tests/Derived/TypeSynonyms.hs +28/−33
- tests/Instances/Control/Applicative.hs +6/−0
- tests/Instances/Data/Functor/Identity.hs +6/−0
- tests/Instances/Data/List/NonEmpty.hs +8/−13
- tests/Instances/Data/Monoid.hs +7/−6
- tests/Instances/Data/Tuple.hs +2/−0
- tests/Instances/Data/Version.hs +6/−0
- tests/Instances/GHC/RTS/Flags.hs +9/−0
- tests/Instances/GHC/StaticPtr.hs +7/−2
- tests/Spec/FromStringTextShowSpec.hs +2/−2
- tests/Spec/GHC/RTS/FlagsSpec.hs +4/−0
- tests/Spec/Utils.hs +3/−3
- text-show.cabal +83/−20
CHANGELOG.md view
@@ -1,3 +1,10 @@+## 3.3+* Refactored the internals of `TextShow.Generic` to avoid the use of proxies.+* Made benchmark suite more comprehensive, including benchmarks for showing an enumeration type+* Microoptimization in derived `TextShow1/2` instances involving `TextShow.TH`+* Allow building with `QuickCheck-2.9`+* Fix GHC HEAD build+ ### 3.2.2 * Added benchmarks
benchmarks/Bench.hs view
@@ -14,25 +14,38 @@ -} module Main (main) where -import Control.DeepSeq (NFData)+import Control.DeepSeq (NFData) -import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf)+import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf) -import Data.List (foldl')+import Data.List (foldl')+import qualified Data.Text as T -import GHC.Generics (Generic)+import GHC.Generics (Generic) -import TextShow (TextShow(..))-import TextShow.Generic (genericShowbPrec)-import TextShow.TH (deriveTextShow)+import TextShow (TextShow(..))+import TextShow.Generic (genericShowbPrec)+import TextShow.TH (deriveTextShow) main :: IO () main = defaultMain- [ sampleGroup "String Show" BTSLeaf BTSBranch BTSEmpty show- , sampleGroup "Text Show (TH)" BTTSTHLeaf BTTSTHBranch BTTSTHEmpty showtl- , sampleGroup "Text Show (generics)" BTTSGLeaf BTTSGBranch BTTSGEmpty showtl+ [ sampleGroup "String Show" BTLeaf1 BTBranch1 BTEmpty1 show+ , sampleGroup "String Show, then Text.pack" BTLeaf1 BTBranch1 BTEmpty1 (T.pack . show)+ , sampleGroup "TextShow (TH)" BTLeaf2 BTBranch2 BTEmpty2 showt+ , sampleGroup "TextShow (generics)" BTLeaf3 BTBranch3 BTEmpty3 showt+ , bgroup "Enumeration type"+ [ bench "String Show" $ nf show Violet+ , bench "String Show, then Text.pack" $ nf (T.pack . show) Violet+ , bench "TextShow (TH)" $ nf showt Violet+ , bench "TextShow (generics)" $ nf showt $ Color2 Violet+ , bench "Manually written showt" $ nf colorShowt Violet+ ] ] +-------------------------------------------------------------------------------+-- Tree-like ADTs+-------------------------------------------------------------------------------+ sampleGroup :: forall a b. NFData b => String -> (Int -> a) -> (a -> a -> a) -> a -> (a -> b) -> Benchmark sampleGroup title leaf branch empty showFun =@@ -54,43 +67,64 @@ smallSample :: Sample smallSample (leaf, branch, _, showFun) =- showFun $- (leaf 12345 `branch` leaf 1234) `branch`- leaf 123456 `branch`- (leaf 1234567 `branch` leaf 123456)+ showFun $ sampleTree leaf branch {-# NOINLINE smallSample #-} mediumSample :: Sample mediumSample (leaf, branch, empty, showFun) =- showFun . foldl' branch empty . replicate 1000 $- (leaf 12345 `branch` leaf 1234) `branch`- leaf 123456 `branch`- (leaf 1234567 `branch` leaf 123456)+ showFun . foldl' branch empty . replicate 1000 $ sampleTree leaf branch {-# NOINLINE mediumSample #-} largeSample :: Sample largeSample (leaf, branch, empty, showFun) =- showFun . foldl' branch empty . replicate 100000 $- (leaf 12345 `branch` leaf 1234) `branch`- leaf 123456 `branch`- (leaf 1234567 `branch` leaf 123456)+ showFun . foldl' branch empty . replicate 100000 $ sampleTree leaf branch {-# NOINLINE largeSample #-} -data BinTreeShow a = BTSEmpty- | BTSLeaf a- | BTSBranch (BinTreeShow a) (BinTreeShow a)+sampleTree :: (Int -> a) -> (a -> a -> a) -> a+sampleTree leaf branch =+ (leaf 12345 `branch` leaf 1234) `branch`+ leaf 123456 `branch`+ (leaf 1234567 `branch` leaf 123456)++-- NB: constructors must be same length!+data BinTree1 a = BTEmpty1+ | BTLeaf1 a+ | BTBranch1 (BinTree1 a) (BinTree1 a) deriving Show -data BinTreeTextShowTH a = BTTSTHEmpty- | BTTSTHLeaf a- | BTTSTHBranch (BinTreeTextShowTH a)- (BinTreeTextShowTH a)-data BinTreeTextShowGenerics a = BTTSGEmpty- | BTTSGLeaf a- | BTTSGBranch (BinTreeTextShowGenerics a)- (BinTreeTextShowGenerics a)+data BinTree2 a = BTEmpty2+ | BTLeaf2 a+ | BTBranch2 (BinTree2 a) (BinTree2 a)++data BinTree3 a = BTEmpty3+ | BTLeaf3 a+ | BTBranch3 (BinTree3 a) (BinTree3 a) deriving Generic-instance TextShow a => TextShow (BinTreeTextShowGenerics a) where++instance TextShow a => TextShow (BinTree3 a) where showbPrec = genericShowbPrec -$(deriveTextShow ''BinTreeTextShowTH)+-------------------------------------------------------------------------------+-- Simple enumeration types+-------------------------------------------------------------------------------++data Color = Red | Green | Blue | Orange | Violet+ deriving (Generic, Show)++newtype Color2 = Color2 Color++instance TextShow Color2 where+ showbPrec p (Color2 c) = genericShowbPrec p c++colorShowt :: Color -> T.Text+colorShowt c = case c of+ Red -> T.pack "Red"+ Green -> T.pack "Green"+ Blue -> T.pack "Blue"+ Orange -> T.pack "Orange"+ Violet -> T.pack "Violet"++-------------------------------------------------------------------------------++$(deriveTextShow ''BinTree2)+$(deriveTextShow ''Color)
src/TextShow/FromStringTextShow.hs view
@@ -78,10 +78,10 @@ showbToShows, showsToShowb) import TextShow.Utils (coerce) -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-import Text.Show (showListWith)-#else+#if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..), showsPrec1, showsPrec2)+#else+import Text.Show (showListWith) #endif -------------------------------------------------------------------------------@@ -128,7 +128,7 @@ showList = coerce (showList :: [a] -> ShowS) instance Show1 FromStringShow where-#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) liftShowList _ sl = sl . coerceList where coerceList :: [FromStringShow a] -> [a]@@ -187,7 +187,7 @@ showList l = showbToShows showbList (coerce l :: [a]) instance Show1 FromTextShow where-#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) liftShowList _ sl = showbToShows (showsToShowb sl) . coerceList where coerceList :: [FromTextShow a] -> [a]@@ -260,7 +260,7 @@ readList = coerce (readList :: ReadS [f a]) readListPrec = coerce (readListPrec :: ReadPrec [f a]) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#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)@@ -338,7 +338,7 @@ readList = coerce (readList :: ReadS [f a]) readListPrec = coerce (readListPrec :: ReadPrec [f a]) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#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)@@ -348,7 +348,7 @@ #endif instance TextShow1 f => Show1 (FromTextShow1 f) where-#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) liftShowList sp sl = showbToShows (liftShowbList (showsPrecToShowbPrec sp) (showsToShowb sl))@@ -419,7 +419,7 @@ readList = coerce (readList :: ReadS [f a b]) readListPrec = coerce (readListPrec :: ReadPrec [f a b]) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) -- TODO: Manually implement this when you can derive Show2 (someday) -- | Not available if using @transformers-0.4@ deriving instance Show2 f => Show2 (FromStringShow2 f)@@ -520,7 +520,7 @@ readList = coerce (readList :: ReadS [f a b]) readListPrec = coerce (readListPrec :: ReadPrec [f a b]) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#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)@@ -564,7 +564,7 @@ ------------------------------------------------------------------------------- -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))+#if !defined(NEW_FUNCTOR_CLASSES) liftShowsPrec :: (Show1 f, Show a) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS liftShowsPrec _ _ = showsPrec1
src/TextShow/GHC/RTS/Flags.hs view
@@ -30,6 +30,9 @@ , showbProfFlagsPrec , showbTraceFlagsPrec , showbTickyFlagsPrec+# if __GLASGOW_HASKELL__ >= 801+ , showbParFlagsPrec+# endif # if MIN_VERSION_base(4,8,2) , showbGiveGCStats , showbDoCostCentres@@ -124,6 +127,16 @@ showbTickyFlagsPrec = showbPrec {-# INLINE showbTickyFlagsPrec #-} +# if __GLASGOW_HASKELL__ >= 801+-- | Convert a 'ParFlags' value to a 'Builder' with the given precedence.+-- This function is only available with GHC 8.1 or later.+--+-- /Since: 3.3/+showbParFlagsPrec :: Int -> ParFlags -> Builder+showbParFlagsPrec = showbPrec+{-# INLINE showbParFlagsPrec #-}+# endif+ # if MIN_VERSION_base(4,8,2) -- | Convert a 'GiveGCStats' value to a 'Builder'. -- This function is only available with @base-4.8.2.0@ or later.@@ -167,6 +180,9 @@ $(deriveTextShow ''ProfFlags) $(deriveTextShow ''TraceFlags) $(deriveTextShow ''TickyFlags)+# if __GLASGOW_HASKELL__ >= 801+$(deriveTextShow ''ParFlags)+# endif $(deriveTextShow giveGCStatsTypeName) $(deriveTextShow doCostCentresTypeName)
src/TextShow/Generic.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}@@ -69,12 +70,13 @@ , GTextShowCon(..) , IsNullary(..) , ConType(..)+ , ShowFuns(..) , Zero , One ) where +import Data.Functor.Contravariant (Contravariant(..)) import Data.Monoid.Compat ((<>))-import Data.Proxy (Proxy(..)) import qualified Data.Text as TS (Text) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import Data.Text.Lazy (toStrict)@@ -199,7 +201,7 @@ -- -- /Since: 2/ genericShowbPrec :: (Generic a, GTextShow Zero (Rep a)) => Int -> a -> Builder-genericShowbPrec p = gShowbPrec (Proxy :: Proxy Zero) undefined undefined p . from+genericShowbPrec p = gShowbPrec NoShowFuns p . from -- | A 'Generic' implementation of 'showbList'. --@@ -237,7 +239,7 @@ genericLiftShowbPrec :: (Generic1 f, GTextShow One (Rep1 f)) => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder-genericLiftShowbPrec sp sl p = gShowbPrec (Proxy :: Proxy One) sp sl p . from1+genericLiftShowbPrec sp sl p = gShowbPrec (Show1Funs sp sl) p . from1 -- | A 'Generic'/'Generic1' implementation of 'showbPrec1'. --@@ -273,14 +275,28 @@ showbPrec = genericShowbPrec INLINE_INST_FUN(showbPrec) +-- | A 'ShowFuns' value either stores nothing (for 'TextShow') or it stores+-- the two function arguments that show occurrences of the type parameter (for+-- 'TextShow1').+--+-- /Since: 3.3/+data ShowFuns arity a where+ NoShowFuns :: ShowFuns Zero a+ Show1Funs :: (Int -> a -> Builder) -> ([a] -> Builder) -> ShowFuns One a+ deriving Typeable++instance Contravariant (ShowFuns arity) where+ contramap _ NoShowFuns = NoShowFuns+ contramap f (Show1Funs sp sl) = Show1Funs (\p -> sp p . f) (sl . map f)+ -- | A type-level indicator that 'TextShow' is being derived generically. ----- / Since: 3.2/+-- /Since: 3.2/ data Zero -- | A type-level indicator that 'TextShow1' is being derived generically. ----- / Since: 3.2/+-- /Since: 3.2/ data One -- | Class of generic representation types that can be converted to@@ -292,30 +308,28 @@ class GTextShow arity f where -- | This is used as the default generic implementation of 'showbPrec' (if the -- @arity@ is 'Zero') or 'liftShowbPrec' (if the @arity@ is 'One').- gShowbPrec :: Proxy arity- -> (Int -> a -> Builder) -> ([a] -> Builder)- -> Int -> f a -> Builder+ gShowbPrec :: ShowFuns arity a -> Int -> f a -> Builder #if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable GTextShow #endif instance GTextShow arity f => GTextShow arity (D1 d f) where- gShowbPrec pa sp sl p (M1 x) = gShowbPrec pa sp sl p x+ gShowbPrec sfs p (M1 x) = gShowbPrec sfs p x instance GTextShow Zero V1 where- gShowbPrec _ _ _ _ !_ = error "Void showbPrec"+ gShowbPrec _ _ !_ = error "Void showbPrec" instance GTextShow One V1 where- gShowbPrec _ _ _ _ !_ = error "Void liftShowbPrec"+ gShowbPrec _ _ !_ = error "Void liftShowbPrec" instance (GTextShow arity f, GTextShow arity g) => GTextShow arity (f :+: g) where- gShowbPrec pa sp sl p (L1 x) = gShowbPrec pa sp sl p x- gShowbPrec pa sp sl p (R1 x) = gShowbPrec pa sp sl p x+ gShowbPrec sfs p (L1 x) = gShowbPrec sfs p x+ gShowbPrec sfs p (R1 x) = gShowbPrec sfs p x instance (Constructor c, GTextShowCon arity f, IsNullary f) => GTextShow arity (C1 c f) where- gShowbPrec pa sp sl p c@(M1 x) = case fixity of+ gShowbPrec sfs p c@(M1 x) = case fixity of Prefix -> showbParen ( p > appPrec && not (isNullary x || conIsTuple c) ) $@@ -326,8 +340,8 @@ <> (if isNullary x || conIsTuple c then mempty else singleton ' ')- <> showbBraces t (gShowbPrecCon pa t sp sl appPrec1 x)- Infix _ m -> showbParen (p > m) $ gShowbPrecCon pa t sp sl (m+1) x+ <> showbBraces t (gShowbPrecCon t sfs appPrec1 x)+ Infix _ m -> showbParen (p > m) $ gShowbPrecCon t sfs (m+1) x where fixity :: Fixity fixity = conFixity c@@ -357,79 +371,76 @@ class GTextShowCon arity f where -- | Convert value of a specific 'ConType' to a 'Builder' with the given -- precedence.- gShowbPrecCon :: Proxy arity -> ConType- -> (Int -> a -> Builder) -> ([a] -> Builder)- -> Int -> f a -> Builder+ gShowbPrecCon :: ConType -> ShowFuns arity a -> Int -> f a -> Builder #if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable GTextShowCon #endif instance GTextShowCon arity U1 where- gShowbPrecCon _ _ _ _ _ U1 = mempty+ gShowbPrecCon _ _ _ U1 = mempty instance GTextShowCon One Par1 where- gShowbPrecCon _ _ sp _ p (Par1 x) = sp p x+ gShowbPrecCon _ (Show1Funs sp _) p (Par1 x) = sp p x instance TextShow c => GTextShowCon arity (K1 i c) where- gShowbPrecCon _ _ _ _ p (K1 x) = showbPrec p x+ gShowbPrecCon _ _ p (K1 x) = showbPrec p x instance TextShow1 f => GTextShowCon One (Rec1 f) where- gShowbPrecCon _ _ sp sl p (Rec1 x) = liftShowbPrec sp sl p x+ gShowbPrecCon _ (Show1Funs sp sl) p (Rec1 x) = liftShowbPrec sp sl p x instance (Selector s, GTextShowCon arity f) => GTextShowCon arity (S1 s f) where- gShowbPrecCon pa t sp sl p sel@(M1 x)- | selName sel == "" = gShowbPrecCon pa t sp sl p x+ gShowbPrecCon t sfs p sel@(M1 x)+ | selName sel == "" = gShowbPrecCon t sfs p x | otherwise = fromString (selName sel) <> " = "- <> gShowbPrecCon pa t sp sl 0 x+ <> gShowbPrecCon t sfs 0 x instance (GTextShowCon arity f, GTextShowCon arity g) => GTextShowCon arity (f :*: g) where- gShowbPrecCon pa t@Rec sp sl _ (a :*: b) =- gShowbPrecCon pa t sp sl 0 a+ gShowbPrecCon t@Rec sfs _ (a :*: b) =+ gShowbPrecCon t sfs 0 a <> ", "- <> gShowbPrecCon pa t sp sl 0 b- gShowbPrecCon pa t@(Inf o) sp sl p (a :*: b) =- gShowbPrecCon pa t sp sl p a+ <> gShowbPrecCon t sfs 0 b+ gShowbPrecCon t@(Inf o) sfs p (a :*: b) =+ gShowbPrecCon t sfs p a <> showbSpace <> infixOp <> showbSpace- <> gShowbPrecCon pa t sp sl p b+ <> gShowbPrecCon t sfs p b where infixOp :: Builder infixOp = if isInfixTypeCon o then fromString o else singleton '`' <> fromString o <> singleton '`'- gShowbPrecCon pa t@Tup sp sl _ (a :*: b) =- gShowbPrecCon pa t sp sl 0 a+ gShowbPrecCon t@Tup sfs _ (a :*: b) =+ gShowbPrecCon t sfs 0 a <> singleton ','- <> gShowbPrecCon pa t sp sl 0 b- gShowbPrecCon pa t@Pref sp sl p (a :*: b) =- gShowbPrecCon pa t sp sl p a+ <> gShowbPrecCon t sfs 0 b+ gShowbPrecCon t@Pref sfs p (a :*: b) =+ gShowbPrecCon t sfs p a <> showbSpace- <> gShowbPrecCon pa t sp sl p b+ <> gShowbPrecCon t sfs p b instance (TextShow1 f, GTextShowCon One g) => GTextShowCon One (f :.: g) where- gShowbPrecCon pa t sp sl p (Comp1 x) =- liftShowbPrec (gShowbPrecCon pa t sp sl)- (showbListWith (gShowbPrecCon pa t sp sl 0))- p x+ gShowbPrecCon t sfs p (Comp1 x) =+ let gspc = gShowbPrecCon t sfs+ in liftShowbPrec gspc (showbListWith (gspc 0)) p x instance GTextShowCon arity UChar where- gShowbPrecCon _ _ _ _ p (UChar c) = showbPrec (hashPrec p) (C# c) <> oneHash+ gShowbPrecCon _ _ p (UChar c) = showbPrec (hashPrec p) (C# c) <> oneHash instance GTextShowCon arity UDouble where- gShowbPrecCon _ _ _ _ p (UDouble d) = showbPrec (hashPrec p) (D# d) <> twoHash+ gShowbPrecCon _ _ p (UDouble d) = showbPrec (hashPrec p) (D# d) <> twoHash instance GTextShowCon arity UFloat where- gShowbPrecCon _ _ _ _ p (UFloat f) = showbPrec (hashPrec p) (F# f) <> oneHash+ gShowbPrecCon _ _ p (UFloat f) = showbPrec (hashPrec p) (F# f) <> oneHash instance GTextShowCon arity UInt where- gShowbPrecCon _ _ _ _ p (UInt i) = showbPrec (hashPrec p) (I# i) <> oneHash+ gShowbPrecCon _ _ p (UInt i) = showbPrec (hashPrec p) (I# i) <> oneHash instance GTextShowCon arity UWord where- gShowbPrecCon _ _ _ _ p (UWord w) = showbPrec (hashPrec p) (W# w) <> twoHash+ gShowbPrecCon _ _ p (UWord w) = showbPrec (hashPrec p) (W# w) <> twoHash oneHash, twoHash :: Builder hashPrec :: Int -> Int
src/TextShow/TH/Internal.hs view
@@ -691,10 +691,12 @@ if any (`mentionsName` tyVarNames) lhsArgs || itf && any (`mentionsName` tyVarNames) tyArgs then outOfPlaceTyVarError tsClass conName- else appsE $ [ varE . showbPrecOrListName sl $ toEnum numLastArgs]- ++ zipWith (makeTextShowForType tsClass conName tvMap)- (cycle [False,True])- (interleave rhsArgs rhsArgs)+ else if any (`mentionsName` tyVarNames) rhsArgs+ then appsE $ [ varE . showbPrecOrListName sl $ toEnum numLastArgs]+ ++ zipWith (makeTextShowForType tsClass conName tvMap)+ (cycle [False,True])+ (interleave rhsArgs rhsArgs)+ else if sl then [| showbList |] else [| showbPrec |] ------------------------------------------------------------------------------- -- Template Haskell reifying and AST manipulation
tests/Derived/DataFamilies.hs view
@@ -44,8 +44,6 @@ #include "generic.h" -import Data.Functor.Classes (Show1(..))- #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif@@ -63,11 +61,17 @@ import Test.QuickCheck (Arbitrary(..), oneof) #if MIN_VERSION_template_haskell(2,7,0)+import Text.Show.Deriving (deriveShow1) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) #endif -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)-import Data.Functor.Classes (Show2(..), showsUnaryWith, showsBinaryWith)+#if defined(NEW_FUNCTOR_CLASSES)+# if MIN_VERSION_template_haskell(2,7,0)+import Text.Show.Deriving (deriveShow2)+# else+import Data.Functor.Classes (Show1(..), Show2(..),+ showsUnaryWith, showsBinaryWith)+# endif #endif -------------------------------------------------------------------------------@@ -91,9 +95,11 @@ , NASShow2 <$> arbitrary ] -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-instance (Show b, Show c) => Show1 (NotAllShow Int b c) where- showsPrec1 = showsPrec+#if !defined(NEW_FUNCTOR_CLASSES)+$(deriveShow1 'NASShow1)+#elif MIN_VERSION_template_haskell(2,7,0)+$(deriveShow1 'NASShow1)+$(deriveShow2 'NASShow2) #else instance (Show b, Show c) => Show1 (NotAllShow Int b c) where liftShowsPrec = liftShowsPrec2 showsPrec showList@@ -148,11 +154,16 @@ => 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 :: Bool) b) where- showsPrec1 = showsPrec+#if !defined(NEW_FUNCTOR_CLASSES)+$(deriveShow1 'KindDistinguishedUnit)++$(deriveShow1 'KindDistinguishedBool)+#elif MIN_VERSION_template_haskell(2,7,0)+$(deriveShow1 'KindDistinguishedUnit)+$(deriveShow2 'KindDistinguishedUnit)++$(deriveShow1 'KindDistinguishedBool)+$(deriveShow2 'KindDistinguishedBool) #else instance Show b => Show1 (KindDistinguished (a :: ()) b) where liftShowsPrec = liftShowsPrec2 showsPrec showList
tests/Derived/DatatypeContexts.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DatatypeContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}+-- I don't know how to silence the -XDatatypeContexts warnings otherwise... {-# OPTIONS_GHC -w #-} {-|@@ -26,9 +27,16 @@ import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..))+import Text.Show.Deriving (makeLiftShowsPrec, makeLiftShowsPrec2)+# if MIN_VERSION_template_haskell(2,7,0)+import Text.Show.Deriving (deriveShow2)+# else import GHC.Show (appPrec, appPrec1, showSpace)+# endif+#else+import Text.Show.Deriving (makeShowsPrec1) #endif -------------------------------------------------------------------------------@@ -53,20 +61,32 @@ ------------------------------------------------------------------------------- -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))+$(return [])+ instance (Ord a, Show a, Show b) => Show1 (TyCon a b) where- showsPrec1 = showsPrec+#if defined(NEW_FUNCTOR_CLASSES)+ liftShowsPrec = $(makeLiftShowsPrec ''TyCon)+#else+ showsPrec1 = $(makeShowsPrec1 ''TyCon)+#endif+#if defined(NEW_FUNCTOR_CLASSES)+instance (Ord a, Show a) => Show2 (TyCon a) where+ liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyCon)+#endif++#if !defined(NEW_FUNCTOR_CLASSES) instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where- showsPrec1 = showsPrec+ showsPrec1 = $(makeShowsPrec1 'TyFamily)+#elif MIN_VERSION_template_haskell(2,7,0)+instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where+ liftShowsPrec = $(makeLiftShowsPrec 'TyFamily)++instance (Ord a, Show a) => Show2 (TyFamily a) where+ liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamily) #else-instance (Ord a, Show a, Show b) => Show1 (TyCon a b) where- liftShowsPrec = liftShowsPrec2 showsPrec showList instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where liftShowsPrec = liftShowsPrec2 showsPrec showList -instance (Ord a, Show a) => Show2 (TyCon a) where- liftShowsPrec2 sp1 _ sp2 _ p (TyCon a b c) =- showsThree sp1 sp2 "TyCon" p a b c instance (Ord a, Show a) => Show2 (TyFamily a) where liftShowsPrec2 sp1 _ sp2 _ p (TyFamily a b c) = showsThree sp1 sp2 "TyFamily" p a b c@@ -80,10 +100,6 @@ . sp1 appPrec1 b . showSpace . sp2 appPrec1 c #endif-----------------------------------------------------------------------------------$(return []) instance (Ord a, TextShow a, TextShow b, TextShow c) => TextShow (TyCon a b c) where showbPrec = $(makeShowbPrec ''TyCon)
tests/Derived/ExistentialQuantification.hs view
@@ -17,19 +17,21 @@ -} module Derived.ExistentialQuantification (TyCon(..), TyFamily(..)) where -import Data.Functor.Classes (Show1(..))- import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), Gen, oneof) +import Text.Show.Deriving (deriveShow1) import TextShow (TextShow) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)-import Data.Functor.Classes (Show2(..), showsBinaryWith)+#if defined(NEW_FUNCTOR_CLASSES)+import Text.Show.Deriving (deriveShow2)+# if !(MIN_VERSION_template_haskell(2,7,0))+import Data.Functor.Classes (Show1(..), Show2(..), showsBinaryWith) import GHC.Show (appPrec, appPrec1, showSpace)+# endif #endif -------------------------------------------------------------------------------@@ -53,6 +55,8 @@ => p -> q -> u -> t -> TyCon r s t u +deriving instance (Show a, Show b, Show c, Show d) => Show (TyCon a b c d)+ ------------------------------------------------------------------------------- data family TyFamily w x y z :: *@@ -76,6 +80,8 @@ => p -> q -> u -> t -> TyFamily r s t u +deriving instance (Show a, Show b, Show c, Show d) => Show (TyFamily a b c d)+ ------------------------------------------------------------------------------- instance (a ~ Int, b ~ Int, c ~ Int, d ~ Int) => Arbitrary (TyCon a b c d) where@@ -98,31 +104,24 @@ ------------------------------------------------------------------------------- -deriving instance (Show a, Show b, Show c, Show d) => Show (TyCon a b c d)-deriving instance (Show a, Show b, Show c, Show d) => Show (TyFamily a b c d)+$(deriveShow1 ''TyCon)+#if defined(NEW_FUNCTOR_CLASSES)+$(deriveShow2 ''TyCon)+#endif -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-instance (Show a, Show b, Show c) => Show1 (TyCon a b c) where- showsPrec1 = showsPrec-instance (Show a, Show b, Show c) => Show1 (TyFamily a b c) where- showsPrec1 = showsPrec+$(deriveTextShow ''TyCon)+$(deriveTextShow1 ''TyCon)+$(deriveTextShow2 ''TyCon)++#if !defined(NEW_FUNCTOR_CLASSES)+$(deriveShow1 'TyFamilyClassConstraints)+#elif MIN_VERSION_template_haskell(2,7,0)+$(deriveShow1 'TyFamilyTypeRefinement1)+$(deriveShow2 'TyFamilyTypeRefinement1) #else-instance (Show a, Show b, Show c) => Show1 (TyCon a b c) where- liftShowsPrec = liftShowsPrec2 showsPrec showList instance (Show a, Show b, Show c) => Show1 (TyFamily a b c) where liftShowsPrec = liftShowsPrec2 showsPrec showList -instance (Show a, Show b) => Show2 (TyCon a b) where- liftShowsPrec2 sp1 _ sp2 _ p (TyConClassConstraints a b c d) =- showsFour sp1 sp2 "TyConClassConstraints" p a b c d- liftShowsPrec2 sp1 _ sp2 _ p (TyConEqualityConstraints a b c d) =- showsFour sp1 sp2 "TyConEqualityConstraints" p a b c d- liftShowsPrec2 _ _ sp2 _ p (TyConTypeRefinement1 i d) =- showsBinaryWith showsPrec sp2 "TyConTypeRefinement1" p i d- liftShowsPrec2 _ _ sp2 _ p (TyConTypeRefinement2 i d) =- showsBinaryWith showsPrec sp2 "TyConTypeRefinement2" p i d- liftShowsPrec2 sp1 _ sp2 _ p (TyConForalls p' q d c) =- showsFour sp2 sp1 "TyConForalls" p p' q d c instance (Show a, Show b) => Show2 (TyFamily a b) where liftShowsPrec2 sp1 _ sp2 _ p (TyFamilyClassConstraints a b c d) = showsFour sp1 sp2 "TyFamilyClassConstraints" p a b c d@@ -145,12 +144,6 @@ . sp1 appPrec1 c . showSpace . sp2 appPrec1 d #endif-----------------------------------------------------------------------------------$(deriveTextShow ''TyCon)-$(deriveTextShow1 ''TyCon)-$(deriveTextShow2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'TyFamilyClassConstraints)
tests/Derived/Infix.hs view
@@ -27,8 +27,6 @@ #include "generic.h" -import Data.Functor.Classes (Show1(..))- #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif@@ -45,11 +43,15 @@ import Test.QuickCheck (Arbitrary(..), oneof) +import Text.Show.Deriving (deriveShow1) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)-import Data.Functor.Classes (Show2(..), showsBinaryWith)+#if defined(NEW_FUNCTOR_CLASSES)+import Text.Show.Deriving (deriveShow2)+# if !(MIN_VERSION_template_haskell(2,7,0))+import Data.Functor.Classes (Show1(..), Show2(..), showsBinaryWith) import GHC.Show (appPrec, appPrec1, showSpace)+# endif #endif -------------------------------------------------------------------------------@@ -152,43 +154,37 @@ ------------------------------------------------------------------------------- -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-instance Show a => Show1 (TyConPlain a) where- showsPrec1 = showsPrec-instance Show a => Show1 (TyConGADT a) where- showsPrec1 = showsPrec-instance Show a => Show1 (TyFamilyPlain a) where- showsPrec1 = showsPrec-instance Show a => Show1 (TyFamilyGADT a) where- showsPrec1 = showsPrec+$(deriveShow1 ''TyConPlain)+$(deriveShow1 ''TyConGADT)+#if defined(NEW_FUNCTOR_CLASSES)+$(deriveShow2 ''TyConPlain)+$(deriveShow2 ''TyConGADT)+#endif++$(deriveTextShow ''TyConPlain)+$(deriveTextShow1 ''TyConPlain)+$(deriveTextShow2 ''TyConPlain)++$(deriveTextShow ''TyConGADT)+$(deriveTextShow1 ''TyConGADT)+$(deriveTextShow2 ''TyConGADT)++#if !defined(NEW_FUNCTOR_CLASSES)+$(deriveShow1 '(:#:))++$(deriveShow1 '(:*))+#elif MIN_VERSION_template_haskell(2,7,0)+$(deriveShow1 '(:#:))+$(deriveShow2 '(:$:))++$(deriveShow1 '(:*))+$(deriveShow2 '(:***)) #else-instance Show a => Show1 (TyConPlain a) where- liftShowsPrec = liftShowsPrec2 showsPrec showList-instance Show a => Show1 (TyConGADT a) where- liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show a => Show1 (TyFamilyPlain a) where liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show a => Show1 (TyFamilyGADT a) where liftShowsPrec = liftShowsPrec2 showsPrec showList -instance Show2 TyConPlain where- liftShowsPrec2 sp1 _ sp2 _ p (a :!: b) =- showsBinaryWith sp1 sp2 "(:!:)" p a b- liftShowsPrec2 sp1 _ sp2 _ p (a :@: b) =- showsInfix sp1 sp2 ":@:" p 4 a b- liftShowsPrec2 sp1 _ sp2 _ p (TyConPlain a b) =- showsInfix sp1 sp2 "`TyConPlain`" p 5 a b- liftShowsPrec2 sp1 _ sp2 _ p (TyConFakeInfix a b) =- showsBinaryWith sp1 sp2 "TyConFakeInfix" p a b-instance Show2 TyConGADT where- liftShowsPrec2 sp1 _ sp2 _ p (a :. b) =- showsInfix sp1 sp2 ":." p 1 a b- liftShowsPrec2 sp1 _ sp2 _ p (a :.. b) =- showsBinaryWith sp1 sp2 "(:..)" p a b- liftShowsPrec2 sp1 _ sp2 _ p ((:...) a b i) =- showsTernaryWith sp1 sp2 "(:...)" p a b i- liftShowsPrec2 sp1 _ sp2 _ p (a :.... b) =- showsBinaryWith sp1 sp2 "(:....)" p a b instance Show2 TyFamilyPlain where liftShowsPrec2 sp1 _ sp2 _ p (a :#: b) = showsBinaryWith sp1 sp2 "(:#:)" p a b@@ -223,16 +219,6 @@ . sp2 appPrec1 b . showSpace . showsPrec appPrec1 i #endif-----------------------------------------------------------------------------------$(deriveTextShow ''TyConPlain)-$(deriveTextShow1 ''TyConPlain)-$(deriveTextShow2 ''TyConPlain)--$(deriveTextShow ''TyConGADT)-$(deriveTextShow1 ''TyConGADT)-$(deriveTextShow2 ''TyConGADT) #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow '(:#:))
tests/Derived/MagicHash.hs view
@@ -19,8 +19,6 @@ -} module Derived.MagicHash (TyCon#(..), TyFamily#(..)) where -import Data.Functor.Classes (Show1(..))- #if __GLASGOW_HASKELL__ < 711 import qualified Generics.Deriving.TH as Generics #endif@@ -35,12 +33,16 @@ import Test.QuickCheck (Arbitrary(..)) +import Text.Show.Deriving (deriveShow1Options, legacyShowOptions) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)-import Data.Functor.Classes (Show2(..))+#if defined(NEW_FUNCTOR_CLASSES)+import Text.Show.Deriving (deriveShow2Options)+# if !(MIN_VERSION_template_haskell(2,7,0))+import Data.Functor.Classes (Show1(..), Show2(..)) import GHC.Show (showSpace) import GHC.Show (appPrec)+# endif #endif -------------------------------------------------------------------------------@@ -105,21 +107,24 @@ ------------------------------------------------------------------------------- -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-instance Show a => Show1 (TyCon# a) where- showsPrec1 = showsPrec-instance Show a => Show1 (TyFamily# a) where- showsPrec1 = showsPrec+$(deriveShow1Options legacyShowOptions ''TyCon#)+#if defined(NEW_FUNCTOR_CLASSES)+$(deriveShow2Options legacyShowOptions ''TyCon#)+#endif++$(deriveTextShow ''TyCon#)+$(deriveTextShow1 ''TyCon#)+$(deriveTextShow2 ''TyCon#)++#if !defined(NEW_FUNCTOR_CLASSES)+$(deriveShow1Options legacyShowOptions 'TyFamily#)+#elif MIN_VERSION_template_haskell(2,7,0)+$(deriveShow1Options legacyShowOptions 'TyFamily#)+$(deriveShow2Options legacyShowOptions 'TyFamily#) #else-instance Show a => Show1 (TyCon# a) where- liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show a => Show1 (TyFamily# a) where liftShowsPrec = liftShowsPrec2 showsPrec showList -instance Show2 TyCon# where- liftShowsPrec2 sp1 _ sp2 _ p (TyCon# a b i f d c w) =- showsHash sp1 sp2 "TyCon#" "tcA" "tcB" "tcInt#" "tcFloat#"- "tcDouble#" "tcChar#" "tcWord#" p a b i f d c w instance Show2 TyFamily# where liftShowsPrec2 sp1 _ sp2 _ p (TyFamily# a b i f d c w) = showsHash sp1 sp2 "TyFamily#" "tfA" "tfB" "tfInt#" "tfFloat#"@@ -156,11 +161,6 @@ # endif #endif ----------------------------------------------------------------------------------$(deriveTextShow ''TyCon#)-$(deriveTextShow1 ''TyCon#)-$(deriveTextShow2 ''TyCon#) #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'TyFamily#) $(deriveTextShow1 'TyFamily#)
tests/Derived/PolyKinds.hs view
@@ -49,15 +49,20 @@ import Test.QuickCheck (Arbitrary) +import Text.Show.Deriving (deriveShow1) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (deriveTextShow2, makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-import Data.Functor.Classes (showsUnary1)-#else-import Data.Functor.Classes (Show2(..), showsUnaryWith)+#if defined(NEW_FUNCTOR_CLASSES)+import Data.Functor.Classes (Show2(..))+import Text.Show.Deriving (deriveShow2, makeLiftShowsPrec, makeLiftShowsPrec2)+# if !(MIN_VERSION_template_haskell(2,7,0))+import Data.Functor.Classes (showsUnaryWith) import GHC.Show (appPrec, appPrec1, showSpace)+# endif+#else+import Text.Show.Deriving (makeShowsPrec1) #endif -------------------------------------------------------------------------------@@ -203,48 +208,92 @@ ------------------------------------------------------------------------------- -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))--- | Kludge to get type with the same instances as @g a@-newtype Apply g a = Apply (g a)+$(return []) -instance (Show1 g, Show a) => Show (Apply g a) where- showsPrec d (Apply x) = showsPrec1 d x+-- TODO: Replace these with non-orphan instances+$(deriveShow1 ''(,,,,))+#if defined(NEW_FUNCTOR_CLASSES)+$(deriveShow2 ''(,,,,))+#endif +#if defined(NEW_FUNCTOR_CLASSES)+instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) =>+ Show1 (TyConCompose f g h j k a) where+ liftShowsPrec = $(makeLiftShowsPrec ''TyConCompose)+instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) =>+ Show2 (TyConCompose f g h j k) where+ liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyConCompose)++instance Show1 (TyConProxy (a :: *)) where+ liftShowsPrec = $(makeLiftShowsPrec ''TyConProxy)+instance Show2 TyConProxy where+ liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyConProxy)++instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where+ liftShowsPrec = $(makeLiftShowsPrec ''TyConReallyHighKinds)+instance Show2 (f a b c) => Show2 (TyConReallyHighKinds f a b c) where+ liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyConReallyHighKinds)+#else instance (Functor (f (g (j a) (k a))), Functor (h (j a)), Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyConCompose f g h j k a) where- showsPrec1 p (TyConCompose x) =- showsUnary1 "TyConCompose" p $ fmap (Apply . fmap Apply) x+ showsPrec1 = $(makeShowsPrec1 ''TyConCompose)+ instance Show1 (TyConProxy (a :: *)) where- showsPrec1 = showsPrec+ showsPrec1 = $(makeShowsPrec1 ''TyConProxy)+ instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where- showsPrec1 p (TyConReallyHighKinds x) =- showsUnary1 "TyConReallyHighKinds" p x+ showsPrec1 = $(makeShowsPrec1 ''TyConReallyHighKinds)+#endif++instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) =>+ TextShow (TyConCompose f g h j k a b) where+ showbPrec = $(makeShowbPrec ''TyConCompose)+instance (TextShow1 (f (g (j a) (k a))), TextShow1 (h (j a)), TextShow1 k) =>+ TextShow1 (TyConCompose f g h j k a) where+ liftShowbPrec = $(makeLiftShowbPrec ''TyConCompose)+$(deriveTextShow2 ''TyConCompose)++instance TextShow (TyConProxy a b) where+ showbPrec = $(makeShowbPrec ''TyConProxy)+instance TextShow1 (TyConProxy a) where+ liftShowbPrec = $(makeLiftShowbPrec ''TyConProxy)+$(deriveTextShow2 ''TyConProxy)++instance TextShow (f a b c d e) => TextShow (TyConReallyHighKinds f a b c d e) where+ showbPrec = $(makeShowbPrec ''TyConReallyHighKinds)+instance TextShow1 (f a b c d) => TextShow1 (TyConReallyHighKinds f a b c d) where+ liftShowbPrec = $(makeLiftShowbPrec ''TyConReallyHighKinds)+instance TextShow2 (f a b c) => TextShow2 (TyConReallyHighKinds f a b c) where+ liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyConReallyHighKinds)++#if !defined(NEW_FUNCTOR_CLASSES) instance (Functor (f (g (j a) (k a))), Functor (h (j a)), Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyFamilyCompose f g h j k a) where- showsPrec1 p (TyFamilyCompose x) =- showsUnary1 "TyFamilyCompose" p $ fmap (Apply . fmap Apply) x+ showsPrec1 = $(makeShowsPrec1 'TyFamilyCompose) instance Show1 (TyFamilyProxy (a :: *)) where- showsPrec1 = showsPrec+ showsPrec1 = $(makeShowsPrec1 'TyFamilyProxy) instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where- showsPrec1 p (TyFamilyReallyHighKinds x) =- showsUnary1 "TyFamilyReallyHighKinds" p x+ showsPrec1 = $(makeShowsPrec1 'TyFamilyReallyHighKinds)+#elif MIN_VERSION_template_haskell(2,7,0)+instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) =>+ Show1 (TyFamilyCompose f g h j k a) where+ liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyCompose)+instance Show1 (TyFamilyProxy (a :: *)) where+ liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyProxy)+instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where+ liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyReallyHighKinds) --- TODO: Move this to base-orphans someday-instance (Show a, Show b, Show c, Show d) => Show1 ((,,,,) a b c d) where- showsPrec1 = showsPrec+instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) =>+ Show2 (TyFamilyCompose f g h j k) where+ liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyCompose)+instance Show2 TyFamilyProxy where+ liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyProxy)+instance Show2 (f a b c) => Show2 (TyFamilyReallyHighKinds f a b c) where+ liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyReallyHighKinds) #else instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) =>- Show1 (TyConCompose f g h j k a) where- liftShowsPrec sp sl p (TyConCompose x) =- showsPrecCompose sp sl "TyConCompose" p x-instance Show1 (TyConProxy (a :: *)) where- liftShowsPrec = liftShowsPrec2 undefined undefined-instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where- liftShowsPrec sp sl p (TyConReallyHighKinds x) =- showsUnaryWith (liftShowsPrec sp sl) "TyConReallyHighKinds" p x-instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyFamilyCompose f g h j k a) where liftShowsPrec sp sl p (TyFamilyCompose x) = showsPrecCompose sp sl "TyFamilyCompose" p x@@ -255,17 +304,6 @@ showsUnaryWith (liftShowsPrec sp sl) "TyFamilyReallyHighKinds" p x instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) =>- Show2 (TyConCompose f g h j k) where- liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyConCompose x) =- showsPrecCompose2 sp1 sl1 sp2 sl2 "TyConCompose" p x-instance Show2 TyConProxy where- liftShowsPrec2 _ _ _ _ p (TyConProxy x) = showParen (p > appPrec) $- showString "TyConProxy "- . showsPrec appPrec1 x-instance Show2 (f a b c) => Show2 (TyConReallyHighKinds f a b c) where- liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyConReallyHighKinds x) =- showsUnaryWith (liftShowsPrec2 sp1 sl1 sp2 sl2) "TyConReallyHighKinds" p x-instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) => Show2 (TyFamilyCompose f g h j k) where liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyFamilyCompose x) = showsPrecCompose2 sp1 sl1 sp2 sl2 "TyFamilyCompose" p x@@ -311,43 +349,7 @@ (liftShowsPrec sp2 sl2) (liftShowList sp2 sl2)) appPrec1 x---- TODO: Move these to base-orphans someday-instance (Show a, Show b, Show c, Show d) => Show1 ((,,,,) a b c d) where- liftShowsPrec = liftShowsPrec2 showsPrec showList-instance (Show a, Show b, Show c) => Show2 ((,,,,) a b c) where- liftShowsPrec2 sp1 _ sp2 _ _ (a, b, c, d, e) =- showChar '(' . shows a . showChar ','- . shows b . showChar ','- . shows c . showChar ','- . sp1 0 d . showChar ','- . sp2 0 e . showChar ')' #endif-----------------------------------------------------------------------------------$(return [])--instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) =>- TextShow (TyConCompose f g h j k a b) where- showbPrec = $(makeShowbPrec ''TyConCompose)-instance (TextShow1 (f (g (j a) (k a))), TextShow1 (h (j a)), TextShow1 k) =>- TextShow1 (TyConCompose f g h j k a) where- liftShowbPrec = $(makeLiftShowbPrec ''TyConCompose)-$(deriveTextShow2 ''TyConCompose)--instance TextShow (TyConProxy a b) where- showbPrec = $(makeShowbPrec ''TyConProxy)-instance TextShow1 (TyConProxy a) where- liftShowbPrec = $(makeLiftShowbPrec ''TyConProxy)-$(deriveTextShow2 ''TyConProxy)--instance TextShow (f a b c d e) => TextShow (TyConReallyHighKinds f a b c d e) where- showbPrec = $(makeShowbPrec ''TyConReallyHighKinds)-instance TextShow1 (f a b c d) => TextShow1 (TyConReallyHighKinds f a b c d) where- liftShowbPrec = $(makeLiftShowbPrec ''TyConReallyHighKinds)-instance TextShow2 (f a b c) => TextShow2 (TyConReallyHighKinds f a b c) where- liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyConReallyHighKinds) #if MIN_VERSION_template_haskell(2,7,0) instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) =>
tests/Derived/RankNTypes.hs view
@@ -27,12 +27,19 @@ import Test.QuickCheck (Arbitrary(..)) +import Text.Show.Deriving (deriveShow1) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2, makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)-import Data.Functor.Classes (Show2(..), showsUnaryWith, showsBinaryWith)+#if defined(NEW_FUNCTOR_CLASSES)+import Data.Functor.Classes (Show2(..))+import Text.Show.Deriving (deriveShow2, makeLiftShowsPrec, makeLiftShowsPrec2)+# if !(MIN_VERSION_template_haskell(2,7,0))+import Data.Functor.Classes (showsBinaryWith)+# endif+#else+import Text.Show.Deriving (makeShowsPrec1) #endif -------------------------------------------------------------------------------@@ -74,24 +81,37 @@ ------------------------------------------------------------------------------- -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-instance Show a => Show1 (TyCon a) where- showsPrec1 = showsPrec-instance Show a => Show1 (TyFamily a) where- showsPrec1 = showsPrec-#else+$(return [])+ instance Show1 (Tagged2 s t) where- liftShowsPrec = liftShowsPrec2 undefined undefined-instance Show a => Show1 (TyCon a) where- liftShowsPrec = liftShowsPrec2 showsPrec showList+#if defined(NEW_FUNCTOR_CLASSES)+ liftShowsPrec = $(makeLiftShowsPrec ''Tagged2)+#else+ showsPrec1 = $(makeShowsPrec1 ''Tagged2)+#endif+#if defined(NEW_FUNCTOR_CLASSES)+instance Show2 (Tagged2 s) where+ liftShowsPrec2 = $(makeLiftShowsPrec2 ''Tagged2)+#endif++$(deriveShow1 ''TyCon)+#if defined(NEW_FUNCTOR_CLASSES)+$(deriveShow2 ''TyCon)+#endif++$(deriveTextShow ''TyCon)+$(deriveTextShow1 ''TyCon)+$(deriveTextShow2 ''TyCon)++#if !defined(NEW_FUNCTOR_CLASSES)+$(deriveShow1 'TyFamily)+#elif MIN_VERSION_template_haskell(2,7,0)+$(deriveShow1 'TyFamily)+$(deriveShow2 'TyFamily)+#else instance Show a => Show1 (TyFamily a) where liftShowsPrec = liftShowsPrec2 showsPrec showList -instance Show2 (Tagged2 s) where- liftShowsPrec2 _ _ sp _ p (Tagged2 b) = showsUnaryWith sp "Tagged2" p b-instance Show2 TyCon where- liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyCon b a) =- showsForall sp1 sl1 sp2 sl2 "TyCon" p b a instance Show2 TyFamily where liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyFamily b a) = showsForall sp1 sl1 sp2 sl2 "TyFamily" p b a@@ -108,12 +128,6 @@ name p b a #endif ----------------------------------------------------------------------------------$(deriveTextShow ''TyCon)-$(deriveTextShow1 ''TyCon)-$(deriveTextShow2 ''TyCon)- #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily)@@ -121,8 +135,6 @@ #endif ---------------------------------------------------------------------------------$(return []) instance TextShow c => TextShow (Tagged2 s t c) where showbPrec = $(makeShowbPrec ''Tagged2)
tests/Derived/Records.hs view
@@ -20,8 +20,6 @@ #include "generic.h" -import Data.Functor.Classes (Show1(..))- #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif@@ -38,12 +36,16 @@ import Test.QuickCheck (Arbitrary(..), oneof) +import Text.Show.Deriving (deriveShow1) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)-import Data.Functor.Classes (Show2(..))+#if defined(NEW_FUNCTOR_CLASSES)+import Text.Show.Deriving (deriveShow2)+# if !(MIN_VERSION_template_haskell(2,7,0))+import Data.Functor.Classes (Show1(..), Show2(..)) import GHC.Show (showSpace) import GHC.Show (appPrec)+# endif #endif -------------------------------------------------------------------------------@@ -90,22 +92,33 @@ ------------------------------------------------------------------------------- -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-instance Show a => Show1 (TyCon a) where- showsPrec1 = showsPrec-instance Show a => Show1 (TyFamily a) where- showsPrec1 = showsPrec+$(deriveShow1 ''TyCon)+#if defined(NEW_FUNCTOR_CLASSES)+$(deriveShow2 ''TyCon)+#endif++$(deriveTextShow ''TyCon)+$(deriveTextShow1 ''TyCon)+$(deriveTextShow2 ''TyCon)++#if __GLASGOW_HASKELL__ < 706+$(Generics.deriveMeta ''TyCon)+$(Generics.deriveRepresentable1 ''TyCon)+#endif++#if __GLASGOW_HASKELL__ < 702+$(Generics.deriveRepresentable0 ''TyCon)+#endif++#if !defined(NEW_FUNCTOR_CLASSES)+$(deriveShow1 'TyFamilyPrefix)+#elif MIN_VERSION_template_haskell(2,7,0)+$(deriveShow1 'TyFamilyPrefix)+$(deriveShow2 '(:!:)) #else-instance Show a => Show1 (TyCon a) where- liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show a => Show1 (TyFamily a) where liftShowsPrec = liftShowsPrec2 showsPrec showList -instance Show2 TyCon where- liftShowsPrec2 sp1 _ sp2 _ p (TyConPrefix a b) =- showsRecord sp1 sp2 "TyConPrefix" "tc1" "tc2" p a b- liftShowsPrec2 sp1 _ sp2 _ p (a :@: b) =- showsRecord sp2 sp1 "(:@:)" "tc3" "tc4" p a b instance Show2 TyFamily where liftShowsPrec2 sp1 _ sp2 _ p (TyFamilyPrefix a b) = showsRecord sp1 sp2 "TyFamilyPrefix" "tf1" "tf2" p a b@@ -123,28 +136,11 @@ . showChar '}' #endif ----------------------------------------------------------------------------------$(deriveTextShow ''TyCon)-$(deriveTextShow1 ''TyCon)-$(deriveTextShow2 ''TyCon)- #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'TyFamilyPrefix) $(deriveTextShow1 '(:!:)) $(deriveTextShow2 'TyFamilyPrefix)-#endif -#if __GLASGOW_HASKELL__ < 706-$(Generics.deriveMeta ''TyCon)-$(Generics.deriveRepresentable1 ''TyCon)-#endif--#if __GLASGOW_HASKELL__ < 702-$(Generics.deriveRepresentable0 ''TyCon)-#endif--#if MIN_VERSION_template_haskell(2,7,0) # if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamilyPrefix) $(Generics.deriveRepresentable1 '(:!:))
tests/Derived/TypeSynonyms.hs view
@@ -23,13 +23,6 @@ #include "generic.h" -import Data.Functor.Classes ( Show1(..)-#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)- , Show2(..)- , showsUnaryWith-#endif- )- #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif@@ -45,8 +38,16 @@ import Test.QuickCheck (Arbitrary) +import Text.Show.Deriving (deriveShow1) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) +#if defined(NEW_FUNCTOR_CLASSES)+import Text.Show.Deriving (deriveShow2)+# if !(MIN_VERSION_template_haskell(2,7,0))+import Data.Functor.Classes (Show1(..), Show2(..), showsUnaryWith)+# endif+#endif+ ------------------------------------------------------------------------------- type FakeOut a = Int@@ -57,16 +58,6 @@ instance Functor ((,,,) a b c) where fmap f (a, b, c, d) = (a, b, c, f d) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)-instance (Show a, Show b) => Show2 ((,,,) a b) where- liftShowsPrec2 sp1 _ sp2 _ _ (a, b, c, d) =- showChar '('- . showsPrec 0 a . showChar ','- . showsPrec 0 b . showChar ','- . sp1 0 c . showChar ','- . sp2 0 d . showChar ')'-#endif- ------------------------------------------------------------------------------- newtype TyCon a b = TyCon@@ -107,20 +98,30 @@ ------------------------------------------------------------------------------- -#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-instance Show a => Show1 (TyCon a) where- showsPrec1 = showsPrec-instance Show a => Show1 (TyFamily a) where- showsPrec1 = showsPrec+-- TODO: Replace these with non-orphan instances+$(deriveShow1 ''(,,,))+#if defined(NEW_FUNCTOR_CLASSES)+$(deriveShow2 ''(,,,))+#endif++$(deriveShow1 ''TyCon)+#if defined(NEW_FUNCTOR_CLASSES)+$(deriveShow2 ''TyCon)+#endif++$(deriveTextShow ''TyCon)+$(deriveTextShow1 ''TyCon)+$(deriveTextShow2 ''TyCon)++#if !defined(NEW_FUNCTOR_CLASSES)+$(deriveShow1 'TyFamily)+#elif MIN_VERSION_template_haskell(2,7,0)+$(deriveShow1 'TyFamily)+$(deriveShow2 'TyFamily) #else-instance Show a => Show1 (TyCon a) where- liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show a => Show1 (TyFamily a) where liftShowsPrec = liftShowsPrec2 showsPrec showList -instance Show2 TyCon where- liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyCon x) =- showsTypeSynonym sp1 sl1 sp2 sl2 "TyCon" p x instance Show2 TyFamily where liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyFamily x) = showsTypeSynonym sp1 sl1 sp2 sl2 "TyFamily" p x@@ -141,12 +142,6 @@ (liftShowList2 sp1 sl1 sp2 sl2) ) name p x #endif-----------------------------------------------------------------------------------$(deriveTextShow ''TyCon)-$(deriveTextShow1 ''TyCon)-$(deriveTextShow2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'TyFamily)
tests/Instances/Control/Applicative.hs view
@@ -1,6 +1,10 @@+{-# LANGUAGE CPP #-}++#if !(MIN_VERSION_QuickCheck(2,9,0)) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+#endif {-| Module: Instances.Control.Applicative@@ -14,8 +18,10 @@ -} module Instances.Control.Applicative () where +#if !(MIN_VERSION_QuickCheck(2,9,0)) import Control.Applicative (Const(..), ZipList(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary a => Arbitrary (Const a b) deriving instance Arbitrary a => Arbitrary (ZipList a)+#endif
tests/Instances/Data/Functor/Identity.hs view
@@ -1,6 +1,10 @@+{-# LANGUAGE CPP #-}++#if !(MIN_VERSION_QuickCheck(2,9,0)) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+#endif {-| Module: Instances.Data.Functor.Identity@@ -14,7 +18,9 @@ -} module Instances.Data.Functor.Identity () where +#if !(MIN_VERSION_QuickCheck(2,9,0)) import Data.Functor.Identity (Identity(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary a => Arbitrary (Identity a)+#endif
tests/Instances/Data/List/NonEmpty.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-|@@ -13,9 +14,11 @@ -} module Instances.Data.List.NonEmpty () where -import Data.Functor.Classes (Show1(..)) import Data.List.NonEmpty (NonEmpty(..)) +import Text.Show.Deriving (deriveShow1)++#if !(MIN_VERSION_QuickCheck(2,9,0)) import Prelude () import Prelude.Compat @@ -23,15 +26,7 @@ instance Arbitrary a => Arbitrary (NonEmpty a) where arbitrary = (:|) <$> arbitrary <*> arbitrary--#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))-instance Show1 NonEmpty where- showsPrec1 = showsPrec-#else-instance Show1 NonEmpty where- liftShowsPrec sp sl p (h :| t) = showParen (p > infixPrec) $- sp (infixPrec+1) h . showString " :| " . liftShowsPrec sp sl (infixPrec+1) t- where- infixPrec :: Int- infixPrec = 5 #endif++-- TODO: Replace this with a non-orphan instance+$(deriveShow1 ''NonEmpty)
tests/Instances/Data/Monoid.hs view
@@ -1,12 +1,11 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-} -#if MIN_VERSION_base(4,8,0)+#if !(MIN_VERSION_QuickCheck(2,9,0)) {-# LANGUAGE FlexibleContexts #-}-#endif-+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+#endif {-| Module: Instances.Data.Monoid@@ -20,6 +19,7 @@ -} module Instances.Data.Monoid () where +#if !(MIN_VERSION_QuickCheck(2,9,0)) import Data.Monoid import Test.QuickCheck (Arbitrary) @@ -30,6 +30,7 @@ deriving instance Arbitrary a => Arbitrary (Last a) deriving instance Arbitrary a => Arbitrary (Product a) deriving instance Arbitrary a => Arbitrary (Sum a)-#if MIN_VERSION_base(4,8,0)+# if MIN_VERSION_base(4,8,0) deriving instance Arbitrary (f a) => Arbitrary (Alt f a)+# endif #endif
tests/Instances/Data/Tuple.hs view
@@ -18,6 +18,7 @@ import Test.QuickCheck (Arbitrary(..)) +#if !(MIN_VERSION_QuickCheck(2,9,0)) instance ( Arbitrary a , Arbitrary b , Arbitrary c@@ -82,6 +83,7 @@ arbitrary = (,,,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+#endif instance ( Arbitrary a , Arbitrary b
tests/Instances/Data/Version.hs view
@@ -1,4 +1,8 @@+{-# LANGUAGE CPP #-}++#if !(MIN_VERSION_QuickCheck(2,9,0)) {-# OPTIONS_GHC -fno-warn-orphans #-}+#endif {-| Module: Instances.Data.Version@@ -12,6 +16,7 @@ -} module Instances.Data.Version () where +#if !(MIN_VERSION_QuickCheck(2,9,0)) import Data.Version (Version(..)) import Prelude ()@@ -21,3 +26,4 @@ instance Arbitrary Version where arbitrary = Version <$> arbitrary <*> arbitrary+#endif
tests/Instances/GHC/RTS/Flags.hs view
@@ -16,7 +16,9 @@ #if MIN_VERSION_base(4,8,0) import GHC.RTS.Flags import Test.QuickCheck (Arbitrary(..))+#endif +#if MIN_VERSION_base(4,8,0) instance Arbitrary ConcFlags where arbitrary = ConcFlags <$> arbitrary <*> arbitrary @@ -32,4 +34,11 @@ instance Arbitrary TickyFlags where arbitrary = TickyFlags <$> arbitrary <*> arbitrary+#endif++#if __GLASGOW_HASKELL__ >= 801+instance Arbitrary ParFlags where+ arbitrary = ParFlags <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary #endif
tests/Instances/GHC/StaticPtr.hs view
@@ -18,5 +18,10 @@ import Test.QuickCheck (Arbitrary(..)) instance Arbitrary StaticPtrInfo where- arbitrary = StaticPtrInfo <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary-#endif + arbitrary = StaticPtrInfo <$> arbitrary+ <*> arbitrary+ <*> arbitrary+# if __GLASGOW_HASKELL__ < 801+ <*> arbitrary+# endif+#endif
tests/Spec/FromStringTextShowSpec.hs view
@@ -21,7 +21,7 @@ import TextShow (FromStringShow(..), FromTextShow(..)) -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) import Spec.Utils (prop_matchesTextShow2) import TextShow (FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..))@@ -44,7 +44,7 @@ describe "FromTextShow String" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromTextShow String -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow String -> Bool)-#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) describe "FromStringShow1 Maybe Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow1 Maybe Int -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow1 Maybe Int -> Bool)
tests/Spec/GHC/RTS/FlagsSpec.hs view
@@ -53,6 +53,10 @@ prop "TextShow instance" prop_showTraceFlags describe "TickyFlags" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TickyFlags -> Bool)+# if __GLASGOW_HASKELL__ >= 801+ describe "ParFlags" $+ prop "TextShow instance" (prop_matchesTextShow :: Int -> ParFlags -> Bool)+# endif #else pure () #endif
tests/Spec/Utils.hs view
@@ -15,7 +15,7 @@ ioProperty , prop_matchesTextShow , prop_matchesTextShow1-#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) , prop_matchesTextShow2 #endif , prop_genericTextShow@@ -36,7 +36,7 @@ import TextShow (TextShow(..), TextShow1(..), showbPrec1, fromString) import TextShow.Generic -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2, showsPrec2) import TextShow (TextShow2(..), showbPrec2) #endif@@ -58,7 +58,7 @@ prop_matchesTextShow1 :: (Show1 f, Show a, TextShow1 f, TextShow a) => Int -> f a -> Bool prop_matchesTextShow1 p x = fromString (showsPrec1 p x "") == showbPrec1 p x -#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+#if defined(NEW_FUNCTOR_CLASSES) -- | Verifies that a type's @Show2@ instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow2 :: (Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b)
text-show.cabal view
@@ -1,5 +1,5 @@ name: text-show-version: 3.2.2+version: 3.3 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@@ -63,6 +63,21 @@ default: False manual: True +flag base-4-9+ description: Use base-4.9 or later.+ default: True++flag template-haskell-2-11+ description: Use template-haskell-2.11.0.0 or later.+ default: True++flag new-functor-classes+ description: Use a version of transformers or transformers-compat with a+ modern-style Data.Functor.Classes module. This flag cannot be+ used when building with transformers-0.4, since it comes with+ a different version of Data.Functor.Classes.+ default: True+ library exposed-modules: TextShow TextShow.Control.Applicative@@ -146,12 +161,12 @@ TextShow.TH.Names TextShow.Utils build-depends: array >= 0.3 && < 0.6- , base >= 4.3 && < 5 , base-compat >= 0.8.1 && < 1 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6+ , contravariant >= 0.5 && < 2 , generic-deriving >= 1.9 && < 2 , ghc-prim , integer-gmp@@ -159,13 +174,28 @@ , semigroups >= 0.17 && < 1 , tagged >= 0.4.4 && < 1 , text >= 0.11.1 && < 1.3- , template-haskell >= 2.5 && < 2.12 , th-lift >= 0.7.6 && < 1- , transformers >= 0.2.1 && < 0.6- , transformers-compat >= 0.5 && < 1 , void >= 0.5 && < 1- if impl(ghc >= 8.0)- build-depends: ghc-boot++ if flag(base-4-9)+ build-depends: base >= 4.9 && < 5+ cpp-options: "-DNEW_FUNCTOR_CLASSES"+ else+ build-depends: base >= 4.3 && < 4.9++ if flag(template-haskell-2-11)+ build-depends: template-haskell >= 2.11 && < 2.12+ , ghc-boot-th+ else+ build-depends: template-haskell >= 2.5 && < 2.11++ if flag(new-functor-classes)+ build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6)+ , transformers-compat >= 0.5 && < 1+ cpp-options: "-DNEW_FUNCTOR_CLASSES"+ else+ build-depends: transformers == 0.4.*+ hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall@@ -330,13 +360,14 @@ -- Only exports tests if base >= 4.9 Spec.GHC.StackSpec build-depends: array >= 0.3 && < 0.6- , base >= 4.3 && < 5 , base-compat >= 0.8.2 && < 1 , base-orphans >= 0.5.2 && < 1 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6+ , contravariant >= 0.5 && < 2+ , deriving-compat >= 0.3 && < 1 , generic-deriving >= 1.10.3 && < 2 , ghc-prim , hspec >= 2 && < 3@@ -346,21 +377,35 @@ , quickcheck-instances >= 0.1 && < 0.4 , semigroups >= 0.17 && < 1 , tagged >= 0.8.3 && < 1- , template-haskell >= 2.5 && < 2.12 , text >= 0.11.1 && < 1.3 , th-lift >= 0.7.6 && < 1- , transformers >= 0.2.1 && < 0.6 , transformers-compat >= 0.5 && < 1 , void >= 0.5 && < 1- if impl(ghc >= 8.0)- build-depends: ghc-boot- if !flag(developer)- build-depends: text-show == 3.2.2 - hs-source-dirs: tests+ if flag(base-4-9)+ build-depends: base >= 4.9 && < 5+ cpp-options: "-DNEW_FUNCTOR_CLASSES"+ else+ build-depends: base >= 4.3 && < 4.9++ if flag(template-haskell-2-11)+ build-depends: template-haskell >= 2.11 && < 2.12+ , ghc-boot-th+ else+ build-depends: template-haskell >= 2.5 && < 2.11++ if flag(new-functor-classes)+ build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6)+ cpp-options: "-DNEW_FUNCTOR_CLASSES"+ else+ build-depends: transformers == 0.4.*+ if flag(developer) hs-source-dirs: src+ else+ build-depends: text-show == 3.3 + hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts include-dirs: include@@ -377,12 +422,12 @@ type: exitcode-stdio-1.0 main-is: Bench.hs build-depends: array >= 0.3 && < 0.6- , base >= 4.5 && < 5 , base-compat >= 0.8.1 && < 1 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6+ , contravariant >= 0.5 && < 2 , criterion >= 1 && < 2 , deepseq >= 1.3 && < 2 , generic-deriving >= 1.9 && < 2@@ -392,15 +437,33 @@ , semigroups >= 0.17 && < 1 , tagged >= 0.4.4 && < 1 , text >= 0.11.1 && < 1.3- , template-haskell >= 2.5 && < 2.12 , th-lift >= 0.7.6 && < 1- , transformers >= 0.2.1 && < 0.6- , transformers-compat >= 0.5 && < 1 , void >= 0.5 && < 1++ if flag(base-4-9)+ build-depends: base >= 4.9 && < 5+ 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.12+ , ghc-boot-th+ else+ build-depends: template-haskell >= 2.5 && < 2.11++ if flag(new-functor-classes)+ build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6)+ , transformers-compat >= 0.5 && < 1+ cpp-options: "-DNEW_FUNCTOR_CLASSES"+ else+ build-depends: transformers == 0.4.*+ if flag(developer) hs-source-dirs: src else- build-depends: text-show == 3.2.2+ build-depends: text-show == 3.3+ hs-source-dirs: benchmarks default-language: Haskell2010 ghc-options: -Wall