packages feed

text-show 2.1.2 → 3

raw patch · 94 files changed

+4373/−2715 lines, 94 filesdep +ghc-bootdep +th-liftdep ~basedep ~semigroupsdep ~tagged

Dependencies added: ghc-boot, th-lift

Dependency ranges changed: base, semigroups, tagged, template-haskell, text-show, transformers-compat

Files

CHANGELOG.md view
@@ -1,3 +1,23 @@+# 3+* GHC 8.0 support+* The functions `showt`, `showtl`, `showtPrec`, `showtlPrec`, `showtList`, and `showtlList` are now part of the `TextShow` class. This was done to allow overriding their definitions with more efficient versions specifically for strict or lazy `Text`. (Currently, no `TextShow` instance in the `text-show` package does this, but this may change in the future.)+* Added the `TextShow.Data.Functor.Compose`, `TextShow.Data.Functor.Product`, `TextShow.Data.Functor.Sum`, and `TextShow.Data.Semigroup` modules+* Added `TextShow` instance for `TypeError` in `TextShow.Control.Exception` (GHC 8.0+)+* Added `TextShow` instances for `TrName` and `Module` in `TextShow.Data.Typeable` (GHC 8.0+)+* Added `Lift` instances for the datatypes in `TextShow` and `TextShow.Generic`+* Renamed the class methods of `TextShow1` and `TextShow2` to be consistent with the naming conventions of `transformers-0.5`. They following were renamed:+  * `showbPrecWith` → `liftShowbPrec`+  * `showbPrecWith2` → `liftShowbPrec2`+  * `makeShowbPrecWith` → `makeLiftShowbPrec`+  * `makeShowbPrecWith2` → `makeLiftShowbPrec2`+  * `genericShowbPrecWith` → `genericLiftShowbPrec`++  In addition, many other monomorphic functions from the various `TextShow` submodules were also renamed to be consistent with the new `lift-` prefix.+* `showsToShowb` and `showbToShows` now only convert functions that ignore precedence (i.e., of type `a -> ShowS` or `a -> Builder`). Their former role has been given to the new functions `showsPrecToShowbPrec` and `showbPrecToShowsPrec`+* Added `FromStringShow1`, `FromTextShow1`, `FromStringShow2`, and `FromTextShow2`, which allow defining string `Show1`/`Show2` instances in terms of `TextShow1`/`TextShow2` instances, and vice versa. Be aware that many of these instances cannot be provided if you are using `tranformers-0.4`, since its version of `Data.Functor.Classes` uses a very differenltly designed `Show1` typeclass (and does not have `Show2` at all).+* Rewrote `TextShow.TH`'s type inferencer. This avoids a nasty GHC 7.8 bug, and it allows `TextShow(1)(2)` to be derived for more datatypes that can only be expressed with `-XTypeInType` enabled.+* Reworked internals of `TextShow.Generic`. Empty datatypes can now be have generic `TextShow` and `TextShow1` instances.+ # 2.1.2 * Fixed GHC 7.10.3 build * Extended `TextShow.Generic` to allow `genericShowbPrec` (and friends) to be used on `Generic` datatypes with `Char#`, `Double#`, `Float#`, `Int#`, and `Word#` argument types, just like string `Show` does@@ -20,78 +40,78 @@ # 2 * Changed the top-level module name from `Text.Show.Text` to `TextShow`, since the former was extremely verbose without much benefit. As a result, this will break all existing code that depends on `text-show`. * Several typeclasses and functions were renamed so as to not to clash with the `Prelude`:- * `Show` → `TextShow`- * `Show1` → `TextShow1`- * `Show2` → `TextShow2`- * `show` → `showt`- * `showLazy` → `showtl`- * `showPrec` → `showtPrec`- * `showPrecLazy` → `showtlPrec`- * `showList` → `showtList`- * `showListLazy` → `showtlList`- * `print` → `printT`- * `printLazy` → `printTL`- * `hPrint` → `hPrintT`- * `hPrintLazy` → `hPrintTL`- * `GShow` → `GTextShow`- * `GShow1` → `GTextShow1`- * `genericShow` → `genericShowt`- * `genericShowLazy` → `genericShowtl`- * `genericShowPrec` → `genericShowtPrec`- * `genericShowPrecLazy` → `genericShowtlPrec`- * `genericShowList` → `genericShowtList`- * `genericShowListLazy` → `genericShowtlList`- * `genericPrint` → `genericPrintT`- * `genericPrintLazy` → `genericPrintTL`- * `genericHPrint` → `genericHPrintT`- * `genericHPrintLazy` → `genericHPrintTL`- * `deriveShow` → `deriveTextShow`- * `deriveShow1` → `deriveTextShow1`- * `deriveShow2` → `deriveTextShow2`- * `mkShow` → `makeShowt`- * `mkShowLazy` → `makeShowtl`- * `mkShowPrec` → `makeShowtPrec`- * `mkShowPrecLazy` → `makeShowtlPrec`- * `mkShowList` → `makeShowtList`- * `mkShowListLazy` → `makeShowtlList`- * `mkShowb` → `makeShowb`- * `mkShowbPrec` → `makeShowbPrec`- * `mkShowbList` → `makeShowbList`- * `mkPrint` → `makePrintT`- * `mkPrintLazy` → `makePrintTL`- * `mkHPrint` → `makeHPrintT`- * `mkHPrintLazy` → `makeHPrintTL`- * `mkShowbPrecWith` → `makeShowbPrecWith`- * `mkShowbPrec1` → `makeShowbPrec1`- * `mkShowbPrecWith2` → `makeShowbPrecWith2`- * `mkShowbPrec2` → `makeShowbPrec2`- * `trace` → `tracet`- * `traceLazy` → `tracetl`- * `traceId` → `tracetId`- * `traceIdLazy` → `tracetlId`- * `traceShow` → `traceTextShow`- * `traceShowId` → `traceTextShowId`- * `traceStack` → `tracetStack`- * `traceStackLazy` → `tracetlStack`- * `traceIO` → `tracetIO`- * `traceIOLazy` → `tracetlIO`- * `traceM` → `tracetM`- * `traceMLazy` → `tracetlM`- * `traceShowM` → `traceTextShowM`- * `traceEvent` → `tracetEvent`- * `traceEventLazy` → `tracetlEvent`- * `traceEventIO` → `travetEventIO`- * `traceEventIOLazy` → `tracetlEventIO`- * `traceMarker` → `tracetMarker`- * `traceMarkerLazy` → `tracetlMarker`- * `traceMarkerIO` → `tracetMarkerIO`- * `traceMarkerIOLazy` → `tracetlMarkerIO`- * `genericTraceShow` → `genericTraceTextShow`- * `genericTraceShowId` → `genericTraceTextShowId`- * `genericTraceShowM` → `genericTraceTextShowM`- * `mkTraceShow` → `makeTraceTextShow`- * `mkTraceShowId` → `makeTraceTextShowId`- * `mkTraceShowM` → `makeTraceTextShowM`+  * `Show` → `TextShow`+  * `Show1` → `TextShow1`+  * `Show2` → `TextShow2`+  * `show` → `showt`+  * `showLazy` → `showtl`+  * `showPrec` → `showtPrec`+  * `showPrecLazy` → `showtlPrec`+  * `showList` → `showtList`+  * `showListLazy` → `showtlList`+  * `print` → `printT`+  * `printLazy` → `printTL`+  * `hPrint` → `hPrintT`+  * `hPrintLazy` → `hPrintTL`+  * `GShow` → `GTextShow`+  * `GShow1` → `GTextShow1`+  * `genericShow` → `genericShowt`+  * `genericShowLazy` → `genericShowtl`+  * `genericShowPrec` → `genericShowtPrec`+  * `genericShowPrecLazy` → `genericShowtlPrec`+  * `genericShowList` → `genericShowtList`+  * `genericShowListLazy` → `genericShowtlList`+  * `genericPrint` → `genericPrintT`+  * `genericPrintLazy` → `genericPrintTL`+  * `genericHPrint` → `genericHPrintT`+  * `genericHPrintLazy` → `genericHPrintTL`+  * `deriveShow` → `deriveTextShow`+  * `deriveShow1` → `deriveTextShow1`+  * `deriveShow2` → `deriveTextShow2`+  * `mkShow` → `makeShowt`+  * `mkShowLazy` → `makeShowtl`+  * `mkShowPrec` → `makeShowtPrec`+  * `mkShowPrecLazy` → `makeShowtlPrec`+  * `mkShowList` → `makeShowtList`+  * `mkShowListLazy` → `makeShowtlList`+  * `mkShowb` → `makeShowb`+  * `mkShowbPrec` → `makeShowbPrec`+  * `mkShowbList` → `makeShowbList`+  * `mkPrint` → `makePrintT`+  * `mkPrintLazy` → `makePrintTL`+  * `mkHPrint` → `makeHPrintT`+  * `mkHPrintLazy` → `makeHPrintTL`+  * `mkShowbPrecWith` → `makeShowbPrecWith`+  * `mkShowbPrec1` → `makeShowbPrec1`+  * `mkShowbPrecWith2` → `makeShowbPrecWith2`+  * `mkShowbPrec2` → `makeShowbPrec2`+  * `trace` → `tracet`+  * `traceLazy` → `tracetl`+  * `traceId` → `tracetId`+  * `traceIdLazy` → `tracetlId`+  * `traceShow` → `traceTextShow`+  * `traceShowId` → `traceTextShowId`+  * `traceStack` → `tracetStack`+  * `traceStackLazy` → `tracetlStack`+  * `traceIO` → `tracetIO`+  * `traceIOLazy` → `tracetlIO`+  * `traceM` → `tracetM`+  * `traceMLazy` → `tracetlM`+  * `traceShowM` → `traceTextShowM`+  * `traceEvent` → `tracetEvent`+  * `traceEventLazy` → `tracetlEvent`+  * `traceEventIO` → `travetEventIO`+  * `traceEventIOLazy` → `tracetlEventIO`+  * `traceMarker` → `tracetMarker`+  * `traceMarkerLazy` → `tracetlMarker`+  * `traceMarkerIO` → `tracetMarkerIO`+  * `traceMarkerIOLazy` → `tracetlMarkerIO`+  * `genericTraceShow` → `genericTraceTextShow`+  * `genericTraceShowId` → `genericTraceTextShowId`+  * `genericTraceShowM` → `genericTraceTextShowM`+  * `mkTraceShow` → `makeTraceTextShow`+  * `mkTraceShowId` → `makeTraceTextShowId`+  * `mkTraceShowM` → `makeTraceTextShowM` * Added `TextShow Lifetime` instance in `TextShow.GHC.Event` (if using `base-4.8.1.0` or later) * Generalized `tracetM`, `tracetlM`, and `traceTextShowM` to use an `Applicative` constraint instead of `Monad` * Fixed a bug in which the `TextShow(1)` instances for `Proxy`, `(:~:)`, and `Coercion` didn't use `-XPolyKinds`
src/TextShow.hs view
@@ -14,12 +14,6 @@       -- * The @TextShow@ classes       -- ** 'TextShow'       TextShow(..)-    , showt-    , showtl-    , showtPrec-    , showtlPrec-    , showtList-    , showtlList     , showbParen     , showbSpace       -- ** 'TextShow1'@@ -56,7 +50,13 @@       -- * Conversion between 'TextShow' and string @Show@     , FromStringShow(..)     , FromTextShow(..)+    , FromStringShow1(..)+    , FromTextShow1(..)+    , FromStringShow2(..)+    , FromTextShow2(..)+    , showsPrecToShowbPrec     , showsToShowb+    , showbPrecToShowsPrec     , showbToShows     ) where
src/TextShow/Classes.hs view
@@ -65,70 +65,112 @@     -- /Since: 2/     showbPrec :: Int -- ^ The operator precedence of the enclosing context (a number                      -- from @0@ to @11@). Function application has precedence @10@.-              -> a   -- ^ The value to be converted to a 'String'.+              -> a   -- ^ The value to be converted to a 'Builder'.               -> Builder     showbPrec _ = showb -    -- | A specialized variant of 'showbPrec' using precedence context zero.+    -- | Converts a value to a strict 'TS.Text'. If you hand-define this, it should+    -- satisfy:     --+    -- @+    -- 'showb' = 'showbPrec' 0+    -- @+    --     -- /Since: 2/-    showb :: a -> Builder+    showb :: a -- ^ The value to be converted to a 'Builder'.+          -> Builder     showb = showbPrec 0 -    -- | Allows for specialized display of lists. This is used, for example, when-    -- showing lists of 'Char's.+    -- | Converts a list of values to a 'Builder'. By default, this is defined as+    -- @'showbList = 'showbListWith' 'showb'@, but it can be overridden to allow+    -- for specialized displaying of lists (e.g., lists of 'Char's).     --     -- /Since: 2/-    showbList :: [a] -> Builder+    showbList :: [a] -- ^ The list of values to be converted to a 'Builder'.+              -> Builder     showbList = showbListWith showb -#if __GLASGOW_HASKELL__ >= 708-    {-# MINIMAL showbPrec | showb #-}+    -- | Converts a value to a strict 'TS.Text' with the given precedence. This+    -- can be overridden for efficiency, but it should satisfy:+    --+    -- @+    -- 'showtPrec' p = 'toStrict' . 'showtlPrec' p+    -- @+    --+    -- /Since: 3/+    showtPrec :: Int -- ^ The operator precedence of the enclosing context (a number+                     -- from @0@ to @11@). Function application has precedence @10@.+              -> a   -- ^ The value to be converted to a strict 'TS.Text'.+              -> TS.Text+    showtPrec p = toStrict . showtlPrec p -deriving instance Typeable TextShow-#endif+    -- | Converts a value to a strict 'TS.Text'. This can be overridden for+    -- efficiency, but it should satisfy:+    --+    -- @+    -- 'showt' = 'toStrict' . 'showtl'+    -- @+    --+    -- /Since: 3/+    showt :: a -- ^ The value to be converted to a strict 'TS.Text'.+          -> TS.Text+    showt = toStrict . showtl --- | Constructs a strict 'TS.Text' from a single value.------ /Since: 2/-showt :: TextShow a => a -> TS.Text-showt = toStrict . showtl-{-# INLINE showt #-}+    -- | Converts a list of values to a strict 'TS.Text'. This can be overridden for+    -- efficiency, but it should satisfy:+    --+    -- @+    -- 'showtList' = 'toStrict' . 'showtlList'+    -- @+    --+    -- /Since: 3/+    showtList :: [a] -- ^ The list of values to be converted to a strict 'TS.Text'.+              -> TS.Text+    showtList = toStrict . showtlList --- | Constructs a lazy 'TL.Text' from a single value.------ /Since: 2/-showtl :: TextShow a => a -> TL.Text-showtl = toLazyText . showb-{-# INLINE showtl #-}+    -- | Converts a value to a lazy 'TL.Text' with the given precedence. This+    -- can be overridden for efficiency, but it should satisfy:+    --+    -- @+    -- 'showtlPrec' p = 'toLazyText' . 'showbPrec' p+    -- @+    --+    -- /Since: 3/+    showtlPrec :: Int -- ^ The operator precedence of the enclosing context (a number+                      -- from @0@ to @11@). Function application has precedence @10@.+               -> a   -- ^ The value to be converted to a lazy 'TL.Text'.+               -> TL.Text+    showtlPrec p = toLazyText . showbPrec p --- | Constructs a strict 'TS.Text' from a single value with the given precedence.------ /Since: 2/-showtPrec :: TextShow a => Int -> a -> TS.Text-showtPrec p = toStrict . showtlPrec p-{-# INLINE showtPrec #-}+    -- | Converts a value to a lazy 'TL.Text'. This can be overridden for+    -- efficiency, but it should satisfy:+    --+    -- @+    -- 'showtl' = 'toLazyText' . 'showb'+    -- @+    --+    -- /Since: 3/+    showtl :: a -- ^ The value to be converted to a lazy 'TL.Text'.+           -> TL.Text+    showtl = toLazyText . showb --- | Constructs a lazy 'TL.Text' from a single value with the given precedence.------ /Since: 2/-showtlPrec :: TextShow a => Int -> a -> TL.Text-showtlPrec p = toLazyText . showbPrec p-{-# INLINE showtlPrec #-}+    -- | Converts a list of values to a lazy 'TL.Text'. This can be overridden for+    -- efficiency, but it should satisfy:+    --+    -- @+    -- 'showtlList' = 'toLazyText' . 'showbList'+    -- @+    --+    -- /Since: 3/+    showtlList :: [a] -- ^ The list of values to be converted to a lazy 'TL.Text'.+               -> TL.Text+    showtlList = toLazyText . showbList --- | Construct a strict 'TS.Text' from a list of values.------ /Since: 2/-showtList :: TextShow a => [a] -> TS.Text-showtList = toStrict . showtlList-{-# INLINE showtList #-}+#if __GLASGOW_HASKELL__ >= 708+    {-# MINIMAL showbPrec | showb #-} --- | Construct a lazy 'TL.Text' from a list of values.------ /Since: 2/-showtlList :: TextShow a => [a] -> TL.Text-showtlList = toLazyText . showbList-{-# INLINE showtlList #-}+deriving instance Typeable TextShow+#endif  -- | Surrounds 'Builder' output with parentheses if the 'Bool' parameter is 'True'. --@@ -192,18 +234,32 @@ hPrintTL h = TL.hPutStrLn h . showtl {-# INLINE hPrintTL #-} +-- | Convert a precedence-aware @ShowS@-based show function to a @Builder@-based one.+--+-- /Since: 3/+showsPrecToShowbPrec :: (Int -> a -> ShowS) -> Int -> a -> Builder+showsPrecToShowbPrec sp p x = fromString $ sp p x ""+{-# INLINE showsPrecToShowbPrec #-}+ -- | Convert a @ShowS@-based show function to a @Builder@-based one. ----- /Since: 2.1/-showsToShowb :: (Int -> a -> ShowS) -> Int -> a -> Builder-showsToShowb sp p x = fromString $ sp p x ""+-- /Since: 3/+showsToShowb :: (a -> ShowS) -> a -> Builder+showsToShowb sf x = fromString $ sf x "" {-# INLINE showsToShowb #-} +-- | Convert a precedence-aware @Builder@-based show function to a @ShowS@-based one.+--+-- /Since: 3/+showbPrecToShowsPrec :: (Int -> a -> Builder) -> Int -> a -> ShowS+showbPrecToShowsPrec sp p = showString . toString . sp p+{-# INLINE showbPrecToShowsPrec #-}+ -- | Convert a @Builder@-based show function to a @ShowS@-based one. ----- /Since: 2.1/-showbToShows :: (Int -> a -> Builder) -> Int -> a -> ShowS-showbToShows sp p = showString . toString . sp p+-- /Since: 3/+showbToShows :: (a -> Builder) -> a -> ShowS+showbToShows sl = showString . toString . sl {-# INLINE showbToShows #-}  -------------------------------------------------------------------------------@@ -212,20 +268,35 @@ -- -- /Since: 2/ class TextShow1 f where-    -- | Lifts a 'showbPrec' function through the type constructor.+    -- | 'showbPrec' function for an application of the type constructor+    -- based on 'showbPrec' and 'showbList' functions for the argument type.     ---    -- /Since: 2/-    showbPrecWith :: (Int -> a -> Builder) -> Int -> f a -> Builder+    -- /Since: 3/+    liftShowbPrec :: (Int -> a -> Builder) -> ([a] -> Builder)+                  -> Int -> f a -> Builder +    -- | 'showbList' function for an application of the type constructor+    -- based on 'showbPrec' and 'showbList' functions for the argument type.+    -- The default implementation using standard list syntax is correct+    -- for most types.+    --+    -- /Since: 3/+    liftShowbList :: (Int -> a -> Builder) -> ([a] -> Builder)+                  -> [f a] -> Builder+    liftShowbList sp sl = showbListWith (liftShowbPrec sp sl 0)+ #if __GLASGOW_HASKELL__ >= 708+    {-# MINIMAL liftShowbPrec #-}+ deriving instance Typeable TextShow1 #endif --- | Lift the standard 'showbPrec' function through the type constructor.+-- | Lift the standard 'showbPrec' and 'showbList' functions through the+-- type constructor. -- -- /Since: 2/ showbPrec1 :: (TextShow1 f, TextShow a) => Int -> f a -> Builder-showbPrec1 = showbPrecWith showbPrec+showbPrec1 = liftShowbPrec showbPrec showbList {-# INLINE showbPrec1 #-}  -- | @'showbUnaryWith' sp n p x@ produces the 'Builder' representation of a unary data@@ -244,13 +315,29 @@ -- -- /Since: 2/ class TextShow2 f where-    -- | Lifts 'showbPrec' functions through the type constructor.+    -- | 'showbPrec' function for an application of the type constructor+    -- based on 'showbPrec' and 'showbList' functions for the argument types.     ---    -- /Since: 2/-    showbPrecWith2 :: (Int -> a -> Builder) -> (Int -> b -> Builder) ->-        Int -> f a b -> Builder+    -- /Since: 3/+    liftShowbPrec2 :: (Int -> a -> Builder) -> ([a] -> Builder)+                   -> (Int -> b -> Builder) -> ([b] -> Builder)+                   -> Int -> f a b -> Builder +    -- | 'showbList' function for an application of the type constructor+    -- based on 'showbPrec' and 'showbList' functions for the argument types.+    -- The default implementation using standard list syntax is correct+    -- for most types.+    --+    -- /Since: 3/+    liftShowbList2 :: (Int -> a -> Builder) -> ([a] -> Builder)+                   -> (Int -> b -> Builder) -> ([b] -> Builder)+                   -> [f a b] -> Builder+    liftShowbList2 sp1 sl1 sp2 sl2 =+        showbListWith (liftShowbPrec2 sp1 sl1 sp2 sl2 0)+ #if __GLASGOW_HASKELL__ >= 708+    {-# MINIMAL liftShowbPrec2 #-}+ deriving instance Typeable TextShow2 #endif @@ -258,7 +345,7 @@ -- -- /Since: 2/ showbPrec2 :: (TextShow2 f, TextShow a, TextShow b) => Int -> f a b -> Builder-showbPrec2 = showbPrecWith2 showbPrec showbPrec+showbPrec2 = liftShowbPrec2 showbPrec showbList showbPrec showbList {-# INLINE showbPrec2 #-}  -- | @'showbBinaryWith' sp n p x y@ produces the 'Builder' representation of a binary
src/TextShow/Control/Applicative.hs view
@@ -13,37 +13,37 @@  /Since: 2/ -}-module TextShow.Control.Applicative (showbConstPrecWith, showbZipListPrecWith) where+module TextShow.Control.Applicative (liftShowbConstPrec, liftShowbZipListPrec) where  import Control.Applicative (Const(..), ZipList)  import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (TextShow(showbPrec), TextShow1(..),+import TextShow.Classes (TextShow(..), TextShow1(..),                          TextShow2(..), showbUnaryWith) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1)  -- | Convert a 'Const' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbConstPrecWith :: (Int -> a -> Builder) -> Int -> Const a b -> Builder-showbConstPrecWith sp = showbPrecWith2 sp undefined+-- /Since: 3/+liftShowbConstPrec :: (Int -> a -> Builder) -> Int -> Const a b -> Builder+liftShowbConstPrec sp = liftShowbPrec2 sp undefined undefined undefined --- | Convert a 'ZipList' to a 'Builder' with the given show function precedence.+-- | Convert a 'ZipList' to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbZipListPrecWith :: (Int -> a -> Builder) -> Int -> ZipList a -> Builder-showbZipListPrecWith = showbPrecWith+-- /Since: 3/+liftShowbZipListPrec :: ([a] -> Builder) -> Int -> ZipList a -> Builder+liftShowbZipListPrec sl = liftShowbPrec undefined sl  instance TextShow a => TextShow (Const a b) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined  instance TextShow a => TextShow1 (Const a) where-    showbPrecWith = showbPrecWith2 showbPrec+    liftShowbPrec = liftShowbPrec2 showbPrec showbList  instance TextShow2 Const where-    showbPrecWith2 sp1 _ p (Const x) = showbUnaryWith sp1 "Const" p x+    liftShowbPrec2 sp1 _ _ _ p (Const x) = showbUnaryWith sp1 "Const" p x  $(deriveTextShow  ''ZipList) $(deriveTextShow1 ''ZipList)
src/TextShow/Control/Concurrent.hs view
@@ -31,7 +31,7 @@ import GHC.Conc.Sync (ThreadId(..)) import GHC.Prim -import TextShow.Classes (TextShow(showb, showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.Foreign.C.Types (showbCIntPrec) import TextShow.TH.Internal (deriveTextShow)
src/TextShow/Control/Exception.hs view
@@ -31,6 +31,9 @@ #if MIN_VERSION_base(4,8,0)   , showbAllocationLimitExceeded #endif+#if MIN_VERSION_base(4,9,0)+  , showbTypeError+#endif   , showbDeadlock   , showbNoMethodError   , showbPatternMatchFail@@ -52,7 +55,7 @@ import Prelude () import Prelude.Compat -import TextShow.Classes (TextShow(showb, showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.FromStringTextShow (FromStringShow(..)) import TextShow.TH.Internal (deriveTextShow) @@ -164,6 +167,16 @@ {-# INLINE showbAllocationLimitExceeded #-} #endif +#if MIN_VERSION_base(4,9,0)+-- | Convert a 'TypeError' to a 'Builder'.+-- This function is only available with @base-4.9.0.0@ or later.+--+-- /Since: 3/+showbTypeError :: TypeError -> Builder+showbTypeError (TypeError err) = fromString err+{-# INLINE showbTypeError #-}+#endif+ -- | Convert a 'Deadlock' exception to a 'Builder'. -- -- /Since: 2/@@ -210,10 +223,12 @@ -- -- /Since: 2/ showbErrorCall :: ErrorCall -> Builder-showbErrorCall (ErrorCall err) = fromString err #if MIN_VERSION_base(4,9,0)+showbErrorCall (ErrorCallWithLocation err "")  = fromString err showbErrorCall (ErrorCallWithLocation err loc) =   fromString err <> singleton '\n' <> fromString loc+#else+showbErrorCall (ErrorCall err) = fromString err #endif  -- | Convert a 'MaskingState' to a 'Builder'.@@ -272,6 +287,12 @@ #if MIN_VERSION_base(4,8,0) instance TextShow AllocationLimitExceeded where     showb = showbAllocationLimitExceeded+    {-# INLINE showb #-}+#endif++#if MIN_VERSION_base(4,9,0)+instance TextShow TypeError where+    showb = showbTypeError     {-# INLINE showb #-} #endif
src/TextShow/Control/Monad/ST.hs view
@@ -17,7 +17,7 @@  import Control.Monad.ST (ST) import Data.Text.Lazy.Builder (Builder)-import TextShow.Classes (TextShow(showb), TextShow1(..), TextShow2(..))+import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..))  #include "inline.h" @@ -29,13 +29,13 @@ {-# INLINE showbST #-}  instance TextShow (ST s a) where-    showb = showbPrecWith undefined 0+    showb = liftShowbPrec undefined undefined 0     INLINE_INST_FUN(showb)  instance TextShow1 (ST s) where-    showbPrecWith = showbPrecWith2 undefined-    INLINE_INST_FUN(showbPrecWith)+    liftShowbPrec = liftShowbPrec2 undefined undefined+    INLINE_INST_FUN(liftShowbPrec)  instance TextShow2 ST where-    showbPrecWith2 _ _ _ _ = "<<ST action>>"-    INLINE_INST_FUN(showbPrecWith2)+    liftShowbPrec2 _ _ _ _ _ _ = "<<ST action>>"+    INLINE_INST_FUN(liftShowbPrec2)
src/TextShow/Data/Array.hs view
@@ -34,7 +34,7 @@ import           Prelude () import           Prelude.Compat -import           TextShow.Classes (TextShow(showb, showbPrec), showbParen, showbSpace)+import           TextShow.Classes (TextShow(..), showbParen, showbSpace) import           TextShow.Data.List () import           TextShow.Data.Tuple ()
src/TextShow/Data/ByteString.hs view
@@ -33,7 +33,7 @@  import           GHC.Exts (ByteArray#, Char(C#), Int(I#), indexCharArray#) -import           TextShow.Classes (TextShow(showb, showbPrec))+import           TextShow.Classes (TextShow(..)) import           TextShow.Data.Char () import           TextShow.Data.List ()
src/TextShow/Data/Complex.hs view
@@ -21,7 +21,7 @@ import Data.Complex (Complex) import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (TextShow(showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.Data.Floating () import TextShow.TH.Internal (makeShowbPrec) #if MIN_VERSION_base(4,4,0)
src/TextShow/Data/Data.hs view
@@ -24,7 +24,7 @@ import Data.Data (Constr, ConstrRep, DataRep, DataType, Fixity, showConstr) import Data.Text.Lazy.Builder (Builder, fromString) -import TextShow.Classes (TextShow(showb, showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.Data.List () import TextShow.Data.Ratio () import TextShow.TH.Internal (deriveTextShow)
src/TextShow/Data/Dynamic.hs view
@@ -21,7 +21,7 @@  import Prelude () -import TextShow.Classes (TextShow(showb))+import TextShow.Classes (TextShow(..)) import TextShow.Data.Typeable (showbTypeRepPrec)  #include "inline.h"
src/TextShow/Data/Either.hs view
@@ -13,11 +13,11 @@  /Since: 2/ -}-module TextShow.Data.Either (showbEitherPrecWith2) where+module TextShow.Data.Either (liftShowbEitherPrec2) where  import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (showbPrecWith2)+import TextShow.Classes (liftShowbPrec2) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2)  #include "inline.h"@@ -25,11 +25,11 @@ -- | Convert a 'Either' value to a 'Builder' with the given show functions -- and precedence. ----- /Since: 2/-showbEitherPrecWith2 :: (Int -> a -> Builder) -> (Int -> b -> Builder)+-- /Since: 3/+liftShowbEitherPrec2 :: (Int -> a -> Builder) -> (Int -> b -> Builder)                      -> Int -> Either a b -> Builder-showbEitherPrecWith2 = showbPrecWith2-{-# INLINE showbEitherPrecWith2 #-}+liftShowbEitherPrec2 sp1 sp2 = liftShowbPrec2 sp1 undefined sp2 undefined+{-# INLINE liftShowbEitherPrec2 #-}  $(deriveTextShow  ''Either) $(deriveTextShow1 ''Either)
src/TextShow/Data/Fixed.hs view
@@ -20,16 +20,17 @@ import Prelude () import Prelude.Compat -import TextShow.Classes (TextShow(showb))+import TextShow.Classes (TextShow(..))  #if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(..)) import Data.Int (Int64) import Data.Monoid.Compat ((<>))+import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (singleton)  import TextShow.Data.Integral ()-import TextShow.Utils (lengthB, mtimesDefault)+import TextShow.Utils (lengthB) #else import Data.Fixed (Fixed, showFixed) import Data.Text.Lazy.Builder (fromString)
src/TextShow/Data/Floating.hs view
@@ -37,7 +37,7 @@ import           Data.Text.Lazy.Builder.Int (decimal) import           Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) -import           TextShow.Classes (TextShow(showb, showbPrec), showbParen)+import           TextShow.Classes (TextShow(..), showbParen) import           TextShow.TH.Internal (deriveTextShow) import           TextShow.Utils (i2d)
+ src/TextShow/Data/Functor/Compose.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module:      TextShow.Data.Functor.Compose+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++Monomorphic 'TextShow' function for 'Compose'.++/Since: 3/+-}+module TextShow.Data.Functor.Compose (liftShowbComposePrec) where++import Data.Functor.Compose (Compose(..))+import Data.Text.Lazy.Builder (Builder)++import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1, showbUnaryWith)++#include "inline.h"++-- | Convert a 'Compose' value to a 'Builder' with the given show functions+-- and precedence.+--+-- /Since: 3/+liftShowbComposePrec :: (TextShow1 f, TextShow1 g)+                     => (Int -> a -> Builder) -> ([a] -> Builder)+                     -> Int -> Compose f g a -> Builder+liftShowbComposePrec sp sl p (Compose x) =+    showbUnaryWith (liftShowbPrec (liftShowbPrec sp sl)+                                  (liftShowbList sp sl))+                   "Compose" p x++instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Compose f g a) where+    showbPrec = showbPrec1+    INLINE_INST_FUN(showbPrec)++instance (TextShow1 f, TextShow1 g) => TextShow1 (Compose f g) where+    liftShowbPrec = liftShowbComposePrec+    INLINE_INST_FUN(liftShowbPrec)
src/TextShow/Data/Functor/Identity.hs view
@@ -13,12 +13,12 @@  /Since: 2/ -}-module TextShow.Data.Functor.Identity (showbIdentityPrecWith) where+module TextShow.Data.Functor.Identity (liftShowbIdentityPrec) where  import Data.Functor.Identity (Identity(..)) import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (TextShow(showbPrec), TextShow1(..),+import TextShow.Classes (TextShow(..), TextShow1(..),                          showbPrec1, showbUnaryWith)  #include "inline.h"@@ -26,17 +26,17 @@ -- | Convert an 'Identity' value to a 'Builder' with the given show function -- and precedence. ----- /Since: 2/-showbIdentityPrecWith :: (Int -> a -> Builder) -> Int -> Identity a -> Builder+-- /Since: 3/+liftShowbIdentityPrec :: (Int -> a -> Builder) -> Int -> Identity a -> Builder -- This would be equivalent to the derived instance of 'Identity' if the -- 'runIdentity' field were removed.-showbIdentityPrecWith sp p (Identity x) = showbUnaryWith sp "Identity" p x-{-# INLINE showbIdentityPrecWith #-}+liftShowbIdentityPrec sp p (Identity x) = showbUnaryWith sp "Identity" p x+{-# INLINE liftShowbIdentityPrec #-}  instance TextShow a => TextShow (Identity a) where     showbPrec = showbPrec1     {-# INLINE showbPrec #-}  instance TextShow1 Identity where-    showbPrecWith = showbIdentityPrecWith-    INLINE_INST_FUN(showbPrecWith)+    liftShowbPrec sp _ = liftShowbIdentityPrec sp+    INLINE_INST_FUN(liftShowbPrec)
+ src/TextShow/Data/Functor/Product.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module:      TextShow.Data.Functor.Product+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++Monomorphic 'TextShow' function for 'Product'.++/Since: 3/+-}+module TextShow.Data.Functor.Product (liftShowbProductPrec) where++import Data.Functor.Product (Product(..))+import Data.Text.Lazy.Builder (Builder)++import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1)+import TextShow.TH.Internal (deriveTextShow1)++#include "inline.h"++-- | Convert a 'Product' value to a 'Builder' with the given show functions+-- and precedence.+--+-- /Since: 3/+liftShowbProductPrec :: (TextShow1 f, TextShow1 g)+                     => (Int -> a -> Builder) -> ([a] -> Builder)+                     -> Int -> Product f g a -> Builder+liftShowbProductPrec = liftShowbPrec+{-# INLINE liftShowbProductPrec #-}++instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Product f g a) where+    showbPrec = showbPrec1+    INLINE_INST_FUN(showbPrec)++$(deriveTextShow1 ''Product)
+ src/TextShow/Data/Functor/Sum.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module:      TextShow.Data.Functor.Sum+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++Monomorphic 'TextShow' function for 'Sum'.++/Since: 3/+-}+module TextShow.Data.Functor.Sum (liftShowbSumPrec) where++import Data.Functor.Sum (Sum(..))+import Data.Text.Lazy.Builder (Builder)++import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1)+import TextShow.TH.Internal (deriveTextShow1)++#include "inline.h"++-- | Convert a 'Sum' value to a 'Builder' with the given show functions+-- and precedence.+--+-- /Since: 3/+liftShowbSumPrec :: (TextShow1 f, TextShow1 g)+                 => (Int -> a -> Builder) -> ([a] -> Builder)+                 -> Int -> Sum f g a -> Builder+liftShowbSumPrec = liftShowbPrec+{-# INLINE liftShowbSumPrec #-}++instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Sum f g a) where+    showbPrec = showbPrec1+    INLINE_INST_FUN(showbPrec)++$(deriveTextShow1 ''Sum)
src/TextShow/Data/Integral.hs view
@@ -50,7 +50,7 @@ import           Prelude () import           Prelude.Compat -import           TextShow.Classes (TextShow(showb, showbPrec))+import           TextShow.Classes (TextShow(..)) import           TextShow.Utils (toString)  #include "inline.h"
src/TextShow/Data/List.hs view
@@ -12,7 +12,7 @@ -} module TextShow.Data.List (showbListWith) where -import TextShow.Classes (TextShow(showb, showbList), TextShow1(..), showbListWith)+import TextShow.Classes (TextShow(..), TextShow1(..), showbListWith) import TextShow.Data.Char () import TextShow.Data.Integral () @@ -26,5 +26,5 @@     INLINE_INST_FUN(showb)  instance TextShow1 [] where-    showbPrecWith sp _ = showbListWith (sp 0)-    INLINE_INST_FUN(showbPrecWith)+    liftShowbPrec _ sl _ = sl+    INLINE_INST_FUN(liftShowbPrec)
+ src/TextShow/Data/List/NonEmpty.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module:      TextShow.Data.List.NonEmpty+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++Monomorphic 'TextShow' function for 'NonEmpty' lists.++/Since: 3/+-}+module TextShow.Data.List.NonEmpty (liftShowbNonEmptyPrec) where++import Data.List.NonEmpty (NonEmpty(..))+import Data.Text.Lazy.Builder (Builder)++import TextShow.Classes (TextShow1(..))+import TextShow.Data.List ()+import TextShow.TH.Internal (deriveTextShow, deriveTextShow1)++liftShowbNonEmptyPrec :: (Int -> a -> Builder) -> ([a] -> Builder)+                      -> Int -> NonEmpty a -> Builder+liftShowbNonEmptyPrec = liftShowbPrec++$(deriveTextShow  ''NonEmpty)+$(deriveTextShow1 ''NonEmpty)
src/TextShow/Data/Maybe.hs view
@@ -13,21 +13,21 @@  /Since: 2/ -}-module TextShow.Data.Maybe (showbMaybePrecWith) where+module TextShow.Data.Maybe (liftShowbMaybePrec) where  import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (showbPrecWith)+import TextShow.Classes (liftShowbPrec) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1)  #include "inline.h"  -- | Convert a 'Maybe' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbMaybePrecWith :: (Int -> a -> Builder) -> Int -> Maybe a -> Builder-showbMaybePrecWith = showbPrecWith-{-# INLINE showbMaybePrecWith #-}+-- /Since: 3/+liftShowbMaybePrec :: (Int -> a -> Builder) -> Int -> Maybe a -> Builder+liftShowbMaybePrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbMaybePrec #-}  $(deriveTextShow  ''Maybe) $(deriveTextShow1 ''Maybe)
src/TextShow/Data/Monoid.hs view
@@ -19,28 +19,27 @@ module TextShow.Data.Monoid (       showbAllPrec     , showbAnyPrec-    , showbDualPrecWith-    , showbFirstPrecWith-    , showbLastPrecWith-    , showbProductPrecWith-    , showbSumPrecWith+    , liftShowbDualPrec+    , liftShowbFirstPrec+    , liftShowbLastPrec+    , liftShowbProductPrec+    , liftShowbSumPrec #if MIN_VERSION_base(4,8,0)     , showbAltPrec-    , showbAltPrecWith+    , liftShowbAltPrec #endif     ) where  import Data.Monoid.Compat (All, Any, Dual, First, Last, Product, Sum) import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (TextShow(showbPrec), showbPrecWith)+import TextShow.Classes (TextShow(..), TextShow1(..)) import TextShow.Data.Bool () import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1)  #if MIN_VERSION_base(4,8,0) import Data.Monoid (Alt)-import TextShow.Classes (TextShow1) import TextShow.TH.Internal (makeShowbPrec) #endif @@ -62,39 +61,39 @@  -- | Convert a 'Dual' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbDualPrecWith :: (Int -> a -> Builder) -> Int -> Dual a -> Builder-showbDualPrecWith = showbPrecWith-{-# INLINE showbDualPrecWith #-}+-- /Since: 3/+liftShowbDualPrec :: (Int -> a -> Builder) -> Int -> Dual a -> Builder+liftShowbDualPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbDualPrec #-}  -- | Convert a 'First' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbFirstPrecWith :: (Int -> a -> Builder) -> Int -> First a -> Builder-showbFirstPrecWith = showbPrecWith-{-# INLINE showbFirstPrecWith #-}+-- /Since: 3/+liftShowbFirstPrec :: (Int -> a -> Builder) -> Int -> First a -> Builder+liftShowbFirstPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbFirstPrec #-}  -- | Convert a 'Last' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbLastPrecWith :: (Int -> a -> Builder) -> Int -> Last a -> Builder-showbLastPrecWith = showbPrecWith-{-# INLINE showbLastPrecWith #-}+-- /Since: 3/+liftShowbLastPrec :: (Int -> a -> Builder) -> Int -> Last a -> Builder+liftShowbLastPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbLastPrec #-}  -- | Convert a 'Product' value to a 'Builder' with the given show function -- and precedence. ----- /Since: 2/-showbProductPrecWith :: (Int -> a -> Builder) -> Int -> Product a -> Builder-showbProductPrecWith = showbPrecWith-{-# INLINE showbProductPrecWith #-}+-- /Since: 3/+liftShowbProductPrec :: (Int -> a -> Builder) -> Int -> Product a -> Builder+liftShowbProductPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbProductPrec #-}  -- | Convert a 'Sum' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbSumPrecWith :: (Int -> a -> Builder) -> Int -> Sum a -> Builder-showbSumPrecWith = showbPrecWith-{-# INLINE showbSumPrecWith #-}+-- /Since: 3/+liftShowbSumPrec :: (Int -> a -> Builder) -> Int -> Sum a -> Builder+liftShowbSumPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbSumPrec #-}  #if MIN_VERSION_base(4,8,0) -- | Convert an 'Alt' value to a 'Builder' with the given precedence.@@ -108,9 +107,11 @@ -- | Convert an 'Alt' value to a 'Builder' with the given show function and precedence. -- This function is only available with @base-4.8.0.0@ or later. ----- /Since: 2/-showbAltPrecWith :: TextShow1 f => (Int -> a -> Builder) -> Int -> Alt f a -> Builder-showbAltPrecWith = showbPrecWith+-- /Since: 3/+liftShowbAltPrec :: TextShow1 f => (Int -> a -> Builder) -> ([a] -> Builder)+                 -> Int -> Alt f a -> Builder+liftShowbAltPrec = liftShowbPrec+{-# INLINE liftShowbAltPrec #-} #endif  $(deriveTextShow  ''All)
src/TextShow/Data/OldTypeable.hs view
@@ -30,7 +30,7 @@                                   funTc, listTc) import Data.Text.Lazy.Builder (Builder, fromString, singleton) -import TextShow.Classes (TextShow(showb, showbPrec), showbParen, showbSpace)+import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import TextShow.Utils (isTupleString)
src/TextShow/Data/Ord.hs view
@@ -14,14 +14,14 @@ -} module TextShow.Data.Ord (       showbOrdering-    , showbDownPrecWith+    , liftShowbDownPrec     ) where  import Data.Text.Lazy.Builder (Builder)  import GHC.Exts (Down) -import TextShow.Classes (showb, showbPrecWith)+import TextShow.Classes (showb, liftShowbPrec) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1)  -- | Convert a 'Ordering' to a 'Builder'.@@ -33,10 +33,10 @@  -- | Convert a 'Down' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbDownPrecWith :: (Int -> a -> Builder) -> Int -> Down a -> Builder-showbDownPrecWith = showbPrecWith-{-# INLINE showbDownPrecWith #-}+-- /Since: 3/+liftShowbDownPrec :: (Int -> a -> Builder) -> Int -> Down a -> Builder+liftShowbDownPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbDownPrec #-}  $(deriveTextShow  ''Ordering) $(deriveTextShow  ''Down)
src/TextShow/Data/Proxy.hs view
@@ -25,7 +25,7 @@ import Data.Proxy (Proxy(..)) import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (TextShow(showb, showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.TH.Internal (deriveTextShow1, makeShowbPrec)  #include "inline.h"
src/TextShow/Data/Ratio.hs view
@@ -20,7 +20,7 @@  import GHC.Real (Ratio(..), ratioPrec, ratioPrec1) -import TextShow.Classes (TextShow(showbPrec), showbParen)+import TextShow.Classes (TextShow(..), showbParen) #if MIN_VERSION_base(4,4,0) import TextShow.Classes (TextShow1(..)) #endif@@ -60,9 +60,9 @@  #if MIN_VERSION_base(4,4,0) instance TextShow1 Ratio where-    showbPrecWith sp p (numer :% denom) = showbParen (p > ratioPrec) $+    liftShowbPrec sp _ p (numer :% denom) = showbParen (p > ratioPrec) $            sp ratioPrec1 numer         <> " % "         <> sp ratioPrec1 denom-    INLINE_INST_FUN(showbPrecWith)+    INLINE_INST_FUN(liftShowbPrec) #endif
+ src/TextShow/Data/Semigroup.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE CPP             #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module:      TextShow.Data.Semigroup+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++Monomorphic 'TextShow' functions for data types in the "Data.Semigroup" module.++/Since: 3/+-}+module TextShow.Data.Semigroup (+      liftShowbMinPrec+    , liftShowbMaxPrec+    , liftShowbFirstPrec+    , liftShowbLastPrec+    , liftShowbWrappedMonoidPrec+    , liftShowbOptionPrec+    , liftShowbArgPrec2+    ) where++import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg)+import Data.Text.Lazy.Builder (Builder)++import TextShow.Classes (TextShow1(..), TextShow2(..))+import TextShow.Data.Maybe ()+import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2)++-- | Convert a 'Min' value to a 'Builder' with the given show function and precedence.+--+-- /Since: 3/+liftShowbMinPrec :: (Int -> a -> Builder) -> Int -> Min a -> Builder+liftShowbMinPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbMinPrec #-}++-- | Convert a 'Max' value to a 'Builder' with the given show function and precedence.+--+-- /Since: 3/+liftShowbMaxPrec :: (Int -> a -> Builder) -> Int -> Max a -> Builder+liftShowbMaxPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbMaxPrec #-}++-- | Convert a 'First' value to a 'Builder' with the given show function and precedence.+--+-- /Since: 3/+liftShowbFirstPrec :: (Int -> a -> Builder) -> Int -> First a -> Builder+liftShowbFirstPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbFirstPrec #-}++-- | Convert a 'Last' value to a 'Builder' with the given show function and precedence.+--+-- /Since: 3/+liftShowbLastPrec :: (Int -> a -> Builder) -> Int -> Last a -> Builder+liftShowbLastPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbLastPrec #-}++-- | Convert a 'WrappedMonoid' to a 'Builder' with the given show function+-- and precedence.+--+-- /Since: 3/+liftShowbWrappedMonoidPrec :: (Int -> m -> Builder) -> Int -> WrappedMonoid m -> Builder+liftShowbWrappedMonoidPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbWrappedMonoidPrec #-}++-- | Convert an 'Option' value to a 'Builder' with the given show function+-- and precedence.+--+-- /Since: 3/+liftShowbOptionPrec :: (Int -> a -> Builder) -> Int -> Option a -> Builder+liftShowbOptionPrec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbOptionPrec #-}++-- | Convert an 'Arg' value to a 'Builder' with the given show functions and precedence.+--+-- /Since: 3/+liftShowbArgPrec2 :: (Int -> a -> Builder) -> (Int -> b -> Builder)+                  -> Int -> Arg a b -> Builder+liftShowbArgPrec2 sp1 sp2 = liftShowbPrec2 sp1 undefined sp2 undefined+{-# INLINE liftShowbArgPrec2 #-}++$(deriveTextShow  ''Min)+$(deriveTextShow1 ''Min)++$(deriveTextShow  ''Max)+$(deriveTextShow1 ''Max)++$(deriveTextShow  ''First)+$(deriveTextShow1 ''First)++$(deriveTextShow  ''Last)+$(deriveTextShow1 ''Last)++$(deriveTextShow  ''WrappedMonoid)+$(deriveTextShow1 ''WrappedMonoid)++$(deriveTextShow  ''Option)+$(deriveTextShow1 ''Option)++$(deriveTextShow  ''Arg)+$(deriveTextShow1 ''Arg)+$(deriveTextShow2 ''Arg)
src/TextShow/Data/Text.hs view
@@ -38,7 +38,7 @@ import qualified Data.Text.Lazy as TL import           Data.Text.Lazy.Builder (Builder, fromString, toLazyText) -import           TextShow.Classes (TextShow(showb, showbPrec))+import           TextShow.Classes (TextShow(..)) import           TextShow.Data.Char (showbString) import           TextShow.Data.Integral (showbHex) import           TextShow.TH.Internal (deriveTextShow)
src/TextShow/Data/Tuple.hs view
@@ -15,25 +15,25 @@ -} module TextShow.Data.Tuple (       showbUnit-    , showb2TupleWith2-    , showb3TupleWith2-    , showb4TupleWith2-    , showb5TupleWith2-    , showb6TupleWith2-    , showb7TupleWith2-    , showb8TupleWith2-    , showb9TupleWith2-    , showb10TupleWith2-    , showb11TupleWith2-    , showb12TupleWith2-    , showb13TupleWith2-    , showb14TupleWith2-    , showb15TupleWith2+    , liftShowb2Tuple2+    , liftShowb3Tuple2+    , liftShowb4Tuple2+    , liftShowb5Tuple2+    , liftShowb6Tuple2+    , liftShowb7Tuple2+    , liftShowb8Tuple2+    , liftShowb9Tuple2+    , liftShowb10Tuple2+    , liftShowb11Tuple2+    , liftShowb12Tuple2+    , liftShowb13Tuple2+    , liftShowb14Tuple2+    , liftShowb15Tuple2     ) where  import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (TextShow(showb), TextShow2(..))+import TextShow.Classes (TextShow(..), TextShow2(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2)  #include "inline.h"@@ -44,142 +44,140 @@ showbUnit :: () -> Builder -- showbUnit () = "()" showbUnit = showb-{-# INLINE showbUnit #-}  -- | Converts a 2-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb2TupleWith2 :: (a -> Builder) -> (b -> Builder)+-- /Since: 3/+liftShowb2Tuple2 :: (a -> Builder) -> (b -> Builder)                  -> (a, b) -> Builder-showb2TupleWith2 = showbWith2-{-# INLINE showb2TupleWith2 #-}+liftShowb2Tuple2 = liftShowb2+{-# INLINE liftShowb2Tuple2 #-}  -- | Converts a 3-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb3TupleWith2 :: TextShow a+-- /Since: 3/+liftShowb3Tuple2 :: TextShow a                  => (b -> Builder) -> (c -> Builder)                  -> (a, b, c) -> Builder-showb3TupleWith2 = showbWith2-{-# INLINE showb3TupleWith2 #-}+liftShowb3Tuple2 = liftShowb2+{-# INLINE liftShowb3Tuple2 #-}  -- | Converts a 4-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb4TupleWith2 :: (TextShow a, TextShow b)+-- /Since: 3/+liftShowb4Tuple2 :: (TextShow a, TextShow b)                  => (c -> Builder) -> (d -> Builder)                  -> (a, b, c, d) -> Builder-showb4TupleWith2 = showbWith2-{-# INLINE showb4TupleWith2 #-}+liftShowb4Tuple2 = liftShowb2+{-# INLINE liftShowb4Tuple2 #-}  -- | Converts a 5-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb5TupleWith2 :: (TextShow a, TextShow b, TextShow c)+-- /Since: 3/+liftShowb5Tuple2 :: (TextShow a, TextShow b, TextShow c)                  => (d -> Builder) -> (e -> Builder)                  -> (a, b, c, d, e) -> Builder-showb5TupleWith2 = showbWith2-{-# INLINE showb5TupleWith2 #-}+liftShowb5Tuple2 = liftShowb2+{-# INLINE liftShowb5Tuple2 #-}  -- | Converts a 6-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb6TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d)+-- /Since: 3/+liftShowb6Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d)                  => (e -> Builder) -> (f -> Builder)                  -> (a, b, c, d, e, f) -> Builder-showb6TupleWith2 = showbWith2-{-# INLINE showb6TupleWith2 #-}+liftShowb6Tuple2 = liftShowb2+{-# INLINE liftShowb6Tuple2 #-}  -- | Converts a 7-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb7TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e)+-- /Since: 3/+liftShowb7Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e)                  => (f -> Builder) -> (g -> Builder)                  -> (a, b, c, d, e, f, g) -> Builder-showb7TupleWith2 = showbWith2-{-# INLINE showb7TupleWith2 #-}+liftShowb7Tuple2 = liftShowb2+{-# INLINE liftShowb7Tuple2 #-}  -- | Converts an 8-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb8TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f)+-- /Since: 3/+liftShowb8Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f)                  => (g -> Builder) -> (h -> Builder)                  -> (a, b, c, d, e, f, g, h) -> Builder-showb8TupleWith2 = showbWith2-{-# INLINE showb8TupleWith2 #-}+liftShowb8Tuple2 = liftShowb2+{-# INLINE liftShowb8Tuple2 #-}  -- | Converts a 9-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb9TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g)+-- /Since: 3/+liftShowb9Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g)                  => (h -> Builder) -> (i -> Builder)                  -> (a, b, c, d, e, f, g, h, i) -> Builder-showb9TupleWith2 = showbWith2-{-# INLINE showb9TupleWith2 #-}+liftShowb9Tuple2 = liftShowb2+{-# INLINE liftShowb9Tuple2 #-}  -- | Converts a 10-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb10TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h)+-- /Since: 3/+liftShowb10Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h)                   => (i -> Builder) -> (j -> Builder)                   -> (a, b, c, d, e, f, g, h, i, j) -> Builder-showb10TupleWith2 = showbWith2-{-# INLINE showb10TupleWith2 #-}+liftShowb10Tuple2 = liftShowb2+{-# INLINE liftShowb10Tuple2 #-}  -- | Converts an 11-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb11TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e,+-- /Since: 3/+liftShowb11Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e,                       TextShow f, TextShow g, TextShow h, TextShow i)                   => (j -> Builder) -> (k -> Builder)                   -> (a, b, c, d, e, f, g, h, i, j, k) -> Builder-showb11TupleWith2 = showbWith2-{-# INLINE showb11TupleWith2 #-}+liftShowb11Tuple2 = liftShowb2+{-# INLINE liftShowb11Tuple2 #-}  -- | Converts a 12-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb12TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e,+-- /Since: 3/+liftShowb12Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e,                       TextShow f, TextShow g, TextShow h, TextShow i, TextShow j)                   => (k -> Builder) -> (l -> Builder)                   -> (a, b, c, d, e, f, g, h, i, j, k, l) -> Builder-showb12TupleWith2 = showbWith2-{-# INLINE showb12TupleWith2 #-}+liftShowb12Tuple2 = liftShowb2+{-# INLINE liftShowb12Tuple2 #-}  -- | Converts a 13-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb13TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f,+-- /Since: 3/+liftShowb13Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f,                       TextShow g, TextShow h, TextShow i, TextShow j, TextShow k)                   => (l -> Builder) -> (m -> Builder)                   -> (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Builder-showb13TupleWith2 = showbWith2-{-# INLINE showb13TupleWith2 #-}+liftShowb13Tuple2 = liftShowb2+{-# INLINE liftShowb13Tuple2 #-}  -- | Converts a 14-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb14TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f,+-- /Since: 3/+liftShowb14Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f,                       TextShow g, TextShow h, TextShow i, TextShow j, TextShow k, TextShow l)                   => (m -> Builder) -> (n -> Builder)                   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Builder-showb14TupleWith2 = showbWith2-{-# INLINE showb14TupleWith2 #-}+liftShowb14Tuple2 = liftShowb2+{-# INLINE liftShowb14Tuple2 #-}  -- | Converts a 15-tuple into a 'Builder' with the given show functions. ----- /Since: 2/-showb15TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g,+-- /Since: 3/+liftShowb15Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g,                       TextShow h, TextShow i, TextShow j, TextShow k, TextShow l, TextShow m)                   => (n -> Builder) -> (o -> Builder)                   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Builder-showb15TupleWith2 = showbWith2-{-# INLINE showb15TupleWith2 #-}+liftShowb15Tuple2 = liftShowb2+{-# INLINE liftShowb15Tuple2 #-} --- | Like 'showbPrecWith2', except precedence-agnostic.-showbWith2 :: TextShow2 f => (a -> Builder) -> (b -> Builder) -> f a b -> Builder-showbWith2 sp1 sp2 = showbPrecWith2 (const sp1) (const sp2) 0-{-# INLINE showbWith2 #-}+-- | Like 'liftShowbPrec2', except precedence-agnostic.+liftShowb2 :: TextShow2 f => (a -> Builder) -> (b -> Builder) -> f a b -> Builder+liftShowb2 sp1 sp2 = liftShowbPrec2 (const sp1) undefined (const sp2) undefined 0  -- The Great Pyramids of Template Haskell $(deriveTextShow ''())
src/TextShow/Data/Type/Coercion.hs view
@@ -29,8 +29,8 @@ import Data.Text.Lazy.Builder (Builder) import Data.Type.Coercion (Coercion(..)) -import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..))-import TextShow.TH.Internal (deriveTextShow2, makeShowbPrec, makeShowbPrecWith)+import TextShow.Classes (TextShow(..), TextShow1(..))+import TextShow.TH.Internal (deriveTextShow, deriveTextShow2, makeLiftShowbPrec)  -- | Convert a representational equality value to a 'Builder'. -- This function is only available with @base-4.7.0.0@ or later.@@ -40,13 +40,10 @@ showbCoercion = showb {-# INLINE showbCoercion #-} -instance TextShow (Coercion a b) where-    showbPrec = $(makeShowbPrec ''Coercion)-    {-# INLINE showbPrec #-}+$(deriveTextShow ''Coercion)  instance TextShow1 (Coercion a) where-    showbPrecWith = $(makeShowbPrecWith ''Coercion)-    {-# INLINE showbPrecWith #-}+    liftShowbPrec = $(makeLiftShowbPrec ''Coercion)  $(deriveTextShow2 ''Coercion) #endif
src/TextShow/Data/Type/Equality.hs view
@@ -30,8 +30,8 @@ import Data.Text.Lazy.Builder (Builder) import Data.Type.Equality ((:~:)(..)) -import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..))-import TextShow.TH.Internal (deriveTextShow2, makeShowbPrec, makeShowbPrecWith)+import TextShow.Classes (TextShow(..), TextShow1(..))+import TextShow.TH.Internal (deriveTextShow, deriveTextShow2, makeLiftShowbPrec)  -- | Convert a propositional equality value to a 'Builder'. -- This function is only available with @base-4.7.0.0@ or later.@@ -41,13 +41,10 @@ showbPropEquality = showb {-# INLINE showbPropEquality #-} -instance TextShow (a :~: b) where-    showbPrec = $(makeShowbPrec ''(:~:))-    {-# INLINE showbPrec #-}+$(deriveTextShow ''(:~:))  instance TextShow1 ((:~:) a) where-    showbPrecWith = $(makeShowbPrecWith ''(:~:))-    {-# INLINE showbPrecWith #-}+    liftShowbPrec = $(makeLiftShowbPrec ''(:~:))  $(deriveTextShow2 ''(:~:)) #endif
src/TextShow/Data/Typeable.hs view
@@ -1,6 +1,13 @@+{-# LANGUAGE BangPatterns      #-} {-# LANGUAGE CPP               #-}+{-# LANGUAGE MagicHash         #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-}++#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds         #-}+#endif+ {-| Module:      TextShow.Data.Typeable Copyright:   (C) 2014-2015 Ryan Scott@@ -13,26 +20,44 @@  /Since: 2/ -}-module TextShow.Data.Typeable (showbTyCon, showbTypeRepPrec) where+module TextShow.Data.Typeable (+      showbTyCon+    , showbTypeRepPrec+#if MIN_VERSION_base(4,9,0)+    , showbTrName+    , showbModule+#endif+    ) where  import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) #if MIN_VERSION_base(4,4,0)-import Data.Typeable.Internal (TyCon, tyConName)+import Data.Typeable.Internal (tyConName) # if MIN_VERSION_base(4,8,0) import Data.Typeable.Internal (typeRepKinds) # endif # if MIN_VERSION_base(4,9,0)-import Data.Typeable.Internal (tcFun, tcList)+import Data.Typeable.Internal (Proxy(..), Typeable, TypeRep(TypeRep), typeRep)+import GHC.Exts (Levity(..), TYPE) # elif MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (funTc, listTc) # endif #else-import Data.Typeable (TyCon, mkTyCon, tyConString, typeOf)+import Data.Typeable (mkTyCon, tyConString, typeOf) #endif -import TextShow.Classes (TextShow(showb, showbPrec), showbParen, showbSpace)+#if MIN_VERSION_base(4,9,0)+import GHC.Exts (Char(..))+import GHC.Prim (Addr#, (+#), eqChar#, indexCharOffAddr#)+import GHC.Types (TyCon(..), TrName(..), Module(..), isTrue#)+#elif MIN_VERSION_base(4,4,0)+import Data.Typeable.Internal (TyCon)+#else+import Data.Typeable (TyCon)+#endif++import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.List () import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import TextShow.Utils (isTupleString)@@ -46,7 +71,16 @@ showbTypeRepPrec p tyrep =     case tys of       [] -> showbTyCon tycon-      [x]   | tycon == tcList -> singleton '[' <> showb x <> singleton ']'+#if MIN_VERSION_base(4,9,0)+      [x@(TypeRep _ argCon _ _)]+#else+      [x]+#endif+        | tycon == tcList -> singleton '[' <> showb x <> singleton ']'+#if MIN_VERSION_base(4,9,0)+        | tycon == tcTYPE && argCon == tc'Lifted   -> singleton '*'+        | tycon == tcTYPE && argCon == tc'Unlifted -> singleton '#'+#endif       [a,r] | tycon == tcFun  -> showbParen (p > 8) $                                     showbPrec 9 a                                  <> " -> "@@ -68,22 +102,40 @@     kinds = typeRepKinds tyrep #endif -#if !(MIN_VERSION_base(4,4,0))+#if MIN_VERSION_base(4,9,0)+tyConOf :: Typeable a => Proxy a -> TyCon+tyConOf = typeRepTyCon . typeRep++tcFun :: TyCon+tcFun = tyConOf (Proxy :: Proxy (Int -> Int))++tcList :: TyCon+tcList = tyConOf (Proxy :: Proxy [])++tcTYPE :: TyCon+tcTYPE = tyConOf (Proxy :: Proxy TYPE)++tc'Lifted :: TyCon+tc'Lifted = tyConOf (Proxy :: Proxy 'Lifted)++tc'Unlifted :: TyCon+tc'Unlifted = tyConOf (Proxy :: Proxy 'Unlifted)+#elif MIN_VERSION_base(4,4,0) -- | The list 'TyCon'. tcList :: TyCon-tcList = typeRepTyCon $ typeOf [()]+tcList = listTc  -- | The function (@->@) 'TyCon'. tcFun :: TyCon-tcFun = mkTyCon "->"-#elif !(MIN_VERSION_base(4,9,0))+tcFun = funTc+#else -- | The list 'TyCon'. tcList :: TyCon-tcList = listTc+tcList = typeRepTyCon $ typeOf [()]  -- | The function (@->@) 'TyCon'. tcFun :: TyCon-tcFun = funTc+tcFun = mkTyCon "->" #endif  -- | Does the 'TyCon' represent a tuple type constructor?@@ -95,9 +147,45 @@ -- -- /Since: 2/ showbTyCon :: TyCon -> Builder+#if MIN_VERSION_base(4,9,0)+showbTyCon (TyCon _ _ _ tc_name) = showb tc_name+#else showbTyCon = fromString . tyConString+#endif {-# INLINE showbTyCon #-} +#if MIN_VERSION_base(4,9,0)+-- | Convert a 'TrName' to a 'Builder'.+-- This function is only available with @base-4.9.0.0@ or later.+--+-- /Since: 3/+showbTrName :: TrName -> Builder+showbTrName (TrNameS s) = unpackCStringToBuilder# s+showbTrName (TrNameD s) = fromString s++-- | Convert a 'Module' to a 'Builder'.+-- This function is only available with @base-4.9.0.0@ or later.+--+-- /Since: 3/+showbModule :: Module -> Builder+showbModule (Module p m) = showb p <> singleton ':' <> showb m+{-# INLINE showbModule #-}++unpackCStringToBuilder# :: Addr# -> Builder+    -- There's really no point in inlining this, ever, as the loop doesn't+    -- specialise in an interesting But it's pretty small, so there's a danger+    -- that it'll be inlined at every literal, which is a waste+unpackCStringToBuilder# addr+  = unpack 0#+  where+    unpack nh+      | isTrue# (ch `eqChar#` '\0'#) = mempty+      | True                         = singleton (C# ch) <> unpack (nh +# 1#)+      where+        !ch = indexCharOffAddr# addr nh+{-# NOINLINE unpackCStringToBuilder# #-}+#endif+ #if MIN_VERSION_base(4,4,0) -- | Identical to 'tyConName'. Defined to avoid using excessive amounts of pragmas -- with base-4.3 and earlier, which use 'tyConString'.@@ -113,3 +201,13 @@ instance TextShow TyCon where     showb = showbTyCon     INLINE_INST_FUN(showb)++#if MIN_VERSION_base(4,9,0)+instance TextShow TrName where+    showb = showbTrName+    INLINE_INST_FUN(showb)++instance TextShow Module where+    showb = showbModule+    INLINE_INST_FUN(showb)+#endif
src/TextShow/Data/Typeable/Utils.hs view
@@ -16,7 +16,7 @@ import Prelude () import Prelude.Compat -import TextShow.Classes (TextShow(showbPrec))+import TextShow.Classes (TextShow(..))  -- | Helper function for showing a list of arguments, each separated by the given -- 'Builder'.
src/TextShow/Data/Void.hs view
@@ -18,7 +18,7 @@  import Prelude () -import TextShow.Classes (TextShow(showb))+import TextShow.Classes (TextShow(..))  -- | Since 'Void' values logically don't exist, attempting to convert one to a -- 'Builder' will never terminate.
src/TextShow/Debug/Trace.hs view
@@ -85,7 +85,7 @@  import           System.IO.Unsafe (unsafePerformIO) -import           TextShow.Classes (TextShow, showt)+import           TextShow.Classes (TextShow(..)) import           TextShow.Instances ()  -- $tracing
src/TextShow/Foreign/C/Types.hs view
@@ -51,7 +51,7 @@  import Foreign.C.Types -import TextShow.Classes (TextShow(showb, showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.Data.Floating () import TextShow.Data.Integral ()
src/TextShow/Foreign/Ptr.hs view
@@ -23,6 +23,7 @@     ) where  import Data.Monoid.Compat ((<>))+import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton)  import Foreign.ForeignPtr (ForeignPtr)@@ -33,9 +34,9 @@ import GHC.Ptr (Ptr(..)) import GHC.Prim (addr2Int#, int2Word#, unsafeCoerce#) -import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..))+import TextShow.Classes (TextShow(..), TextShow1(..)) import TextShow.Data.Integral (showbHex, showbIntPrec, showbWord)-import TextShow.Utils (lengthB, mtimesDefault)+import TextShow.Utils (lengthB)  #include "MachDeps.h" #include "inline.h"@@ -77,11 +78,11 @@ {-# INLINE showbForeignPtr #-}  instance TextShow (Ptr a) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined     INLINE_INST_FUN(showbPrec)  instance TextShow1 Ptr where-    showbPrecWith _ _ (Ptr a) = padOut . showbHex $ wordToInteger (int2Word# (addr2Int# a))+    liftShowbPrec _ _ _ (Ptr a) = padOut . showbHex $ wordToInteger (int2Word# (addr2Int# a))       where         padOut :: Builder -> Builder         padOut ls =@@ -90,12 +91,12 @@           <> ls  instance TextShow (FunPtr a) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined     INLINE_INST_FUN(showbPrec)  instance TextShow1 FunPtr where-    showbPrecWith _ _ = showb . castFunPtrToPtr-    INLINE_INST_FUN(showbPrecWith)+    liftShowbPrec _ _ _ = showb . castFunPtrToPtr+    INLINE_INST_FUN(liftShowbPrec)  instance TextShow IntPtr where     showbPrec = showbIntPtrPrec@@ -106,9 +107,9 @@     INLINE_INST_FUN(showb)  instance TextShow (ForeignPtr a) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined     INLINE_INST_FUN(showbPrec)  instance TextShow1 ForeignPtr where-    showbPrecWith _ _ = showb . unsafeForeignPtrToPtr-    INLINE_INST_FUN(showbPrecWith)+    liftShowbPrec _ _ _ = showb . unsafeForeignPtrToPtr+    INLINE_INST_FUN(liftShowbPrec)
src/TextShow/FromStringTextShow.hs view
@@ -3,7 +3,11 @@ {-# LANGUAGE DeriveFoldable             #-} {-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE TemplateHaskell            #-} {-# LANGUAGE TypeFamilies               #-} @@ -11,12 +15,21 @@ {-# LANGUAGE DeriveGeneric              #-} #endif +#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds                  #-}+#endif+ #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE AutoDeriveTypeable         #-}-{-# LANGUAGE DataKinds                  #-} {-# LANGUAGE PolyKinds                  #-} #endif +#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE DeriveLift                 #-}+#endif++{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+ {-| Module:      TextShow.FromStringTextShow Copyright:   (C) 2014-2015 Ryan Scott@@ -27,31 +40,52 @@  The 'FromStringShow' and 'FromTextShow' data types. -}-module TextShow.FromStringTextShow (FromStringShow(..), FromTextShow(..)) where+module TextShow.FromStringTextShow (+      FromStringShow(..)+    , FromTextShow(..)+    , FromStringShow1(..)+    , FromTextShow1(..)+    , FromStringShow2(..)+    , FromTextShow2(..)+    ) where +#include "generic.h"++import           Data.Bifunctor.TH (deriveBifunctor, deriveBifoldable,+                                    deriveBitraversable) import           Data.Data (Data, Typeable)+import           Data.Functor.Classes (Show1(..)) -#if __GLASGOW_HASKELL__ < 706+#if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif -#if __GLASGOW_HASKELL__ >= 702-import           GHC.Generics (Generic)-# if __GLASGOW_HASKELL__ >= 706-import           GHC.Generics (Generic1)-# endif+#if __GLASGOW_HASKELL__ >= 706+import           GHC.Generics (Generic, Generic1) #endif +import           Language.Haskell.TH.Lift+ import           Prelude () import           Prelude.Compat -import           Text.Read (Read(..), readListPrecDefault)+import           Text.ParserCombinators.ReadPrec (ReadPrec)+import           Text.Read (Read(..)) -import           TextShow.Classes (TextShow(..), TextShow1(..),+import           TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..),+                                   showbPrec1, showbPrec2,+                                   showbPrecToShowsPrec, showsPrecToShowbPrec,                                    showbToShows, showsToShowb)+import           TextShow.Utils (coerce) -#include "inline.h"+#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))+import           Text.Show (showListWith)+#else+import           Data.Functor.Classes (Show2(..), showsPrec1, showsPrec2)+#endif +-------------------------------------------------------------------------------+ -- | The 'TextShow' instance for 'FromStringShow' is based on its @String@ -- 'Show' instance. That is, --@@ -65,37 +99,56 @@            , Eq            , Foldable            , Functor-#if __GLASGOW_HASKELL__ >= 702+#if __GLASGOW_HASKELL__ >= 706            , Generic-# if __GLASGOW_HASKELL__ >= 706            , Generic1-# endif #endif+#if __GLASGOW_HASKELL__ >= 800+           , Lift+#endif            , Ord            , Traversable            , Typeable            )  instance Read a => Read (FromStringShow a) where-    readPrec = FromStringShow <$> readPrec-    INLINE_INST_FUN(readPrec)--    readListPrec = readListPrecDefault-    INLINE_INST_FUN(readListPrec)+    readPrec     = coerce (readPrec     :: ReadPrec a)+    readsPrec    = coerce (readsPrec    :: Int -> ReadS a)+    readList     = coerce (readList     :: ReadS [a])+    readListPrec = coerce (readListPrec :: ReadPrec [a])  instance Show a => TextShow (FromStringShow a) where-    showbPrec p = showsToShowb showsPrec p . fromStringShow-    INLINE_INST_FUN(showbPrec)+    showbPrec p = showsPrecToShowbPrec showsPrec p . fromStringShow+    showb = showsToShowb shows . fromStringShow+    showbList l = showsToShowb showList (coerce l :: [a])  instance Show a => Show (FromStringShow a) where-    showsPrec p = showsPrec p . fromStringShow-    INLINE_INST_FUN(showsPrec)+    showsPrec = coerce (showsPrec :: Int -> a -> ShowS)+    show      = coerce (show      :: a -> String)+    showList  = coerce (showList  :: [a] -> ShowS) +instance Show1 FromStringShow where+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+    liftShowList  _  sl   = sl   . coerceList+      where+        coerceList :: [FromStringShow a] -> [a]+        coerceList = coerce+    liftShowsPrec sp _ p = sp p . fromStringShow+#else+    showsPrec1 p = showsPrec p . fromStringShow+#endif+ instance TextShow1 FromStringShow where-    showbPrecWith sp p =-        showsToShowb (showbToShows sp) p . fromStringShow-    INLINE_INST_FUN(showbPrecWith)+    liftShowbPrec sp' _ p =+        showsPrecToShowbPrec (showbPrecToShowsPrec sp') p . fromStringShow +    liftShowbList _ sl' = showsToShowb (showbToShows sl') . coerceList+      where+        coerceList :: [FromStringShow a] -> [a]+        coerceList = coerce++-------------------------------------------------------------------------------+ -- | The @String@ 'Show' instance for 'FromTextShow' is based on its -- 'TextShow' instance. That is, --@@ -109,12 +162,13 @@            , Eq            , Foldable            , Functor-#if __GLASGOW_HASKELL__ >= 702+#if __GLASGOW_HASKELL__ >= 706            , Generic-# if __GLASGOW_HASKELL__ >= 706            , Generic1-# endif #endif+#if __GLASGOW_HASKELL__ >= 800+           , Lift+#endif            , Ord            , TextShow            , Traversable@@ -122,30 +176,421 @@            )  instance Read a => Read (FromTextShow a) where-    readPrec = FromTextShow <$> readPrec-    INLINE_INST_FUN(readPrec)--    readListPrec = readListPrecDefault-    INLINE_INST_FUN(readListPrec)+    readPrec     = coerce (readPrec     :: ReadPrec a)+    readsPrec    = coerce (readsPrec    :: Int -> ReadS a)+    readList     = coerce (readList     :: ReadS [a])+    readListPrec = coerce (readListPrec :: ReadPrec [a])  instance TextShow a => Show (FromTextShow a) where-    showsPrec p = showbToShows showbPrec p . fromTextShow-    INLINE_INST_FUN(showsPrec)+    showsPrec p = showbPrecToShowsPrec showbPrec p . fromTextShow+    show (FromTextShow x) = showbToShows showb x ""+    showList l = showbToShows showbList (coerce l :: [a]) +instance Show1 FromTextShow where+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+    liftShowList _ sl = showbToShows (showsToShowb sl) . coerceList+      where+        coerceList :: [FromTextShow a] -> [a]+        coerceList = coerce+    liftShowsPrec sp _ p+      = showbPrecToShowsPrec (showsPrecToShowbPrec sp) p . fromTextShow+#else+    showsPrec1 p+      = showbPrecToShowsPrec (showsPrecToShowbPrec showsPrec) p . fromTextShow+#endif+ instance TextShow1 FromTextShow where-    showbPrecWith sp p = sp p . fromTextShow-    INLINE_INST_FUN(showbPrecWith)+    liftShowbPrec sp' _ p = sp' p . fromTextShow +    liftShowbList _ sl' = sl' . coerceList+      where+        coerceList :: [FromTextShow a] -> [a]+        coerceList = coerce+ ------------------------------------------------------------------------------- -#if __GLASGOW_HASKELL__ < 706-$(Generics.deriveMeta           ''FromStringShow)-$(Generics.deriveRepresentable1 ''FromStringShow)-$(Generics.deriveMeta           ''FromTextShow)-$(Generics.deriveRepresentable1 ''FromTextShow)+-- | The 'TextShow1' instance for 'FromStringShow1' is based on its @String@+-- 'Show1' instance. That is,+--+-- @+-- 'liftShowbPrec' sp sl p ('FromStringShow1' x) =+--     'showsPrecToShowbPrec' ('liftShowsPrec' ('showbPrecToShowsPrec' sp)+--                                             ('showbToShows'         sl))+--                            p x+-- @+--+-- /Since: 3/+newtype FromStringShow1 f a = FromStringShow1 { fromStringShow1 :: f a }+  deriving ( Eq+#if __GLASGOW_HASKELL__ >= 706+           , Generic+# if defined(__LANGUAGE_DERIVE_GENERIC1__)+           , Generic1+# endif #endif+#if __GLASGOW_HASKELL__ >= 800+           , Lift+#endif+           , Ord+           ) -#if __GLASGOW_HASKELL__ < 702-$(Generics.deriveRepresentable0 ''FromStringShow)-$(Generics.deriveRepresentable0 ''FromTextShow)+deriving instance Show1       f => Show1       (FromStringShow1 f)+deriving instance Functor     f => Functor     (FromStringShow1 f)+deriving instance Foldable    f => Foldable    (FromStringShow1 f)+deriving instance Traversable f => Traversable (FromStringShow1 f)++#if __GLASGOW_HASKELL__ >= 708+deriving instance Typeable FromStringShow1+deriving instance ( Data (f a), Typeable f, Typeable a+                  ) => Data (FromStringShow1 f (a :: *))+#endif++instance Read (f a) => Read (FromStringShow1 f a) where+    readPrec     = coerce (readPrec     :: ReadPrec (f a))+    readsPrec    = coerce (readsPrec    :: Int -> ReadS (f a))+    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)+-- | Not available if using @transformers-0.4@+instance (Show1 f, Show a) => TextShow (FromStringShow1 f a) where+    showbPrec = liftShowbPrec (showsPrecToShowbPrec showsPrec)+                              (showsToShowb showList)+    showbList = liftShowbList (showsPrecToShowbPrec showsPrec)+                              (showsToShowb showList)++-- | Not available if using @transformers-0.4@+instance Show1 f => TextShow1 (FromStringShow1 f) where+    liftShowbPrec sp sl p =+        showsPrecToShowbPrec (liftShowsPrec (showbPrecToShowsPrec sp)+                                            (showbToShows         sl))+                             p . fromStringShow1+    liftShowbList sp sl =+        showsToShowb (liftShowList (showbPrecToShowsPrec sp)+                                   (showbToShows         sl))+                     . coerceList+      where+        coerceList :: [FromStringShow1 f a] -> [f a]+        coerceList = coerce+#endif++instance (Show1 f, Show a) => Show (FromStringShow1 f a) where+    showsPrec = showsPrec1+    showList  = liftShowList showsPrec showList++-------------------------------------------------------------------------------++-- | The @String@ 'Show1' instance for 'FromTextShow1' is based on its+-- 'TextShow1' instance. That is,+--+-- @+-- 'liftShowsPrec' sp sl p ('FromTextShow1' x) =+--     'showbPrecToShowsPrec' ('liftShowbPrec' ('showsPrecToShowbPrec' sp)+--                                             ('showsToShowb'         sl))+--                            p x+-- @+--+-- /Since: 3/+newtype FromTextShow1 f a = FromTextShow1 { fromTextShow1 :: f a }+  deriving ( Eq+#if __GLASGOW_HASKELL__ >= 706+           , Generic+# if defined(__LANGUAGE_DERIVE_GENERIC1__)+           , Generic1+# endif+#endif+#if __GLASGOW_HASKELL__ >= 800+           , Lift+#endif+           , Ord+           )++deriving instance TextShow1   f => TextShow1   (FromTextShow1 f)+deriving instance Functor     f => Functor     (FromTextShow1 f)+deriving instance Foldable    f => Foldable    (FromTextShow1 f)+deriving instance Traversable f => Traversable (FromTextShow1 f)++#if __GLASGOW_HASKELL__ >= 708+deriving instance Typeable FromTextShow1+deriving instance ( Data (f a), Typeable f, Typeable a+                  ) => Data (FromTextShow1 f (a :: *))+#endif++instance Read (f a) => Read (FromTextShow1 f a) where+    readPrec     = coerce (readPrec     :: ReadPrec (f a))+    readsPrec    = coerce (readsPrec    :: Int -> ReadS (f a))+    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)+-- | Not available if using @transformers-0.4@+instance (TextShow1 f, TextShow a) => Show (FromTextShow1 f a) where+    showsPrec = liftShowsPrec (showbPrecToShowsPrec showbPrec)+                              (showbToShows showbList)+    showList  = liftShowList  (showbPrecToShowsPrec showbPrec)+                              (showbToShows showbList)+#endif++instance TextShow1 f => Show1 (FromTextShow1 f) where+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+    liftShowList sp sl =+        showbToShows (liftShowbList (showsPrecToShowbPrec sp)+                                    (showsToShowb         sl))+                     . coerceList+      where+        coerceList :: [FromTextShow1 f a] -> [f a]+        coerceList = coerce+    liftShowsPrec sp sl p+#else+    showsPrec1 p+#endif+      = showbPrecToShowsPrec (liftShowbPrec (showsPrecToShowbPrec sp)+                                            (showsToShowb         sl))+                             p . fromTextShow1++instance (TextShow1 f, TextShow a) => TextShow (FromTextShow1 f a) where+    showbPrec = showbPrec1+    showbList = liftShowbList showbPrec showbList++-------------------------------------------------------------------------------++-- | The 'TextShow2' instance for 'FromStringShow2' is based on its @String@+-- 'Show2' instance. That is,+--+-- @+-- 'liftShowbPrec2' sp1 sl1 sp2 sl2 p ('FromStringShow2' x) =+--     'showsPrecToShowbPrec' ('liftShowsPrec2' ('showbPrecToShowsPrec' sp1)+--                                              ('showbToShows'         sl1)+--                                              ('showbPrecToShowsPrec' sp2)+--                                              ('showbToShows'         sl2))+--                            p x+-- @+--+-- /Since: 3/+newtype FromStringShow2 f a b = FromStringShow2 { fromStringShow2 :: f a b }+  deriving ( Eq+#if __GLASGOW_HASKELL__ >= 706+           , Generic+# if defined(__LANGUAGE_DERIVE_GENERIC1__)+           , Generic1+# endif+#endif+#if __GLASGOW_HASKELL__ >= 800+           , Lift+#endif+           , Ord+           )++deriving instance Functor     (f a) => Functor     (FromStringShow2 f a)+deriving instance Foldable    (f a) => Foldable    (FromStringShow2 f a)+deriving instance Traversable (f a) => Traversable (FromStringShow2 f a)++#if __GLASGOW_HASKELL__ >= 708+deriving instance Typeable FromStringShow2+deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b+                  ) => Data (FromStringShow2 f (a :: *) (b :: *))+#endif++instance Read (f a b) => Read (FromStringShow2 f a b) where+    readPrec     = coerce (readPrec     :: ReadPrec (f a b))+    readsPrec    = coerce (readsPrec    :: Int -> ReadS (f a b))+    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)+-- TODO: Manually implement this when you can derive Show2 (someday)+-- | Not available if using @transformers-0.4@+deriving instance Show2 f => Show2 (FromStringShow2 f)++-- | Not available if using @transformers-0.4@+instance (Show2 f, Show a, Show b) => TextShow (FromStringShow2 f a b) where+    showbPrec = liftShowbPrec (showsPrecToShowbPrec showsPrec)+                              (showsToShowb showList)+    showbList = liftShowbList (showsPrecToShowbPrec showsPrec)+                              (showsToShowb showList)++-- | Not available if using @transformers-0.4@+instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a) where+    liftShowbPrec = liftShowbPrec2 (showsPrecToShowbPrec showsPrec)+                                   (showsToShowb showList)+    liftShowbList = liftShowbList2 (showsPrecToShowbPrec showsPrec)+                                   (showsToShowb showList)++-- | Not available if using @transformers-0.4@+instance Show2 f => TextShow2 (FromStringShow2 f) where+    liftShowbPrec2 sp1 sl1 sp2 sl2 p =+        showsPrecToShowbPrec (liftShowsPrec2 (showbPrecToShowsPrec sp1)+                                             (showbToShows         sl1)+                                             (showbPrecToShowsPrec sp2)+                                             (showbToShows         sl2))+                             p . fromStringShow2+    liftShowbList2 sp1 sl1 sp2 sl2 =+        showsToShowb (liftShowList2 (showbPrecToShowsPrec sp1)+                                    (showbToShows         sl1)+                                    (showbPrecToShowsPrec sp2)+                                    (showbToShows         sl2))+                     . coerceList+      where+        coerceList :: [FromStringShow2 f a b] -> [f a b]+        coerceList = coerce++-- | Not available if using @transformers-0.4@+instance (Show2 f, Show a, Show b) => Show (FromStringShow2 f a b) where+    showsPrec = showsPrec2+    showList  = liftShowList2 showsPrec showList showsPrec showList++-- | Not available if using @transformers-0.4@+instance (Show2 f, Show a) => Show1 (FromStringShow2 f a) where+    liftShowsPrec = liftShowsPrec2 showsPrec showList+    liftShowList  = liftShowList2  showsPrec showList+#endif++-------------------------------------------------------------------------------++-- | The @String@ 'Show2' instance for 'FromTextShow2' is based on its+-- 'TextShow2' instance. That is,+--+-- @+-- liftShowsPrec2 sp1 sl1 sp2 sl2 p ('FromTextShow2' x) =+--     'showbPrecToShowsPrec' ('liftShowbPrec2' ('showsPrecToShowbPrec' sp1)+--                                              ('showsToShowb'         sl1)+--                                              ('showsPrecToShowbPrec' sp2)+--                                              ('showsToShowb'         sl2))+--                            p x+-- @+--+-- /Since: 3/+newtype FromTextShow2 f a b = FromTextShow2 { fromTextShow2 :: f a b }+  deriving ( Eq+#if __GLASGOW_HASKELL__ >= 706+           , Generic+# if defined(__LANGUAGE_DERIVE_GENERIC1__)+           , Generic1+# endif+#endif+#if __GLASGOW_HASKELL__ >= 800+           , Lift+#endif+           , Ord+           )++deriving instance TextShow2    f    => TextShow2   (FromTextShow2 f)+deriving instance Functor     (f a) => Functor     (FromTextShow2 f a)+deriving instance Foldable    (f a) => Foldable    (FromTextShow2 f a)+deriving instance Traversable (f a) => Traversable (FromTextShow2 f a)++#if __GLASGOW_HASKELL__ >= 708+deriving instance Typeable FromTextShow2+deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b+                  ) => Data (FromTextShow2 f (a :: *) (b :: *))+#endif++instance Read (f a b) => Read (FromTextShow2 f a b) where+    readPrec     = coerce (readPrec     :: ReadPrec (f a b))+    readsPrec    = coerce (readsPrec    :: Int -> ReadS (f a b))+    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)+-- | Not available if using @transformers-0.4@+instance (TextShow2 f, TextShow a, TextShow b) => Show (FromTextShow2 f a b) where+    showsPrec = liftShowsPrec (showbPrecToShowsPrec showbPrec)+                              (showbToShows showbList)+    showList  = liftShowList  (showbPrecToShowsPrec showbPrec)+                              (showbToShows showbList)++-- | Not available if using @transformers-0.4@+instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a) where+    liftShowsPrec = liftShowsPrec2 (showbPrecToShowsPrec showbPrec)+                                   (showbToShows         showbList)+    liftShowList = liftShowList2 (showbPrecToShowsPrec showbPrec)+                                 (showbToShows         showbList)++-- | Not available if using @transformers-0.4@+instance TextShow2 f => Show2 (FromTextShow2 f) where+    liftShowsPrec2 sp1 sl1 sp2 sl2 p =+        showbPrecToShowsPrec (liftShowbPrec2 (showsPrecToShowbPrec sp1)+                                             (showsToShowb         sl1)+                                             (showsPrecToShowbPrec sp2)+                                             (showsToShowb         sl2))+                             p . fromTextShow2+    liftShowList2 sp1 sl1 sp2 sl2 =+        showbToShows (liftShowbList2 (showsPrecToShowbPrec sp1)+                                     (showsToShowb         sl1)+                                     (showsPrecToShowbPrec sp2)+                                     (showsToShowb         sl2))+                     . coerceList+      where+        coerceList :: [FromTextShow2 f a b] -> [f a b]+        coerceList = coerce+#endif++instance (TextShow2 f, TextShow a, TextShow b) => TextShow (FromTextShow2 f a b) where+    showbPrec = showbPrec2+    showbList = liftShowbList2 showbPrec showbList showbPrec showbList++instance (TextShow2 f, TextShow a) => TextShow1 (FromTextShow2 f a) where+    liftShowbPrec = liftShowbPrec2 showbPrec showbList+    liftShowbList = liftShowbList2 showbPrec showbList++-------------------------------------------------------------------------------++#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))+liftShowsPrec :: (Show1 f, Show a) => (Int -> a -> ShowS) -> ([a] -> ShowS)+              -> Int -> f a -> ShowS+liftShowsPrec _ _ = showsPrec1++liftShowList :: (Show1 f, Show a) => (Int -> a -> ShowS) -> ([a] -> ShowS)+              -> [f a] -> ShowS+liftShowList sp' sl' = showListWith (liftShowsPrec sp' sl' 0)++sp :: Int -> a -> ShowS+sp  = undefined++sl :: [a] -> ShowS+sl  = undefined+#endif++-------------------------------------------------------------------------------++$(deriveBifunctor     ''FromStringShow2)+$(deriveBifunctor     ''FromTextShow2)+$(deriveBifoldable    ''FromStringShow2)+$(deriveBifoldable    ''FromTextShow2)+$(deriveBitraversable ''FromStringShow2)+$(deriveBitraversable ''FromTextShow2)++#if __GLASGOW_HASKELL__ < 800+$(deriveLift ''FromStringShow)+$(deriveLift ''FromTextShow)++instance Lift (f a) => Lift (FromStringShow1 f a) where+    lift = $(makeLift ''FromStringShow1)+instance Lift (f a) => Lift (FromTextShow1 f a) where+    lift = $(makeLift ''FromTextShow1)++instance Lift (f a b) => Lift (FromStringShow2 f a b) where+    lift = $(makeLift ''FromStringShow2)+instance Lift (f a b) => Lift (FromTextShow2 f a b) where+    lift = $(makeLift ''FromTextShow2)+#endif++#if !defined(__LANGUAGE_DERIVE_GENERIC1__)+$(Generics.deriveMeta           ''FromStringShow1)+$(Generics.deriveRepresentable1 ''FromStringShow1)+$(Generics.deriveMeta           ''FromTextShow1)+$(Generics.deriveRepresentable1 ''FromTextShow1)+$(Generics.deriveMeta           ''FromStringShow2)+$(Generics.deriveRepresentable1 ''FromStringShow2)+$(Generics.deriveMeta           ''FromTextShow2)+$(Generics.deriveRepresentable1 ''FromTextShow2)+#endif++#if __GLASGOW_HASKELL__ < 706+$(Generics.deriveAll0And1       ''FromStringShow)+$(Generics.deriveAll0And1       ''FromTextShow)+$(Generics.deriveRepresentable0 ''FromStringShow1)+$(Generics.deriveRepresentable0 ''FromStringShow2)+$(Generics.deriveRepresentable0 ''FromTextShow1)+$(Generics.deriveRepresentable0 ''FromTextShow2) #endif
src/TextShow/Functions.hs view
@@ -16,7 +16,7 @@ module TextShow.Functions (showbFunction) where  import Data.Text.Lazy.Builder (Builder)-import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..), TextShow2(..))+import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..))  #include "inline.h" @@ -28,13 +28,13 @@ {-# INLINE showbFunction #-}  instance TextShow (a -> b) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined     INLINE_INST_FUN(showbPrec)  instance TextShow1 ((->) a) where-    showbPrecWith = showbPrecWith2 undefined-    INLINE_INST_FUN(showbPrecWith)+    liftShowbPrec = liftShowbPrec2 undefined undefined+    INLINE_INST_FUN(liftShowbPrec)  instance TextShow2 (->) where-    showbPrecWith2 _ _ _ _ = "<function>"-    INLINE_INST_FUN(showbPrecWith2)+    liftShowbPrec2 _ _ _ _ _ _ = "<function>"+    INLINE_INST_FUN(liftShowbPrec2)
src/TextShow/GHC/Event.hs view
@@ -42,7 +42,7 @@ import Prelude () import Prelude.Compat -import TextShow.Classes (TextShow(showb, showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral      () import TextShow.System.Posix.Types () import TextShow.TH.Internal (deriveTextShow)
src/TextShow/GHC/Fingerprint.hs view
@@ -24,14 +24,15 @@     ) where  import Data.Monoid.Compat ((<>))+import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Word (Word64)  import GHC.Fingerprint.Type (Fingerprint(..)) -import TextShow.Classes (TextShow(showb))+import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral (showbHex)-import TextShow.Utils (lengthB, mtimesDefault)+import TextShow.Utils (lengthB)  -- | Convert a 'Fingerprint' to a 'Builder'. -- This function is only available with @base-4.4.0.0@ or later.
src/TextShow/GHC/Generics.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP                  #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE KindSignatures       #-} {-# LANGUAGE MagicHash            #-} {-# LANGUAGE TemplateHaskell      #-} {-# LANGUAGE TypeOperators        #-}@@ -21,21 +22,27 @@ -} module TextShow.GHC.Generics (       showbU1-    , showbPar1PrecWith+    , liftShowbPar1Prec     , showbRec1Prec-    , showbRec1PrecWith-    , showbK1PrecWith+    , liftShowbRec1Prec+    , liftShowbK1Prec     , showbM1Prec-    , showbM1PrecWith+    , liftShowbM1Prec     , showbSumTypePrec-    , showbSumTypePrecWith+    , liftShowbSumTypePrec     , showbProductTypePrec-    , showbProductTypePrecWith+    , liftShowbProductTypePrec     , showbCompFunctorsPrec-    , showbCompFunctorsPrecWith+    , liftShowbCompFunctorsPrec     , showbFixityPrec     , showbAssociativity+#if MIN_VERSION_base(4,9,0)+    , showbSourceUnpackedness+    , showbSourceStrictness+    , showbDecidedStrictness+#else     , showbArityPrec+#endif     , showbUCharPrec     , showbUDoublePrec     , showbUFloatPrec@@ -47,12 +54,12 @@  import Generics.Deriving.Base -import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..), TextShow2(..))+import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.Data.Char     () import TextShow.Data.Floating () import TextShow.Data.Integral () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, makeShowbPrec,-                             makeShowbPrecWith, makeShowbPrecWith2)+                             makeLiftShowbPrec, makeLiftShowbPrec2)  #if !(MIN_VERSION_template_haskell(2,7,0)) import Data.Monoid.Compat ((<>))@@ -73,10 +80,10 @@  -- | Convert a 'Par1' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbPar1PrecWith :: (Int -> p -> Builder) -> Int -> Par1 p -> Builder-showbPar1PrecWith = showbPrecWith-{-# INLINE showbPar1PrecWith #-}+-- /Since: 3/+liftShowbPar1Prec :: (Int -> p -> Builder) -> Int -> Par1 p -> Builder+liftShowbPar1Prec sp = liftShowbPrec sp undefined+{-# INLINE liftShowbPar1Prec #-}  -- | Convert a 'Rec1' value to a 'Builder' with the given precedence. --@@ -87,17 +94,18 @@  -- | Convert a 'Rec1' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbRec1PrecWith :: TextShow1 f => (Int -> p -> Builder) -> Int -> Rec1 f p -> Builder-showbRec1PrecWith = showbPrecWith-{-# INLINE showbRec1PrecWith #-}+-- /Since: 3/+liftShowbRec1Prec :: TextShow1 f => (Int -> p -> Builder) -> ([p] -> Builder)+                  -> Int -> Rec1 f p -> Builder+liftShowbRec1Prec = liftShowbPrec+{-# INLINE liftShowbRec1Prec #-}  -- | Convert a 'K1' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbK1PrecWith :: (Int -> c -> Builder) -> Int -> K1 i c p -> Builder-showbK1PrecWith sp = showbPrecWith2 sp undefined-{-# INLINE showbK1PrecWith #-}+-- /Since: 3/+liftShowbK1Prec :: (Int -> c -> Builder) -> Int -> K1 i c p -> Builder+liftShowbK1Prec sp = liftShowbPrec2 sp undefined undefined undefined+{-# INLINE liftShowbK1Prec #-}  -- | Convert an 'M1' value to a 'Builder' with the given precedence. --@@ -108,10 +116,11 @@  -- | Convert an 'M1' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbM1PrecWith :: TextShow1 f => (Int -> p -> Builder) -> Int -> M1 i c f p -> Builder-showbM1PrecWith = showbPrecWith-{-# INLINE showbM1PrecWith #-}+-- /Since: 3/+liftShowbM1Prec :: TextShow1 f => (Int -> p -> Builder) -> ([p] -> Builder)+                -> Int -> M1 i c f p -> Builder+liftShowbM1Prec = liftShowbPrec+{-# INLINE liftShowbM1Prec #-}  -- | Convert a '(:+:)' value to a 'Builder' with the given precedence. --@@ -122,10 +131,12 @@  -- | Convert a '(:+:)' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbSumTypePrecWith :: (TextShow1 f, TextShow1 g) => (Int -> p -> Builder) -> Int -> (f :+: g) p -> Builder-showbSumTypePrecWith = showbPrecWith-{-# INLINE showbSumTypePrecWith #-}+-- /Since: 3/+liftShowbSumTypePrec :: (TextShow1 f, TextShow1 g)+                     => (Int -> p -> Builder) -> ([p] -> Builder)+                     -> Int -> (f :+: g) p -> Builder+liftShowbSumTypePrec = liftShowbPrec+{-# INLINE liftShowbSumTypePrec #-}  -- | Convert a '(:*:)' value to a 'Builder' with the given precedence. --@@ -136,10 +147,12 @@  -- | Convert a '(:*:)' value to a 'Builder' with the given show function and precedence. ----- /Since: 2/-showbProductTypePrecWith :: (TextShow1 f, TextShow1 g) => (Int -> p -> Builder) -> Int -> (f :*: g) p -> Builder-showbProductTypePrecWith = showbPrecWith-{-# INLINE showbProductTypePrecWith #-}+-- /Since: 3/+liftShowbProductTypePrec :: (TextShow1 f, TextShow1 g)+                         => (Int -> p -> Builder) -> ([p] -> Builder)+                         -> Int -> (f :*: g) p -> Builder+liftShowbProductTypePrec = liftShowbPrec+{-# INLINE liftShowbProductTypePrec #-}  -- | Convert a '(:.:)' value to a 'Builder' with the given precedence. --@@ -149,12 +162,13 @@ {-# INLINE showbCompFunctorsPrec #-}  -- | Convert a '(:.:)' value to a 'Builder' with the given show function and precedence.--- This function is only available with @base-4.4.0.0@ or later. ----- /Since: 2/-showbCompFunctorsPrecWith :: (TextShow1 f, TextShow1 g) => (Int -> p -> Builder) -> Int -> (f :.: g) p -> Builder-showbCompFunctorsPrecWith = showbPrecWith-{-# INLINE showbCompFunctorsPrecWith #-}+-- /Since: 3/+liftShowbCompFunctorsPrec :: (TextShow1 f, TextShow1 g)+                          => (Int -> p -> Builder) -> ([p] -> Builder)+                          -> Int -> (f :.: g) p -> Builder+liftShowbCompFunctorsPrec = liftShowbPrec+{-# INLINE liftShowbCompFunctorsPrec #-}  -- | Convert a 'Fixity' value to a 'Builder' with the given precedence. --@@ -164,57 +178,83 @@ {-# INLINE showbFixityPrec #-}  -- | Convert an 'Associativity' value to a 'Builder'.--- This function is only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ showbAssociativity :: Associativity -> Builder showbAssociativity = showb {-# INLINE showbAssociativity #-} +#if MIN_VERSION_base(4,9,0)+-- | Convert a 'SourceUnpackedness' value to a 'Builder'.+-- This function is only available with @base-4.9.0.0@ or later.+--+-- /Since: 3/+showbSourceUnpackedness :: SourceUnpackedness -> Builder+showbSourceUnpackedness = showb+{-# INLINE showbSourceUnpackedness #-}++-- | Convert a 'SourceStrictness' value to a 'Builder'.+-- This function is only available with @base-4.9.0.0@ or later.+--+-- /Since: 3/+showbSourceStrictness :: SourceStrictness -> Builder+showbSourceStrictness = showb+{-# INLINE showbSourceStrictness #-}++-- | Convert a 'DecidedStrictness' value to a 'Builder'.+-- This function is only available with @base-4.9.0.0@ or later.+--+-- /Since: 3/+showbDecidedStrictness :: DecidedStrictness -> Builder+showbDecidedStrictness = showb+{-# INLINE showbDecidedStrictness #-}+#else -- | Convert an 'Arity' value to a 'Builder' with the given precedence.+-- This function is only available with @base-4.8@ or earlier. -- -- /Since: 2/ showbArityPrec :: Int -> Arity -> Builder showbArityPrec = showbPrec {-# INLINE showbArityPrec #-}+#endif  -- | Convert a 'UChar' to a 'Builder' with the given precedence. ----- /Since: 2.2/+-- /Since: 2.1.2/ showbUCharPrec :: Int -> UChar p -> Builder showbUCharPrec = showbPrec {-# INLINE showbUCharPrec #-}  -- | Convert a 'UDouble' to a 'Builder' with the given precedence. ----- /Since: 2.2/+-- /Since: 2.1.2/ showbUDoublePrec :: Int -> UDouble p -> Builder showbUDoublePrec = showbPrec {-# INLINE showbUDoublePrec #-}  -- | Convert a 'UFloat' to a 'Builder' with the given precedence. ----- /Since: 2.2/+-- /Since: 2.1.2/ showbUFloatPrec :: Int -> UFloat p -> Builder showbUFloatPrec = showbPrec {-# INLINE showbUFloatPrec #-}  -- | Convert a 'UInt' to a 'Builder' with the given precedence. ----- /Since: 2.2/+-- /Since: 2.1.2/ showbUIntPrec :: Int -> UInt p -> Builder showbUIntPrec = showbPrec {-# INLINE showbUIntPrec #-}  -- | Convert a 'UWord' to a 'Builder' with the given precedence. ----- /Since: 2.2/+-- /Since: 2.1.2/ showbUWordPrec :: Int -> UWord p -> Builder showbUWordPrec = showbPrec {-# INLINE showbUWordPrec #-}  instance TextShow (U1 p) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined $(deriveTextShow1 ''U1)  $(deriveTextShow  ''Par1)@@ -225,16 +265,16 @@ $(deriveTextShow1 ''Rec1)  instance TextShow c => TextShow (K1 i c p) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined instance TextShow c => TextShow1 (K1 i c) where-    showbPrecWith = showbPrecWith2 showbPrec+    liftShowbPrec = liftShowbPrec2 showbPrec showbList instance TextShow2 (K1 i) where-    showbPrecWith2 = $(makeShowbPrecWith2 ''K1)+    liftShowbPrec2 = $(makeLiftShowbPrec2 ''K1)  instance TextShow (f p) => TextShow (M1 i c f p) where     showbPrec = $(makeShowbPrec ''M1) instance TextShow1 f => TextShow1 (M1 i c f) where-    showbPrecWith = $(makeShowbPrecWith ''M1)+    liftShowbPrec = $(makeLiftShowbPrec ''M1)  instance (TextShow (f p), TextShow (g p)) => TextShow ((f :+: g) p) where     showbPrec = $(makeShowbPrec ''(:+:))@@ -270,41 +310,41 @@ $(deriveTextShow1 'UWord) #else instance TextShow (UChar p) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined instance TextShow1 UChar where-    showbPrecWith _ p (UChar c) = showbParen (p > appPrec) $+    liftShowbPrec _ _ p (UChar c) = showbParen (p > appPrec) $            fromString "UChar "    <> singleton '{'         <> fromString "uChar# = " <> showb (C# c)         <> singleton '}'  instance TextShow (UDouble p) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined instance TextShow1 UDouble where-    showbPrecWith _ p (UDouble d) = showbParen (p > appPrec) $+    liftShowbPrec _ _ p (UDouble d) = showbParen (p > appPrec) $            fromString "UDouble "    <> singleton '{'         <> fromString "uDouble# = " <> showb (D# d)         <> singleton '}'  instance TextShow (UFloat p) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined instance TextShow1 UFloat where-    showbPrecWith _ p (UFloat f) = showbParen (p > appPrec) $+    liftShowbPrec _ _ p (UFloat f) = showbParen (p > appPrec) $            fromString "UFloat "    <> singleton '{'         <> fromString "uFloat# = " <> showb (F# f)         <> singleton '}'  instance TextShow (UInt p) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined instance TextShow1 UInt where-    showbPrecWith _ p (UInt i) = showbParen (p > appPrec) $+    liftShowbPrec _ _ p (UInt i) = showbParen (p > appPrec) $            fromString "UInt "    <> singleton '{'         <> fromString "uInt# = " <> showb (I# i)         <> singleton '}'  instance TextShow (UWord p) where-    showbPrec = showbPrecWith undefined+    showbPrec = liftShowbPrec undefined undefined instance TextShow1 UWord where-    showbPrecWith _ p (UWord w) = showbParen (p > appPrec) $+    liftShowbPrec _ _ p (UWord w) = showbParen (p > appPrec) $            fromString "UWord "    <> singleton '{'         <> fromString "uWord# = " <> showb (W# w)         <> singleton '}'@@ -312,4 +352,10 @@  $(deriveTextShow ''Fixity) $(deriveTextShow ''Associativity)+#if MIN_VERSION_base(4,9,0)+$(deriveTextShow ''SourceUnpackedness)+$(deriveTextShow ''SourceStrictness)+$(deriveTextShow ''DecidedStrictness)+#else $(deriveTextShow ''Arity)+#endif
src/TextShow/GHC/RTS/Flags.hs view
@@ -42,10 +42,7 @@  import GHC.RTS.Flags -import TextShow.Classes (TextShow(showbPrec))-# if MIN_VERSION_base(4,8,2)-import TextShow.Classes (showb)-# endif+import TextShow.Classes (TextShow(..)) import TextShow.Data.Bool     () import TextShow.Data.Char     () import TextShow.Data.Floating ()
src/TextShow/GHC/TypeLits.hs view
@@ -42,7 +42,7 @@ #if MIN_VERSION_base(4,6,0)  import Data.Text.Lazy.Builder (Builder)-import TextShow.Classes (TextShow(showb, showbPrec))+import TextShow.Classes (TextShow(..))  # if MIN_VERSION_base(4,7,0) import GHC.TypeLits (SomeNat(..), SomeSymbol(..), natVal, symbolVal)
src/TextShow/Generic.hs view
@@ -19,6 +19,10 @@ {-# LANGUAGE PolyKinds            #-} #endif +#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE DeriveLift           #-}+#endif+ {-| Module:      TextShow.Generic Copyright:   (C) 2014-2015 Ryan Scott@@ -55,11 +59,14 @@     , genericPrintTL     , genericHPrintT     , genericHPrintTL-    , genericShowbPrecWith+    , genericLiftShowbPrec     , genericShowbPrec1       -- * The 'GTextShow' and 'GTextShow1' classes     , GTextShow(..)+    , GTextShowCon(..)     , GTextShow1(..)+    , GTextShow1Con(..)+    , IsNullary(..)     , ConType(..)     ) where @@ -80,12 +87,14 @@ import           GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) import           GHC.Show (appPrec, appPrec1) +import           Language.Haskell.TH.Lift+ import           Prelude () import           Prelude.Compat  import           System.IO (Handle) -import           TextShow.Classes (TextShow(showbPrec), TextShow1(..),+import           TextShow.Classes (TextShow(..), TextShow1(..),                                    showbListWith, showbParen, showbSpace) import           TextShow.Instances () import           TextShow.Utils (isInfixTypeCon, isTupleString)@@ -110,7 +119,7 @@     showbPrec = 'genericShowbPrec'  instance TextShow1 D where-    showbPrecWith = 'genericShowbPrecWith'+    liftShowbPrec = 'genericLiftShowbPrec' @ -} @@ -186,7 +195,7 @@ -- -- /Since: 2/ genericShowbPrec :: (Generic a, GTextShow (Rep a)) => Int -> a -> Builder-genericShowbPrec p = gShowbPrec Pref p . from+genericShowbPrec p = gShowbPrec p . from  -- | A 'Generic' implementation of 'showbList'. --@@ -218,19 +227,20 @@ genericHPrintTL :: (Generic a, GTextShow (Rep a)) => Handle -> a -> IO () genericHPrintTL h = TL.hPutStrLn h . genericShowtl --- | A 'Generic1' implementation of 'showbPrecWith'.+-- | A 'Generic1' implementation of 'genericLiftShowbPrec'. -- -- /Since: 2/-genericShowbPrecWith :: (Generic1 f, GTextShow1 (Rep1 f))-                     => (Int -> a -> Builder) -> Int -> f a -> Builder-genericShowbPrecWith sp p = gShowbPrecWith Pref sp p . from1+genericLiftShowbPrec :: (Generic1 f, GTextShow1 (Rep1 f))+                     => (Int -> a -> Builder) -> ([a] -> Builder)+                     -> Int -> f a -> Builder+genericLiftShowbPrec sp sl p = gLiftShowbPrec sp sl p . from1  -- | A 'Generic'/'Generic1' implementation of 'showbPrec1'. -- -- /Since: 2/ genericShowbPrec1 :: (Generic a, Generic1 f, GTextShow (Rep a), GTextShow1 (Rep1 f))                   => Int -> f a -> Builder-genericShowbPrec1 = genericShowbPrecWith genericShowbPrec+genericShowbPrec1 = genericLiftShowbPrec genericShowbPrec genericShowbList  ------------------------------------------------------------------------------- @@ -247,6 +257,9 @@ #if __GLASGOW_HASKELL__ >= 702            , Generic #endif+#if __GLASGOW_HASKELL__ >= 800+           , Lift+#endif            )  instance TextShow ConType where@@ -256,66 +269,66 @@ -- | Class of generic representation types ('Rep') that can be converted to -- a 'Builder'. ----- /Since: 2/+-- /Since: 3/ class GTextShow f where     -- | This is used as the default generic implementation of 'showbPrec'.-    gShowbPrec :: ConType -> Int -> f a -> Builder-    -- | Whether a representation type has any constructors.-    isNullary :: f a -> Bool-    isNullary = error "generic showbPrec (isNullary): unnecessary case"-#if __GLASGOW_HASKELL__ >= 708-    {-# MINIMAL gShowbPrec #-}+    gShowbPrec :: Int -> f a -> Builder +#if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable GTextShow #endif -instance GTextShow U1 where-    gShowbPrec _ _ U1 = mempty-    isNullary _ = True+instance GTextShow f => GTextShow (D1 d f) where+    gShowbPrec p (M1 x) = gShowbPrec p x -instance TextShow c => GTextShow (K1 i c) where-    gShowbPrec _ n (K1 a) = showbPrec n a-    isNullary _ = False+instance (GTextShow f, GTextShow g) => GTextShow (f :+: g) where+    gShowbPrec p (L1 x) = gShowbPrec p x+    gShowbPrec p (R1 x) = gShowbPrec p x -instance (Constructor c, GTextShow f) => GTextShow (C1 c f) where-    gShowbPrec = gShowbConstructor gShowbPrec isNullary+instance (Constructor c, GTextShowCon f, IsNullary f) => GTextShow (C1 c f) where+    gShowbPrec = gShowbConstructor gShowbPrecCon -instance (Selector s, GTextShow f) => GTextShow (S1 s f) where-    gShowbPrec = gShowbSelector gShowbPrec-    isNullary (M1 x) = isNullary x+-- | Class of generic representation types ('Rep') for which the 'ConType'+-- has been determined.+class GTextShowCon f where+    -- | Convert value of a specific 'ConType' to a 'Builder' with the given+    -- precedence.+    gShowbPrecCon :: ConType -> Int -> f a -> Builder -instance GTextShow f => GTextShow (D1 d f) where-    gShowbPrec t n (M1 x) = gShowbPrec t n x+#if __GLASGOW_HASKELL__ >= 708+deriving instance Typeable GTextShowCon+#endif -instance (GTextShow f, GTextShow g) => GTextShow (f :+: g) where-    gShowbPrec t n (L1 x) = gShowbPrec t n x-    gShowbPrec t n (R1 x) = gShowbPrec t n x+instance GTextShowCon V1 where+    gShowbPrecCon = error "Void showbPrec" -instance (GTextShow f, GTextShow g) => GTextShow (f :*: g) where-    gShowbPrec = gShowbProduct gShowbPrec gShowbPrec-    -- If we have a product then it is not a nullary constructor-    isNullary _ = False+instance GTextShowCon U1 where+    gShowbPrecCon _ _ U1 = mempty -instance GTextShow UChar where-    gShowbPrec _ = gShowbUCharPrec-    isNullary _ = False+instance TextShow c => GTextShowCon (K1 i c) where+    gShowbPrecCon _ p (K1 x) = showbPrec p x -instance GTextShow UDouble where-    gShowbPrec _ = gShowbUDoublePrec-    isNullary _ = False+instance (Selector s, GTextShowCon f) => GTextShowCon (S1 s f) where+    gShowbPrecCon = gShowbSelector gShowbPrecCon -instance GTextShow UFloat where-    gShowbPrec _ = gShowbUFloatPrec-    isNullary _ = False+instance (GTextShowCon f, GTextShowCon g) => GTextShowCon (f :*: g) where+    gShowbPrecCon = gShowbProduct gShowbPrecCon gShowbPrecCon -instance GTextShow UInt where-    gShowbPrec _ = gShowbUIntPrec-    isNullary _ = False+instance GTextShowCon UChar where+    gShowbPrecCon _ = gShowbUCharPrec -instance GTextShow UWord where-    gShowbPrec _ = gShowbUWordPrec-    isNullary _ = False+instance GTextShowCon UDouble where+    gShowbPrecCon _ = gShowbUDoublePrec +instance GTextShowCon UFloat where+    gShowbPrecCon _ = gShowbUFloatPrec++instance GTextShowCon UInt where+    gShowbPrecCon _ = gShowbUIntPrec++instance GTextShowCon UWord where+    gShowbPrecCon _ = gShowbUWordPrec+ -------------------------------------------------------------------------------  -- | Class of generic representation types ('Rep1') that can be converted to@@ -324,86 +337,133 @@ -- /Since: 2/ class GTextShow1 f where     -- | This is used as the default generic implementation of 'showbPrecWith'.-    gShowbPrecWith :: ConType -> (Int -> a -> Builder) -> Int -> f a -> Builder-    -- | Whether a representation type has any constructors.-    isNullary1 :: f a -> Bool-    isNullary1 = error "generic showbPrecWith (isNullary1): unnecessary case"-#if __GLASGOW_HASKELL__ >= 708-    {-# MINIMAL gShowbPrecWith #-}+    gLiftShowbPrec :: (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder +#if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable GTextShow1 #endif -instance GTextShow1 U1 where-    gShowbPrecWith _ _ _ U1 = mempty-    isNullary1 _ = True+instance GTextShow1 f => GTextShow1 (D1 d f) where+    gLiftShowbPrec sp sl p (M1 x) = gLiftShowbPrec sp sl p x -instance GTextShow1 Par1 where-    gShowbPrecWith _ sp n (Par1 p) = sp n p-    isNullary1 _ = False+instance GTextShow1 V1 where+    gLiftShowbPrec = error "Void showbPrecWith" -instance TextShow c => GTextShow1 (K1 i c) where-    gShowbPrecWith _ _ n (K1 a) = showbPrec n a-    isNullary1 _ = False+instance (GTextShow1 f, GTextShow1 g) => GTextShow1 (f :+: g) where+    gLiftShowbPrec sp sl p (L1 x) = gLiftShowbPrec sp sl p x+    gLiftShowbPrec sp sl p (R1 x) = gLiftShowbPrec sp sl p x -instance TextShow1 f => GTextShow1 (Rec1 f) where-    gShowbPrecWith _ sp n (Rec1 r) = showbPrecWith sp n r-    isNullary1 _ = False+instance (Constructor c, GTextShow1Con f, IsNullary f) => GTextShow1 (C1 c f) where+    gLiftShowbPrec sp sl =+      gShowbConstructor (\t' -> gLiftShowbPrecCon t' sp sl) -instance (Constructor c, GTextShow1 f) => GTextShow1 (C1 c f) where-    gShowbPrecWith t sp = gShowbConstructor (flip gShowbPrecWith sp) isNullary1 t+-- | Class of generic representation types ('Rep1') for which the 'ConType'+-- has been determined.+class GTextShow1Con f where+    -- | Convert a value of a specific 'ConType' to a 'Builder' with the given+    -- show function and precedence.+    gLiftShowbPrecCon :: ConType -> (Int -> a -> Builder) -> ([a] -> Builder)+                      -> Int -> f a -> Builder -instance (Selector s, GTextShow1 f) => GTextShow1 (S1 s f) where-    gShowbPrecWith t sp = gShowbSelector (flip gShowbPrecWith sp) t-    isNullary1 (M1 x) = isNullary1 x+#if __GLASGOW_HASKELL__ >= 708+deriving instance Typeable GTextShow1Con+#endif -instance GTextShow1 f => GTextShow1 (D1 d f) where-    gShowbPrecWith t sp n (M1 x) = gShowbPrecWith t sp n x+instance GTextShow1Con U1 where+    gLiftShowbPrecCon _ _ _ _ U1 = mempty -instance (GTextShow1 f, GTextShow1 g) => GTextShow1 (f :+: g) where-    gShowbPrecWith t sp n (L1 x) = gShowbPrecWith t sp n x-    gShowbPrecWith t sp n (R1 x) = gShowbPrecWith t sp n x+instance GTextShow1Con Par1 where+    gLiftShowbPrecCon _ sp _ p (Par1 x) = sp p x -instance (GTextShow1 f, GTextShow1 g) => GTextShow1 (f :*: g) where-    gShowbPrecWith t sp = gShowbProduct (flip gShowbPrecWith sp) (flip gShowbPrecWith sp) t-    -- If we have a product then it is not a nullary constructor-    isNullary1 _ = False+instance TextShow c => GTextShow1Con (K1 i c) where+    gLiftShowbPrecCon _ _ _ p (K1 x) = showbPrec p x -instance (TextShow1 f, GTextShow1 g) => GTextShow1 (f :.: g) where-    gShowbPrecWith t sp n (Comp1 c) = showbPrecWith (gShowbPrecWith t sp) n c-    isNullary1 _ = False+instance TextShow1 f => GTextShow1Con (Rec1 f) where+    gLiftShowbPrecCon _ sp sl p (Rec1 x) = liftShowbPrec sp sl p x -instance GTextShow1 UChar where-    gShowbPrecWith _ _ = gShowbUCharPrec-    isNullary1 _ = False+instance (Selector s, GTextShow1Con f) => GTextShow1Con (S1 s f) where+    gLiftShowbPrecCon t sp sl =+      gShowbSelector (\t' -> gLiftShowbPrecCon t' sp sl) t -instance GTextShow1 UDouble where-    gShowbPrecWith _ _ = gShowbUDoublePrec-    isNullary1 _ = False+instance (GTextShow1Con f, GTextShow1Con g) => GTextShow1Con (f :*: g) where+    gLiftShowbPrecCon t sp sl =+      gShowbProduct (\t' -> gLiftShowbPrecCon t' sp sl)+                    (\t' -> gLiftShowbPrecCon t' sp sl) t -instance GTextShow1 UFloat where-    gShowbPrecWith _ _ = gShowbUFloatPrec-    isNullary1 _ = False+instance (TextShow1 f, GTextShow1Con g) => GTextShow1Con (f :.: g) where+    gLiftShowbPrecCon t sp sl p (Comp1 x) =+      liftShowbPrec (gLiftShowbPrecCon t sp sl)+                    (showbListWith (gLiftShowbPrecCon t sp sl 0))+                    p x -instance GTextShow1 UInt where-    gShowbPrecWith _ _ = gShowbUIntPrec-    isNullary1 _ = False+instance GTextShow1Con UChar where+    gLiftShowbPrecCon _ _ _ = gShowbUCharPrec -instance GTextShow1 UWord where-    gShowbPrecWith _ _ = gShowbUWordPrec-    isNullary1 _ = False+instance GTextShow1Con UDouble where+    gLiftShowbPrecCon _ _ _ = gShowbUDoublePrec +instance GTextShow1Con UFloat where+    gLiftShowbPrecCon _ _ _ = gShowbUFloatPrec++instance GTextShow1Con UInt where+    gLiftShowbPrecCon _ _ _ = gShowbUIntPrec++instance GTextShow1Con UWord where+    gLiftShowbPrecCon _ _ _ = gShowbUWordPrec+ ------------------------------------------------------------------------------- -- Shared code between GTextShow and GTextShow1 ------------------------------------------------------------------------------- -gShowbConstructor :: forall c f p. Constructor c+-- | Class of generic representation types that represent a constructor with+-- zero or more fields.+class IsNullary f where+    -- Returns 'True' if the constructor has no fields.+    isNullary :: f a -> Bool++instance IsNullary U1 where+    isNullary _ = True++instance IsNullary Par1 where+    isNullary _ = False++instance IsNullary (K1 i c) where+    isNullary _ = False++instance IsNullary f => IsNullary (S1 s f) where+    isNullary (M1 x) = isNullary x++instance IsNullary (Rec1 f) where+    isNullary _ = False++instance IsNullary (f :*: g) where+    isNullary _ = False++instance IsNullary (f :.: g) where+    isNullary _ = False++instance IsNullary UChar where+    isNullary _ = False++instance IsNullary UDouble where+    isNullary _ = False++instance IsNullary UFloat where+    isNullary _ = False++instance IsNullary UInt where+    isNullary _ = False++instance IsNullary UWord where+    isNullary _ = False++gShowbConstructor :: forall c f p.+                     (Constructor c, IsNullary f)                   => (ConType -> Int -> f p -> Builder)-                  -> (f p -> Bool)-                  -> ConType -> Int -> C1 c f p -> Builder-gShowbConstructor gs isNull _ n c@(M1 x) = case fixity of-    Prefix -> showbParen ( n > appPrec-                           && not ( isNull x+                  -> 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@@ -413,14 +473,12 @@            (if conIsTuple c                then mempty                else let cn = conName c-                    in showbParen (isInfixTypeCon cn) $ fromString cn-           )-        <> (if isNull x || conIsTuple c+                    in showbParen (isInfixTypeCon cn) $ fromString cn)+        <> (if isNullary x || conIsTuple c                then mempty-               else singleton ' '-           )+               else singleton ' ')         <> showbBraces t (gs t appPrec1 x)-    Infix _ m -> showbParen (n > m) . showbBraces t $ gs t (m+1) x+    Infix _ m -> showbParen (p > m) $ gs t (m+1) x   where     fixity :: Fixity     fixity = conFixity c@@ -446,8 +504,8 @@ gShowbSelector :: Selector s                => (ConType -> Int -> f p -> Builder)                -> ConType -> Int -> S1 s f p -> Builder-gShowbSelector gs t n sel@(M1 x)-    | selName sel == "" = gs t n x+gShowbSelector gs t p sel@(M1 x)+    | selName sel == "" = gs t p x     | otherwise         = fromString (selName sel) <> " = " <> gs t 0 x  gShowbProduct :: (ConType -> Int -> f p -> Builder)@@ -457,12 +515,12 @@        gsa t 0 a     <> ", "     <> gsb t 0 b-gShowbProduct gsa gsb t@(Inf o) n (a :*: b) =-       gsa t n a+gShowbProduct gsa gsb t@(Inf o) p (a :*: b) =+       gsa t p a     <> showbSpace     <> infixOp     <> showbSpace-    <> gsb t n b+    <> gsb t p b   where     infixOp :: Builder     infixOp = if isInfixTypeCon o@@ -472,10 +530,10 @@        gsa t 0 a     <> singleton ','     <> gsb t 0 b-gShowbProduct gsa gsb t@Pref n (a :*: b) =-       gsa t n a+gShowbProduct gsa gsb t@Pref p (a :*: b) =+       gsa t p a     <> showbSpace-    <> gsb t n b+    <> gsb t p b  gShowbUCharPrec :: Int -> UChar p -> Builder gShowbUCharPrec p (UChar c) = showbPrec (hashPrec p) (C# c) <> oneHash@@ -508,4 +566,8 @@  #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll ''ConType)+#endif++#if __GLASGOW_HASKELL__ < 800+$(deriveLift ''ConType) #endif
src/TextShow/Instances.hs view
@@ -27,15 +27,20 @@ import TextShow.Data.Either           () import TextShow.Data.Fixed            () import TextShow.Data.Floating         ()+import TextShow.Data.Functor.Compose  () import TextShow.Data.Functor.Identity ()+import TextShow.Data.Functor.Product  ()+import TextShow.Data.Functor.Sum      () import TextShow.Data.Integral         () import TextShow.Data.List             ()+import TextShow.Data.List.NonEmpty    () import TextShow.Data.Maybe            () import TextShow.Data.Monoid           () import TextShow.Data.OldTypeable      () import TextShow.Data.Ord              () import TextShow.Data.Proxy            () import TextShow.Data.Ratio            ()+import TextShow.Data.Semigroup        () import TextShow.Data.Text             () import TextShow.Data.Tuple            () import TextShow.Data.Type.Coercion    ()
src/TextShow/Numeric/Natural.hs view
@@ -29,7 +29,7 @@ import Numeric.Natural (Natural) #endif -import TextShow.Classes (TextShow(showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral (showbIntegerPrec)  #include "inline.h"
src/TextShow/System/IO.hs view
@@ -42,7 +42,7 @@  import System.IO (BufferMode, IOMode, Newline, NewlineMode, SeekMode) -import TextShow.Classes (TextShow(showb, showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral (showbIntegerPrec) import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow)
src/TextShow/System/Posix/Types.hs view
@@ -67,7 +67,7 @@  import System.Posix.Types -import TextShow.Classes (TextShow(showb, showbPrec))+import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral () import TextShow.Foreign.C.Types ()
src/TextShow/TH/Internal.hs view
@@ -42,1314 +42,1679 @@     , makePrintTL     , makeHPrintT     , makeHPrintTL-    , makeShowbPrecWith-    , makeShowbPrec1-    , makeShowbPrecWith2-    , makeShowbPrec2-    ) where--import           Data.Function (on)-import           Data.List.Compat-import qualified Data.List.NonEmpty as NE-import           Data.List.NonEmpty (NonEmpty(..), (<|))-import qualified Data.Map as Map (fromList, findWithDefault)-import           Data.Map (Map)-import           Data.Monoid.Compat ((<>))-import qualified Data.Set as Set-import           Data.Set (Set)-import qualified Data.Text    as TS ()-import qualified Data.Text.IO as TS (putStrLn, hPutStrLn)-import           Data.Text.Lazy (toStrict)-import           Data.Text.Lazy.Builder (Builder, fromString, singleton, toLazyText)-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.Prim (Char#, Double#, Float#, Int#, Word#)-import           GHC.Show (appPrec, appPrec1)--import           Language.Haskell.TH.Lib-import           Language.Haskell.TH.Ppr hiding (appPrec)-import           Language.Haskell.TH.Syntax--import           Prelude ()-import           Prelude.Compat--import           TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..),-                                   showbListWith, showbParen, showbSpace)-import           TextShow.Utils (isInfixTypeCon, isTupleString)------------------------------------------------------------------------------------ User-facing API----------------------------------------------------------------------------------{- $deriveTextShow--'deriveTextShow' automatically generates a 'TextShow' instance declaration for a data-type, newtype, or data family instance. This emulates what would (hypothetically)-happen if you could attach a @deriving 'TextShow'@ clause to the end of a data-declaration.--Here are some examples of how to derive 'TextShow' for simple data types:--@-&#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;-import TextShow.TH--data Letter = A | B | C-$('deriveTextShow' ''Letter) -- instance TextShow Letter where ...--newtype Box a = Box a-$('deriveTextShow' ''Box) -- instance TextShow a => TextShow (Box a) where ...-@--If you are using @template-haskell-2.7.0.0@ or later (i.e., GHC 7.4 or later),-'deriveTextShow' can also be used to derive 'TextShow' instances for data family-instances (which requires the @-XTypeFamilies@ extension). To do so, pass the name of-a data or newtype instance constructor (NOT a data family name!) to 'deriveTextShow'.-Note that the generated code may require the @-XFlexibleInstances@ extension.-Some examples:--@-&#123;-&#35; LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies &#35;-&#125;-import TextShow.TH (deriveTextShow)--class AssocClass a where-    data AssocData a-instance AssocClass Int where-    data AssocData Int = AssocDataInt1 Int | AssocDataInt2 Int Int-$('deriveTextShow' 'AssocDataInt1) -- instance TextShow (AssocData Int) where ...--- Alternatively, one could use $(deriveTextShow 'AssocDataInt2)--data family DataFam a b-newtype instance DataFam () b = DataFamB b-$('deriveTextShow' 'DataFamB) -- instance TextShow b => TextShow (DataFam () b)-@--Note that at the moment, there are some limitations:--* The 'Name' argument to 'deriveTextShow' must not be a type synonym.--* 'deriveTextShow' makes the assumption that all type variables of kind @*@ require a-  'TextShow' constraint when creating the type context. For example, if you have @data-  Phantom a = Phantom@, then @('deriveTextShow' ''Phantom)@ will generate @instance-  'TextShow' a => 'TextShow' (Phantom a) where ...@, even though @'TextShow' a@ is-  not required. If you want a proper 'TextShow' instance for @Phantom@, you will need-  to use 'makeShowbPrec' (see the documentation of the @make@ functions for more-  information).--* 'deriveTextShow' lacks the ability to properly detect data types with higher-kinded-   type parameters (e.g., @data HK f a = HK (f a)@) or with kinds other than @*@-   (e.g., @data List a (empty :: Bool)@). If you wish to derive 'TextShow'-   instances for these data types, you will need to use 'makeShowbPrec'.--* Some data constructors have arguments whose 'TextShow' instance depends on a-  typeclass besides 'TextShow'. For example, consider @newtype MyFixed a = MyFixed-  (Fixed a)@. @'Fixed' a@ is a 'TextShow' instance only if @a@ is an instance of both-  @HasResolution@ and 'TextShow'. Unfortunately, 'deriveTextShow' cannot infer that-  'a' must be an instance of 'HasResolution', so it cannot create a 'TextShow'-  instance for @MyFixed@. However, you can use 'makeShowbPrec' to get around this.---}---- | Generates a 'TextShow' instance declaration for the given data type or data--- family instance.------ /Since: 2/-deriveTextShow :: Name -> Q [Dec]-deriveTextShow = deriveTextShowClass TextShow--{- $deriveTextShow1--'deriveTextShow1' automatically generates a 'Show1' instance declaration for a data-type, newtype, or data family instance that has at least one type variable.-This emulates what would (hypothetically) happen if you could attach a @deriving-'TextShow1'@ clause to the end of a data declaration. Examples:--@-&#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;-import TextShow.TH--data Stream a = Stream a (Stream a)-$('deriveTextShow1' ''Stream) -- instance TextShow1 TextStream where ...--newtype WrappedFunctor f a = WrapFunctor (f a)-$('deriveTextShow1' ''WrappedFunctor) -- instance TextShow1 f => TextShow1 (WrappedFunctor f) where ...-@--The same restrictions that apply to 'deriveTextShow' also apply to 'deriveTextShow1',-with some caveats:--* With 'deriveTextShow1', the last type variable must be of kind @*@. For other ones,-  type variables of kind @*@ are assumed to require a 'TextShow' context, and type-  variables of kind @* -> *@ are assumed to require a 'TextShow1' context. For more-  complicated scenarios, use 'makeShowbPrecWith'.--* If using @-XDatatypeContexts@, a datatype constraint cannot mention the last type-  variable. For example, @data Ord a => Illegal a = Illegal a@ cannot have a derived-  'TextShow1' instance.--* If the last type variable is used within a data field of a constructor, it must only-  be used in the last argument of the data type constructor. For example, @data Legal a-  = Legal (Either Int a)@ can have a derived 'TextShow1' instance, but @data Illegal a-  = Illegal (Either a a)@ cannot.--* Data family instances must be able to eta-reduce the last type variable. In other-  words, if you have a instance of the form:--  @-  data family Family a1 ... an t-  data instance Family e1 ... e2 v = ...-  @--  Then the following conditions must hold:--  1. @v@ must be a type variable.-  2. @v@ must not be mentioned in any of @e1@, ..., @e2@.--* In GHC 7.8, a bug exists that can cause problems when a data family declaration and-  one of its data instances use different type variables, e.g.,--  @-  data family Foo a b c-  data instance Foo Int y z = Foo Int y z-  $('deriveTextShow1' 'Foo)-  @--  To avoid this issue, it is recommened that you use the same type variables in the-  same positions in which they appeared in the data family declaration:--  @-  data family Foo a b c-  data instance Foo Int b c = Foo Int b c-  $('deriveTextShow1' 'Foo)-  @---}---- | Generates a 'TextShow1' instance declaration for the given data type or data--- family instance.------ /Since: 2/-deriveTextShow1 :: Name -> Q [Dec]-deriveTextShow1 = deriveTextShowClass TextShow1--{- $deriveTextShow2--'deriveTextShow2' automatically generates a 'TextShow2' instance declaration for a data-type, newtype, or data family instance that has at least two type variables.-This emulates what would (hypothetically) happen if you could attach a @deriving-'TextShow2'@ clause to the end of a data declaration. Examples:--@-&#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;-import TextShow.TH--data OneOrNone a b = OneL a | OneR b | None-$('deriveTextShow2' ''OneOrNone) -- instance TextShow2 OneOrNone where ...--newtype WrappedBifunctor f a b = WrapBifunctor (f a b)-$('deriveTextShow2' ''WrappedBifunctor) -- instance TextShow2 f => TextShow2 (WrappedBifunctor f) where ...-@--The same restrictions that apply to 'deriveTextShow' and 'deriveTextShow1' also apply-to 'deriveTextShow2', with some caveats:--* With 'deriveTextShow2', the last type variables must both be of kind @*@. For other-  ones, type variables of kind @*@ are assumed to require a 'TextShow' constraint, type-  variables of kind @* -> *@ are assumed to require a 'TextShow1' constraint, and type-  variables of kind @* -> * -> *@ are assumed to require a 'TextShow2' constraint. For-  more complicated scenarios, use 'makeShowbPrecWith2'.--* If using @-XDatatypeContexts@, a datatype constraint cannot mention either of the last-  two type variables. For example, @data Ord a => Illegal a b = Illegal a b@ cannot-  have a derived 'TextShow2' instance.--* If either of the last two type variables is used within a data field of a constructor,-  it must only be used in the last two arguments of the data type constructor. For-  example, @data Legal a b = Legal (Int, Int, a, b)@ can have a derived 'TextShow2'-  instance, but @data Illegal a b = Illegal (a, b, a, b)@ cannot.--* Data family instances must be able to eta-reduce the last two type variables. In other-  words, if you have a instance of the form:--  @-  data family Family a1 ... an t1 t2-  data instance Family e1 ... e2 v1 v2 = ...-  @--  Then the following conditions must hold:--  1. @v1@ and @v2@ must be distinct type variables.-  2. Neither @v1@ not @v2@ must be mentioned in any of @e1@, ..., @e2@.---}---- | Generates a 'TextShow2' instance declaration for the given data type or data--- family instance.------ /Since: 2/-deriveTextShow2 :: Name -> Q [Dec]-deriveTextShow2 = deriveTextShowClass TextShow2--{- $make--There may be scenarios in which you want to show an arbitrary data type or data-family instance without having to make the type an instance of 'TextShow'. For these-cases, this modules provides several functions (all prefixed with @make@-) that-splice the appropriate lambda expression into your source code. Example:--This is particularly useful for creating instances for sophisticated data types. For-example, 'deriveTextShow' cannot infer the correct type context for-@newtype HigherKinded f a = HigherKinded (f a)@, since @f@ is of kind @* -> *@.-However, it is still possible to derive a 'TextShow' instance for @HigherKinded@-without too much trouble using 'makeShowbPrec':--@-&#123;-&#35; LANGUAGE FlexibleContexts, TemplateHaskell &#35;-&#125;-import TextShow-import TextShow.TH--instance TextShow (f a) => TextShow (HigherKinded f a) where-    showbPrec = $(makeShowbPrec ''HigherKinded)-@---}---- | Generates a lambda expression which behaves like 'showt' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makeShowt :: Name -> Q Exp-makeShowt name = [| toStrict . $(makeShowtl name) |]---- | Generates a lambda expression which behaves like 'showtl' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makeShowtl :: Name -> Q Exp-makeShowtl name = [| toLazyText . $(makeShowb name) |]---- | Generates a lambda expression which behaves like 'showtPrec' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makeShowtPrec :: Name -> Q Exp-makeShowtPrec name = [| \p -> toStrict . $(makeShowtlPrec name) p |]---- | Generates a lambda expression which behaves like 'showtlPrec' (without--- requiring a 'TextShow' instance).------ /Since: 2/-makeShowtlPrec :: Name -> Q Exp-makeShowtlPrec name = [| \p -> toLazyText . $(makeShowbPrec name) p |]---- | Generates a lambda expression which behaves like 'showtList' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makeShowtList :: Name -> Q Exp-makeShowtList name = [| toStrict . $(makeShowtlList name) |]---- | Generates a lambda expression which behaves like 'showtlList' (without--- requiring a 'TextShow' instance).------ /Since: 2/-makeShowtlList :: Name -> Q Exp-makeShowtlList name = [| toLazyText . $(makeShowbList name) |]---- | Generates a lambda expression which behaves like 'showb' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makeShowb :: Name -> Q Exp-makeShowb name = makeShowbPrec name `appE` [| zero |]-  where-    -- To prevent the generated TH code from having a type ascription-    zero :: Int-    zero = 0---- | Generates a lambda expression which behaves like 'showbPrec' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makeShowbPrec :: Name -> Q Exp-makeShowbPrec = makeShowbPrecClass TextShow---- | Generates a lambda expression which behaves like 'showbPrecWith' (without--- requiring a 'TextShow1' instance).------ /Since: 2/-makeShowbPrecWith :: Name -> Q Exp-makeShowbPrecWith = makeShowbPrecClass TextShow1---- | Generates a lambda expression which behaves like 'showbPrec1' (without--- requiring a 'TextShow1' instance).------ /Since: 2/-makeShowbPrec1 :: Name -> Q Exp-makeShowbPrec1 name = [| $(makeShowbPrecWith name) showbPrec |]---- | Generates a lambda expression which behaves like 'showbPrecWith2' (without--- requiring a 'TextShow2' instance).------ /Since: 2/-makeShowbPrecWith2 :: Name -> Q Exp-makeShowbPrecWith2 = makeShowbPrecClass TextShow2---- | Generates a lambda expression which behaves like 'showbPrecWith2' (without--- requiring a 'TextShow2' instance).------ /Since: 2/-makeShowbPrec2 :: Name -> Q Exp-makeShowbPrec2 name = [| $(makeShowbPrecWith2 name) showbPrec showbPrec |]---- | Generates a lambda expression which behaves like 'showbList' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makeShowbList :: Name -> Q Exp-makeShowbList name = [| showbListWith $(makeShowb name) |]---- | Generates a lambda expression which behaves like 'printT' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makePrintT :: Name -> Q Exp-makePrintT name = [| TS.putStrLn . $(makeShowt name) |]---- | Generates a lambda expression which behaves like 'printTL' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makePrintTL :: Name -> Q Exp-makePrintTL name = [| TL.putStrLn . $(makeShowtl name) |]---- | Generates a lambda expression which behaves like 'hPrintT' (without requiring a--- 'TextShow' instance).------ /Since: 2/-makeHPrintT :: Name -> Q Exp-makeHPrintT name = [| \h -> TS.hPutStrLn h . $(makeShowt name) |]---- | Generates a lambda expression which behaves like 'hPrintTL' (without--- requiring a 'TextShow' instance).------ /Since: 2/-makeHPrintTL :: Name -> Q Exp-makeHPrintTL name = [| \h -> TL.hPutStrLn h . $(makeShowtl name) |]------------------------------------------------------------------------------------ Code generation------------------------------------------------------------------------------------ | Derive a TextShow(1)(2) instance declaration (depending on the TextShowClass--- argument's value).-deriveTextShowClass :: TextShowClass -> Name -> Q [Dec]-deriveTextShowClass tsClass name = withType name fromCons-  where-    fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q [Dec]-    fromCons name' ctxt tvbs cons mbTys = (:[]) <$>-        instanceD (return instanceCxt)-                  (return instanceType)-                  (showbPrecDecs droppedNbs cons)-      where-        (instanceCxt, instanceType, droppedNbs) =-            buildTypeInstance tsClass name' ctxt tvbs mbTys---- | Generates a declaration defining the primary function corresponding to a--- particular class (showbPrec for TextShow, showbPrecWith for TextShow1, and--- showbPrecWith2 for TextShow2).-showbPrecDecs :: [NameBase] -> [Con] -> [Q Dec]-showbPrecDecs nbs cons =-    [ funD classFuncName-           [ clause []-                    (normalB $ makeTextShowForCons nbs cons)-                    []-           ]-    ]-  where-    classFuncName :: Name-    classFuncName  = showbPrecName . toEnum $ length nbs---- | Generates a lambda expression which behaves like showbPrec (for TextShow),--- showbPrecWith (for TextShow1), or showbPrecWth2 (for TextShow2).-makeShowbPrecClass :: TextShowClass -> Name -> Q Exp-makeShowbPrecClass tsClass name = withType name fromCons-  where-    fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q Exp-    fromCons name' ctxt tvbs cons mbTys =-        let (_, _, !nbs) = buildTypeInstance tsClass name' ctxt tvbs mbTys-         in makeTextShowForCons nbs cons---- | Generates a lambda expression for showbPrec(With)(2) for the given constructors.--- All constructors must be from the same type.-makeTextShowForCons :: [NameBase] -> [Con] -> Q Exp-makeTextShowForCons _   []   = error "Must have at least one data constructor"-makeTextShowForCons nbs cons = do-    p     <- newName "p"-    value <- newName "value"-    sps   <- newNameList "sp" $ length nbs-    let tvis   = zip nbs sps-        tsClass = toEnum $ length nbs-    lamE (map varP $ sps ++ [p, value])-        . appsE-        $ [ varE $ showbPrecConstName tsClass-          , caseE (varE value) $ map (makeTextShowForCon p tsClass tvis) cons-          ] ++ map varE sps-            ++ [varE p, varE value]---- | Generates a lambda expression for showbPrec(With)(2) for a single constructor.-makeTextShowForCon :: Name -> TextShowClass -> [TyVarInfo] -> Con -> Q Match-makeTextShowForCon _ _ _ (NormalC conName [])-    = match (conP conName [])-            (normalB [| fromString $(stringE (parenInfixConName conName "")) |])-            []-makeTextShowForCon p tsClass tvis (NormalC conName [(_, argTy)]) = do-    arg <- newName "arg"--    let showArg  = makeTextShowForArg appPrec1 tsClass conName tvis argTy arg-        namedArg = [| fromString $(stringE (parenInfixConName conName " ")) <> $(showArg) |]--    match (conP conName [varP arg])-          (normalB [| showbParen ($(varE p) > $(lift appPrec)) $(namedArg) |])-          []-makeTextShowForCon p tsClass tvis (NormalC conName ts) = do-    args <- newNameList "arg" $ length ts--    if isNonUnitTuple conName-       then do-           let showArgs       = map (\(arg, (_, argTy)) -> makeTextShowForArg 0 tsClass conName tvis argTy arg)-                                    (zip args ts)-               parenCommaArgs = [| singleton '(' |] : intersperse [| singleton ',' |] showArgs-               mappendArgs    = foldr (`infixApp` [| (<>) |])-                                      [| singleton ')' |]-                                      parenCommaArgs--           match (conP conName $ map varP args)-                 (normalB mappendArgs)-                 []-       else do-           let showArgs = map (\(arg, (_, argTy)) -> makeTextShowForArg appPrec1 tsClass conName tvis argTy arg)-                              (zip args ts)-               mappendArgs = foldr1 (\v q -> [| $(v) <> showbSpace <> $(q) |]) showArgs-               namedArgs   = [| fromString $(stringE (parenInfixConName conName " ")) <> $(mappendArgs) |]--           match (conP conName $ map varP args)-                 (normalB [| showbParen ($(varE p) > $(lift appPrec)) $(namedArgs) |])-                 []-makeTextShowForCon p  tsClass tvis (RecC conName []) = makeTextShowForCon p tsClass tvis $ NormalC conName []-makeTextShowForCon _p tsClass tvis (RecC conName ts) = do-    args <- newNameList "arg" $ length ts--    let showArgs       = concatMap (\(arg, (argName, _, argTy))-                                      -> [ [| fromString $(stringE (nameBase argName ++ " = ")) |]-                                         , makeTextShowForArg 0 tsClass conName tvis argTy arg-                                         , [| fromString ", "                                   |]-                                         ]-                                   )-                                   (zip args ts)-        braceCommaArgs = [| singleton '{' |] : take (length showArgs - 1) showArgs-        mappendArgs    = foldr (`infixApp` [| (<>) |])-                           [| singleton '}' |]-                           braceCommaArgs-        namedArgs      = [| fromString $(stringE (parenInfixConName conName " ")) <> $(mappendArgs) |]--    match (conP conName $ map varP args)-          (normalB-#if __GLASGOW_HASKELL__ >= 711-                    namedArgs-#else-                    [| showbParen ($(varE _p) > $(lift appPrec)) $(namedArgs) |]-#endif-          )-          []-makeTextShowForCon p tsClass tvis (InfixC (_, alTy) conName (_, arTy)) = do-    al   <- newName "argL"-    ar   <- newName "argR"-    info <- reify conName--#if __GLASGOW_HASKELL__ >= 711-    conPrec <- case info of-                        DataConI{} -> do-                            Fixity prec _ <- reifyFixity conName-                            return prec-#else-    let conPrec  = case info of-                        DataConI _ _ _ (Fixity prec _) -> prec-#endif-                        _ -> error $ "TextShow.TH.makeTextShowForCon: Unsupported type: " ++ show info--    let opName   = nameBase conName-        infixOpE = if isInfixTypeCon opName-                      then [| fromString $(stringE $ " "  ++ opName ++ " " ) |]-                      else [| fromString $(stringE $ " `" ++ opName ++ "` ") |]--    match (infixP (varP al) conName (varP ar))-          (normalB $ appE [| showbParen ($(varE p) > conPrec) |]-                          [| $(makeTextShowForArg (conPrec + 1) tsClass conName tvis alTy al)-                          <> $(infixOpE)-                          <> $(makeTextShowForArg (conPrec + 1) tsClass conName tvis arTy ar)-                          |]-          )-          []-makeTextShowForCon p tsClass tvis (ForallC tvbs _ con) = makeTextShowForCon p tsClass (removeForalled tvbs tvis) con---- | Generates a lambda expression for showbPrec(With)(2) for an argument of a--- constructor.-makeTextShowForArg :: Int-                   -> TextShowClass-                   -> Name-                   -> [TyVarInfo]-                   -> Type-                   -> Name-                   -> Q Exp-makeTextShowForArg p tsClass conName tvis ty tyExpName = do-    ty' <- expandSyn ty-    makeTextShowForArg' p tsClass conName tvis ty' tyExpName---- | Generates a lambda expression for showbPrec(With)(2) for an argument of a--- constructor, after expanding all type synonyms.-makeTextShowForArg' :: Int-                    -> TextShowClass-                    -> Name-                    -> [TyVarInfo]-                    -> Type-                    -> Name-                    -> Q Exp-makeTextShowForArg' p _ _ _ (ConT tyName) tyExpName =-#if __GLASGOW_HASKELL__ >= 711--- 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.-    showE-  where-    tyVarE :: Q Exp-    tyVarE = varE tyExpName--    showE :: Q Exp-    showE | tyName == ''Char#   = [| showbPrec 0 (C# $(tyVarE)) <> singleton '#'   |]-          | tyName == ''Double# = [| showbPrec 0 (D# $(tyVarE)) <> fromString "##" |]-          | tyName == ''Float#  = [| showbPrec 0 (F# $(tyVarE)) <> singleton '#'   |]-          | tyName == ''Int#    = [| showbPrec 0 (I# $(tyVarE)) <> singleton '#'   |]-          | tyName == ''Word#   = [| showbPrec 0 (W# $(tyVarE)) <> fromString "##" |]-          | otherwise = [| showbPrec p $(tyVarE) |]-#else-    [| showbPrec p $(expr) |]-  where-    tyVarE :: Q Exp-    tyVarE = varE tyExpName--    expr :: Q Exp-    expr | tyName == ''Char#   = [| C# $(tyVarE) |]-         | tyName == ''Double# = [| D# $(tyVarE) |]-         | tyName == ''Float#  = [| F# $(tyVarE) |]-         | tyName == ''Int#    = [| I# $(tyVarE) |]-         | tyName == ''Word#   = [| W# $(tyVarE) |]-         | otherwise = tyVarE-#endif-makeTextShowForArg' p tsClass conName tvis ty tyExpName =-    [| $(makeTextShowForType tsClass conName tvis ty) p $(varE tyExpName) |]---- | Generates a lambda expression for showbPrec(With)(2) for a specific type.--- The generated expression depends on the number of type variables.------ 1. If the type is of kind * (T), apply showbPrec.--- 2. If the type is of kind * -> * (T a), apply showbPrecWith $(makeTextShowForType a)--- 3. If the type is of kind * -> * -> * (T a b), apply---    showbPrecWith2 $(makeTextShowForType a) $(makeTextShowForType b)-makeTextShowForType :: TextShowClass-                    -> Name-                    -> [TyVarInfo]-                    -> Type-                    -> Q Exp-makeTextShowForType _ _ tvis (VarT tyName) =-    case lookup (NameBase tyName) tvis of-         Just spExp -> varE spExp-         Nothing    -> [| showbPrec |]-makeTextShowForType tsClass conName tvis (SigT ty _)         = makeTextShowForType tsClass conName tvis ty-makeTextShowForType tsClass conName tvis (ForallT tvbs _ ty) = makeTextShowForType tsClass conName (removeForalled tvbs tvis) ty-makeTextShowForType tsClass conName tvis ty = do-    let tyArgs :: [Type]-        tyCon :| tyArgs = unapplyTy ty--        numLastArgs :: Int-        numLastArgs = min (fromEnum tsClass) (length tyArgs)--        lhsArgs, rhsArgs :: [Type]-        (lhsArgs, rhsArgs) = splitAt (length tyArgs - numLastArgs) tyArgs--        tyVarNameBases :: [NameBase]-        tyVarNameBases = map fst tvis--    itf <- isTyFamily tyCon-    if any (`mentionsNameBase` tyVarNameBases) lhsArgs-          || itf && any (`mentionsNameBase` tyVarNameBases) tyArgs-       then outOfPlaceTyVarError conName tyVarNameBases-       else appsE $ [ varE . showbPrecName $ toEnum numLastArgs]-                    ++ map (makeTextShowForType tsClass conName tvis) rhsArgs------------------------------------------------------------------------------------ Template Haskell reifying and AST manipulation------------------------------------------------------------------------------------ | Extracts a plain type constructor's information.--- | Boilerplate for top level splices.------ The given Name must meet one of two criteria:------ 1. It must be the name of a type constructor of a plain data type or newtype.--- 2. It must be the name of a data family instance or newtype instance constructor.------ Any other value will result in an exception.-withType :: Name-         -> (Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q a)-         -> Q a-withType name f = do-  info <- reify name-  case info of-    TyConI dec ->-      case dec of-        DataD    ctxt _ tvbs cons _ -> f name ctxt tvbs cons Nothing-        NewtypeD ctxt _ tvbs con  _ -> f name ctxt tvbs [con] Nothing-        _ -> error $ ns ++ "Unsupported type: " ++ show dec-#if MIN_VERSION_template_haskell(2,7,0)-# if MIN_VERSION_template_haskell(2,11,0)-    DataConI _ _ parentName   -> do-# else-    DataConI _ _ parentName _ -> do-# endif-      parentInfo <- reify parentName-      case parentInfo of-# if MIN_VERSION_template_haskell(2,11,0)-        FamilyI (DataFamilyD _ tvbs _) decs ->-# else-        FamilyI (FamilyD DataFam _ tvbs _) decs ->-# endif-          let instDec = flip find decs $ \dec -> case dec of-                DataInstD    _ _ _ cons _ -> any ((name ==) . constructorName) cons-                NewtypeInstD _ _ _ con  _ -> name == constructorName con-                _ -> error $ ns ++ "Must be a data or newtype instance."-           in case instDec of-                Just (DataInstD    ctxt _ instTys cons _)-                  -> f parentName ctxt tvbs cons $ Just instTys-                Just (NewtypeInstD ctxt _ instTys con  _)-                  -> f parentName ctxt tvbs [con] $ Just instTys-                _ -> error $ ns ++-                  "Could not find data or newtype instance constructor."-        _ -> error $ ns ++ "Data constructor " ++ show name ++-          " is not from a data family instance constructor."-# if MIN_VERSION_template_haskell(2,11,0)-    FamilyI DataFamilyD{} _ ->-# else-    FamilyI (FamilyD DataFam _ _ _) _ ->-# endif-      error $ ns ++-        "Cannot use a data family name. Use a data family instance constructor instead."-    _ -> error $ ns ++ "The name must be of a plain data type constructor, "-                    ++ "or a data family instance constructor."-#else-    DataConI{} -> dataConIError-    _          -> error $ ns ++ "The name must be of a plain type constructor."-#endif-  where-    ns :: String-    ns = "TextShow.TH.withType: "---- | Deduces the instance context, instance head, and eta-reduced type variables--- for an instance.-buildTypeInstance :: TextShowClass-                  -- ^ TextShow, TextShow1, or TextShow2-                  -> Name-                  -- ^ The type constructor or data family name-                  -> Cxt-                  -- ^ The datatype context-                  -> [TyVarBndr]-                  -- ^ The type variables from the data type/data family declaration-                  -> Maybe [Type]-                  -- ^ 'Just' the types used to instantiate a data family instance,-                  -- or 'Nothing' if it's a plain data type-                  -> (Cxt, Type, [NameBase])--- Plain data type/newtype case-buildTypeInstance tsClass tyConName dataCxt tvbs Nothing-    | remainingLength < 0 || not (wellKinded droppedKinds) -- If we have enough well-kinded type variables-    = derivingKindError tsClass tyConName-    | any (`predMentionsNameBase` droppedNbs) dataCxt -- If the last type variable(s) are mentioned in a datatype context-    = datatypeContextError tyConName instanceType-    | otherwise = (instanceCxt, instanceType, droppedNbs)-  where-    instanceCxt :: Cxt-    instanceCxt = map (applyShowConstraint)-                $ filter (needsConstraint tsClass . tvbKind) remaining--    instanceType :: Type-    instanceType = AppT (ConT $ textShowClassName tsClass)-                 . applyTyCon tyConName-                 $ map (VarT . tvbName) remaining--    remainingLength :: Int-    remainingLength = length tvbs - fromEnum tsClass--    remaining, dropped :: [TyVarBndr]-    (remaining, dropped) = splitAt remainingLength tvbs--    droppedKinds :: [Kind]-    droppedKinds = map tvbKind dropped--    droppedNbs :: [NameBase]-    droppedNbs = map (NameBase . tvbName) dropped--- Data family instance case-buildTypeInstance tsClass parentName dataCxt tvbs (Just instTysAndKinds)-    | remainingLength < 0 || not (wellKinded droppedKinds) -- If we have enough well-kinded type variables-    = derivingKindError tsClass parentName-    | any (`predMentionsNameBase` droppedNbs) dataCxt -- If the last type variable(s) are mentioned in a datatype context-    = datatypeContextError parentName instanceType-    | canEtaReduce remaining dropped -- If it is safe to drop the type variables-    = (instanceCxt, instanceType, droppedNbs)-    | otherwise = etaReductionError instanceType-  where-    instanceCxt :: Cxt-    instanceCxt = map (applyShowConstraint)-                $ filter (needsConstraint tsClass . tvbKind) lhsTvbs--    -- We need to make sure that type variables in the instance head which have-    -- TextShow constrains aren't poly-kinded, e.g.,-    ---    -- @-    -- instance TextShow a => TextShow (Foo (a :: k)) where-    -- @-    ---    -- To do this, we remove every kind ascription (i.e., strip off every 'SigT').-    instanceType :: Type-    instanceType = AppT (ConT $ textShowClassName tsClass)-                 . applyTyCon parentName-                 $ map unSigT remaining--    remainingLength :: Int-    remainingLength = length tvbs - fromEnum tsClass--    remaining, dropped :: [Type]-    (remaining, dropped) = splitAt remainingLength rhsTypes--    droppedKinds :: [Kind]-    droppedKinds = map tvbKind . snd $ splitAt remainingLength tvbs--    droppedNbs :: [NameBase]-    droppedNbs = map varTToNameBase dropped--    -- We need to mindful of an old GHC bug which causes kind variables appear in-    -- @instTysAndKinds@ (as the name suggests) if (1) @PolyKinds@ is enabled, and-    -- (2) either GHC 7.6 or 7.8 is being used (for more info, see-    -- https://ghc.haskell.org/trac/ghc/ticket/9692).-    ---    -- Since Template Haskell doesn't seem to have a mechanism for detecting which-    -- language extensions are enabled, we do the next-best thing by counting-    -- the number of distinct kind variables in the data family declaration, and-    -- then dropping that number of entries from @instTysAndKinds@-    instTypes :: [Type]-    instTypes =-#if __GLASGOW_HASKELL__ >= 710 || !(MIN_VERSION_template_haskell(2,8,0))-        instTysAndKinds-#else-        drop (Set.size . Set.unions $ map (distinctKindVars . tvbKind) tvbs)-             instTysAndKinds-#endif--    lhsTvbs :: [TyVarBndr]-    lhsTvbs = map (uncurry replaceTyVarName)-            . filter (isTyVar . snd)-            . take remainingLength-            $ zip tvbs rhsTypes--    -- In GHC 7.8, only the @Type@s up to the rightmost non-eta-reduced type variable-    -- in @instTypes@ are provided (as a result of this extremely annoying bug:-    -- https://ghc.haskell.org/trac/ghc/ticket/9692). This is pretty inconvenient,-    -- as it makes it impossible to come up with the correct 'TextShow1' or 'TextShow2'-    -- instances in some cases. For example, consider the following code:-    ---    -- @-    -- data family Foo a b c-    -- data instance Foo Int y z = Foo Int y z-    -- $(deriveTextShow2 'Foo)-    -- @-    ---    -- Due to the aformentioned bug, Template Haskell doesn't tell us the names of-    -- either of type variables in the data instance (@y@ and @z@). As a result, we-    -- won't know which fields of the 'Foo' constructor to apply the show functions,-    -- which will result in an incorrect instance. Urgh.-    ---    -- A workaround is to ensure that you use the exact same type variables, in the-    -- exact same order, in the data family declaration and any data or newtype-    -- instances:-    ---    -- @-    -- data family Foo a b c-    -- data instance Foo Int b c = Foo Int b c-    -- $(deriveTextShow2 'Foo)-    -- @-    ---    -- Thankfully, other versions of GHC don't seem to have this bug.-    rhsTypes :: [Type]-    rhsTypes =-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-            instTypes ++ map tvbToType-                             (drop (length instTypes)-                                   tvbs)-#else-            instTypes-#endif---- | Given a TyVarBndr, apply a TextShow(1)(2) constraint to it, depending--- on its kind.-applyShowConstraint :: TyVarBndr -> Pred-applyShowConstraint (PlainTV  name)      = applyClass ''TextShow  name-applyShowConstraint (KindedTV name kind) = applyClass className   name-  where-    className :: Name-    className = textShowClassName . toEnum $ numKindArrows kind---- | Can a kind signature inhabit a TextShow(1)(2) constraint?------ TextShow:  k--- TextShow1: k1 -> k2--- TextShow2: k1 -> k2 -> k3-needsConstraint :: TextShowClass -> Kind -> Bool-needsConstraint tsClass kind =-       fromEnum tsClass >= numKindArrows kind-    && canRealizeKindStarChain kind------------------------------------------------------------------------------------ Error messages------------------------------------------------------------------------------------ | Either the given data type doesn't have enough type variables, or one of--- the type variables to be eta-reduced cannot realize kind *.-derivingKindError :: TextShowClass -> Name -> a-derivingKindError tsClass tyConName = error-    . showString "Cannot derive well-kinded instance of form ‘"-    . showString className-    . showChar ' '-    . showParen True-      ( showString (nameBase tyConName)-      . showString " ..."-      )-    . showString "‘\n\tClass "-    . showString className-    . showString " expects an argument of kind "-    . showString (pprint . createKindChain $ fromEnum tsClass)-    $ ""-  where-    className :: String-    className = nameBase $ textShowClassName tsClass---- | One of the last type variables cannot be eta-reduced (see the canEtaReduce--- function for the criteria it would have to meet).-etaReductionError :: Type -> a-etaReductionError instanceType = error $-    "Cannot eta-reduce to an instance of form \n\tinstance (...) => "-    ++ pprint instanceType---- | The data type has a DatatypeContext which mentions one of the eta-reduced--- type variables.-datatypeContextError :: Name -> Type -> a-datatypeContextError dataName instanceType = error-    . showString "Can't make a derived instance of ‘"-    . showString (pprint instanceType)-    . showString "‘:\n\tData type ‘"-    . showString (nameBase dataName)-    . showString "‘ must not have a class context involving the last type argument(s)"-    $ ""---- | The data type mentions one of the n eta-reduced type variables in a place other--- than the last nth positions of a data type in a constructor's field.-outOfPlaceTyVarError :: Name -> [NameBase] -> a-outOfPlaceTyVarError conName tyVarNames = error-    . showString "Constructor ‘"-    . showString (nameBase conName)-    . showString "‘ must use the type variable(s) "-    . shows tyVarNames-    . showString " only in the last argument(s) of a data type"-    $ ""--#if !(MIN_VERSION_template_haskell(2,7,0))--- | Template Haskell didn't list all of a data family's instances upon reification--- until template-haskell-2.7.0.0, which is necessary for a derived TextShow(1)(2)--- instance to work.-dataConIError :: a-dataConIError = error-    . showString "Cannot use a data constructor."-    . showString "\n\t(Note: if you are trying to derive TextShow for a"-    . showString "\n\ttype family, use GHC >= 7.4 instead.)"-    $ ""-#endif------------------------------------------------------------------------------------ Expanding type synonyms------------------------------------------------------------------------------------ | Expands all type synonyms in a type. Written by Dan Rosén in the--- @genifunctors@ package (licensed under BSD3).-expandSyn :: Type -> Q Type-expandSyn (ForallT tvs ctx t) = fmap (ForallT tvs ctx) $ expandSyn t-expandSyn t@AppT{}            = expandSynApp t []-expandSyn t@ConT{}            = expandSynApp t []-expandSyn (SigT t _)          = expandSyn t   -- Ignore kind synonyms-expandSyn t                   = return t--expandSynApp :: Type -> [Type] -> Q Type-expandSynApp (AppT t1 t2) ts = do-    t2' <- expandSyn t2-    expandSynApp t1 (t2':ts)-expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl' AppT ListT ts-expandSynApp t@(ConT n) ts = do-    info <- reify n-    case info of-        TyConI (TySynD _ tvs rhs) ->-            let (ts', ts'') = splitAt (length tvs) ts-                subs = mkSubst tvs ts'-                rhs' = subst subs rhs-             in expandSynApp rhs' ts''-        _ -> return $ foldl' AppT t ts-expandSynApp t ts = do-    t' <- expandSyn t-    return $ foldl' AppT t' ts--type Subst = Map Name Type--mkSubst :: [TyVarBndr] -> [Type] -> Subst-mkSubst vs ts =-   let vs' = map un vs-       un (PlainTV v)    = v-       un (KindedTV v _) = v-   in Map.fromList $ zip vs' ts--subst :: Subst -> Type -> Type-subst subs (ForallT v c t) = ForallT v c $ subst subs t-subst subs t@(VarT n)      = Map.findWithDefault t n subs-subst subs (AppT t1 t2)    = AppT (subst subs t1) (subst subs t2)-subst subs (SigT t k)      = SigT (subst subs t) k-subst _ t                  = t------------------------------------------------------------------------------------ Class-specific constants------------------------------------------------------------------------------------ | A representation of which TextShow variant is being derived.-data TextShowClass = TextShow | TextShow1 | TextShow2-  deriving (Enum, Eq, Ord)--showbPrecConstName :: TextShowClass -> Name-showbPrecConstName TextShow  = 'showbPrecConst-showbPrecConstName TextShow1 = 'showbPrecWithConst-showbPrecConstName TextShow2 = 'showbPrecWith2Const--textShowClassName :: TextShowClass -> Name-textShowClassName TextShow  = ''TextShow-textShowClassName TextShow1 = ''TextShow1-textShowClassName TextShow2 = ''TextShow2--showbPrecName :: TextShowClass -> Name-showbPrecName TextShow  = 'showbPrec-showbPrecName TextShow1 = 'showbPrecWith-showbPrecName TextShow2 = 'showbPrecWith2---- | A type-restricted version of 'const'. This is useful when generating the lambda--- expression in 'makeShowbPrec' for a data type with only nullary constructors (since--- the expression wouldn't depend on the precedence). For example, if you had @data--- Nullary = Nullary@ and attempted to run @$(makeShowbPrec ''Nullary) Nullary@, simply--- ignoring the precedence argument would cause the type signature of @$(makeShowbPrec--- ''Nullary)@ to be @a -> Nullary -> Builder@, not @Int -> Nullary -> Builder@.-showbPrecConst :: Builder -> Int -> a -> Builder-showbPrecConst = const . const-{-# INLINE showbPrecConst #-}--showbPrecWithConst :: Builder -> (Int -> a -> Builder) -> Int -> f a -> Builder-showbPrecWithConst = const . const . const-{-# INLINE showbPrecWithConst #-}--showbPrecWith2Const :: Builder -> (Int -> a -> Builder) -> (Int -> b -> Builder)-                    -> Int -> f a b -> Builder-showbPrecWith2Const = const . const . const . const-{-# INLINE showbPrecWith2Const #-}------------------------------------------------------------------------------------ NameBase------------------------------------------------------------------------------------ | A wrapper around Name which only uses the 'nameBase' (not the entire Name)--- to compare for equality. For example, if you had two Names a_123 and a_456,--- they are not equal as Names, but they are equal as NameBases.------ This is useful when inspecting type variables, since a type variable in an--- instance context may have a distinct Name from a type variable within an--- actual constructor declaration, but we'd want to treat them as the same--- if they have the same 'nameBase' (since that's what the programmer uses to--- begin with).-newtype NameBase = NameBase { getName :: Name }--getNameBase :: NameBase -> String-getNameBase = nameBase . getName--instance Eq NameBase where-    (==) = (==) `on` getNameBase--instance Ord NameBase where-    compare = compare `on` getNameBase--instance Show NameBase where-    showsPrec p = showsPrec p . getNameBase---- | A NameBase paired with the name of its show function. For example, in a--- TextShow2 declaration, a list of TyVarInfos might look like [(a, 'sp1), (b, 'sp2)].-type TyVarInfo = (NameBase, Name)------------------------------------------------------------------------------------ Assorted utilities------------------------------------------------------------------------------------ | Generate a list of fresh names with a common prefix, and numbered suffixes.-newNameList :: String -> Int -> Q [Name]-newNameList prefix n = mapM (newName . (prefix ++) . show) [1..n]---- | Remove any occurrences of a forall-ed type variable from a list of @TyVarInfo@s.-removeForalled :: [TyVarBndr] -> [TyVarInfo] -> [TyVarInfo]-removeForalled tvbs = filter (not . foralled tvbs)-  where-    foralled :: [TyVarBndr] -> TyVarInfo -> Bool-    foralled tvbs' tvi = fst tvi `elem` map (NameBase . tvbName) tvbs'---- | Checks if a 'Name' represents a tuple type constructor (other than '()')-isNonUnitTuple :: Name -> Bool-isNonUnitTuple = isTupleString . nameBase---- | Parenthesize an infix constructor name if it is being applied as a prefix--- function (e.g., data Amp a = (:&) a a)-parenInfixConName :: Name -> ShowS-parenInfixConName conName =-    let conNameBase = nameBase conName-     in showParen (isInfixTypeCon conNameBase) $ showString conNameBase---- | Extracts the name from a TyVarBndr.-tvbName :: TyVarBndr -> Name-tvbName (PlainTV  name)   = name-tvbName (KindedTV name _) = name---- | Extracts the kind from a TyVarBndr.-tvbKind :: TyVarBndr -> Kind-tvbKind (PlainTV  _)   = starK-tvbKind (KindedTV _ k) = k---- | Replace the Name of a TyVarBndr with one from a Type (if the Type has a Name).-replaceTyVarName :: TyVarBndr -> Type -> TyVarBndr-replaceTyVarName tvb            (SigT t _) = replaceTyVarName tvb t-replaceTyVarName (PlainTV  _)   (VarT n)   = PlainTV  n-replaceTyVarName (KindedTV _ k) (VarT n)   = KindedTV n k-replaceTyVarName tvb            _          = tvb---- | Applies a typeclass constraint to a type.-applyClass :: Name -> Name -> Pred-#if MIN_VERSION_template_haskell(2,10,0)-applyClass con t = AppT (ConT con) (VarT t)-#else-applyClass con t = ClassP con [VarT t]-#endif---- | Checks to see if the last types in a data family instance can be safely eta---- reduced (i.e., dropped), given the other types. This checks for three conditions:------ (1) All of the dropped types are type variables--- (2) All of the dropped types are distinct--- (3) None of the remaining types mention any of the dropped types-canEtaReduce :: [Type] -> [Type] -> Bool-canEtaReduce remaining dropped =-       all isTyVar dropped-    && allDistinct nbs -- Make sure not to pass something of type [Type], since Type-                       -- didn't have an Ord instance until template-haskell-2.10.0.0-    && not (any (`mentionsNameBase` nbs) remaining)-  where-    nbs :: [NameBase]-    nbs = map varTToNameBase dropped---- | Extract the Name from a type variable.-varTToName :: Type -> Name-varTToName (VarT n)   = n-varTToName (SigT t _) = varTToName t-varTToName _          = error "Not a type variable!"---- | Extract the NameBase from a type variable.-varTToNameBase :: Type -> NameBase-varTToNameBase = NameBase . varTToName---- | Peel off a kind signature from a Type (if it has one).-unSigT :: Type -> Type-unSigT (SigT t _) = t-unSigT t          = t---- | Is the given type a variable?-isTyVar :: Type -> Bool-isTyVar (VarT _)   = True-isTyVar (SigT t _) = isTyVar t-isTyVar _          = False---- | Is the given type a type family constructor (and not a data family constructor)?-isTyFamily :: Type -> Q Bool-isTyFamily (ConT n) = do-    info <- reify n-    return $ case info of-#if MIN_VERSION_template_haskell(2,11,0)-         FamilyI OpenTypeFamilyD{} _       -> True-#elif MIN_VERSION_template_haskell(2,7,0)-         FamilyI (FamilyD TypeFam _ _ _) _ -> True-#else-         TyConI  (FamilyD TypeFam _ _ _)   -> True-#endif-#if MIN_VERSION_template_haskell(2,9,0)-         FamilyI ClosedTypeFamilyD{} _     -> True-#endif-         _ -> False-isTyFamily _ = return False---- | Are all of the items in a list (which have an ordering) distinct?------ This uses Set (as opposed to nub) for better asymptotic time complexity.-allDistinct :: Ord a => [a] -> Bool-allDistinct = allDistinct' Set.empty-  where-    allDistinct' :: Ord a => Set a -> [a] -> Bool-    allDistinct' uniqs (x:xs)-        | x `Set.member` uniqs = False-        | otherwise            = allDistinct' (Set.insert x uniqs) xs-    allDistinct' _ _           = True---- | Does the given type mention any of the NameBases in the list?-mentionsNameBase :: Type -> [NameBase] -> Bool-mentionsNameBase = go Set.empty-  where-    go :: Set NameBase -> Type -> [NameBase] -> Bool-    go foralls (ForallT tvbs _ t) nbs =-        go (foralls `Set.union` Set.fromList (map (NameBase . tvbName) tvbs)) t nbs-    go foralls (AppT t1 t2) nbs = go foralls t1 nbs || go foralls t2 nbs-    go foralls (SigT t _)   nbs = go foralls t nbs-    go foralls (VarT n)     nbs = varNb `elem` nbs && not (varNb `Set.member` foralls)-      where-        varNb = NameBase n-    go _       _            _   = False---- | Does an instance predicate mention any of the NameBases in the list?-predMentionsNameBase :: Pred -> [NameBase] -> Bool-#if MIN_VERSION_template_haskell(2,10,0)-predMentionsNameBase = mentionsNameBase-#else-predMentionsNameBase (ClassP _ tys) nbs = any (`mentionsNameBase` nbs) tys-predMentionsNameBase (EqualP t1 t2) nbs = mentionsNameBase t1 nbs || mentionsNameBase t2 nbs-#endif---- | The number of arrows that compose the spine of a kind signature--- (e.g., (* -> *) -> k -> * has two arrows on its spine).-numKindArrows :: Kind -> Int-numKindArrows k = length (uncurryKind k) - 1---- | Construct a type via curried application.-applyTy :: Type -> [Type] -> Type-applyTy = foldl' AppT---- | Fully applies a type constructor to its type variables.-applyTyCon :: Name -> [Type] -> Type-applyTyCon = applyTy . ConT---- | Split an applied type into its individual components. For example, this:------ @--- Either Int Char--- @------ would split to this:------ @--- [Either, Int, Char]--- @-unapplyTy :: Type -> NonEmpty Type-unapplyTy = NE.reverse . go-  where-    go :: Type -> NonEmpty Type-    go (AppT t1 t2) = t2 <| go t1-    go (SigT t _)   = go t-    go t            = t :| []---- | Split a type signature by the arrows on its spine. For example, this:------ @--- (Int -> String) -> Char -> ()--- @------ would split to this:------ @--- [Int -> String, Char, ()]--- @-uncurryTy :: Type -> NonEmpty Type-uncurryTy (AppT (AppT ArrowT t1) t2) = t1 <| uncurryTy t2-uncurryTy (SigT t _)                 = uncurryTy t-uncurryTy t                          = t :| []---- | Like uncurryType, except on a kind level.-uncurryKind :: Kind -> NonEmpty Kind-#if MIN_VERSION_template_haskell(2,8,0)-uncurryKind = uncurryTy-#else-uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2-uncurryKind k              = k :| []-#endif--wellKinded :: [Kind] -> Bool-wellKinded = all canRealizeKindStar---- | Of form k1 -> k2 -> ... -> kn, where k is either a single kind variable or *.-canRealizeKindStarChain :: Kind -> Bool-canRealizeKindStarChain = all canRealizeKindStar . uncurryKind--canRealizeKindStar :: Kind -> Bool-canRealizeKindStar k = case uncurryKind k of-    k' :| [] -> case k' of-#if MIN_VERSION_template_haskell(2,8,0)-                     StarT    -> True-                     (VarT _) -> True -- Kind k can be instantiated with *-#else-                     StarK    -> True-#endif-                     _ -> False-    _ -> False--createKindChain :: Int -> Kind-createKindChain = go starK-  where-    go :: Kind -> Int -> Kind-    go k !0 = k-#if MIN_VERSION_template_haskell(2,8,0)-    go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)-#else-    go k !n = go (ArrowK StarK k) (n - 1)-#endif--# if MIN_VERSION_template_haskell(2,8,0) && __GLASGOW_HASKELL__ < 710-distinctKindVars :: Kind -> Set Name-distinctKindVars (AppT k1 k2) = distinctKindVars k1 `Set.union` distinctKindVars k2-distinctKindVars (SigT k _)   = distinctKindVars k-distinctKindVars (VarT k)     = Set.singleton k-distinctKindVars _            = Set.empty-#endif--#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-tvbToType :: TyVarBndr -> Type-tvbToType (PlainTV n)    = VarT n-tvbToType (KindedTV n k) = SigT (VarT n) k-#endif--#if MIN_VERSION_template_haskell(2,7,0)--- | Extracts the name of a constructor.-constructorName :: Con -> Name-constructorName (NormalC name      _  ) = name-constructorName (RecC    name      _  ) = name-constructorName (InfixC  _    name _  ) = name-constructorName (ForallC _    _    con) = constructorName con-#endif+    , makeLiftShowbPrec+    , makeShowbPrec1+    , makeLiftShowbPrec2+    , makeShowbPrec2+    ) where++import           Control.Monad (liftM, unless, when)+#if MIN_VERSION_template_haskell(2,11,0)+import           Control.Monad ((<=<))+#endif+import           Data.Foldable.Compat+import           Data.List.Compat+import qualified Data.List.NonEmpty as NE (drop, length, reverse, splitAt)+import           Data.List.NonEmpty (NonEmpty(..), (<|))+import qualified Data.Map as Map (fromList, findWithDefault, keys, lookup, singleton)+import           Data.Map (Map)+import           Data.Maybe+import           Data.Monoid.Compat ((<>))+import qualified Data.Set as Set+import           Data.Set (Set)+import qualified Data.Text    as TS ()+import qualified Data.Text.IO as TS (putStrLn, hPutStrLn)+import           Data.Text.Lazy (toStrict)+import           Data.Text.Lazy.Builder (Builder, fromString, singleton, toLazyText)+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(..))+#if __GLASGOW_HASKELL__ >= 800+import           GHC.Lexeme (startsConSym)+#endif+import           GHC.Prim (Char#, Double#, Float#, Int#, Word#)+import           GHC.Show (appPrec, appPrec1)++import           Language.Haskell.TH.Lib+import           Language.Haskell.TH.Ppr hiding (appPrec)+import           Language.Haskell.TH.Syntax++import           Prelude ()+import           Prelude.Compat++import           TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..),+                                   showbListWith, showbParen, showbSpace)+import           TextShow.Utils (isInfixTypeCon, isTupleString)++-------------------------------------------------------------------------------+-- User-facing API+-------------------------------------------------------------------------------++{- $deriveTextShow++'deriveTextShow' automatically generates a 'TextShow' instance declaration for a data+type, newtype, or data family instance. This emulates what would (hypothetically)+happen if you could attach a @deriving 'TextShow'@ clause to the end of a data+declaration.++Here are some examples of how to derive 'TextShow' for simple data types:++@+&#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;+import TextShow.TH++data Letter = A | B | C+$('deriveTextShow' ''Letter) -- instance TextShow Letter where ...++newtype Box a = Box a+$('deriveTextShow' ''Box) -- instance TextShow a => TextShow (Box a) where ...+@++If you are using @template-haskell-2.7.0.0@ or later (i.e., GHC 7.4 or later),+'deriveTextShow' can also be used to derive 'TextShow' instances for data family+instances (which requires the @-XTypeFamilies@ extension). To do so, pass the name of+a data or newtype instance constructor (NOT a data family name!) to 'deriveTextShow'.+Note that the generated code may require the @-XFlexibleInstances@ extension.+Some examples:++@+&#123;-&#35; LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies &#35;-&#125;+import TextShow.TH (deriveTextShow)++class AssocClass a where+    data AssocData a+instance AssocClass Int where+    data AssocData Int = AssocDataInt1 Int | AssocDataInt2 Int Int+$('deriveTextShow' 'AssocDataInt1) -- instance TextShow (AssocData Int) where ...+-- Alternatively, one could use $(deriveTextShow 'AssocDataInt2)++data family DataFam a b+newtype instance DataFam () b = DataFamB b+$('deriveTextShow' 'DataFamB) -- instance TextShow b => TextShow (DataFam () b)+@++Note that at the moment, there are some limitations:++* The 'Name' argument to 'deriveTextShow' must not be a type synonym.++* 'deriveTextShow' makes the assumption that all type variables of kind @*@ require a+  'TextShow' constraint when creating the type context. For example, if you have @data+  Phantom a = Phantom@, then @('deriveTextShow' ''Phantom)@ will generate @instance+  'TextShow' a => 'TextShow' (Phantom a) where ...@, even though @'TextShow' a@ is+  not required. If you want a proper 'TextShow' instance for @Phantom@, you will need+  to use 'makeShowbPrec' (see the documentation of the @make@ functions for more+  information).++* 'deriveTextShow' lacks the ability to properly detect data types with higher-kinded+   type parameters (e.g., @data HK f a = HK (f a)@) or with kinds other than @*@+   (e.g., @data List a (empty :: Bool)@). If you wish to derive 'TextShow'+   instances for these data types, you will need to use 'makeShowbPrec'.++* Some data constructors have arguments whose 'TextShow' instance depends on a+  typeclass besides 'TextShow'. For example, consider @newtype MyFixed a = MyFixed+  (Fixed a)@. @'Fixed' a@ is a 'TextShow' instance only if @a@ is an instance of both+  @HasResolution@ and 'TextShow'. Unfortunately, 'deriveTextShow' cannot infer that+  'a' must be an instance of 'HasResolution', so it cannot create a 'TextShow'+  instance for @MyFixed@. However, you can use 'makeShowbPrec' to get around this.++-}++-- | Generates a 'TextShow' instance declaration for the given data type or data+-- family instance.+--+-- /Since: 2/+deriveTextShow :: Name -> Q [Dec]+deriveTextShow = deriveTextShowClass TextShow++{- $deriveTextShow1++'deriveTextShow1' automatically generates a 'Show1' instance declaration for a data+type, newtype, or data family instance that has at least one type variable.+This emulates what would (hypothetically) happen if you could attach a @deriving+'TextShow1'@ clause to the end of a data declaration. Examples:++@+&#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;+import TextShow.TH++data Stream a = Stream a (Stream a)+$('deriveTextShow1' ''Stream) -- instance TextShow1 TextStream where ...++newtype WrappedFunctor f a = WrapFunctor (f a)+$('deriveTextShow1' ''WrappedFunctor) -- instance TextShow1 f => TextShow1 (WrappedFunctor f) where ...+@++The same restrictions that apply to 'deriveTextShow' also apply to 'deriveTextShow1',+with some caveats:++* With 'deriveTextShow1', the last type variable must be of kind @*@. For other ones,+  type variables of kind @*@ are assumed to require a 'TextShow' context, and type+  variables of kind @* -> *@ are assumed to require a 'TextShow1' context. For more+  complicated scenarios, use 'makeLiftShowbPrec'.++* If using @-XDatatypeContexts@, a datatype constraint cannot mention the last type+  variable. For example, @data Ord a => Illegal a = Illegal a@ cannot have a derived+  'TextShow1' instance.++* If the last type variable is used within a data field of a constructor, it must only+  be used in the last argument of the data type constructor. For example, @data Legal a+  = Legal (Either Int a)@ can have a derived 'TextShow1' instance, but @data Illegal a+  = Illegal (Either a a)@ cannot.++* Data family instances must be able to eta-reduce the last type variable. In other+  words, if you have a instance of the form:++  @+  data family Family a1 ... an t+  data instance Family e1 ... e2 v = ...+  @++  Then the following conditions must hold:++  1. @v@ must be a type variable.+  2. @v@ must not be mentioned in any of @e1@, ..., @e2@.++-}++-- | Generates a 'TextShow1' instance declaration for the given data type or data+-- family instance.+--+-- /Since: 2/+deriveTextShow1 :: Name -> Q [Dec]+deriveTextShow1 = deriveTextShowClass TextShow1++{- $deriveTextShow2++'deriveTextShow2' automatically generates a 'TextShow2' instance declaration for a data+type, newtype, or data family instance that has at least two type variables.+This emulates what would (hypothetically) happen if you could attach a @deriving+'TextShow2'@ clause to the end of a data declaration. Examples:++@+&#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;+import TextShow.TH++data OneOrNone a b = OneL a | OneR b | None+$('deriveTextShow2' ''OneOrNone) -- instance TextShow2 OneOrNone where ...++newtype WrappedBifunctor f a b = WrapBifunctor (f a b)+$('deriveTextShow2' ''WrappedBifunctor) -- instance TextShow2 f => TextShow2 (WrappedBifunctor f) where ...+@++The same restrictions that apply to 'deriveTextShow' and 'deriveTextShow1' also apply+to 'deriveTextShow2', with some caveats:++* With 'deriveTextShow2', the last type variables must both be of kind @*@. For other+  ones, type variables of kind @*@ are assumed to require a 'TextShow' constraint, type+  variables of kind @* -> *@ are assumed to require a 'TextShow1' constraint, and type+  variables of kind @* -> * -> *@ are assumed to require a 'TextShow2' constraint. For+  more complicated scenarios, use 'makeLiftShowbPrec2'.++* If using @-XDatatypeContexts@, a datatype constraint cannot mention either of the last+  two type variables. For example, @data Ord a => Illegal a b = Illegal a b@ cannot+  have a derived 'TextShow2' instance.++* If either of the last two type variables is used within a data field of a constructor,+  it must only be used in the last two arguments of the data type constructor. For+  example, @data Legal a b = Legal (Int, Int, a, b)@ can have a derived 'TextShow2'+  instance, but @data Illegal a b = Illegal (a, b, a, b)@ cannot.++* Data family instances must be able to eta-reduce the last two type variables. In other+  words, if you have a instance of the form:++  @+  data family Family a1 ... an t1 t2+  data instance Family e1 ... e2 v1 v2 = ...+  @++  Then the following conditions must hold:++  1. @v1@ and @v2@ must be distinct type variables.+  2. Neither @v1@ not @v2@ must be mentioned in any of @e1@, ..., @e2@.++-}++-- | Generates a 'TextShow2' instance declaration for the given data type or data+-- family instance.+--+-- /Since: 2/+deriveTextShow2 :: Name -> Q [Dec]+deriveTextShow2 = deriveTextShowClass TextShow2++{- $make++There may be scenarios in which you want to show an arbitrary data type or data+family instance without having to make the type an instance of 'TextShow'. For these+cases, this modules provides several functions (all prefixed with @make@-) that+splice the appropriate lambda expression into your source code. Example:++This is particularly useful for creating instances for sophisticated data types. For+example, 'deriveTextShow' cannot infer the correct type context for+@newtype HigherKinded f a = HigherKinded (f a)@, since @f@ is of kind @* -> *@.+However, it is still possible to derive a 'TextShow' instance for @HigherKinded@+without too much trouble using 'makeShowbPrec':++@+&#123;-&#35; LANGUAGE FlexibleContexts, TemplateHaskell &#35;-&#125;+import TextShow+import TextShow.TH++instance TextShow (f a) => TextShow (HigherKinded f a) where+    showbPrec = $(makeShowbPrec ''HigherKinded)+@++-}++-- | Generates a lambda expression which behaves like 'showt' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makeShowt :: Name -> Q Exp+makeShowt name = [| toStrict . $(makeShowtl name) |]++-- | Generates a lambda expression which behaves like 'showtl' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makeShowtl :: Name -> Q Exp+makeShowtl name = [| toLazyText . $(makeShowb name) |]++-- | Generates a lambda expression which behaves like 'showtPrec' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makeShowtPrec :: Name -> Q Exp+makeShowtPrec name = [| \p -> toStrict . $(makeShowtlPrec name) p |]++-- | Generates a lambda expression which behaves like 'showtlPrec' (without+-- requiring a 'TextShow' instance).+--+-- /Since: 2/+makeShowtlPrec :: Name -> Q Exp+makeShowtlPrec name = [| \p -> toLazyText . $(makeShowbPrec name) p |]++-- | Generates a lambda expression which behaves like 'showtList' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makeShowtList :: Name -> Q Exp+makeShowtList name = [| toStrict . $(makeShowtlList name) |]++-- | Generates a lambda expression which behaves like 'showtlList' (without+-- requiring a 'TextShow' instance).+--+-- /Since: 2/+makeShowtlList :: Name -> Q Exp+makeShowtlList name = [| toLazyText . $(makeShowbList name) |]++-- | Generates a lambda expression which behaves like 'showb' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makeShowb :: Name -> Q Exp+makeShowb name = makeShowbPrec name `appE` [| zero |]+  where+    -- To prevent the generated TH code from having a type ascription+    zero :: Int+    zero = 0++-- | Generates a lambda expression which behaves like 'showbPrec' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makeShowbPrec :: Name -> Q Exp+makeShowbPrec = makeShowbPrecClass TextShow++-- | Generates a lambda expression which behaves like 'liftShowbPrec' (without+-- requiring a 'TextShow1' instance).+--+-- /Since: 3/+makeLiftShowbPrec :: Name -> Q Exp+makeLiftShowbPrec = makeShowbPrecClass TextShow1++-- | Generates a lambda expression which behaves like 'showbPrec1' (without+-- requiring a 'TextShow1' instance).+--+-- /Since: 2/+makeShowbPrec1 :: Name -> Q Exp+makeShowbPrec1 name = [| $(makeLiftShowbPrec name) showbPrec showbList |]++-- | Generates a lambda expression which behaves like 'liftShowbPrec2' (without+-- requiring a 'TextShow2' instance).+--+-- /Since: 3/+makeLiftShowbPrec2 :: Name -> Q Exp+makeLiftShowbPrec2 = makeShowbPrecClass TextShow2++-- | Generates a lambda expression which behaves like 'showbPrec2' (without+-- requiring a 'TextShow2' instance).+--+-- /Since: 2/+makeShowbPrec2 :: Name -> Q Exp+makeShowbPrec2 name = [| $(makeLiftShowbPrec2 name) showbPrec showbList showbPrec showbList |]++-- | Generates a lambda expression which behaves like 'showbList' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makeShowbList :: Name -> Q Exp+makeShowbList name = [| showbListWith $(makeShowb name) |]++-- | Generates a lambda expression which behaves like 'printT' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makePrintT :: Name -> Q Exp+makePrintT name = [| TS.putStrLn . $(makeShowt name) |]++-- | Generates a lambda expression which behaves like 'printTL' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makePrintTL :: Name -> Q Exp+makePrintTL name = [| TL.putStrLn . $(makeShowtl name) |]++-- | Generates a lambda expression which behaves like 'hPrintT' (without requiring a+-- 'TextShow' instance).+--+-- /Since: 2/+makeHPrintT :: Name -> Q Exp+makeHPrintT name = [| \h -> TS.hPutStrLn h . $(makeShowt name) |]++-- | Generates a lambda expression which behaves like 'hPrintTL' (without+-- requiring a 'TextShow' instance).+--+-- /Since: 2/+makeHPrintTL :: Name -> Q Exp+makeHPrintTL name = [| \h -> TL.hPutStrLn h . $(makeShowtl name) |]++-------------------------------------------------------------------------------+-- Code generation+-------------------------------------------------------------------------------++-- | Derive a TextShow(1)(2) instance declaration (depending on the TextShowClass+-- argument's value).+deriveTextShowClass :: TextShowClass -> Name -> Q [Dec]+deriveTextShowClass tsClass name = withType name fromCons+  where+    fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q [Dec]+    fromCons name' ctxt tvbs cons mbTys = (:[]) <$> do+        (instanceCxt, instanceType)+            <- buildTypeInstance tsClass name' ctxt tvbs mbTys+        instanceD (return instanceCxt)+                  (return instanceType)+                  (showbPrecDecs tsClass cons)++-- | Generates a declaration defining the primary function corresponding to a+-- particular class (showbPrec for TextShow, liftShowbPrec for TextShow1, and+-- liftShowbPrec2 for TextShow2).+showbPrecDecs :: TextShowClass -> [Con] -> [Q Dec]+showbPrecDecs tsClass cons =+    [ funD (showbPrecName tsClass)+           [ clause []+                    (normalB $ makeTextShowForCons tsClass cons)+                    []+           ]+    ]++-- | Generates a lambda expression which behaves like showbPrec (for TextShow),+-- liftShowbPrec (for TextShow1), or liftShowbPrec2 (for TextShow2).+makeShowbPrecClass :: TextShowClass -> Name -> Q Exp+makeShowbPrecClass tsClass name = withType name fromCons+  where+    fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q Exp+    fromCons name' ctxt tvbs cons mbTys =+        -- We force buildTypeInstance here since it performs some checks for whether+        -- or not the provided datatype can actually have showbPrec/liftShowbPrec/etc.+        -- implemented for it, and produces errors if it can't.+        buildTypeInstance tsClass name' ctxt tvbs mbTys+          `seq` makeTextShowForCons tsClass cons++-- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for the+-- given constructors. All constructors must be from the same type.+makeTextShowForCons :: TextShowClass -> [Con] -> Q Exp+makeTextShowForCons _ [] = error "Must have at least one data constructor"+makeTextShowForCons tsClass cons = do+    p       <- newName "p"+    value   <- newName "value"+    sps     <- newNameList "sp" $ fromEnum tsClass+    sls     <- newNameList "sl" $ fromEnum tsClass+    let spls      = zip sps sls+        spsAndSls = interleave sps sls+    matches <- concatMapM (makeTextShowForCon p tsClass spls) cons+    lamE (map varP $ spsAndSls ++ [p, value])+        . appsE+        $ [ varE $ showbPrecConstName tsClass+          , caseE (varE value) (map return matches)+          ] ++ map varE spsAndSls+            ++ [varE p, varE value]++-- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a+-- single constructor.+makeTextShowForCon :: Name -> TextShowClass -> [(Name, Name)] -> Con -> Q [Match]+makeTextShowForCon _ _ _ (NormalC conName []) = do+    m <- match+           (conP conName [])+           (normalB [| fromString $(stringE (parenInfixConName conName "")) |])+           []+    return [m]+makeTextShowForCon p tsClass spls (NormalC conName [_]) = do+    ([argTy], tvMap) <- reifyConTys tsClass spls conName+    arg <- newName "arg"++    let showArg  = makeTextShowForArg appPrec1 tsClass conName tvMap argTy arg+        namedArg = [| fromString $(stringE (parenInfixConName conName " ")) <> $(showArg) |]++    m <- match+           (conP conName [varP arg])+           (normalB [| showbParen ($(varE p) > $(lift appPrec)) $(namedArg) |])+           []+    return [m]+makeTextShowForCon p tsClass spls (NormalC conName _) = do+    (argTys, tvMap) <- reifyConTys tsClass spls conName+    args <- newNameList "arg" $ length argTys++    m <- if isNonUnitTuple conName+         then do+           let showArgs       = zipWith (makeTextShowForArg 0 tsClass conName tvMap) argTys args+               parenCommaArgs = [| singleton '(' |] : intersperse [| singleton ',' |] showArgs+               mappendArgs    = foldr (`infixApp` [| (<>) |])+                                      [| singleton ')' |]+                                      parenCommaArgs++           match (conP conName $ map varP args)+                 (normalB mappendArgs)+                 []+         else do+           let showArgs    = zipWith (makeTextShowForArg appPrec1 tsClass conName tvMap) argTys args+               mappendArgs = foldr1 (\v q -> [| $(v) <> showbSpace <> $(q) |]) showArgs+               namedArgs   = [| fromString $(stringE (parenInfixConName conName " ")) <> $(mappendArgs) |]++           match (conP conName $ map varP args)+                 (normalB [| showbParen ($(varE p) > $(lift appPrec)) $(namedArgs) |])+                 []+    return [m]+makeTextShowForCon p tsClass spls (RecC conName []) =+    makeTextShowForCon p tsClass spls $ NormalC conName []+makeTextShowForCon _p tsClass spls (RecC conName ts) = do+    (argTys, tvMap) <- reifyConTys tsClass spls conName+    args <- newNameList "arg" $ length argTys++    let showArgs       = concatMap (\((argName, _, _), argTy, arg)+                                      -> [ [| fromString $(stringE (nameBase argName ++ " = ")) |]+                                         , makeTextShowForArg 0 tsClass conName tvMap argTy arg+                                         , [| fromString ", " |]+                                         ]+                                   )+                                   (zip3 ts argTys args)+        braceCommaArgs = [| singleton '{' |] : take (length showArgs - 1) showArgs+        mappendArgs    = foldr (`infixApp` [| (<>) |])+                           [| singleton '}' |]+                           braceCommaArgs+        namedArgs      = [| fromString $(stringE (parenInfixConName conName " ")) <> $(mappendArgs) |]++    m <- match+           (conP conName $ map varP args)+           (normalB+#if __GLASGOW_HASKELL__ >= 711+                     namedArgs+#else+                     [| showbParen ($(varE _p) > $(lift appPrec)) $(namedArgs) |]+#endif+           )+           []+    return [m]+makeTextShowForCon p tsClass spls (InfixC _ conName _) = do+    ([alTy, arTy], tvMap) <- reifyConTys tsClass spls conName+    al   <- newName "argL"+    ar   <- newName "argR"+    info <- reify conName++#if __GLASGOW_HASKELL__ >= 711+    conPrec <- case info of+                        DataConI{} -> do+                            fi <- fromMaybe defaultFixity <$> reifyFixity conName+                            case fi of+                                 Fixity prec _ -> return prec+#else+    let conPrec  = case info of+                        DataConI _ _ _ (Fixity prec _) -> prec+#endif+                        _ -> error $ "TextShow.TH.makeTextShowForCon: Unsupported type: " ++ show info++    let opName   = nameBase conName+        infixOpE = if isInfixTypeCon opName+                      then [| fromString $(stringE $ " "  ++ opName ++ " " ) |]+                      else [| fromString $(stringE $ " `" ++ opName ++ "` ") |]++    m <- match+           (infixP (varP al) conName (varP ar))+           (normalB $ appE [| showbParen ($(varE p) > conPrec) |]+                           [| $(makeTextShowForArg (conPrec + 1) tsClass conName tvMap alTy al)+                           <> $(infixOpE)+                           <> $(makeTextShowForArg (conPrec + 1) tsClass conName tvMap arTy ar)+                           |]+           )+           []+    return [m]+makeTextShowForCon p tsClass spls (ForallC _ _ con) =+    makeTextShowForCon p tsClass spls con+#if MIN_VERSION_template_haskell(2,11,0)+makeTextShowForCon p tsClass spls (GadtC conNames ts _) =+    let con :: Name -> Q Con+        con conName = do+            mbFi <- reifyFixity conName+            return $ if startsConSym (head $ nameBase conName)+                        && length ts == 2+                        && isJust mbFi+                      then let [t1, t2] = ts in InfixC t1 conName t2+                      else NormalC conName ts++    in concatMapM (makeTextShowForCon p tsClass spls <=< con) conNames+makeTextShowForCon p tsClass spls (RecGadtC conNames ts _) =+    concatMapM (makeTextShowForCon p tsClass spls . flip RecC ts) conNames+#endif++-- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for an+-- argument of a constructor.+makeTextShowForArg :: Int+                   -> TextShowClass+                   -> Name+                   -> TyVarMap+                   -> Type+                   -> Name+                   -> Q Exp+makeTextShowForArg p _ _ _ (ConT tyName) tyExpName =+#if __GLASGOW_HASKELL__ >= 711+-- 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.+    showE+  where+    tyVarE :: Q Exp+    tyVarE = varE tyExpName++    showE :: Q Exp+    showE | tyName == ''Char#   = [| showbPrec 0 (C# $(tyVarE)) <> singleton '#'   |]+          | tyName == ''Double# = [| showbPrec 0 (D# $(tyVarE)) <> fromString "##" |]+          | tyName == ''Float#  = [| showbPrec 0 (F# $(tyVarE)) <> singleton '#'   |]+          | tyName == ''Int#    = [| showbPrec 0 (I# $(tyVarE)) <> singleton '#'   |]+          | tyName == ''Word#   = [| showbPrec 0 (W# $(tyVarE)) <> fromString "##" |]+          | otherwise = [| showbPrec p $(tyVarE) |]+#else+    [| showbPrec p $(expr) |]+  where+    tyVarE :: Q Exp+    tyVarE = varE tyExpName++    expr :: Q Exp+    expr | tyName == ''Char#   = [| C# $(tyVarE) |]+         | tyName == ''Double# = [| D# $(tyVarE) |]+         | tyName == ''Float#  = [| F# $(tyVarE) |]+         | tyName == ''Int#    = [| I# $(tyVarE) |]+         | tyName == ''Word#   = [| W# $(tyVarE) |]+         | otherwise = tyVarE+#endif+makeTextShowForArg p tsClass conName tvMap ty tyExpName =+    [| $(makeTextShowForType tsClass conName tvMap False ty) p $(varE tyExpName) |]++-- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a+-- specific type. The generated expression depends on the number of type variables.+--+-- 1. If the type is of kind * (T), apply showbPrec.+-- 2. If the type is of kind * -> * (T a), apply liftShowbPrec $(makeTextShowForType a)+-- 3. If the type is of kind * -> * -> * (T a b), apply+--    liftShowbPrec2 $(makeTextShowForType a) $(makeTextShowForType b)+makeTextShowForType :: TextShowClass+                    -> Name+                    -> TyVarMap+                    -> Bool -- ^ True if we are using the function of type ([a] -> Builder),+                            --   False if we are using the function of type (Int -> a -> Builder).+                    -> Type+                    -> Q Exp+makeTextShowForType _ _ tvMap sl (VarT tyName) =+    case Map.lookup tyName tvMap of+         Just (spExp, slExp) -> varE (if sl then slExp else spExp)+         Nothing             -> if sl then [| showbList |] else [| showbPrec |]+makeTextShowForType tsClass conName tvMap sl (SigT ty _)      = makeTextShowForType tsClass conName tvMap sl ty+makeTextShowForType tsClass conName tvMap sl (ForallT _ _ ty) = makeTextShowForType tsClass conName tvMap sl ty+makeTextShowForType tsClass conName tvMap sl ty = do+    let tyCon :: Type+        tyArgs :: [Type]+        tyCon :| tyArgs = unapplyTy ty++        numLastArgs :: Int+        numLastArgs = min (fromEnum tsClass) (length tyArgs)++        lhsArgs, rhsArgs :: [Type]+        (lhsArgs, rhsArgs) = splitAt (length tyArgs - numLastArgs) tyArgs++        tyVarNames :: [Name]+        tyVarNames = Map.keys tvMap++    itf <- isTyFamily tyCon+    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)++-------------------------------------------------------------------------------+-- Template Haskell reifying and AST manipulation+-------------------------------------------------------------------------------++-- | Extracts a plain type constructor's information.+-- | Boilerplate for top level splices.+--+-- The given Name must meet one of two criteria:+--+-- 1. It must be the name of a type constructor of a plain data type or newtype.+-- 2. It must be the name of a data family instance or newtype instance constructor.+--+-- Any other value will result in an exception.+withType :: Name+         -> (Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q a)+         -> Q a+withType name f = do+  info <- reify name+  case info of+    TyConI dec ->+      case dec of+        DataD ctxt _ tvbs+#if MIN_VERSION_template_haskell(2,11,0)+              _+#endif+              cons _ -> f name ctxt tvbs cons Nothing+        NewtypeD ctxt _ tvbs+#if MIN_VERSION_template_haskell(2,11,0)+                 _+#endif+                 con _ -> f name ctxt tvbs [con] Nothing+        _ -> error $ ns ++ "Unsupported type: " ++ show dec+#if MIN_VERSION_template_haskell(2,7,0)+# if MIN_VERSION_template_haskell(2,11,0)+    DataConI _ _ parentName   -> do+# else+    DataConI _ _ parentName _ -> do+# endif+      parentInfo <- reify parentName+      case parentInfo of+# if MIN_VERSION_template_haskell(2,11,0)+        FamilyI (DataFamilyD _ tvbs _) decs ->+# else+        FamilyI (FamilyD DataFam _ tvbs _) decs ->+# endif+          let instDec = flip find decs $ \dec -> case dec of+                DataInstD _ _ _+# if MIN_VERSION_template_haskell(2,11,0)+                          _+# endif+                          cons _ -> any ((name ==) . constructorName) cons+                NewtypeInstD _ _ _+# if MIN_VERSION_template_haskell(2,11,0)+                             _+# endif+                             con _ -> name == constructorName con+                _ -> error $ ns ++ "Must be a data or newtype instance."+           in case instDec of+                Just (DataInstD ctxt _ instTys+# if MIN_VERSION_template_haskell(2,11,0)+                                _+# endif+                                cons _)+                  -> f parentName ctxt tvbs cons $ Just instTys+                Just (NewtypeInstD ctxt _ instTys+# if MIN_VERSION_template_haskell(2,11,0)+                                   _+# endif+                                   con _)+                  -> f parentName ctxt tvbs [con] $ Just instTys+                _ -> error $ ns +++                  "Could not find data or newtype instance constructor."+        _ -> error $ ns ++ "Data constructor " ++ show name +++          " is not from a data family instance constructor."+# if MIN_VERSION_template_haskell(2,11,0)+    FamilyI DataFamilyD{} _ ->+# else+    FamilyI (FamilyD DataFam _ _ _) _ ->+# endif+      error $ ns +++        "Cannot use a data family name. Use a data family instance constructor instead."+    _ -> error $ ns ++ "The name must be of a plain data type constructor, "+                    ++ "or a data family instance constructor."+#else+    DataConI{} -> dataConIError+    _          -> error $ ns ++ "The name must be of a plain type constructor."+#endif+  where+    ns :: String+    ns = "TextShow.TH.withType: "++-- | Deduces the instance context and head for an instance.+buildTypeInstance :: TextShowClass+                  -- ^ TextShow, TextShow1, or TextShow2+                  -> Name+                  -- ^ The type constructor or data family name+                  -> Cxt+                  -- ^ The datatype context+                  -> [TyVarBndr]+                  -- ^ The type variables from the data type/data family declaration+                  -> Maybe [Type]+                  -- ^ 'Just' the types used to instantiate a data family instance,+                  -- or 'Nothing' if it's a plain data type+                  -> Q (Cxt, Type)+-- Plain data type/newtype case+buildTypeInstance tsClass tyConName dataCxt tvbs Nothing =+    let varTys :: [Type]+        varTys = map tvbToType tvbs+    in buildTypeInstanceFromTys tsClass tyConName dataCxt varTys False+-- Data family instance case+--+-- The CPP is present to work around a couple of annoying old GHC bugs.+-- See Note [Polykinded data families in Template Haskell]+buildTypeInstance tsClass parentName dataCxt tvbs (Just instTysAndKinds) = do+#if !(MIN_VERSION_template_haskell(2,8,0)) || MIN_VERSION_template_haskell(2,10,0)+    let instTys :: [Type]+        instTys = zipWith stealKindForType tvbs instTysAndKinds+#else+    let kindVarNames :: [Name]+        kindVarNames = nub $ concatMap (tyVarNamesOfType . tvbKind) tvbs++        numKindVars :: Int+        numKindVars = length kindVarNames++        givenKinds, givenKinds' :: [Kind]+        givenTys                :: [Type]+        (givenKinds, givenTys) = splitAt numKindVars instTysAndKinds+        givenKinds' = map sanitizeStars givenKinds++        -- A GHC 7.6-specific bug requires us to replace all occurrences of+        -- (ConT GHC.Prim.*) with StarT, or else Template Haskell will reject it.+        -- Luckily, (ConT GHC.Prim.*) only seems to occur in this one spot.+        sanitizeStars :: Kind -> Kind+        sanitizeStars = go+          where+            go :: Kind -> Kind+            go (AppT t1 t2)                 = AppT (go t1) (go t2)+            go (SigT t k)                   = SigT (go t) (go k)+            go (ConT n) | n == starKindName = StarT+            go t                            = t++            -- It's quite awkward to import * from GHC.Prim, so we'll just+            -- hack our way around it.+            starKindName :: Name+            starKindName = mkNameG_tc "ghc-prim" "GHC.Prim" "*"++    -- If we run this code with GHC 7.8, we might have to generate extra type+    -- variables to compensate for any type variables that Template Haskell+    -- eta-reduced away.+    -- See Note [Polykinded data families in Template Haskell]+    xTypeNames <- newNameList "tExtra" (length tvbs - length givenTys)++    let xTys   :: [Type]+        xTys = map VarT xTypeNames+        -- ^ Because these type variables were eta-reduced away, we can only+        --   determine their kind by using stealKindForType. Therefore, we mark+        --   them as VarT to ensure they will be given an explicit kind annotation+        --   (and so the kind inference machinery has the right information).++        substNamesWithKinds :: [(Name, Kind)] -> Type -> Type+        substNamesWithKinds nks t = foldr' (uncurry substNameWithKind) t nks++        -- The types from the data family instance might not have explicit kind+        -- annotations, which the kind machinery needs to work correctly. To+        -- compensate, we use stealKindForType to explicitly annotate any+        -- types without kind annotations.+        instTys :: [Type]+        instTys = map (substNamesWithKinds (zip kindVarNames givenKinds'))+                  -- ^ Note that due to a GHC 7.8-specific bug+                  --   (see Note [Polykinded data families in Template Haskell]),+                  --   there may be more kind variable names than there are kinds+                  --   to substitute. But this is OK! If a kind is eta-reduced, it+                  --   means that is was not instantiated to something more specific,+                  --   so we need not substitute it. Using stealKindForType will+                  --   grab the correct kind.+                $ zipWith stealKindForType tvbs (givenTys ++ xTys)+#endif+    buildTypeInstanceFromTys tsClass parentName dataCxt instTys True++-- For the given Types, generate an instance context and head. Coming up with+-- the instance type isn't as simple as dropping the last types, as you need to+-- be wary of kinds being instantiated with *.+-- See Note [Type inference in derived instances]+buildTypeInstanceFromTys :: TextShowClass+                         -- ^ TextShow, TextShow1, or TextShow2+                         -> Name+                         -- ^ The type constructor or data family name+                         -> Cxt+                         -- ^ The datatype context+                         -> [Type]+                         -- ^ The types to instantiate the instance with+                         -> Bool+                         -- ^ True if it's a data family, False otherwise+                         -> Q (Cxt, Type)+buildTypeInstanceFromTys tsClass tyConName dataCxt varTysOrig isDataFamily = do+    -- Make sure to expand through type/kind synonyms! Otherwise, the+    -- eta-reduction check might get tripped up over type variables in a+    -- synonym that are actually dropped.+    -- (See GHC Trac #11416 for a scenario where this actually happened.)+    varTysExp <- mapM expandSyn varTysOrig++    let remainingLength :: Int+        remainingLength = length varTysOrig - fromEnum tsClass++        droppedTysExp :: [Type]+        droppedTysExp = drop remainingLength varTysExp++        droppedStarKindStati :: [StarKindStatus]+        droppedStarKindStati = map canRealizeKindStar droppedTysExp++    -- Check there are enough types to drop and that all of them are either of+    -- kind * or kind k (for some kind variable k). If not, throw an error.+    when (remainingLength < 0 || any (== NotKindStar) droppedStarKindStati) $+      derivingKindError tsClass tyConName++    let droppedKindVarNames :: [Name]+        droppedKindVarNames = catKindVarNames droppedStarKindStati++        -- Substitute kind * for any dropped kind variables+        varTysExpSubst :: [Type]+        varTysExpSubst = map (substNamesWithKindStar droppedKindVarNames) varTysExp++        remainingTysExpSubst, droppedTysExpSubst :: [Type]+        (remainingTysExpSubst, droppedTysExpSubst) =+          splitAt remainingLength varTysExpSubst++        -- All of the type variables mentioned in the dropped types+        -- (post-synonym expansion)+        droppedTyVarNames :: [Name]+        droppedTyVarNames = concatMap tyVarNamesOfType droppedTysExpSubst++    -- If any of the dropped types were polykinded, ensure that there are of kind+    -- * after substituting * for the dropped kind variables. If not, throw an error.+    unless (all hasKindStar droppedTysExpSubst) $+      derivingKindError tsClass tyConName++    let preds    :: [Maybe Pred]+        kvNames  :: [[Name]]+        kvNames' :: [Name]+        -- Derive instance constraints (and any kind variables which are specialized+        -- to * in those constraints)+        (preds, kvNames) = unzip $ map (deriveConstraint tsClass) remainingTysExpSubst+        kvNames' = concat kvNames++        -- Substitute the kind variables specialized in the constraints with *+        remainingTysExpSubst' :: [Type]+        remainingTysExpSubst' =+          map (substNamesWithKindStar kvNames') remainingTysExpSubst++        -- We now substitute all of the specialized-to-* kind variable names with+        -- *, but in the original types, not the synonym-expanded types. The reason+        -- we do this is a superficial one: we want the derived instance to resemble+        -- the datatype written in source code as closely as possible. For example,+        -- for the following data family instance:+        --+        --   data family Fam a+        --   newtype instance Fam String = Fam String+        --+        -- We'd want to generate the instance:+        --+        --   instance C (Fam String)+        --+        -- Not:+        --+        --   instance C (Fam [Char])+        remainingTysOrigSubst :: [Type]+        remainingTysOrigSubst =+          map (substNamesWithKindStar (union droppedKindVarNames kvNames'))+            $ take remainingLength varTysOrig++        remainingTysOrigSubst' :: [Type]+        -- See Note [Kind signatures in derived instances] for an explanation+        -- of the isDataFamily check.+        remainingTysOrigSubst' =+          if isDataFamily+             then remainingTysOrigSubst+             else map unSigT remainingTysOrigSubst++        instanceCxt :: Cxt+        instanceCxt = catMaybes preds++        instanceType :: Type+        instanceType = AppT (ConT $ textShowClassName tsClass)+                     $ applyTyCon tyConName remainingTysOrigSubst'++    -- If the datatype context mentions any of the dropped type variables,+    -- we can't derive an instance, so throw an error.+    when (any (`predMentionsName` droppedTyVarNames) dataCxt) $+      datatypeContextError tyConName instanceType+    -- Also ensure the dropped types can be safely eta-reduced. Otherwise,+    -- throw an error.+    unless (canEtaReduce remainingTysExpSubst' droppedTysExpSubst) $+      etaReductionError instanceType+    return (instanceCxt, instanceType)++-- | Attempt to derive a constraint on a Type. If successful, return+-- Just the constraint and any kind variable names constrained to *.+-- Otherwise, return Nothing and the empty list.+--+-- See Note [Type inference in derived instances] for the heuristics used to+-- come up with constraints.+deriveConstraint :: TextShowClass -> Type -> (Maybe Pred, [Name])+deriveConstraint tsClass t+  | not (isTyVar t) = (Nothing, [])+  | hasKindStar t   = (Just (applyClass ''TextShow tName), [])+  | otherwise = case hasKindVarChain 1 t of+      Just ns | tsClass >= TextShow1+              -> (Just (applyClass ''TextShow1 tName), ns)+      _ -> case hasKindVarChain 2 t of+           Just ns | tsClass == TextShow2+                   -> (Just (applyClass ''TextShow2 tName), ns)+           _ -> (Nothing, [])+  where+    tName :: Name+    tName = varTToName t++{-+Note [Polykinded data families in Template Haskell]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++In order to come up with the correct instance context and head for an instance, e.g.,++  instance C a => C (Data a) where ...++We need to know the exact types and kinds used to instantiate the instance. For+plain old datatypes, this is simple: every type must be a type variable, and+Template Haskell reliably tells us the type variables and their kinds.++Doing the same for data families proves to be much harder for three reasons:++1. On any version of Template Haskell, it may not tell you what an instantiated+   type's kind is. For instance, in the following data family instance:++     data family Fam (f :: * -> *) (a :: *)+     data instance Fam f a++   Then if we use TH's reify function, it would tell us the TyVarBndrs of the+   data family declaration are:++     [KindedTV f (AppT (AppT ArrowT StarT) StarT),KindedTV a StarT]++   and the instantiated types of the data family instance are:++     [VarT f1,VarT a1]++   We can't just pass [VarT f1,VarT a1] to buildTypeInstanceFromTys, since we+   have no way of knowing their kinds. Luckily, the TyVarBndrs tell us what the+   kind is in case an instantiated type isn't a SigT, so we use the stealKindForType+   function to ensure all of the instantiated types are SigTs before passing them+   to buildTypeInstanceFromTys.+2. On GHC 7.6 and 7.8, a bug is present in which Template Haskell lists all of+   the specified kinds of a data family instance efore any of the instantiated+   types. Fortunately, this is easy to deal with: you simply count the number of+   distinct kind variables in the data family declaration, take that many elements+   from the front of the  Types list of the data family instance, substitute the+   kind variables with their respective instantiated kinds (which you took earlier),+   and proceed as normal.+3. On GHC 7.8, an even uglier bug is present (GHC Trac #9692) in which Template+   Haskell might not even list all of the Types of a data family instance, since+   they are eta-reduced away! And yes, kinds can be eta-reduced too.++   The simplest workaround is to count how many instantiated types are missing from+   the list and generate extra type variables to use in their place. Luckily, we+   needn't worry much if its kind was eta-reduced away, since using stealKindForType+   will get it back.++Note [Kind signatures in derived instances]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++It is possible to put explicit kind signatures into the derived instances, e.g.,++  instance C a => C (Data (f :: * -> *)) where ...++But it is preferable to avoid this if possible. If we come up with an incorrect+kind signature (which is entirely possible, since our type inferencer is pretty+unsophisticated - see Note [Type inference in derived instances]), then GHC will+flat-out reject the instance, which is quite unfortunate.++Plain old datatypes have the advantage that you can avoid using any kind signatures+at all in their instances. This is because a datatype declaration uses all type+variables, so the types that we use in a derived instance uniquely determine their+kinds. As long as we plug in the right types, the kind inferencer can do the rest+of the work. For this reason, we use unSigT to remove all kind signatures before+splicing in the instance context and head.++Data family instances are trickier, since a data family can have two instances that+are distinguished by kind alone, e.g.,++  data family Fam (a :: k)+  data instance Fam (a :: * -> *)+  data instance Fam (a :: *)++If we dropped the kind signatures for C (Fam a), then GHC will have no way of+knowing which instance we are talking about. To avoid this scenario, we always+include explicit kind signatures in data family instances. There is a chance that+the inferred kind signatures will be incorrect, but if so, we can always fall back+on the make- functions.++Note [Type inference in derived instances]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Type inference is can be tricky to get right, and we want to avoid recreating the+entirety of GHC's type inferencer in Template Haskell. For this reason, we will+probably never come up with derived instance contexts that are as accurate as+GHC's. But that doesn't mean we can't do anything! There are a couple of simple+things we can do to make instance contexts that work for 80% of use cases:++1. If one of the last type parameters is polykinded, then its kind will be+   specialized to * in the derived instance. We note what kind variable the type+   parameter had and substitute it with * in the other types as well. For example,+   imagine you had++     data Data (a :: k) (b :: k)++   Then you'd want to derived instance to be:++     instance C (Data (a :: *))++   Not:++     instance C (Data (a :: k))++2. We naïvely come up with instance constraints using the following criteria:++   (i)   If there's a type parameter n of kind *, generate a TextShow n constraint.+   (ii)  If there's a type parameter n of kind k1 -> k2 (where k1/k2 are * or kind+         variables), then generate a TextShow1 n constraint, and if k1/k2 are kind+         variables, then substitute k1/k2 with * elsewhere in the types. We must+         consider the case where they are kind variables because you might have a+         scenario like this:++           newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1)+             = Compose (f (g a))++         Which would have a derived TextShow1 instance of:++           instance (TextShow1 f, TextShow1 g) => TextShow1 (Compose f g) where ...+   (iii) If there's a type parameter n of kind k1 -> k2 -> k3 (where k1/k2/k3 are+         * or kind variables), then generate a TextShow2 constraint and perform+         kind substitution as in the other cases.+-}++-------------------------------------------------------------------------------+-- Error messages+-------------------------------------------------------------------------------++-- | Either the given data type doesn't have enough type variables, or one of+-- the type variables to be eta-reduced cannot realize kind *.+derivingKindError :: TextShowClass -> Name -> a+derivingKindError tsClass tyConName = error+    . showString "Cannot derive well-kinded instance of form ‘"+    . showString className+    . showChar ' '+    . showParen True+      ( showString (nameBase tyConName)+      . showString " ..."+      )+    . showString "‘\n\tClass "+    . showString className+    . showString " expects an argument of kind "+    . showString (pprint . createKindChain $ fromEnum tsClass)+    $ ""+  where+    className :: String+    className = nameBase $ textShowClassName tsClass++-- | One of the last type variables cannot be eta-reduced (see the canEtaReduce+-- function for the criteria it would have to meet).+etaReductionError :: Type -> a+etaReductionError instanceType = error $+    "Cannot eta-reduce to an instance of form \n\tinstance (...) => "+    ++ pprint instanceType++-- | The data type has a DatatypeContext which mentions one of the eta-reduced+-- type variables.+datatypeContextError :: Name -> Type -> a+datatypeContextError dataName instanceType = error+    . showString "Can't make a derived instance of ‘"+    . showString (pprint instanceType)+    . showString "‘:\n\tData type ‘"+    . showString (nameBase dataName)+    . showString "‘ must not have a class context involving the last type argument(s)"+    $ ""++-- | The data type mentions one of the n eta-reduced type variables in a place other+-- than the last nth positions of a data type in a constructor's field.+outOfPlaceTyVarError :: TextShowClass -> Name -> a+outOfPlaceTyVarError tsClass conName = error+    . showString "Constructor ‘"+    . showString (nameBase conName)+    . showString "‘ must only use its last "+    . shows n+    . showString " type variable(s) within the last "+    . shows n+    . showString " argument(s) of a data type"+    $ ""+  where+    n :: Int+    n = fromEnum tsClass++#if !(MIN_VERSION_template_haskell(2,7,0))+-- | Template Haskell didn't list all of a data family's instances upon reification+-- until template-haskell-2.7.0.0, which is necessary for a derived TextShow(1)(2)+-- instance to work.+dataConIError :: a+dataConIError = error+    . showString "Cannot use a data constructor."+    . showString "\n\t(Note: if you are trying to derive TextShow for a"+    . showString "\n\ttype family, use GHC >= 7.4 instead.)"+    $ ""+#endif++-------------------------------------------------------------------------------+-- Expanding type synonyms+-------------------------------------------------------------------------------++-- | Expands all type synonyms in a type. Written by Dan Rosén in the+-- @genifunctors@ package (licensed under BSD3).+expandSyn :: Type -> Q Type+expandSyn (ForallT tvs ctx t) = fmap (ForallT tvs ctx) $ expandSyn t+expandSyn t@AppT{}            = expandSynApp t []+expandSyn t@ConT{}            = expandSynApp t []+expandSyn (SigT t k)          = do t' <- expandSyn t+                                   k' <- expandSynKind k+                                   return (SigT t' k')+expandSyn t                   = return t++expandSynKind :: Kind -> Q Kind+#if MIN_VERSION_template_haskell(2,8,0)+expandSynKind = expandSyn+#else+expandSynKind = return -- There are no kind synonyms to deal with+#endif++expandSynApp :: Type -> [Type] -> Q Type+expandSynApp (AppT t1 t2) ts = do+    t2' <- expandSyn t2+    expandSynApp t1 (t2':ts)+expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl' AppT ListT ts+expandSynApp t@(ConT n) ts = do+    info <- reify n+    case info of+        TyConI (TySynD _ tvs rhs) ->+            let (ts', ts'') = splitAt (length tvs) ts+                subs = mkSubst tvs ts'+                rhs' = substType subs rhs+             in expandSynApp rhs' ts''+        _ -> return $ foldl' AppT t ts+expandSynApp t ts = do+    t' <- expandSyn t+    return $ foldl' AppT t' ts++type TypeSubst = Map Name Type+type KindSubst = Map Name Kind++mkSubst :: [TyVarBndr] -> [Type] -> TypeSubst+mkSubst vs ts =+   let vs' = map un vs+       un (PlainTV v)    = v+       un (KindedTV v _) = v+   in Map.fromList $ zip vs' ts++substType :: TypeSubst -> Type -> Type+substType subs (ForallT v c t) = ForallT v c $ substType subs t+substType subs t@(VarT n)      = Map.findWithDefault t n subs+substType subs (AppT t1 t2)    = AppT (substType subs t1) (substType subs t2)+substType subs (SigT t k)      = SigT (substType subs t)+#if MIN_VERSION_template_haskell(2,8,0)+                                      (substType subs k)+#else+                                      k+#endif+substType _ t                  = t++substKind :: KindSubst -> Type -> Type+#if MIN_VERSION_template_haskell(2,8,0)+substKind = substType+#else+substKind _ = id -- There are no kind variables!+#endif++substNameWithKind :: Name -> Kind -> Type -> Type+substNameWithKind n k = substKind (Map.singleton n k)++substNamesWithKindStar :: [Name] -> Type -> Type+substNamesWithKindStar ns t = foldr' (flip substNameWithKind starK) t ns++-------------------------------------------------------------------------------+-- Class-specific constants+-------------------------------------------------------------------------------++-- | A representation of which TextShow variant is being derived.+data TextShowClass = TextShow | TextShow1 | TextShow2+  deriving (Enum, Eq, Ord)++showbPrecConstName :: TextShowClass -> Name+showbPrecConstName TextShow  = 'showbPrecConst+showbPrecConstName TextShow1 = 'liftShowbPrecConst+showbPrecConstName TextShow2 = 'liftShowbPrec2Const++textShowClassName :: TextShowClass -> Name+textShowClassName TextShow  = ''TextShow+textShowClassName TextShow1 = ''TextShow1+textShowClassName TextShow2 = ''TextShow2++showbPrecName :: TextShowClass -> Name+showbPrecName TextShow  = 'showbPrec+showbPrecName TextShow1 = 'liftShowbPrec+showbPrecName TextShow2 = 'liftShowbPrec2++showbListName :: TextShowClass -> Name+showbListName TextShow  = 'showbList+showbListName TextShow1 = 'liftShowbList+showbListName TextShow2 = 'liftShowbList2++showbPrecOrListName :: Bool -- ^ showbListName if True, showbPrecName if False+                    -> TextShowClass+                    -> Name+showbPrecOrListName False  = showbPrecName+showbPrecOrListName True = showbListName++-- | A type-restricted version of 'const'. This is useful when generating the lambda+-- expression in 'makeShowbPrec' for a data type with only nullary constructors (since+-- the expression wouldn't depend on the precedence). For example, if you had @data+-- Nullary = Nullary@ and attempted to run @$(makeShowbPrec ''Nullary) Nullary@, simply+-- ignoring the precedence argument would cause the type signature of @$(makeShowbPrec+-- ''Nullary)@ to be @a -> Nullary -> Builder@, not @Int -> Nullary -> Builder@.+showbPrecConst :: Builder+               -> Int -> a -> Builder+showbPrecConst b _ _ = b++liftShowbPrecConst :: Builder+                   -> (Int -> a -> Builder) -> ([a] -> Builder)+                   -> Int -> f a -> Builder+liftShowbPrecConst b _ _ _ _ = b++liftShowbPrec2Const :: Builder+                    -> (Int -> a -> Builder) -> ([a] -> Builder)+                    -> (Int -> b -> Builder) -> ([b] -> Builder)+                    -> Int -> f a b -> Builder+liftShowbPrec2Const b _ _ _ _ _ _ = b++-------------------------------------------------------------------------------+-- StarKindStatus+-------------------------------------------------------------------------------++-- | Whether a type is not of kind *, is of kind *, or is a kind variable.+data StarKindStatus = NotKindStar+                    | KindStar+                    | IsKindVar Name+  deriving Eq++-- | Does a Type have kind * or k (for some kind variable k)?+canRealizeKindStar :: Type -> StarKindStatus+canRealizeKindStar t+  | hasKindStar t = KindStar+  | otherwise = case t of+#if MIN_VERSION_template_haskell(2,8,0)+                     SigT _ (VarT k) -> IsKindVar k+#endif+                     _               -> NotKindStar++-- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.+-- Otherwise, returns 'Nothing'.+starKindStatusToName :: StarKindStatus -> Maybe Name+starKindStatusToName (IsKindVar n) = Just n+starKindStatusToName _             = Nothing++-- | Concat together all of the StarKindStatuses that are IsKindVar and extract+-- the kind variables' Names out.+catKindVarNames :: [StarKindStatus] -> [Name]+catKindVarNames = mapMaybe starKindStatusToName++-------------------------------------------------------------------------------+-- Assorted utilities+-------------------------------------------------------------------------------++-- | Returns True if a Type has kind *.+hasKindStar :: Type -> Bool+hasKindStar VarT{}         = True+#if MIN_VERSION_template_haskell(2,8,0)+hasKindStar (SigT _ StarT) = True+#else+hasKindStar (SigT _ StarK) = True+#endif+hasKindStar _              = False++-- Returns True is a kind is equal to *, or if it is a kind variable.+isStarOrVar :: Kind -> Bool+#if MIN_VERSION_template_haskell(2,8,0)+isStarOrVar StarT  = True+isStarOrVar VarT{} = True+#else+isStarOrVar StarK  = True+#endif+isStarOrVar _      = False++-- Generate a list of fresh names with a common prefix, and numbered suffixes.+newNameList :: String -> Int -> Q [Name]+newNameList prefix n = mapM (newName . (prefix ++) . show) [1..n]++-- | Gets all of the type/kind variable names mentioned somewhere in a Type.+tyVarNamesOfType :: Type -> [Name]+tyVarNamesOfType = go+  where+    go :: Type -> [Name]+    go (AppT t1 t2) = go t1 ++ go t2+    go (SigT t _k)  = go t+#if MIN_VERSION_template_haskell(2,8,0)+                           ++ go _k+#endif+    go (VarT n)     = [n]+    go _            = []++-- | Gets all of the type/kind variable names mentioned somewhere in a Kind.+tyVarNamesOfKind :: Kind -> [Name]+#if MIN_VERSION_template_haskell(2,8,0)+tyVarNamesOfKind = tyVarNamesOfType+#else+tyVarNamesOfKind _ = [] -- There are no kind variables+#endif++-- | @hasKindVarChain n kind@ Checks if @kind@ is of the form+-- k_0 -> k_1 -> ... -> k_(n-1), where k0, k1, ..., and k_(n-1) can be * or+-- kind variables.+hasKindVarChain :: Int -> Type -> Maybe [Name]+hasKindVarChain kindArrows t =+  let uk = uncurryKind (tyKind t)+  in if (length uk - 1 == kindArrows) && all isStarOrVar uk+        then Just (concatMap tyVarNamesOfKind uk)+        else Nothing++-- | If a Type is a SigT, returns its kind signature. Otherwise, return *.+tyKind :: Type -> Kind+tyKind (SigT _ k) = k+tyKind _          = starK++-- | If a VarT is missing an explicit kind signature, steal it from a TyVarBndr.+stealKindForType :: TyVarBndr -> Type -> Type+stealKindForType tvb t@VarT{} = SigT t (tvbKind tvb)+stealKindForType _   t        = t++-- | Monadic version of concatMap+concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = liftM concat (mapM f xs)++-- | A mapping of type variable Names to their show function Names. For example, in a+-- TextShow2 declaration, a TyVarMap might look like (a ~> sp1, b ~> sp2), where+-- a and b are the last two type variables of the datatype, and sp1 and sp2 are the two+-- functions which show their respective type variables.+type TyVarMap = Map Name (Name, Name)++-- | Checks if a 'Name' represents a tuple type constructor (other than '()')+isNonUnitTuple :: Name -> Bool+isNonUnitTuple = isTupleString . nameBase++-- | Parenthesize an infix constructor name if it is being applied as a prefix+-- function (e.g., data Amp a = (:&) a a)+parenInfixConName :: Name -> ShowS+parenInfixConName conName =+    let conNameBase = nameBase conName+     in showParen (isInfixTypeCon conNameBase) $ showString conNameBase++-- | Extracts the kind from a TyVarBndr.+tvbKind :: TyVarBndr -> Kind+tvbKind (PlainTV  _)   = starK+tvbKind (KindedTV _ k) = k++-- | Convert a TyVarBndr to a Type.+tvbToType :: TyVarBndr -> Type+tvbToType (PlainTV n)    = VarT n+tvbToType (KindedTV n k) = SigT (VarT n) k++-- | Applies a typeclass constraint to a type.+applyClass :: Name -> Name -> Pred+#if MIN_VERSION_template_haskell(2,10,0)+applyClass con t = AppT (ConT con) (VarT t)+#else+applyClass con t = ClassP con [VarT t]+#endif++-- | Checks to see if the last types in a data family instance can be safely eta-+-- reduced (i.e., dropped), given the other types. This checks for three conditions:+--+-- (1) All of the dropped types are type variables+-- (2) All of the dropped types are distinct+-- (3) None of the remaining types mention any of the dropped types+canEtaReduce :: [Type] -> [Type] -> Bool+canEtaReduce remaining dropped =+       all isTyVar dropped+    && allDistinct droppedNames -- Make sure not to pass something of type [Type], since Type+                                -- didn't have an Ord instance until template-haskell-2.10.0.0+    && not (any (`mentionsName` droppedNames) remaining)+  where+    droppedNames :: [Name]+    droppedNames = map varTToName dropped++-- | Extract Just the Name from a type variable. If the argument Type is not a+-- type variable, return Nothing.+varTToName_maybe :: Type -> Maybe Name+varTToName_maybe (VarT n)   = Just n+varTToName_maybe (SigT t _) = varTToName_maybe t+varTToName_maybe _          = Nothing++-- | Extract the Name from a type variable. If the argument Type is not a+-- type variable, throw an error.+varTToName :: Type -> Name+varTToName = fromMaybe (error "Not a type variable!") . varTToName_maybe++-- | Peel off a kind signature from a Type (if it has one).+unSigT :: Type -> Type+unSigT (SigT t _) = t+unSigT t          = t++-- | Is the given type a variable?+isTyVar :: Type -> Bool+isTyVar (VarT _)   = True+isTyVar (SigT t _) = isTyVar t+isTyVar _          = False++-- | Is the given type a type family constructor (and not a data family constructor)?+isTyFamily :: Type -> Q Bool+isTyFamily (ConT n) = do+    info <- reify n+    return $ case info of+#if MIN_VERSION_template_haskell(2,11,0)+         FamilyI OpenTypeFamilyD{} _       -> True+#elif MIN_VERSION_template_haskell(2,7,0)+         FamilyI (FamilyD TypeFam _ _ _) _ -> True+#else+         TyConI  (FamilyD TypeFam _ _ _)   -> True+#endif+#if MIN_VERSION_template_haskell(2,9,0)+         FamilyI ClosedTypeFamilyD{} _     -> True+#endif+         _ -> False+isTyFamily _ = return False++-- | Are all of the items in a list (which have an ordering) distinct?+--+-- This uses Set (as opposed to nub) for better asymptotic time complexity.+allDistinct :: Ord a => [a] -> Bool+allDistinct = allDistinct' Set.empty+  where+    allDistinct' :: Ord a => Set a -> [a] -> Bool+    allDistinct' uniqs (x:xs)+        | x `Set.member` uniqs = False+        | otherwise            = allDistinct' (Set.insert x uniqs) xs+    allDistinct' _ _           = True++-- | Does the given type mention any of the Names in the list?+mentionsName :: Type -> [Name] -> Bool+mentionsName = go+  where+    go :: Type -> [Name] -> Bool+    go (AppT t1 t2) names = go t1 names || go t2 names+    go (SigT t _k)  names = go t names+#if MIN_VERSION_template_haskell(2,8,0)+                              || go _k names+#endif+    go (VarT n)     names = n `elem` names+    go _            _     = False++-- | Does an instance predicate mention any of the Names in the list?+predMentionsName :: Pred -> [Name] -> Bool+#if MIN_VERSION_template_haskell(2,10,0)+predMentionsName = mentionsName+#else+predMentionsName (ClassP n tys) names = n `elem` names || any (`mentionsName` names) tys+predMentionsName (EqualP t1 t2) names = mentionsName t1 names || mentionsName t2 names+#endif++-- | Construct a type via curried application.+applyTy :: Type -> [Type] -> Type+applyTy = foldl' AppT++-- | Fully applies a type constructor to its type variables.+applyTyCon :: Name -> [Type] -> Type+applyTyCon = applyTy . ConT++-- | Split an applied type into its individual components. For example, this:+--+-- @+-- Either Int Char+-- @+--+-- would split to this:+--+-- @+-- [Either, Int, Char]+-- @+unapplyTy :: Type -> NonEmpty Type+unapplyTy = NE.reverse . go+  where+    go :: Type -> NonEmpty Type+    go (AppT t1 t2)    = t2 <| go t1+    go (SigT t _)      = go t+    go (ForallT _ _ t) = go t+    go t               = t :| []++-- | Split a type signature by the arrows on its spine. For example, this:+--+-- @+-- (Int -> String) -> Char -> ()+-- @+--+-- would split to this:+--+-- @+-- [Int -> String, Char, ()]+-- @+uncurryTy :: Type -> NonEmpty Type+uncurryTy (AppT (AppT ArrowT t1) t2) = t1 <| uncurryTy t2+uncurryTy (SigT t _)                 = uncurryTy t+uncurryTy (ForallT _ _ t)            = uncurryTy t+uncurryTy t                          = t :| []++-- | Like uncurryType, except on a kind level.+uncurryKind :: Kind -> NonEmpty Kind+#if MIN_VERSION_template_haskell(2,8,0)+uncurryKind = uncurryTy+#else+uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2+uncurryKind k              = k :| []+#endif++createKindChain :: Int -> Kind+createKindChain = go starK+  where+    go :: Kind -> Int -> Kind+    go k !0 = k+#if MIN_VERSION_template_haskell(2,8,0)+    go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)+#else+    go k !n = go (ArrowK StarK k) (n - 1)+#endif++#if MIN_VERSION_template_haskell(2,7,0)+-- | Extracts the name of a constructor.+constructorName :: Con -> Name+constructorName (NormalC name      _  ) = name+constructorName (RecC    name      _  ) = name+constructorName (InfixC  _    name _  ) = name+constructorName (ForallC _    _    con) = constructorName con+# if MIN_VERSION_template_haskell(2,11,0)+constructorName (GadtC    names _ _)    = head names+constructorName (RecGadtC names _ _)    = head names+# endif+#endif++interleave :: [a] -> [a] -> [a]+interleave (a1:a1s) (a2:a2s) = a1:a2:interleave a1s a2s+interleave _        _        = []++-- Determines the types of a constructor's arguments as well as the last type+-- parameters (mapped to their show functions), expanding through any type synonyms.+-- The type parameters are determined on a constructor-by-constructor basis since+-- they may be refined to be particular types in a GADT.+reifyConTys :: TextShowClass+            -> [(Name, Name)]+            -> Name+            -> Q ([Type], TyVarMap)+reifyConTys tsClass spls conName = do+    info  <- reify conName+    uncTy <- case info of+                  DataConI _ ty _+#if !(MIN_VERSION_template_haskell(2,11,0))+                           _+#endif+                           -> fmap uncurryTy (expandSyn ty)+                  _ -> error "Must be a data constructor"+    let (argTys, [resTy]) = NE.splitAt (length uncTy - 1) uncTy+        unapResTy = unapplyTy resTy+        -- If one of the last type variables is refined to a particular type+        -- (i.e., not truly polymorphic), we mark it with Nothing and filter+        -- it out later, since we only apply show functions to arguments of+        -- a type that it (1) one of the last type variables, and (2)+        -- of a truly polymorphic type.+        mbTvNames = map varTToName_maybe $+                        NE.drop (NE.length unapResTy - fromEnum tsClass) unapResTy+        -- We use Map.fromList to ensure that if there are any duplicate type+        -- variables (as can happen in a GADT), the rightmost type variable gets+        -- associated with the show function.+        --+        -- See Note [Matching functions with GADT type variables]+        tvMap = Map.fromList+                    . catMaybes -- Drop refined types+                    $ zipWith (\mbTvName sp ->+                                  fmap (\tvName -> (tvName, sp)) mbTvName)+                              mbTvNames spls+    return (argTys, tvMap)++{-+Note [Matching functions with GADT type variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++When deriving TextShow2, there is a tricky corner case to consider:++  data Both a b where+    BothCon :: x -> x -> Both x x++Which show functions should be applied to which arguments of BothCon? We have a+choice, since both the function of type (Int -> a -> Builder) and of type+(Int -> b -> Builder) can be applied to either argument. In such a scenario, the+second show function takes precedence over the first show function, so the+derived TextShow2 instance would be:++  instance TextShow Both where+    liftShowsPrec2 sp1 sp2 p (BothCon x1 x2) =+      showbParen (p > appPrec) $+        "BothCon " <> sp2 appPrec1 x1 <> showbSpace <> sp2 appPrec1 x2++This is not an arbitrary choice, as this definition ensures that+liftShowsPrec2 showsPrec = liftShowsPrec for a derived TextShow1 instance for+Both.+-}
src/TextShow/Utils.hs view
@@ -12,33 +12,43 @@ Miscellaneous utility functions. -} module TextShow.Utils (-      i2d+      coerce+    , i2d     , isInfixTypeCon     , isTupleString     , lengthB-    , mtimesDefault     , toString     , toText     , unlinesB     , unwordsB     ) where -import Data.Int (Int64)-import Data.Text (Text)-import Data.Monoid.Compat ((<>))-#if MIN_VERSION_semigroups(0,17,0)-import Data.Semigroup (mtimesDefault)+import           Data.Int (Int64)+import           Data.Text (Text)+import           Data.Monoid.Compat ((<>))+import           Data.Text.Lazy (length, toStrict, unpack)+import           Data.Text.Lazy.Builder (Builder, singleton, toLazyText)++import           GHC.Exts (Char(C#), Int(I#))+import           GHC.Prim ((+#), chr#, ord#)++import           Prelude ()+import           Prelude.Compat hiding (length)++#if __GLASGOW_HASKELL__ >= 708+import qualified Data.Coerce as C (Coercible, coerce) #else-import Data.Semigroup (timesN)+import           Unsafe.Coerce (unsafeCoerce) #endif-import Data.Text.Lazy (length, toStrict, unpack)-import Data.Text.Lazy.Builder (Builder, singleton, toLazyText) -import GHC.Exts (Char(C#), Int(I#))-import GHC.Prim ((+#), chr#, ord#)--import Prelude ()-import Prelude.Compat hiding (length)+-- On GHC 7.8+, this is 'Data.Coerce.coerce'. Otherwise, it's 'unsafeCoerce'.+#if __GLASGOW_HASKELL__ >= 708+coerce :: C.Coercible a b => a -> b+coerce = C.coerce+#else+coerce :: a -> b+coerce = unsafeCoerce+#endif  -- | Unsafe conversion for decimal digits. i2d :: Int -> Char@@ -64,15 +74,6 @@ lengthB :: Builder -> Int64 lengthB = length . toLazyText {-# INLINE lengthB #-}--#if !(MIN_VERSION_semigroups(0,17,0))--- | Repeat a value @n@ times.------ > mtimesDefault n a = a <> a <> ... <> a  -- using <> (n-1) times-mtimesDefault :: (Integral b, Monoid a) => b -> a -> a-mtimesDefault = timesN . fromIntegral-{-# INLINE mtimesDefault #-}-#endif  -- | Convert a 'Builder' to a 'String' (without surrounding it with double quotes, -- as 'show' would).
tests/Derived/DataFamilies.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP                        #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures             #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE TemplateHaskell            #-} {-# LANGUAGE TypeFamilies               #-}@@ -9,6 +10,10 @@ {-# LANGUAGE DeriveGeneric              #-} #endif +#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds                  #-}+#endif+ #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 -- Starting with GHC 7.10, NullaryTypeClasses was deprecated in favor of -- MultiParamTypeClasses, which is already enabled@@ -27,6 +32,9 @@ -} module Derived.DataFamilies (       NotAllShow(..)+#if __GLASGOW_HASKELL__ >= 706+    , KindDistinguished(..)+#endif #if __GLASGOW_HASKELL__ >= 708     , NullaryClass(..)     , NullaryData(..)@@ -35,6 +43,8 @@  #include "generic.h" +import           Data.Functor.Classes (Show1(..))+ #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif@@ -45,7 +55,6 @@ import           GHC.Generics (Generic1) # endif #endif-import           GHC.Show (appPrec, appPrec1, showSpace)  import           Prelude () import           Prelude.Compat@@ -56,16 +65,14 @@ import           TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) #endif -import TransformersCompat (Show1(..), Show2(..))+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+import           Data.Functor.Classes (Show2(..))+import           GHC.Show (appPrec, appPrec1, showSpace)+#endif  ------------------------------------------------------------------------------- -data family NotAllShow-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-    a b c d :: *-#else-    w x y z :: *-#endif+data family NotAllShow (w :: *) (x :: *) (y :: *) (z :: *) :: *  data instance NotAllShow ()  ()  () d = NASNoShow data instance NotAllShow Int b   c  d = NASShow1 c b@@ -84,16 +91,21 @@                       , 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-    showsPrecWith = showsPrecWith2 showsPrec+    showsPrec1 = showsPrec+#else+instance (Show b, Show c) => Show1 (NotAllShow Int b c) where+    liftShowsPrec = liftShowsPrec2 showsPrec showList instance Show b => Show2 (NotAllShow Int b) where-    showsPrecWith2 sp1 _ p (NASShow1 c b) = showParen (p > appPrec) $+    liftShowsPrec2 sp1 _ _ _ p (NASShow1 c b) = showParen (p > appPrec) $           showString "NASShow1 "         . sp1 appPrec1 c . showSpace         . showsPrec appPrec1 b-    showsPrecWith2 _ sp2 p (NASShow2 d) = showParen (p > appPrec) $+    liftShowsPrec2 _ _ sp2 _ p (NASShow2 d) = showParen (p > appPrec) $           showString "NASShow2 "         . sp2 appPrec1 d+#endif  #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow  'NASShow1)@@ -107,6 +119,86 @@  # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'NASShow1)+# endif+#endif++-------------------------------------------------------------------------------++#if __GLASGOW_HASKELL__ >= 706+data family KindDistinguished (x :: k) (y :: *) (z :: *) :: *++newtype instance KindDistinguished (a :: *) b c = KindDistinguished1 b+  deriving ( Arbitrary+           , Show+           , Generic+# if defined(__LANGUAGE_DERIVE_GENERIC1__)+           , Generic1+# endif+           )++newtype instance KindDistinguished (a :: * -> *) b c = KindDistinguished2 b+  deriving ( Arbitrary+           , 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+           )++#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+    showsPrec1 = showsPrec+instance Show b => Show1 (KindDistinguished (Either :: * -> * -> *) 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+    liftShowsPrec = liftShowsPrec2 showsPrec showList+instance Show b => Show1 (KindDistinguished (Either :: * -> * -> *) 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+#endif++$(deriveTextShow  'KindDistinguished1)+$(deriveTextShow1 'KindDistinguished1)+$(deriveTextShow2 'KindDistinguished1)++$(deriveTextShow  'KindDistinguished2)+$(deriveTextShow1 'KindDistinguished2)+$(deriveTextShow2 'KindDistinguished2)++$(deriveTextShow  'KindDistinguished3)+$(deriveTextShow1 'KindDistinguished3)+$(deriveTextShow2 'KindDistinguished3)++# if !defined(__LANGUAGE_DERIVE_GENERIC1__)+$(Generics.deriveAll1 'KindDistinguished1)+$(Generics.deriveAll1 'KindDistinguished2)+$(Generics.deriveAll1 'KindDistinguished3) # endif #endif
tests/Derived/DatatypeContexts.hs view
@@ -16,7 +16,7 @@ -} module Derived.DatatypeContexts (TyCon(..), TyFamily(..)) where -import GHC.Show (appPrec, appPrec1, showSpace)+import Data.Functor.Classes (Show1(..))  import Prelude () import Prelude.Compat@@ -24,9 +24,12 @@ import Test.QuickCheck (Arbitrary(..))  import TextShow (TextShow(..), TextShow1(..), TextShow2(..))-import TextShow.TH (makeShowbPrec, makeShowbPrecWith, makeShowbPrecWith2)+import TextShow.TH (makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) -import TransformersCompat (Show1(..), Show2(..))+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+import Data.Functor.Classes (Show2(..))+import GHC.Show (appPrec, appPrec1, showSpace)+#endif  ------------------------------------------------------------------------------- @@ -35,12 +38,7 @@  ------------------------------------------------------------------------------- -data family TyFamily-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-    a b c :: *-#else-    x y z :: *-#endif+data family TyFamily x y z :: *  data instance Ord a => TyFamily a b c = TyFamily a b c   deriving Show@@ -55,16 +53,22 @@  ------------------------------------------------------------------------------- +#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0)) instance (Ord a, Show a, Show b) => Show1 (TyCon a b) where-    showsPrecWith = showsPrecWith2 showsPrec+    showsPrec1 = showsPrec+instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where+    showsPrec1 = showsPrec+#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-    showsPrecWith2 sp1 sp2 p (TyCon a b c) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyCon a b c) =         showsThree sp1 sp2 "TyCon" p a b c--instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where-    showsPrecWith = showsPrecWith2 showsPrec instance (Ord a, Show a) => Show2 (TyFamily a) where-    showsPrecWith2 sp1 sp2 p (TyFamily a b c) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyFamily a b c) =         showsThree sp1 sp2 "TyFamily" p a b c  showsThree :: Show a@@ -75,6 +79,7 @@     . showsPrec appPrec1 a . showSpace     . sp1 appPrec1 b       . showSpace     . sp2 appPrec1 c+#endif  ------------------------------------------------------------------------------- @@ -83,15 +88,15 @@ instance (Ord a, TextShow a, TextShow b, TextShow c) => TextShow (TyCon a b c) where     showbPrec = $(makeShowbPrec ''TyCon) instance (Ord a, TextShow a, TextShow b) => TextShow1 (TyCon a b) where-    showbPrecWith = $(makeShowbPrecWith ''TyCon)+    liftShowbPrec = $(makeLiftShowbPrec ''TyCon) instance (Ord a, TextShow a) => TextShow2 (TyCon a) where-    showbPrecWith2 = $(makeShowbPrecWith2 ''TyCon)+    liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyCon)  #if MIN_VERSION_template_haskell(2,7,0) instance (Ord a, TextShow a, TextShow b, TextShow c) => TextShow (TyFamily a b c) where     showbPrec = $(makeShowbPrec 'TyFamily) instance (Ord a, TextShow a, TextShow b) => TextShow1 (TyFamily a b) where-    showbPrecWith = $(makeShowbPrecWith 'TyFamily)+    liftShowbPrec = $(makeLiftShowbPrec 'TyFamily) instance (Ord a, TextShow a) => TextShow2 (TyFamily a) where-    showbPrecWith2 = $(makeShowbPrecWith2 'TyFamily)+    liftShowbPrec2 = $(makeLiftShowbPrec2 'TyFamily) #endif
tests/Derived/ExistentialQuantification.hs view
@@ -17,7 +17,7 @@ -} module Derived.ExistentialQuantification (TyCon(..), TyFamily(..)) where -import GHC.Show (appPrec, appPrec1, showSpace)+import Data.Functor.Classes (Show1(..))  import Prelude () import Prelude.Compat@@ -27,7 +27,10 @@ import TextShow (TextShow) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -import TransformersCompat (Show1(..), Show2(..), showsBinaryWith)+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+import Data.Functor.Classes (Show2(..), showsBinaryWith)+import GHC.Show (appPrec, appPrec1, showSpace)+#endif  ------------------------------------------------------------------------------- @@ -40,8 +43,9 @@                                 => e -> f -> g -> h                              -> TyCon e f g h -    TyConTypeRefinement      :: Int -> z-                             -> TyCon Int z Int z+    TyConTypeRefinement1,+      TyConTypeRefinement2   :: Int -> z+                             -> TyCon Int Int z z      TyConForalls             :: forall p q r s t u.                                 (Arbitrary p, Show p, TextShow p,@@ -51,12 +55,7 @@  ------------------------------------------------------------------------------- -data family TyFamily-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-    a b c d :: *-#else-    w x y z :: *-#endif+data family TyFamily w x y z :: *  data instance TyFamily a b c d where     TyFamilyClassConstraints    :: (Ord m, Ord n, Ord o, Ord p)@@ -67,8 +66,9 @@                                 => e -> f -> g -> h                                 -> TyFamily e f g h -    TyFamilyTypeRefinement      :: Int -> z-                                -> TyFamily Int z Int z+    TyFamilyTypeRefinement1,+      TyFamilyTypeRefinement2   :: Int -> z+                                -> TyFamily Int Int z z      TyFamilyForalls             :: forall p q r s t u.                                    (Arbitrary p, Show p, TextShow p,@@ -81,7 +81,8 @@ instance (a ~ Int, b ~ Int, c ~ Int, d ~ Int) => Arbitrary (TyCon a b c d) where     arbitrary = oneof [ TyConClassConstraints    <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary                       , TyConEqualityConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary-                      , TyConTypeRefinement      <$> arbitrary <*> arbitrary+                      , TyConTypeRefinement1     <$> arbitrary <*> arbitrary+                      , TyConTypeRefinement2     <$> arbitrary <*> arbitrary                       , TyConForalls             <$> (arbitrary :: Gen Int) <*> (arbitrary :: Gen Int)                                                  <*> arbitrary              <*> arbitrary                       ]@@ -89,7 +90,8 @@ instance (a ~ Int, b ~ Int, c ~ Int, d ~ Int) => Arbitrary (TyFamily a b c d) where     arbitrary = oneof [ TyFamilyClassConstraints    <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary                       , TyFamilyEqualityConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary-                      , TyFamilyTypeRefinement      <$> arbitrary <*> arbitrary+                      , TyFamilyTypeRefinement1     <$> arbitrary <*> arbitrary+                      , TyFamilyTypeRefinement2     <$> arbitrary <*> arbitrary                       , TyFamilyForalls             <$> (arbitrary :: Gen Int) <*> (arbitrary :: Gen Int)                                                     <*> arbitrary              <*> arbitrary                       ]@@ -97,29 +99,40 @@ -------------------------------------------------------------------------------  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)++#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-    showsPrecWith = showsPrecWith2 showsPrec+    showsPrec1 = showsPrec+instance (Show a, Show b, Show c) => Show1 (TyFamily a b c) where+    showsPrec1 = showsPrec+#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-    showsPrecWith2 sp1 sp2 p (TyConClassConstraints a b c d) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyConClassConstraints a b c d) =         showsFour sp1 sp2 "TyConClassConstraints" p a b c d-    showsPrecWith2 sp1 sp2 p (TyConEqualityConstraints a b c d) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyConEqualityConstraints a b c d) =         showsFour sp1 sp2 "TyConEqualityConstraints" p a b c d-    showsPrecWith2 _   sp2 p (TyConTypeRefinement i d) =-        showsBinaryWith showsPrec sp2 "TyConTypeRefinement" p i d-    showsPrecWith2 sp1 sp2 p (TyConForalls p' q d c) =+    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--deriving instance (Show a, Show b, Show c, Show d) => Show (TyFamily a b c d)-instance (Show a, Show b, Show c) => Show1 (TyFamily a b c) where-    showsPrecWith = showsPrecWith2 showsPrec instance (Show a, Show b) => Show2 (TyFamily a b) where-    showsPrecWith2 sp1 sp2 p (TyFamilyClassConstraints a b c d) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyFamilyClassConstraints a b c d) =         showsFour sp1 sp2 "TyFamilyClassConstraints" p a b c d-    showsPrecWith2 sp1 sp2 p (TyFamilyEqualityConstraints a b c d) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyFamilyEqualityConstraints a b c d) =         showsFour sp1 sp2 "TyFamilyEqualityConstraints" p a b c d-    showsPrecWith2 _ sp2 p (TyFamilyTypeRefinement i d) =-        showsBinaryWith showsPrec sp2 "TyFamilyTypeRefinement" p i d-    showsPrecWith2 sp1 sp2 p (TyFamilyForalls p' q d c) =+    liftShowsPrec2 _ _ sp2 _ p (TyFamilyTypeRefinement1 i d) =+        showsBinaryWith showsPrec sp2 "TyFamilyTypeRefinement1" p i d+    liftShowsPrec2 _ _ sp2 _ p (TyFamilyTypeRefinement2 i d) =+        showsBinaryWith showsPrec sp2 "TyFamilyTypeRefinement2" p i d+    liftShowsPrec2 sp1 _ sp2 _ p (TyFamilyForalls p' q d c) =         showsFour sp2 sp1 "TyFamilyForalls" p p' q d c  showsFour :: (Show a, Show b)@@ -131,6 +144,7 @@     . showsPrec appPrec1 b . showSpace     . sp1 appPrec1 c       . showSpace     . sp2 appPrec1 d+#endif  ------------------------------------------------------------------------------- @@ -140,6 +154,6 @@  #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow  'TyFamilyClassConstraints)-$(deriveTextShow1 'TyFamilyEqualityConstraints)-$(deriveTextShow2 'TyFamilyTypeRefinement)+$(deriveTextShow1 'TyFamilyTypeRefinement1)+$(deriveTextShow2 'TyFamilyTypeRefinement2) #endif
tests/Derived/Infix.hs view
@@ -27,6 +27,8 @@  #include "generic.h" +import           Data.Functor.Classes (Show1(..))+ #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif@@ -37,7 +39,6 @@ import           GHC.Generics (Generic1) # endif #endif-import           GHC.Show (appPrec, appPrec1, showSpace)  import           Prelude () import           Prelude.Compat@@ -46,16 +47,21 @@  import           TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -import           TransformersCompat (Show1(..), Show2(..), showsBinaryWith)+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+import           Data.Functor.Classes (Show2(..), showsBinaryWith)+import           GHC.Show (appPrec, appPrec1, showSpace)+#endif  -------------------------------------------------------------------------------  infixl 3 :!: infix  4 :@: infixr 5 `TyConPlain`+infixr 6 `TyConFakeInfix` data TyConPlain a b = (:!:) a b                     | a :@: b                     | a `TyConPlain` b+                    | TyConFakeInfix a b   deriving ( Show #if __GLASGOW_HASKELL__ >= 702            , Generic@@ -82,19 +88,16 @@  ------------------------------------------------------------------------------- -data family TyFamilyPlain-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-                          a b :: *-#else-                          y z :: *-#endif+data family TyFamilyPlain y z :: *  infixl 3 :#: infix  4 :$: infixr 5 `TyFamilyPlain`+infixr 6 `TyFamilyFakeInfix` data instance TyFamilyPlain a b = (:#:) a b                                 | a :$: b                                 | a `TyFamilyPlain` b+                                | TyFamilyFakeInfix a b   deriving ( Show #if __GLASGOW_HASKELL__ >= 706            , Generic@@ -106,12 +109,7 @@  ------------------------------------------------------------------------------- -data family TyFamilyGADT-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-                         a b :: *-#else-                         y z :: *-#endif+data family TyFamilyGADT y z :: *  infixr 1 :*, :***, :**** data instance TyFamilyGADT a b where@@ -154,48 +152,60 @@  ------------------------------------------------------------------------------- +#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0)) instance Show a => Show1 (TyConPlain a) where-    showsPrecWith = showsPrecWith2 showsPrec+    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+#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-    showsPrecWith2 sp1 sp2 p (a :!: b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :!: b) =         showsBinaryWith sp1 sp2 "(:!:)" p a b-    showsPrecWith2 sp1 sp2 p (a :@: b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :@: b) =         showsInfix sp1 sp2 ":@:" p 4 a b-    showsPrecWith2 sp1 sp2 p (TyConPlain a b) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyConPlain a b) =         showsInfix sp1 sp2 "`TyConPlain`" p 5 a b--instance Show a => Show1 (TyConGADT a) where-    showsPrecWith = showsPrecWith2 showsPrec+    liftShowsPrec2 sp1 _ sp2 _ p (TyConFakeInfix a b) =+        showsBinaryWith sp1 sp2 "TyConFakeInfix" p a b instance Show2 TyConGADT where-    showsPrecWith2 sp1 sp2 p (a :. b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :. b) =         showsInfix sp1 sp2 ":." p 1 a b-    showsPrecWith2 sp1 sp2 p (a :.. b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :.. b) =         showsBinaryWith sp1 sp2 "(:..)" p a b-    showsPrecWith2 sp1 sp2 p ((:...) a b i) =+    liftShowsPrec2 sp1 _ sp2 _ p ((:...) a b i) =         showsTernaryWith sp1 sp2 "(:...)" p a b i-    showsPrecWith2 sp1 sp2 p (a :.... b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :.... b) =         showsBinaryWith sp1 sp2 "(:....)" p a b--instance Show a => Show1 (TyFamilyPlain a) where-    showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyFamilyPlain where-    showsPrecWith2 sp1 sp2 p (a :#: b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :#: b) =         showsBinaryWith sp1 sp2 "(:#:)" p a b-    showsPrecWith2 sp1 sp2 p (a :$: b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :$: b) =         showsInfix sp1 sp2 ":$:" p 4 a b-    showsPrecWith2 sp1 sp2 p (TyFamilyPlain a b) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyFamilyPlain a b) =         showsInfix sp1 sp2 "`TyFamilyPlain`" p 5 a b--instance Show a => Show1 (TyFamilyGADT a) where-    showsPrecWith = showsPrecWith2 showsPrec+    liftShowsPrec2 sp1 _ sp2 _ p (TyFamilyFakeInfix a b) =+        showsBinaryWith sp1 sp2 "TyFamilyFakeInfix" p a b instance Show2 TyFamilyGADT where-    showsPrecWith2 sp1 sp2 p (a :* b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :* b) =         showsInfix sp1 sp2 ":*" p 1 a b-    showsPrecWith2 sp1 sp2 p (a :** b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :** b) =         showsBinaryWith sp1 sp2 "(:**)" p a b-    showsPrecWith2 sp1 sp2 p ((:***) a b i) =+    liftShowsPrec2 sp1 _ sp2 _ p ((:***) a b i) =         showsTernaryWith sp1 sp2 "(:***)" p a b i-    showsPrecWith2 sp1 sp2 p (a :**** b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :**** b) =         showsBinaryWith sp1 sp2 "(:****)" p a b  showsInfix :: (Int -> a -> ShowS) -> (Int -> b -> ShowS)@@ -212,6 +222,7 @@     . sp1 appPrec1 a  . showSpace     . sp2 appPrec1 b  . showSpace     . showsPrec appPrec1 i+#endif  -------------------------------------------------------------------------------
tests/Derived/MagicHash.hs view
@@ -19,6 +19,8 @@ -} module Derived.MagicHash (TyCon#(..), TyFamily#(..)) where +import           Data.Functor.Classes (Show1(..))+ #if __GLASGOW_HASKELL__ < 711 import qualified Generics.Deriving.TH as Generics #endif@@ -27,10 +29,6 @@ #if __GLASGOW_HASKELL__ >= 711 import           GHC.Generics (Generic, Generic1) #endif-import           GHC.Show (showSpace)-#if __GLASGOW_HASKELL__ < 711-import           GHC.Show (appPrec)-#endif  import           Prelude () import           Prelude.Compat@@ -39,7 +37,13 @@  import           TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -import           TransformersCompat (Show1(..), Show2(..))+#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  ------------------------------------------------------------------------------- @@ -60,12 +64,7 @@  ------------------------------------------------------------------------------- -data family TyFamily#-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-    a b :: *-#else-    y z :: *-#endif+data family TyFamily# y z :: *  data instance TyFamily# a b = TyFamily# {     tfA       :: a@@ -108,17 +107,23 @@  ------------------------------------------------------------------------------- +#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0)) instance Show a => Show1 (TyCon# a) where-    showsPrecWith = showsPrecWith2 showsPrec+    showsPrec1 = showsPrec+instance Show a => Show1 (TyFamily# a) where+    showsPrec1 = showsPrec+#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-    showsPrecWith2 sp1 sp2 p (TyCon# a b i f d c w) =+    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 Show a => Show1 (TyFamily# a) where-    showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyFamily# where-    showsPrecWith2 sp1 sp2 p (TyFamily# a b i f d c w) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyFamily# a b i f d c w) =         showsHash sp1 sp2 "TyFamily#" "tfA" "tfB" "tfInt#" "tfFloat#"                   "tfDouble#" "tfChar#" "tfWord#" p a b i f d c w @@ -127,9 +132,9 @@           -> 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+# if __GLASGOW_HASKELL__ < 711     showParen (_p > appPrec) $-#endif+# endif           showString con . showSpace         . showChar '{'         . showString rec1 . equals . sp1 0 a                . comma@@ -146,12 +151,13 @@     equals = showString " = "      oneHash, twoHash :: ShowS-#if __GLASGOW_HASKELL__ >= 711+# if __GLASGOW_HASKELL__ >= 711     oneHash  = showChar '#'     twoHash  = showString "##"-#else+# else     oneHash  = id     twoHash  = id+# endif #endif  -------------------------------------------------------------------------------
tests/Derived/PolyKinds.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP                        #-}+{-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures             #-} {-# LANGUAGE StandaloneDeriving         #-}@@ -12,9 +13,12 @@ #endif  #if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE DataKinds                  #-} {-# LANGUAGE PolyKinds                  #-} #endif +{-# OPTIONS_GHC -fno-warn-orphans #-}+ {-| Module:      Derived.PolyKinds Copyright:   (C) 2014-2015 Ryan Scott@@ -36,20 +40,25 @@  #include "generic.h" +import           Data.Functor.Classes (Show1(..))+ import           Generics.Deriving.Base-#if !defined(__LANGUAGE_DERIVE_GENERIC1__)+#if !defined(__LANGUAGE_DERIVE_GENERIC1__) || MIN_VERSION_template_haskell(2,7,0) import qualified Generics.Deriving.TH as Generics #endif -import           GHC.Show (appPrec, appPrec1, showSpace)- import           Test.QuickCheck (Arbitrary)  import           TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import           TextShow.TH (deriveTextShow2, makeShowbPrec,-                              makeShowbPrecWith, makeShowbPrecWith2)+                              makeLiftShowbPrec, makeLiftShowbPrec2) -import           TransformersCompat (Show1(..), Show2(..), showsUnaryWith)+#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)+import           GHC.Show (appPrec, appPrec1, showSpace)+#endif  ------------------------------------------------------------------------------- @@ -73,7 +82,8 @@  ------------------------------------------------------------------------------- -newtype TyConProxy a b = TyConProxy ()+newtype TyConProxy a b where+    TyConProxy :: () -> TyConProxy a b   deriving ( Arbitrary            , Show #if __GLASGOW_HASKELL__ >= 702@@ -100,15 +110,7 @@ -------------------------------------------------------------------------------  data family TyFamilyCompose-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-    (f :: k1 -> k2 -> *)-    (g :: k3 -> k4 -> k1)-    (h :: k3 -> k4 -> k2)-    (j :: k5 -> k3)-    (k :: k5 -> k4)-    (a :: k5)-    (b :: k5)-#elif __GLASGOW_HASKELL__ >= 706+#if __GLASGOW_HASKELL__ >= 706     (t :: k1 -> k2 -> *)     (u :: k3 -> k4 -> k1)     (v :: k3 -> k4 -> k2)@@ -136,49 +138,32 @@ 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)  -------------------------------------------------------------------------------  data family TyFamilyProxy-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-    (a :: k1) (b :: k2)-#elif __GLASGOW_HASKELL__ >= 706+#if __GLASGOW_HASKELL__ >= 706     (x :: k1) (y :: k2) #else     (x :: *)  (y :: *) #endif     :: * -newtype instance TyFamilyProxy a b = TyFamilyProxy ()+newtype instance TyFamilyProxy a b where+    TyFamilyProxy :: () -> TyFamilyProxy a b   deriving ( Arbitrary            , Show #if __GLASGOW_HASKELL__ >= 706            , Generic-# if defined(__LANGUAGE_DERIVE_GENERIC1__)-           , Generic1-# endif #endif            )  -------------------------------------------------------------------------------  data family TyFamilyReallyHighKinds-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-    (f :: k1 -> k2 -> k3 -> k4 -> k5 -> *)-    (a :: k1)-    (b :: k2)-    (c :: k3)-    (d :: k4)-    (e :: k5)-#elif __GLASGOW_HASKELL__ >= 706+#if __GLASGOW_HASKELL__ >= 706     (g :: k1 -> k2 -> k3 -> k4 -> k5 -> *)     (v :: k1)     (w :: k2)@@ -201,76 +186,132 @@            , Show #if __GLASGOW_HASKELL__ >= 706            , Generic-# if defined(__LANGUAGE_DERIVE_GENERIC1__)-           , Generic1-# endif #endif            )  ------------------------------------------------------------------------------- +#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)++instance (Show1 g, Show a) => Show (Apply g a) where+    showsPrec d (Apply x) = showsPrec1 d x++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+instance Show1 (TyConProxy (a :: *)) where+    showsPrec1 = showsPrec+instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where+    showsPrec1 p (TyConReallyHighKinds x) =+      showsUnary1 "TyConReallyHighKinds" p x+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+instance Show1 (TyFamilyProxy (a :: *)) where+    showsPrec1 = showsPrec+instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where+    showsPrec1 p (TyFamilyReallyHighKinds x) =+      showsUnary1 "TyFamilyReallyHighKinds" p x++-- TODO: Move this to base-orphans someday+instance (Show a, Show b, Show c, Show d) => Show1 ((,,,,) a b c d) where+    showsPrec1 = showsPrec+#else instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) =>   Show1 (TyConCompose f g h j k a) where-    showsPrecWith sp p (TyConCompose x) =-        showsPrecCompose sp "TyConCompose" p x+    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+instance Show1 (TyFamilyProxy (a :: *)) where+    liftShowsPrec = liftShowsPrec2 undefined undefined+instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where+    liftShowsPrec sp sl p (TyFamilyReallyHighKinds x) =+        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-    showsPrecWith2 sp1 sp2 p (TyConCompose x) =-        showsPrecCompose2 sp1 sp2 "TyConCompose" p x--instance Show1 (TyConProxy (a :: *)) where-    showsPrecWith = showsPrecWith2 undefined+    liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyConCompose x) =+        showsPrecCompose2 sp1 sl1 sp2 sl2 "TyConCompose" p x instance Show2 TyConProxy where-    showsPrecWith2 _ _ p (TyConProxy x) = showParen (p > appPrec) $+    liftShowsPrec2 _ _ _ _ p (TyConProxy x) = showParen (p > appPrec) $           showString "TyConProxy "         . showsPrec appPrec1 x--instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where-    showsPrecWith sp p (TyConReallyHighKinds x) =-        showsUnaryWith (showsPrecWith sp) "TyConReallyHighKinds" p x instance Show2 (f a b c) => Show2 (TyConReallyHighKinds f a b c) where-    showsPrecWith2 sp1 sp2 p (TyConReallyHighKinds x) =-        showsUnaryWith (showsPrecWith2 sp1 sp2) "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-    showsPrecWith sp p (TyFamilyCompose x) =-        showsPrecCompose sp "TyFamilyCompose" p x+    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-    showsPrecWith2 sp1 sp2 p (TyFamilyCompose x) =-        showsPrecCompose2 sp1 sp2 "TyFamilyCompose" p x--instance Show1 (TyFamilyProxy (a :: *)) where-    showsPrecWith = showsPrecWith2 undefined+    liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyFamilyCompose x) =+        showsPrecCompose2 sp1 sl1 sp2 sl2 "TyFamilyCompose" p x instance Show2 TyFamilyProxy where-    showsPrecWith2 _ _ p (TyFamilyProxy x) = showParen (p > appPrec) $+    liftShowsPrec2 _ _ _ _ p (TyFamilyProxy x) = showParen (p > appPrec) $           showString "TyFamilyProxy "         . showsPrec appPrec1 x--instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where-    showsPrecWith sp p (TyFamilyReallyHighKinds x) =-        showsUnaryWith (showsPrecWith sp) "TyFamilyReallyHighKinds" p x instance Show2 (f a b c) => Show2 (TyFamilyReallyHighKinds f a b c) where-    showsPrecWith2 sp1 sp2 p (TyFamilyReallyHighKinds x) =-        showsUnaryWith (showsPrecWith2 sp1 sp2) "TyFamilyReallyHighKinds" p x+    liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyFamilyReallyHighKinds x) =+        showsUnaryWith (liftShowsPrec2 sp1 sl1 sp2 sl2) "TyFamilyReallyHighKinds" p x  showsPrecCompose :: (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k)-                 => (Int -> b -> ShowS) -> String-                 -> Int -> f (g (j a) (k a)) (h (j a) (k b)) -> ShowS-showsPrecCompose sp name p x = showParen (p > appPrec) $+                 => (Int -> b -> ShowS) -> ([b] -> ShowS)+                 -> String -> Int -> f (g (j a) (k a)) (h (j a) (k b)) -> ShowS+showsPrecCompose sp sl name p x = showParen (p > appPrec) $       showString name . showSpace-    . showsPrecWith (showsPrecWith (showsPrecWith sp)) appPrec1 x+    . liftShowsPrec (liftShowsPrec (liftShowsPrec sp sl)+                                   (liftShowList  sp sl))+                    (liftShowList  (liftShowsPrec sp sl)+                                   (liftShowList  sp sl))+                    appPrec1 x  showsPrecCompose2 :: (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k)-                  => (Int -> a -> ShowS) -> (Int -> b -> ShowS)+                  => (Int -> a -> ShowS) -> ([a] -> ShowS)+                  -> (Int -> b -> ShowS) -> ([b] -> ShowS)                   -> String -> Int -> f (g (j a) (k a)) (h (j a) (k b)) -> ShowS-showsPrecCompose2 sp1 sp2 name p x = showParen (p > appPrec) $+showsPrecCompose2 sp1 sl1 sp2 sl2 name p x = showParen (p > appPrec) $       showString name . showSpace-    . showsPrecWith2 (showsPrecWith2 (showsPrecWith sp1) (showsPrecWith sp1))-                     (showsPrecWith2 (showsPrecWith sp1) (showsPrecWith sp2))+    . liftShowsPrec2 (liftShowsPrec2 (liftShowsPrec sp1 sl1)+                                     (liftShowList  sp1 sl1)+                                     (liftShowsPrec sp1 sl1)+                                     (liftShowList  sp1 sl1))+                     (liftShowList2  (liftShowsPrec sp1 sl1)+                                     (liftShowList  sp1 sl1)+                                     (liftShowsPrec sp1 sl1)+                                     (liftShowList  sp1 sl1))+                     (liftShowsPrec2 (liftShowsPrec sp1 sl1)+                                     (liftShowList  sp1 sl1)+                                     (liftShowsPrec sp2 sl2)+                                     (liftShowList  sp2 sl2))+                     (liftShowList2  (liftShowsPrec sp1 sl1)+                                     (liftShowList  sp1 sl1)+                                     (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 [])@@ -280,21 +321,21 @@     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-    showbPrecWith = $(makeShowbPrecWith ''TyConCompose)+    liftShowbPrec = $(makeLiftShowbPrec ''TyConCompose) $(deriveTextShow2 ''TyConCompose)  instance TextShow (TyConProxy a b) where     showbPrec = $(makeShowbPrec ''TyConProxy) instance TextShow1 (TyConProxy a) where-    showbPrecWith = $(makeShowbPrecWith ''TyConProxy)+    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-    showbPrecWith = $(makeShowbPrecWith ''TyConReallyHighKinds)+    liftShowbPrec = $(makeLiftShowbPrec ''TyConReallyHighKinds) instance TextShow2 (f a b c) => TextShow2 (TyConReallyHighKinds f a b c) where-    showbPrecWith2 = $(makeShowbPrecWith2 ''TyConReallyHighKinds)+    liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyConReallyHighKinds)  #if MIN_VERSION_template_haskell(2,7,0) instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) =>@@ -302,21 +343,21 @@     showbPrec = $(makeShowbPrec 'TyFamilyCompose) instance (TextShow1 (f (g (j a) (k a))), TextShow1 (h (j a)), TextShow1 k) =>   TextShow1 (TyFamilyCompose f g h j k a) where-    showbPrecWith = $(makeShowbPrecWith 'TyFamilyCompose)+    liftShowbPrec = $(makeLiftShowbPrec 'TyFamilyCompose) $(deriveTextShow2 'TyFamilyCompose)  instance TextShow (TyFamilyProxy a b) where     showbPrec = $(makeShowbPrec 'TyFamilyProxy) instance TextShow1 (TyFamilyProxy a) where-    showbPrecWith = $(makeShowbPrecWith 'TyFamilyProxy)+    liftShowbPrec = $(makeLiftShowbPrec 'TyFamilyProxy) $(deriveTextShow2 'TyFamilyProxy)  instance TextShow (f a b c d e) => TextShow (TyFamilyReallyHighKinds f a b c d e) where     showbPrec = $(makeShowbPrec 'TyFamilyReallyHighKinds) instance TextShow1 (f a b c d) => TextShow1 (TyFamilyReallyHighKinds f a b c d) where-    showbPrecWith = $(makeShowbPrecWith 'TyFamilyReallyHighKinds)+    liftShowbPrec = $(makeLiftShowbPrec 'TyFamilyReallyHighKinds) instance TextShow2 (f a b c) => TextShow2 (TyFamilyReallyHighKinds f a b c) where-    showbPrecWith2 = $(makeShowbPrecWith2 'TyFamilyReallyHighKinds)+    liftShowbPrec2 = $(makeLiftShowbPrec2 'TyFamilyReallyHighKinds) #endif  #if !defined(__LANGUAGE_DERIVE_GENERIC1__)@@ -343,7 +384,7 @@ #endif  #if MIN_VERSION_template_haskell(2,7,0)-# if !defined(__LANGUAGE_DERIVE_GENERIC1__)+-- TODO: Reinstate CPP bounds once Trac #11357 is fixed $(Generics.deriveMeta           'TyFamilyCompose) $(Generics.deriveRep1           'TyFamilyCompose) @@ -358,7 +399,6 @@ $(Generics.deriveRepresentable1 'TyFamilyProxy) $(Generics.deriveMeta           'TyFamilyReallyHighKinds) $(Generics.deriveRepresentable1 'TyFamilyReallyHighKinds)-# endif  # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyCompose)
tests/Derived/RankNTypes.hs view
@@ -20,16 +20,20 @@ -} module Derived.RankNTypes (TyCon(..), TyFamily(..)) where +import Data.Functor.Classes (Show1(..))+ import Prelude () import Prelude.Compat  import Test.QuickCheck (Arbitrary(..)) -import TextShow (Show(..), Show1(..), Show2(..))+import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2,-                    makeShowbPrec, makeShowbPrecWith, makeShowbPrecWith2)+                    makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) -import TransformersCompat (Show1(..), Show2(..), showsUnaryWith, showsBinaryWith)+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+import Data.Functor.Classes (Show2(..), showsUnaryWith, showsBinaryWith)+#endif  ------------------------------------------------------------------------------- @@ -40,12 +44,7 @@  ------------------------------------------------------------------------------- -data family TyFamily-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-                     a b :: *-#else-                     x y :: *-#endif+data family TyFamily x y :: *  data instance TyFamily a b = TyFamily (forall a. Tagged2 a Int b)                                       (forall b. Tagged2 b a   a)@@ -75,55 +74,61 @@  ------------------------------------------------------------------------------- +#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0)) instance Show a => Show1 (TyCon a) where-    showsPrecWith = showsPrecWith2 showsPrec-instance Show2 TyCon where-    showsPrecWith2 sp1 sp2 p (TyCon b a) =-        showsForall sp1 sp2 "TyCon" p b a-+    showsPrec1 = showsPrec instance Show a => Show1 (TyFamily a) where-    showsPrecWith = showsPrecWith2 showsPrec+    showsPrec1 = showsPrec+#else+instance Show1 (Tagged2 s t) where+    liftShowsPrec = liftShowsPrec2 undefined undefined+instance Show a => Show1 (TyCon a) where+    liftShowsPrec = liftShowsPrec2 showsPrec showList+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-    showsPrecWith2 sp1 sp2 p (TyFamily b a) =-        showsForall sp1 sp2 "TyFamily" p b a+    liftShowsPrec2 sp1 sl1 sp2 sl2 p (TyFamily b a) =+        showsForall sp1 sl1 sp2 sl2 "TyFamily" p b a -showsForall :: (Int -> a -> ShowS) -> (Int -> b -> ShowS)+showsForall :: (Int -> a -> ShowS) -> ([a] -> ShowS)+            -> (Int -> b -> ShowS) -> ([b] -> ShowS)             -> String -> Int             -> (forall a. Tagged2 a Int b)             -> (forall b. Tagged2 b a a)             -> ShowS-showsForall sp1 sp2 name p b a =-        showsBinaryWith (showsPrecWith2 showsPrec sp2)-                        (showsPrecWith2 sp1       sp1)+showsForall sp1 sl1 sp2 sl2 name p b a =+        showsBinaryWith (liftShowsPrec2 showsPrec showList sp2 sl2)+                        (liftShowsPrec2 sp1       sl1      sp1 sl1)                         name p b a+#endif  ------------------------------------------------------------------------------- -$(deriveShow  ''TyCon)-$(deriveShow1 ''TyCon)-$(deriveShow2 ''TyCon)+$(deriveTextShow  ''TyCon)+$(deriveTextShow1 ''TyCon)+$(deriveTextShow2 ''TyCon)  #if MIN_VERSION_template_haskell(2,7,0)-$(deriveShow  'TyFamily)-$(deriveShow1 'TyFamily)-$(deriveShow2 'TyFamily)+$(deriveTextShow  'TyFamily)+$(deriveTextShow1 'TyFamily)+$(deriveTextShow2 'TyFamily) #endif  -------------------------------------------------------------------------------  $(return []) -instance TextShow1 (Tagged2 s t) where-    showsPrecWith sp p (Tagged2 b) = showsUnaryWith sp "Tagged2" p b--instance TextShow2 (Tagged2 s) where-    showsPrecWith2 _ = showsPrecWith- instance TextShow c => TextShow (Tagged2 s t c) where     showbPrec = $(makeShowbPrec ''Tagged2)  instance TextShow1 (Tagged2 s t) where-    showbPrecWith = $(makeShowbPrecWith ''Tagged2)+    liftShowbPrec = $(makeLiftShowbPrec ''Tagged2)  instance TextShow2 (Tagged2 s) where-    showbPrecWith2 = $(makeShowbPrecWith2 ''Tagged2)+    liftShowbPrec2 = $(makeLiftShowbPrec2 ''Tagged2)
tests/Derived/Records.hs view
@@ -20,6 +20,8 @@  #include "generic.h" +import           Data.Functor.Classes (Show1(..))+ #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif@@ -30,10 +32,6 @@ import           GHC.Generics (Generic1) # endif #endif-import           GHC.Show (showSpace)-#if __GLASGOW_HASKELL__ < 711-import           GHC.Show (appPrec)-#endif  import           Prelude () import           Prelude.Compat@@ -42,7 +40,13 @@  import           TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -import           TransformersCompat (Show1(..), Show2(..))+#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  ------------------------------------------------------------------------------- @@ -60,12 +64,7 @@  ------------------------------------------------------------------------------- -data family TyFamily-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-    a b :: *-#else-    y z :: *-#endif+data family TyFamily y z :: *  infixl 4 :!: data instance TyFamily a b = TyFamilyPrefix { tf1 :: a, tf2 :: b }@@ -93,33 +92,40 @@  ------------------------------------------------------------------------------- +#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0)) instance Show a => Show1 (TyCon a) where-    showsPrecWith = showsPrecWith2 showsPrec+    showsPrec1 = showsPrec+instance Show a => Show1 (TyFamily a) where+    showsPrec1 = showsPrec+#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-    showsPrecWith2 sp1 sp2 p (TyConPrefix a b) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyConPrefix a b) =         showsRecord sp1 sp2 "TyConPrefix" "tc1" "tc2" p a b-    showsPrecWith2 sp1 sp2 p (a :@: b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :@: b) =         showsRecord sp2 sp1 "(:@:)" "tc3" "tc4" p a b--instance Show a => Show1 (TyFamily a) where-    showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyFamily where-    showsPrecWith2 sp1 sp2 p (TyFamilyPrefix a b) =+    liftShowsPrec2 sp1 _ sp2 _ p (TyFamilyPrefix a b) =         showsRecord sp1 sp2 "TyFamilyPrefix" "tf1" "tf2" p a b-    showsPrecWith2 sp1 sp2 p (a :!: b) =+    liftShowsPrec2 sp1 _ sp2 _ p (a :!: b) =         showsRecord sp2 sp1 "(:!:)" "tf3" "tf4" p a b  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+# if __GLASGOW_HASKELL__ < 711     showParen (_p > appPrec) $-#endif+# endif           showString con . showSpace         . showChar '{'         . showString rec1 . showString " = " . sp1 0 a . showString ", "         . showString rec2 . showString " = " . sp2 0 b         . showChar '}'+#endif  -------------------------------------------------------------------------------
tests/Derived/TypeSynonyms.hs view
@@ -23,6 +23,13 @@  #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@@ -40,8 +47,6 @@  import           TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -import           TransformersCompat (Show1(..), Show2(..), showsUnaryWith)- -------------------------------------------------------------------------------  type FakeOut a = Int@@ -52,13 +57,15 @@ 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-    showsPrecWith2 sp1 sp2 _ (a, b, c, d) =+    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  ------------------------------------------------------------------------------- @@ -80,12 +87,7 @@  ------------------------------------------------------------------------------- -data family TyFamily-#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-                     a b :: *-#else-                     y z :: *-#endif+data family TyFamily y z :: *  newtype instance TyFamily a b = TyFamily     ( Id (FakeOut (Id a))@@ -105,21 +107,32 @@  ------------------------------------------------------------------------------- +#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0)) instance Show a => Show1 (TyCon a) where-    showsPrecWith = showsPrecWith2 showsPrec+    showsPrec1 = showsPrec+instance Show a => Show1 (TyFamily a) where+    showsPrec1 = showsPrec+#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-    showsPrecWith2 sp1 sp2 p (TyCon x) =-        showsUnaryWith (showsPrecWith2 (showsPrecWith2 showsPrec sp1)-                                       (showsPrecWith2 sp1       sp2)+    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--instance Show a => Show1 (TyFamily a) where-    showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyFamily where-    showsPrecWith2 sp1 sp2 p (TyFamily x) =-        showsUnaryWith (showsPrecWith2 (showsPrecWith2 showsPrec sp1)-                                       (showsPrecWith2 sp1       sp2)+    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+#endif  -------------------------------------------------------------------------------
tests/Instances/Control/Exception.hs view
@@ -79,6 +79,11 @@     arbitrary = pure AllocationLimitExceeded #endif +#if MIN_VERSION_base(4,9,0)+instance Arbitrary TypeError where+    arbitrary = TypeError <$> arbitrary+#endif+ instance Arbitrary Deadlock where     arbitrary = pure Deadlock
+ tests/Instances/Data/Functor/Compose.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds #-}+#endif++{-|+Module:      Instances.Data.Functor.Compose+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++'Arbitrary' instance for 'Compose'.+-}+module Instances.Data.Functor.Compose () where++import Data.Functor.Compose (Compose(..))+import Test.QuickCheck (Arbitrary)++deriving instance Arbitrary (f (g a)) => Arbitrary (Compose f g a)
+ tests/Instances/Data/Functor/Product.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds #-}+#endif++{-|+Module:      Instances.Data.Functor.Product+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++'Arbitrary' instance for 'Product'.+-}+module Instances.Data.Functor.Product () where++import Data.Functor.Product (Product(..))++import Prelude ()+import Prelude.Compat++import Test.QuickCheck (Arbitrary(..))++instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Product f g a) where+    arbitrary = Pair <$> arbitrary <*> arbitrary
+ tests/Instances/Data/Functor/Sum.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds #-}+#endif++{-|+Module:      Instances.Data.Functor.Sum+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++'Arbitrary' instance for 'Sum'.+-}+module Instances.Data.Functor.Sum () where++import Data.Functor.Sum (Sum(..))++import Prelude ()+import Prelude.Compat++import Test.QuickCheck (Arbitrary(..), oneof)++instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Sum f g a) where+    arbitrary = oneof [InL <$> arbitrary, InR <$> arbitrary]
+ tests/Instances/Data/List/NonEmpty.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module:      Instances.Data.List.NonEmpty+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++'Arbitrary' instance for 'NonEmpty'.+-}+module Instances.Data.List.NonEmpty () where++import Data.Functor.Classes (Show1(..))+import Data.List.NonEmpty (NonEmpty(..))++import Prelude ()+import Prelude.Compat++import Test.QuickCheck (Arbitrary(..))++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
+ tests/Instances/Data/Semigroup.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Module:      Instances.Data.Semigroup+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++'Arbitrary' instances for datatypes in the "Data.Semigroup" module.+-}+module Instances.Data.Semigroup () where++import Data.Semigroup (Min(..), Max(..), First(..), Last(..),+                       WrappedMonoid(..), Option(..), Arg(..))++import Prelude ()+import Prelude.Compat++import Test.QuickCheck (Arbitrary(..))++deriving instance Arbitrary a => Arbitrary (Min a)+deriving instance Arbitrary a => Arbitrary (Max a)+deriving instance Arbitrary a => Arbitrary (First a)+deriving instance Arbitrary a => Arbitrary (Last a)+deriving instance Arbitrary a => Arbitrary (WrappedMonoid a)+deriving instance Arbitrary a => Arbitrary (Option a)++instance (Arbitrary a, Arbitrary b) => Arbitrary (Arg a b) where+    arbitrary = Arg <$> arbitrary <*> arbitrary
tests/Instances/Data/Typeable.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP       #-}+{-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  {-|@@ -13,14 +14,28 @@ -} module Instances.Data.Typeable () where +#include "MachDeps.h"+ #if MIN_VERSION_base(4,4,0)-import Data.Typeable.Internal (TyCon(..), TypeRep(..))+import Data.Typeable.Internal (TypeRep(..)) import Instances.Utils ((<@>)) #else import Data.Typeable (TyCon, TypeRep, mkTyCon, typeOf) import Test.QuickCheck (Gen) #endif +#if MIN_VERSION_base(4,9,0)+import GHC.Types (TyCon(..), TrName(..), Module(..))+# if WORD_SIZE_IN_BITS < 64+import GHC.Word (Word64(..))+# else+import GHC.Word (Word(..))+# endif+import Test.QuickCheck (oneof)+#elif MIN_VERSION_base(4,4,0)+import Data.Typeable.Internal (TyCon(..))+#endif+ import Instances.GHC.Fingerprint ()  import Prelude ()@@ -42,8 +57,26 @@ #endif  instance Arbitrary TyCon where-#if MIN_VERSION_base(4,4,0)+#if MIN_VERSION_base(4,9,0)+    arbitrary = do+# if WORD_SIZE_IN_BITS < 64+        W64# w1# <- arbitrary+        W64# w2# <- arbitrary+# else+        W#   w1# <- arbitrary+        W#   w2# <- arbitrary+# endif+        TyCon w1# w2# <$> arbitrary <*> arbitrary+#elif MIN_VERSION_base(4,4,0)     arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #else     arbitrary = mkTyCon <$> arbitrary+#endif++#if MIN_VERSION_base(4,9,0)+instance Arbitrary TrName where+    arbitrary = oneof [pure (TrNameS "wat"#), TrNameD <$> arbitrary]++instance Arbitrary Module where+    arbitrary = Module <$> arbitrary <*> arbitrary #endif
tests/Instances/FromStringTextShow.hs view
@@ -16,9 +16,9 @@ module Instances.FromStringTextShow () where  import Test.QuickCheck (Arbitrary)-import TextShow (FromStringShow(..), FromTextShow(..))-import TransformersCompat (FromStringShow1(..), FromStringShow2(..),-                           FromTextShow1(..), FromTextShow2(..))+import TextShow (FromStringShow(..), FromTextShow(..),+                 FromStringShow1(..), FromStringShow2(..),+                 FromTextShow1(..), FromTextShow2(..))  deriving instance Arbitrary a       => Arbitrary (FromStringShow a) deriving instance Arbitrary (f a)   => Arbitrary (FromStringShow1 f a)
tests/Instances/GHC/Generics.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                        #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -51,8 +52,25 @@ 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 instance Arbitrary Arity where     arbitrary = oneof [pure NoArity, Arity <$> arbitrary]+#endif  instance Arbitrary (UChar p) where     arbitrary = do
tests/Spec/Control/ApplicativeSpec.hs view
@@ -11,6 +11,7 @@ module Spec.Control.ApplicativeSpec (main, spec) where  import Control.Applicative (Const, ZipList)+import Control.Monad.Trans.Instances ()  import Data.Orphans () @@ -18,7 +19,7 @@  import Instances.Control.Applicative () -import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow2,+import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow1,                    prop_genericTextShow, prop_genericTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel)@@ -30,7 +31,7 @@ spec :: Spec spec = parallel $ do     describe "Const Int Int" $-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> Const Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Const Int Int -> Bool)     describe "ZipList Int" $ do         prop "TextShow instance"  (prop_matchesTextShow  :: Int -> ZipList Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> ZipList Int -> Bool)
tests/Spec/Control/ExceptionSpec.hs view
@@ -54,6 +54,10 @@     describe "AllocationLimitExceeded" $         prop "TextShow instance" (prop_matchesTextShow :: Int -> AllocationLimitExceeded -> Bool) #endif+#if MIN_VERSION_base(4,9,0)+    describe "TypeError" $+        prop "TextShow instance" (prop_matchesTextShow :: Int -> TypeError -> Bool)+#endif     describe "Deadlock" $         prop "TextShow instance" (prop_matchesTextShow :: Int -> Deadlock -> Bool)     describe "NoMethodError" $
tests/Spec/Data/EitherSpec.hs view
@@ -12,7 +12,7 @@  import Generics.Deriving.Instances () -import Spec.Utils (prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1)+import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)@@ -22,6 +22,6 @@  spec :: Spec spec = parallel . describe "Either Int Int" $ do-    prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> Either Int Int -> Bool)+    prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Either Int Int -> Bool)     prop "generic TextShow"   (prop_genericTextShow  :: Int -> Either Int Int -> Bool)     prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> Either Int Int -> Bool)
+ tests/Spec/Data/Functor/ComposeSpec.hs view
@@ -0,0 +1,30 @@+{-|+Module:      Spec.Data.Functor.ComposeSpec+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++@hspec@ test for 'Compose'.+-}+module Spec.Data.Functor.ComposeSpec (main, spec) where++import Control.Monad.Trans.Instances ()++import Data.Functor.Compose (Compose)++import Instances.Data.Functor.Compose ()++import Spec.Utils (prop_matchesTextShow1)++import Test.Hspec (Spec, describe, hspec, parallel)+import Test.Hspec.QuickCheck (prop)++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel . describe "Compose Maybe Maybe Int" $+    prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Compose Maybe Maybe Int -> Bool)+
tests/Spec/Data/Functor/IdentitySpec.hs view
@@ -1,5 +1,5 @@ {-|-Module:      Spec.Data.Functor.Identity+Module:      Spec.Data.Functor.IdentitySpec Copyright:   (C) 2014-2015 Ryan Scott License:     BSD-style (see the file LICENSE) Maintainer:  Ryan Scott@@ -10,7 +10,8 @@ -} module Spec.Data.Functor.IdentitySpec (main, spec) where -import Data.Functor.Classes ()+import Control.Monad.Trans.Instances ()+ import Data.Functor.Identity (Identity)  import Instances.Data.Functor.Identity ()
+ tests/Spec/Data/Functor/ProductSpec.hs view
@@ -0,0 +1,29 @@+{-|+Module:      Spec.Data.Functor.ProductSpec+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++@hspec@ test for 'Product'.+-}+module Spec.Data.Functor.ProductSpec (main, spec) where++import Control.Monad.Trans.Instances ()++import Data.Functor.Product (Product)++import Instances.Data.Functor.Product ()++import Spec.Utils (prop_matchesTextShow1)++import Test.Hspec (Spec, describe, hspec, parallel)+import Test.Hspec.QuickCheck (prop)++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel . describe "Product Maybe Maybe Int" $+    prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Product Maybe Maybe Int -> Bool)
+ tests/Spec/Data/Functor/SumSpec.hs view
@@ -0,0 +1,30 @@+{-|+Module:      Spec.Data.Functor.SumSpec+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++@hspec@ test for 'Sum'.+-}+module Spec.Data.Functor.SumSpec (main, spec) where++import Control.Monad.Trans.Instances ()++import Data.Functor.Sum (Sum)++import Instances.Data.Functor.Sum ()++import Spec.Utils (prop_matchesTextShow1)++import Test.Hspec (Spec, describe, hspec, parallel)+import Test.Hspec.QuickCheck (prop)++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel . describe "Sum Maybe Maybe Int" $+    prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Sum Maybe Maybe Int -> Bool)+
+ tests/Spec/Data/List/NonEmptySpec.hs view
@@ -0,0 +1,27 @@+{-|+Module:      Spec.Data.List.NonEmptySpec+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++@hspec@ test for 'NonEmpty'.+-}+module Spec.Data.List.NonEmptySpec (main, spec) where++import Data.List.NonEmpty (NonEmpty)++import Instances.Data.List.NonEmpty ()++import Spec.Utils (prop_matchesTextShow1)++import Test.Hspec (Spec, describe, hspec, parallel)+import Test.Hspec.QuickCheck (prop)++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel . describe "NonEmpty Int" $+    prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> NonEmpty Int -> Bool)
+ tests/Spec/Data/SemigroupSpec.hs view
@@ -0,0 +1,40 @@+{-|+Module:      Spec.Data.SemigroupSpec+Copyright:   (C) 2014-2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott+Stability:   Provisional+Portability: GHC++@hspec@ tests for data types in the "Data.Semigroup" module.+-}+module Spec.Data.SemigroupSpec (main, spec) where++import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg)++import Instances.Data.Semigroup ()++import Spec.Utils (prop_matchesTextShow)++import Test.Hspec (Spec, describe, hspec, parallel)+import Test.Hspec.QuickCheck (prop)++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $ do+    describe "Min Int" $+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> Min Int -> Bool)+    describe "Max Int" $+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> Max Int -> Bool)+    describe "First Int" $+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> First Int -> Bool)+    describe "Last Int" $+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> Last Int -> Bool)+    describe "WrappedMonoid ()" $+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> WrappedMonoid () -> Bool)+    describe "Option Int" $+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> Option Int -> Bool)+    describe "Arg Int Char" $+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> Arg Int Char -> Bool)
tests/Spec/Data/TupleSpec.hs view
@@ -14,7 +14,7 @@  import Instances.Data.Tuple () -import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow2,+import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow1,                    prop_genericTextShow, prop_genericTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel)@@ -31,8 +31,8 @@         prop "generic TextShow"             (prop_genericTextShow :: Int -> () -> Bool)     describe "(Int, Int)" $ do-        prop "TextShow2 instance"-            (prop_matchesTextShow2 :: Int -> (Int, Int) -> Bool)+        prop "TextShow1 instance"+            (prop_matchesTextShow1 :: Int -> (Int, Int) -> Bool)         prop "generic TextShow"             (prop_genericTextShow  :: Int -> (Int, Int) -> Bool)         prop "generic TextShow1"
tests/Spec/Data/TypeableSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {-| Module:      Spec.Data.TypeableSpec Copyright:   (C) 2014-2015 Ryan Scott@@ -12,6 +14,10 @@  import Data.Typeable (TyCon, TypeRep) +#if MIN_VERSION_base(4,9,0)+import GHC.Types (TrName, Module)+#endif+ import Instances.Data.Typeable ()  import Spec.Utils (prop_matchesTextShow)@@ -28,3 +34,9 @@         prop "TextShow instance" (prop_matchesTextShow :: Int -> TypeRep -> Bool)     describe "TyCon" $         prop "TextShow instance" (prop_matchesTextShow :: Int -> TyCon -> Bool)+#if MIN_VERSION_base(4,9,0)+    describe "TrName" $+        prop "TextShow instance" (prop_matchesTextShow :: Int -> TrName -> Bool)+    describe "Module" $+        prop "TextShow instance" (prop_matchesTextShow :: Int -> Module -> Bool)+#endif
tests/Spec/Derived/DataFamiliesSpec.hs view
@@ -20,11 +20,15 @@ #if MIN_VERSION_template_haskell(2,7,0) import Derived.DataFamilies (NotAllShow) -import Spec.Utils (prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1)+import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1)  import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) +# if __GLASGOW_HASKELL__ >= 706+import Derived.DataFamilies (KindDistinguished)+# endif+ # if __GLASGOW_HASKELL__ >= 708 import Derived.DataFamilies (NullaryData) import Spec.Utils (prop_matchesTextShow)@@ -38,9 +42,23 @@ spec = parallel $ do #if MIN_VERSION_template_haskell(2,7,0)     describe "NotAllShow Int Int Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> NotAllShow Int Int Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> NotAllShow Int Int Int Int -> Bool)         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)+# endif # if __GLASGOW_HASKELL__ >= 708     describe "NullaryData" $ do         prop "TextShow instance"  (prop_matchesTextShow  :: Int -> NullaryData -> Bool)
tests/Spec/Derived/DatatypeContextsSpec.hs view
@@ -14,7 +14,7 @@  import Derived.DatatypeContexts -import Spec.Utils (prop_matchesTextShow2)+import Spec.Utils (prop_matchesTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)@@ -25,8 +25,8 @@ spec :: Spec spec = parallel $ do     describe "TyCon Int Int Int" $-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyCon Int Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0)     describe "TyFamily Int Int Int" $-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamily Int Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int Int -> Bool) #endif
tests/Spec/Derived/ExistentialQuantificationSpec.hs view
@@ -14,7 +14,7 @@  import Derived.ExistentialQuantification -import Spec.Utils (prop_matchesTextShow2)+import Spec.Utils (prop_matchesTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)@@ -25,8 +25,8 @@ spec :: Spec spec = parallel $ do     describe "TyCon Int Int Int Int" $-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyCon Int Int Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0)     describe "TyFamily Int Int Int Int" $-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamily Int Int Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int Int Int -> Bool) #endif
tests/Spec/Derived/MagicHashSpec.hs view
@@ -15,7 +15,7 @@  import Derived.MagicHash -import Spec.Utils (prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1)+import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)@@ -26,12 +26,12 @@ spec :: Spec spec = parallel $ do     describe "TyCon# Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyCon# Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon# Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyCon# Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyCon# Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0)     describe "TyFamily# Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamily# Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily# Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyFamily# Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyFamily# Int Int -> Bool) #endif
tests/Spec/Derived/PolyKindsSpec.hs view
@@ -14,7 +14,7 @@  import Derived.PolyKinds -import Spec.Utils (prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1)+import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)@@ -25,28 +25,28 @@ spec :: Spec spec = parallel $ do     describe "TyConCompose Either Either Either Maybe Maybe Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool)     describe "TyConProxy Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyConProxy Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyConProxy Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyConProxy Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyConProxy Int Int -> Bool)     describe "TyConReallyHighKinds (,,,,) Int Int Int Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0)     describe "TyFamilyCompose Either Either Either Maybe Maybe Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool)     describe "TyFamilyProxy Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamilyProxy Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamilyProxy Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyFamilyProxy Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyFamilyProxy Int Int -> Bool)     describe "TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) #endif
tests/Spec/Derived/RankNTypesSpec.hs view
@@ -12,9 +12,9 @@ -} module Spec.Derived.RankNTypesSpec (main, spec) where -import Derived.Records+import Derived.RankNTypes -import Spec.Utils (prop_matchesTextShow2)+import Spec.Utils (prop_matchesTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)@@ -25,8 +25,8 @@ spec :: Spec spec = parallel $ do     describe "TyCon Int Int" $-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyCon Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0)     describe "TyFamily Int Int" $-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamily Int Int -> Bool)+        prop "TextShow2 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int -> Bool) #endif
tests/Spec/Derived/RecordsSpec.hs view
@@ -14,7 +14,7 @@  import Derived.Records -import Spec.Utils (prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1)+import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)@@ -25,12 +25,12 @@ spec :: Spec spec = parallel $ do     describe "TyCon Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyCon Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyCon Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyCon Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0)     describe "TyFamily Int Int" $ do-        prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamily Int Int -> Bool)+        prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int -> Bool)         prop "generic TextShow"   (prop_genericTextShow  :: Int -> TyFamily Int Int -> Bool)         prop "generic TextShow1"  (prop_genericTextShow1 :: Int -> TyFamily Int Int -> Bool) #endif
tests/Spec/FromStringTextShowSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {-| Module:      Spec.FromStringTextShowSpec Copyright:   (C) 2014-2015 Ryan Scott@@ -12,15 +14,18 @@  import Instances.FromStringTextShow () -import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow1, prop_matchesTextShow2)+import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow1)  import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)  import TextShow (FromStringShow(..), FromTextShow(..)) -import TransformersCompat (FromStringShow1(..), FromStringShow2(..),-                           FromTextShow1(..), FromTextShow2(..))+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+import Spec.Utils (prop_matchesTextShow2)+import TextShow (FromStringShow1(..), FromStringShow2(..),+                 FromTextShow1(..), FromTextShow2(..))+#endif  main :: IO () main = hspec spec@@ -39,6 +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)     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)@@ -53,3 +59,4 @@         prop "TextShow instance"  (prop_matchesTextShow  :: Int -> FromTextShow2 Either Char Int -> Bool)         prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow2 Either Char Int -> Bool)         prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> FromTextShow2 Either Char Int -> Bool)+#endif
tests/Spec/GHC/GenericsSpec.hs view
@@ -1,5 +1,10 @@+{-# LANGUAGE CPP           #-} {-# LANGUAGE TypeOperators #-} +#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE DataKinds     #-}+#endif+ {-| Module:      Spec.GHC.GenericsSpec Copyright:   (C) 2014-2015 Ryan Scott@@ -14,9 +19,16 @@  import Data.Orphans () -import Generics.Deriving.Base (U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:),-                               UChar, UDouble, UFloat, UInt, UWord,-                               Fixity, Associativity, Arity)+import Generics.Deriving.Base ( U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:)+                              , UChar, UDouble, UFloat, UInt, UWord+                              , Fixity, Associativity+#if MIN_VERSION_base(4,9,0)+                              , Meta(MetaData), SourceUnpackedness+                              , SourceStrictness, DecidedStrictness+#else+                              , Arity+#endif+                              ) import Generics.Deriving.Instances ()  import Instances.GHC.Generics ()@@ -29,6 +41,18 @@ main :: IO () main = hspec spec +#if MIN_VERSION_base(4,9,0)+type MD = 'MetaData "Example" "Module" "package" 'False++m1Description :: String+m1Description = "M1 () ('MetaData \"Example\" \"Module\" \"package\" 'False) Maybe Int"+#else+type MD = ()++m1Description :: String+m1Description = "M1 () () Maybe Int"+#endif+ spec :: Spec spec = parallel $ do     describe "Fixity" $ do@@ -37,9 +61,21 @@     describe "Associativity" $ do         prop "TextShow instance" (prop_matchesTextShow  :: Int -> Associativity -> Bool)         prop "generic TextShow"  (prop_genericTextShow  :: Int -> Associativity -> Bool)+#if MIN_VERSION_base(4,9,0)+    describe "SourceUnpackedness" $ do+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> SourceUnpackedness -> Bool)+        prop "generic TextShow"  (prop_genericTextShow  :: Int -> SourceUnpackedness -> Bool)+    describe "SourceStrictness" $ do+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> SourceStrictness -> Bool)+        prop "generic TextShow"  (prop_genericTextShow  :: Int -> SourceStrictness -> Bool)+    describe "DecidedStrictness" $ do+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> DecidedStrictness -> Bool)+        prop "generic TextShow"  (prop_genericTextShow  :: Int -> DecidedStrictness -> Bool)+#else     describe "Arity" $ do         prop "TextShow instance" (prop_matchesTextShow  :: Int -> Arity -> Bool)         prop "generic TextShow"  (prop_genericTextShow  :: Int -> Arity -> Bool)+#endif     describe "U1 Int" $ do         prop "TextShow instance" (prop_matchesTextShow  :: Int -> U1 Int -> Bool)         prop "generic TextShow"  (prop_genericTextShow  :: Int -> U1 Int -> Bool)@@ -52,9 +88,9 @@     describe "K1 () Int ()" $ do         prop "TextShow instance" (prop_matchesTextShow  :: Int -> K1 () Int () -> Bool)         prop "generic TextShow"  (prop_genericTextShow  :: Int -> K1 () Int () -> Bool)-    describe "M1 () () Maybe Int" $ do-        prop "TextShow instance" (prop_matchesTextShow  :: Int -> M1 () () Maybe Int -> Bool)-        prop "generic TextShow"  (prop_genericTextShow  :: Int -> M1 () () Maybe Int -> Bool)+    describe m1Description $ do+        prop "TextShow instance" (prop_matchesTextShow  :: Int -> M1 () MD Maybe Int -> Bool)+        prop "generic TextShow"  (prop_genericTextShow  :: Int -> M1 () MD Maybe Int -> Bool)     describe "(Maybe :+: Maybe) Int" $ do         prop "TextShow instance" (prop_matchesTextShow  :: Int -> (Maybe :+: Maybe) Int -> Bool)         prop "generic TextShow"  (prop_genericTextShow  :: Int -> (Maybe :+: Maybe) Int -> Bool)
tests/Spec/Utils.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP              #-} {-# LANGUAGE FlexibleContexts #-}+ {-| Module:      Spec.Utils Copyright:   (C) 2014-2015 Ryan Scott@@ -14,12 +15,14 @@       ioProperty     , prop_matchesTextShow     , prop_matchesTextShow1+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)     , prop_matchesTextShow2+#endif     , prop_genericTextShow     , prop_genericTextShow1     ) where -#include "generic.h"+import           Data.Functor.Classes (Show1, showsPrec1)  import           Generics.Deriving.Base @@ -30,12 +33,13 @@ #endif import           Test.QuickCheck (Property, Testable) -import           TextShow (TextShow(..), TextShow1(..), TextShow2(..),-                           Builder, FromStringShow(..))+import           TextShow (TextShow(..), TextShow1(..), showbPrec1, fromString) import           TextShow.Generic -import           TransformersCompat (Show1, Show2,-                                    FromStringShow1(..), FromStringShow2(..))+#if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)+import           Data.Functor.Classes (Show2, showsPrec2)+import           TextShow (TextShow2(..), showbPrec2)+#endif  ioProperty :: Testable prop => IO prop -> Property #if MIN_VERSION_QuickCheck(2,7,0)@@ -47,29 +51,20 @@ -- | Verifies that a type's @Show@ instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow :: (Show a, TextShow a) => Int -> a -> Bool-prop_matchesTextShow p x = showbPrec p (FromStringShow x) == showbPrec p x+prop_matchesTextShow p x = fromString (showsPrec p x "") == showbPrec p x  -- | Verifies that a type's @Show1@ instances coincide for both 'String's and 'Text', -- irrespective of precedence.-prop_matchesTextShow1 :: (Show1 f, TextShow1 f) => Int -> f a -> Bool-prop_matchesTextShow1 p x = showbPrecWith showb27Prec p (FromStringShow1 x)-                       == showbPrecWith showb27Prec p x+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) -- | Verifies that a type's @Show2@ instances coincide for both 'String's and 'Text', -- irrespective of precedence.-prop_matchesTextShow2 :: (Show2 f, TextShow2 f) => Int -> f a b -> Bool-prop_matchesTextShow2 p x = showbPrecWith2 showb27Prec showb42Prec p (FromStringShow2 x)-                           == showbPrecWith2 showb27Prec showb42Prec p x---- | Show the number 27, which certain parody singer-songwriters find humorous.--- Useful for testing higher-order @Show@ classes.-showb27Prec :: Int -> a -> Builder-showb27Prec p _ = showbPrec p $ Just (27 :: Int)---- | Show the number 42, which is said to be the answer to something or other.--- Useful for testing higher-order @Show@ classes.-showb42Prec :: Int -> a -> Builder-showb42Prec p _ = showbPrec p $ Just (42 :: Int)+prop_matchesTextShow2 :: (Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b)+                      => Int -> f a b -> Bool+prop_matchesTextShow2 p x = fromString (showsPrec2 p x "") == showbPrec2 p x+#endif  -- | Verifies that a type's 'TextShow' instance coincides with the output produced -- by the equivalent 'Generic' functions.@@ -79,7 +74,7 @@  -- | Verifies that a type's 'TextShow1' instance coincides with the output produced -- by the equivalent 'Generic1' functions.-prop_genericTextShow1 :: (TextShow1 f, Generic1 f, GTextShow1 (Rep1 f))+prop_genericTextShow1 :: (TextShow1 f, Generic1 f, GTextShow1 (Rep1 f), TextShow a)                       => Int -> f a -> Bool-prop_genericTextShow1 p x = showbPrecWith showb27Prec p x-                        == genericShowbPrecWith showb27Prec p x+prop_genericTextShow1 p x =+    showbPrec1 p x == genericLiftShowbPrec showbPrec showbList p x
− tests/TransformersCompat.hs 
@@ -1,396 +0,0 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFoldable             #-}-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE DeriveTraversable          #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TemplateHaskell            #-}-{-# LANGUAGE TypeFamilies               #-}--#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE DeriveGeneric              #-}-#endif--{-# OPTIONS_GHC -fno-warn-name-shadowing #-}--{-|-Module:      TransformersCompat-Copyright:   (C) 2014-2015 Ryan Scott-License:     BSD-style (see the file LICENSE)-Maintainer:  Ryan Scott-Stability:   Provisional-Portability: GHC--Defines the 'Show1' and 'Show2' classes for @String@s. This module will be removed-once the next version of @transformers@/@transformers-compat@ is released.--}-module TransformersCompat (-    -- * Liftings of Prelude classes-    -- ** For unary constructors-    Show1(..), showsPrec1,-    -- ** For binary constructors-    Show2(..), showsPrec2,-    -- * Helper functions-    showsUnaryWith,-    showsBinaryWith,-    -- * Conversion between @Text-@ and @String@ @Show1@/@Show2@-    FromStringShow1(..), FromTextShow1(..),-    FromStringShow2(..), FromTextShow2(..)-    ) where--#include "inline.h"--import           Control.Applicative (Const(..))--import           Data.Bifunctor.TH (deriveBifunctor, deriveBifoldable,-                                    deriveBitraversable)-#if __GLASGOW_HASKELL__ >= 708-import           Data.Data (Data, Typeable)-#endif-import           Data.Functor.Identity (Identity(..))--#if __GLASGOW_HASKELL__ < 706-import qualified Generics.Deriving.TH as Generics-#endif--#if __GLASGOW_HASKELL__ >= 702-import           GHC.Generics (Generic)-# if __GLASGOW_HASKELL__ >= 706-import           GHC.Generics (Generic1)-# endif-#endif--import           Prelude ()-import           Prelude.Compat--import           Text.Read (Read(..), readListPrecDefault)--import           TextShow (TextShow(showbPrec), TextShow1(..), TextShow2(..),-                           FromStringShow(..), FromTextShow(..),-                           showsToShowb, showbToShows, showbPrec1, showbPrec2)---- | Lifting of the 'Show' class to unary type constructors.-class Show1 f where-    -- | Lift a 'showsPrec' function through the type constructor.-    showsPrecWith :: (Int -> a -> ShowS) -> Int -> f a -> ShowS---- | Lift the standard 'showsPrec' function through the type constructor.-showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS-showsPrec1 = showsPrecWith showsPrec---- | The 'TextShow1' instance for 'FromStringShow1' is based on its @String@--- 'Show1' instance. That is,------ @--- showbPrecWith sp p ('FromStringShow1' x) =---     'showsToShowb' ('showsPrecWith' ('showbToShows' sp)) p x--- @------ /Since: ?.?/-newtype FromStringShow1 f a = FromStringShow1 { fromStringShow1 :: f a }-  deriving ( Eq-           , Functor-           , Foldable-#if __GLASGOW_HASKELL__ >= 702-           , Generic-# if __GLASGOW_HASKELL__ >= 706-           , Generic1-# endif-#endif-           , Ord-           , Show1-           , Traversable-#if __GLASGOW_HASKELL__ >= 708-           , Data-           , Typeable-#endif-           )--instance Read (f a) => Read (FromStringShow1 f a) where-    readPrec = FromStringShow1 <$> readPrec-    INLINE_INST_FUN(readPrec)--    readListPrec = readListPrecDefault-    INLINE_INST_FUN(readListPrec)--instance (Show1 f, Show a) => TextShow (FromStringShow1 f a) where-    showbPrec = showbPrecWith (showsToShowb showsPrec)-    INLINE_INST_FUN(showbPrec)--instance Show1 f => TextShow1 (FromStringShow1 f) where-    showbPrecWith sp p =-        showsToShowb (showsPrecWith $ showbToShows sp) p . fromStringShow1-    INLINE_INST_FUN(showbPrecWith)--instance (Show1 f, Show a) => Show (FromStringShow1 f a) where-    showsPrec = showsPrec1-    INLINE_INST_FUN(showsPrec)---- | Lifting of the 'Show' class to binary type constructors.-class Show2 f where-    -- | Lift 'showsPrec' functions through the type constructor.-    showsPrecWith2 :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->-        Int -> f a b -> ShowS---- | Lift the standard 'showsPrec' function through the type constructor.-showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS-showsPrec2 = showsPrecWith2 showsPrec showsPrec---- | The @String@ 'Show1' instance for 'FromTextShow1' is based on its--- 'TextShow1' instance. That is,------ @--- showsPrecWith sp p ('FromTextShow1' x) =---     'showbToShows' ('showbPrecWith' ('showsToShowb' sp)) p x--- @------ /Since: ?.?/-newtype FromTextShow1 f a = FromTextShow1 { fromTextShow1 :: f a }-  deriving ( Eq-           , Functor-           , Foldable-#if __GLASGOW_HASKELL__ >= 702-           , Generic-# if __GLASGOW_HASKELL__ >= 706-           , Generic1-# endif-#endif-           , Ord-           , TextShow1-           , Traversable-#if __GLASGOW_HASKELL__ >= 708-           , Data-           , Typeable-#endif-           )--instance Read (f a) => Read (FromTextShow1 f a) where-    readPrec = FromTextShow1 <$> readPrec-    INLINE_INST_FUN(readPrec)--    readListPrec = readListPrecDefault-    INLINE_INST_FUN(readListPrec)--instance (TextShow1 f, TextShow a) => Show (FromTextShow1 f a) where-    showsPrec = showsPrecWith (showbToShows showbPrec)-    INLINE_INST_FUN(showsPrec)--instance TextShow1 f => Show1 (FromTextShow1 f) where-    showsPrecWith sp p =-        showbToShows (showbPrecWith $ showsToShowb sp) p . fromTextShow1-    INLINE_INST_FUN(showsPrecWith)--instance (TextShow1 f, TextShow a) => TextShow (FromTextShow1 f a) where-    showbPrec = showbPrec1-    INLINE_INST_FUN(showbPrec)---- | The 'TextShow2' instance for 'FromStringShow2' is based on its @String@--- 'Show2' instance. That is,------ @--- showbPrecWith2 sp1 sp2 p ('FromStringShow2' x) =---     'showsToShowb' ('showsPrecWith2' ('showbToShows' sp1) ('showbToShows' sp2)) p x--- @------ /Since: ?.?/-newtype FromStringShow2 f a b = FromStringShow2 { fromStringShow2 :: f a b }-  deriving ( Eq-           , Functor-           , Foldable-#if __GLASGOW_HASKELL__ >= 702-           , Generic-# if defined(__LANGUAGE_DERIVE_GENERIC1__)-           , Generic1-# endif-#endif-           , Ord-           , Show2-           , Traversable-#if __GLASGOW_HASKELL__ >= 708-           , Data-           , Typeable-#endif-           )--instance Read (f a b) => Read (FromStringShow2 f a b) where-    readPrec = FromStringShow2 <$> readPrec-    INLINE_INST_FUN(readPrec)--    readListPrec = readListPrecDefault-    INLINE_INST_FUN(readListPrec)--instance (Show2 f, Show a, Show b) => TextShow (FromStringShow2 f a b) where-    showbPrec = showbPrecWith (showsToShowb showsPrec)-    INLINE_INST_FUN(showbPrec)--instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a) where-    showbPrecWith = showbPrecWith2 (showsToShowb showsPrec)-    INLINE_INST_FUN(showbPrecWith)--instance Show2 f => TextShow2 (FromStringShow2 f) where-    showbPrecWith2 sp1 sp2 p =-        showsToShowb (showsPrecWith2 (showbToShows sp1) (showbToShows sp2)) p . fromStringShow2-    INLINE_INST_FUN(showbPrecWith2)--instance (Show2 f, Show a, Show b) => Show (FromStringShow2 f a b) where-    showsPrec = showsPrec2-    INLINE_INST_FUN(showsPrec)--instance (Show2 f, Show a) => Show1 (FromStringShow2 f a) where-    showsPrecWith = showsPrecWith2 showsPrec-    INLINE_INST_FUN(showsPrecWith)---- | The @String@ 'Show2' instance for 'FromTextShow2' is based on its--- 'TextShow2' instance. That is,------ @--- showsPrecWith2 sp1 sp2 p ('FromTextShow2' x) =---     'showbToShows' ('showbPrecWith2' ('showsToShowb' sp1) ('showsToShowb' sp2)) p x--- @------ /Since: ?.?/-newtype FromTextShow2 f a b = FromTextShow2 { fromTextShow2 :: f a b }-  deriving ( Eq-           , Functor-           , Foldable-#if __GLASGOW_HASKELL__ >= 702-           , Generic-# if defined(__LANGUAGE_DERIVE_GENERIC1__)-           , Generic1-# endif-#endif-           , Ord-           , TextShow2-           , Traversable-#if __GLASGOW_HASKELL__ >= 708-           , Data-           , Typeable-#endif-           )--instance Read (f a b) => Read (FromTextShow2 f a b) where-    readPrec = FromTextShow2 <$> readPrec-    INLINE_INST_FUN(readPrec)--    readListPrec = readListPrecDefault-    INLINE_INST_FUN(readListPrec)--instance (TextShow2 f, TextShow a, TextShow b) => Show (FromTextShow2 f a b) where-    showsPrec = showsPrecWith (showbToShows showbPrec)-    INLINE_INST_FUN(showsPrec)--instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a) where-    showsPrecWith = showsPrecWith2 (showbToShows showbPrec)-    INLINE_INST_FUN(showsPrecWith)--instance TextShow2 f => Show2 (FromTextShow2 f) where-    showsPrecWith2 sp1 sp2 p =-        showbToShows (showbPrecWith2 (showsToShowb sp1) (showsToShowb sp2)) p . fromTextShow2-    INLINE_INST_FUN(showsPrecWith2)--instance (TextShow2 f, TextShow a, TextShow b) => TextShow (FromTextShow2 f a b) where-    showbPrec = showbPrec2-    INLINE_INST_FUN(showbPrec)--instance (TextShow2 f, TextShow a) => TextShow1 (FromTextShow2 f a) where-    showbPrecWith = showbPrecWith2 showbPrec-    INLINE_INST_FUN(showbPrecWith)------------------------------------------------------------------------------------- | @'showsUnaryWith' sp n d x@ produces the string representation of a--- unary data constructor with name @n@ and argument @x@, in precedence--- context @d@.-showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS-showsUnaryWith sp name d x = showParen (d > 10) $-    showString name . showChar ' ' . sp 11 x---- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string--- representation of a binary data constructor with name @n@ and arguments--- @x@ and @y@, in precedence context @d@.-showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->-    String -> Int -> a -> b -> ShowS-showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $-    showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y-----------------------------------------------------------------------------------instance Show a => Show1 ((,) a) where-    showsPrecWith = showsPrecWith2 showsPrec--instance Show a => Show1 (Either a) where-    showsPrecWith = showsPrecWith2 showsPrec--instance Show a => Show1 (Const a) where-    showsPrecWith = showsPrecWith2 showsPrec--instance Show1 Maybe where-    showsPrecWith _  _ Nothing  = showString "Nothing"-    showsPrecWith sp d (Just x) = showsUnaryWith sp "Just" d x--instance Show1 [] where-    showsPrecWith _  _ []     = showString "[]"-    showsPrecWith sp _ (x:xs) = showChar '[' . sp 0 x . showl xs-      where-        showl []     = showChar ']'-        showl (y:ys) = showChar ',' . sp 0 y . showl ys--instance Show1 Identity where-    showsPrecWith sp d (Identity x) = showsUnaryWith sp "Identity" d x--instance Show2 (,) where-    showsPrecWith2 sp1 sp2 _ (x, y) =-        showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')'--instance Show2 Either where-    showsPrecWith2 sp1 _   d (Left x)  = showsUnaryWith sp1 "Left" d x-    showsPrecWith2 _   sp2 d (Right x) = showsUnaryWith sp2 "Right" d x--instance Show2 Const where-    showsPrecWith2 sp _ d (Const x) = showsUnaryWith sp "Const" d x--instance (Show a, Show b, Show c) => Show2 ((,,,,) a b c) where-    showsPrecWith2 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 ')'---- TODO: Move these instance into text-show itself once transformers is updated-instance Show1 FromStringShow where-    showsPrecWith sp p = sp p . fromStringShow-    INLINE_INST_FUN(showsPrecWith)--instance Show1 FromTextShow where-    showsPrecWith sp p =-        showbToShows (showsToShowb sp) p . fromTextShow-    INLINE_INST_FUN(showsPrecWith)-----------------------------------------------------------------------------------$(deriveBifunctor     ''FromStringShow2)-$(deriveBifunctor     ''FromTextShow2)-$(deriveBifoldable    ''FromStringShow2)-$(deriveBifoldable    ''FromTextShow2)-$(deriveBitraversable ''FromStringShow2)-$(deriveBitraversable ''FromTextShow2)--#if __GLASGOW_HASKELL__ < 706-$(Generics.deriveMeta           ''FromStringShow1)-$(Generics.deriveRepresentable1 ''FromStringShow1)-$(Generics.deriveMeta           ''FromTextShow1)-$(Generics.deriveRepresentable1 ''FromTextShow1)-$(Generics.deriveMeta           ''FromStringShow2)-$(Generics.deriveRepresentable1 ''FromStringShow2)-$(Generics.deriveMeta           ''FromTextShow2)-$(Generics.deriveRepresentable1 ''FromTextShow2)-#endif--#if __GLASGOW_HASKELL__ < 702-$(Generics.deriveRepresentable0 ''FromStringShow1)-$(Generics.deriveRepresentable0 ''FromStringShow2)-$(Generics.deriveRepresentable0 ''FromTextShow1)-$(Generics.deriveRepresentable0 ''FromTextShow2)-#endif
text-show.cabal view
@@ -1,5 +1,5 @@ name:                text-show-version:             2.1.2+version:             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@@ -50,6 +50,7 @@                    , GHC == 7.6.3                    , GHC == 7.8.4                    , GHC == 7.10.3+                   , GHC == 8.0.1 extra-source-files:  CHANGELOG.md, README.md, include/*.h cabal-version:       >=1.10 @@ -78,18 +79,23 @@                        TextShow.Data.Either                        TextShow.Data.Fixed                        TextShow.Data.Floating+                       TextShow.Data.Functor.Compose                        TextShow.Data.Functor.Identity+                       TextShow.Data.Functor.Product+                       TextShow.Data.Functor.Sum                        TextShow.Debug.Trace                        TextShow.Debug.Trace.Generic                        TextShow.Debug.Trace.TH                        TextShow.Generic                        TextShow.Data.Integral                        TextShow.Data.List+                       TextShow.Data.List.NonEmpty                        TextShow.Data.Maybe                        TextShow.Data.Monoid                        TextShow.Data.Ord                        TextShow.Data.Proxy                        TextShow.Data.Ratio+                       TextShow.Data.Semigroup                        TextShow.Data.Text                        TextShow.Data.Tuple                        TextShow.Data.Typeable@@ -136,30 +142,33 @@                        TextShow.TH.Internal                        TextShow.TH.Names                        TextShow.Utils-  build-depends:       array              >= 0.3     && < 0.6-                     , base               >= 4.3     && < 5-                     , base-compat        >= 0.8.1   && < 1-                     , bytestring         >= 0.9     && < 0.11+  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-                     , generic-deriving   >= 1.9     && < 2+                     , containers          >= 0.1    && < 0.6+                     , generic-deriving    >= 1.9    && < 2                      , ghc-prim                      , integer-gmp-                     , nats               >= 0.1     && < 2-                     , semigroups         >= 0.16.1  && < 1-                     , tagged             >= 0.4.4   && < 1-                     , text               >= 0.11.1  && < 1.3-                     , template-haskell   >= 2.5     && < 2.12-                     , transformers       >= 0.2.1   && < 0.5-                     , void               >= 0.5     && < 1+                     , nats                >= 0.1    && < 2+                     , 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   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -Wall   include-dirs:        include   includes:            inline.h                      , utils.h-  install-includes:    inline.h-                     , utils.h  test-suite spec   type:                exitcode-stdio-1.0@@ -183,10 +192,15 @@                        Instances.Data.Data                        Instances.Data.Dynamic                        Instances.Data.Floating+                       Instances.Data.Functor.Compose                        Instances.Data.Functor.Identity+                       Instances.Data.Functor.Product+                       Instances.Data.Functor.Sum+                       Instances.Data.List.NonEmpty                        Instances.Data.Monoid                        Instances.Data.Ord                        Instances.Data.Proxy+                       Instances.Data.Semigroup                        Instances.Data.Text                        Instances.Data.Tuple                        Instances.Data.Typeable@@ -242,14 +256,19 @@                        Spec.Data.EitherSpec                        Spec.Data.FixedSpec                        Spec.Data.FloatingSpec+                       Spec.Data.Functor.ComposeSpec                        Spec.Data.Functor.IdentitySpec+                       Spec.Data.Functor.ProductSpec+                       Spec.Data.Functor.SumSpec                        Spec.Data.IntegralSpec                        Spec.Data.ListSpec+                       Spec.Data.List.NonEmptySpec                        Spec.Data.MaybeSpec                        Spec.Data.MonoidSpec                        Spec.Data.OrdSpec                        Spec.Data.ProxySpec                        Spec.Data.RatioSpec+                       Spec.Data.SemigroupSpec                        Spec.Data.TextSpec                        Spec.Data.TupleSpec                        Spec.Data.TypeableSpec@@ -301,33 +320,32 @@                        -- Only exports tests if base >= 4.8                        Spec.GHC.RTS.FlagsSpec                        Spec.GHC.StaticPtrSpec--                       TransformersCompat   build-depends:       array                >= 0.3    && < 0.6                      , base                 >= 4.3    && < 5                      , base-compat          >= 0.8.2  && < 1                      , base-orphans         >= 0.4.2  && < 1                      , bifunctors           >= 5.1    && < 6-                     , bytestring           >= 0.9    && < 0.11+                     , bytestring           >= 0.9    && < 0.11                      , bytestring-builder+                     , containers           >= 0.1    && < 0.6                      , generic-deriving     >= 1.9    && < 2                      , ghc-prim                      , hspec                >= 2      && < 3+                     , integer-gmp                      , nats                 >= 0.1    && < 2                      , QuickCheck           >= 2.5    && < 3                      , quickcheck-instances >= 0.1    && < 0.4-                     , tagged               >= 0.8.1  && < 1+                     , semigroups           >= 0.17   && < 1+                     , tagged               >= 0.8.3  && < 1+                     , template-haskell     >= 2.5    && < 2.12                      , text                 >= 0.11.1 && < 1.3-                     , transformers         >= 0.2.1  && < 0.5-                     , transformers-compat  >= 0.3    && < 1+                     , transformers         >= 0.2.1  && < 0.6+                     , transformers-compat  >= 0.5    && < 1                      , void                 >= 0.5    && < 1-  if flag(developer)-    build-depends:     containers           >= 0.1    && < 0.6-                     , integer-gmp-                     , semigroups           >= 0.16.1 && < 1-                     , template-haskell     >= 2.5    && < 2.12-  else-    build-depends:     text-show            == 2.1.2+  if impl(ghc >= 8.0)+    build-depends:     ghc-boot+  if !flag(developer)+    build-depends:     text-show            == 3    hs-source-dirs:      tests   if flag(developer)@@ -337,8 +355,5 @@   ghc-options:         -Wall -threaded -rtsopts   include-dirs:        include   includes:            generic.h-                     , overlap.h-                     , utils.h-  install-includes:    generic.h                      , overlap.h                      , utils.h