text-show-3.10.4/0000755000000000000000000000000007346545000011732 5ustar0000000000000000text-show-3.10.4/CHANGELOG.md0000644000000000000000000010106307346545000013544 0ustar0000000000000000### 3.10.4 [2023.08.06] * Support building with GHC 9.8. * Ensure that the `TextShow` instance for `TypeRep` properly displays `TypeRep []` as `"[]"`. * Ensure that the `TextShow` instance for `TypeRep` properly handles partial applications of tuple constructors (e.g., `(,) Int`). * Support deriving `TextShow(1)(2)` instances for data types with fields of type `Int64#` or `Word64#` on GHC 9.8 or later. * When generating `TextShow(1)(2)` instances with `TextShow.TH` using GHC 9.8 or later, data types that have fields of type `Int{8,16,32,64}#` or `Word{8,16,32,64}#` will be printed using extended literal syntax, mirroring corresponding changes introduced in GHC 9.8 (see https://github.com/ghc-proposals/ghc-proposals/pull/596). ### 3.10.3 [2023.06.03] * Support building with `QuickCheck-2.14.3` in the test suite. ### 3.10.2 [2023.03.05] * Allow building with GHC 9.6. * Add `TextShow` instances for `SomeChar` (if building with `base-4.16` or later), as well as `SNat`, `SSymbol`, and `SChar` (if building with `base-4.18` or later). ### 3.10.1 [2023.02.27] * Support `th-abstraction-0.5.*`. ## 3.10 [2022.10.05] * The instances in `TextShow.FromStringTextShow` module have been scaled back somewhat for forward compatibility with Core Libraries proposal #10, which will add quantified `Show` superclasses to `Show1` and `Show2`: * `FromStringShow` and `FromTextShow` no longer have `Show1` or `TextShow1` instances. If you want to derive instances of `Show1` or `TextShow1` via a newtype, use `FromStringShow1` or `FromTextShow1` instead. * The `Show` instances for `FromTextShow1` and `FromTextShow2` have had their instance contexts changed to accommodate the new superclasses in `Show1` and `Show2`: ```diff -instance (TextShow1 f, TextShow a) => Show (FromTextShow1 f a) +instance (TextShow1 f, Show a) => Show (FromTextShow1 f a) -instance (TextShow2 f, TextShow a, TextShow b) => Show (FromTextShow2 f a b) +instance (TextShow2 f, Show a, Show b) => Show (FromTextShow2 f a b) ``` While these instances do technically work, they are probably not what you would have in mind if you wanted to derive a `Show` instance purely in terms of `TextShow` classes. For this reason, if you want to derive an instance of `Show` via a newtype, use `FromTextShow` instead. * By similar reasoning, the `Show1` instance for `FromTextShow2` has had its instance context changed: ```diff -instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a) +instance (TextShow2 f, Show a) => Show1 (FromTextShow2 f a) ``` * By similar reasoning, the `TextShow` instances for `FromStringShow1` and `FromStringShow2`, as well as the `TextShow1` instance for `FromStringShow2`, have had their instance contexts changed: ```diff -instance (Show1 f, Show a) => TextShow (FromStringShow1 f a) +instance (Show1 f, TextShow a) => TextShow (FromStringShow1 f a) -instance (Show2 f, Show a, Show b) => TextShow (FromStringShow2 f a b) +instance (Show2 f, TextShow a, TextShow b) => TextShow (FromStringShow2 f a b) -instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a) +instance (Show2 f, TextShow a) => TextShow1 (FromStringShow2 f a) ``` * The `TextShow{1,2}` classes now have quantified superclasses: ```hs class (forall a. TextShow a => TextShow (f a)) => TextShow1 f where ... class (forall a. TextShow a => TextShow1 (f a)) => TextShow2 f where ... ``` This mirrors corresponding changes made to `Show1` and `Show2` in the `base` library. See https://github.com/haskell/core-libraries-committee/issues/10. Because of this change, any code that defines a `TextShow1` instance for a data type without a corresponding `TextShow` instance will no longer compile, so you may need to define more `TextShow` instances to adapt to this change. Similarly, `TextShow2` instances will now also require corresponding `TextShow` and `TextShow1` instances. * The `GTextShow*` classes in `TextShow.Generic`, which power generic derivation of `TextShow` and `TextShow1` instances, have been split up to facilitate the addition of a quantified superclass to `TextShow1`. Moreover, the `ShowFuns*` data types, the `Zero` data type, and the `One data type have been removed, as they are no longer necessary in light of this split. Although this is a breaking API change, the changes should be invisible to most users of the module, especially if your code only uses it to derive `TextShow{,1}` instances. * Add a `TextShow` instance for `ByteArray` from `Data.Array.Byte` when building with `base-4.17.0.0` or later. ### 3.9.7 [2022.05.28] * Allow the test suite to build with GHC 9.4. * Allow building with `transformers-0.6.*`. ### 3.9.6 [2022.01.14] * `text-show` no longer depends on `integer-gmp` when built with GHC 9.0 or later. When building with older versions of GHC, the `integer-gmp` dependency can be toggled by disabling the `integer-gmp` `cabal` flag. ### 3.9.5 [2022.01.03] * Work around a GHC 8.0–specific issue in which GHC's simplifier ticks would become exhausted, causing compilation to fail. ### 3.9.4 [2021.12.26] * Allow the test suite to build with `text-2.0.*` and `transformers-compat-0.7.1`. ### 3.9.3 [2021.10.31] * Allow building with GHC 9.2. * Drop support for GHC 7.4 and 7.6. * Add `TextShow(1)` instances for `Solo` when building with `ghc-prim-0.7` or later. * Support deriving `TextShow(1)(2)` instances for data types with fields of type `Int32#` or `Word32#` on GHC 8.2 or later. ### 3.9.2 [2021.08.30] * Require `generic-deriving-1.14.1` or later in the test suite. ### 3.9.1 [2021.08.29] * Require `base-orphans-0.8.5` or later in the test suite. ## 3.9 [2020.10.03] * Allow building with GHC 9.0. * Remove `TextShow(1)` instances for `Data.Semigroup.Option`, which is deprecated as of `base-4.15.0.0`. * Fix a bug in which `deriveTextShow{1,2}` would needlessly reject data types whose last type parameters appear as oversaturated arguments to a type family. ### 3.8.5 [2020.02.28] * Import from `GHC.Exts`, not `GHC.Prim`. ### 3.8.4 [2020.01.28] * Update the `TextShow(1)` instances for `Down` and `ThreadId` to match their implementations in `base-4.14`. ### 3.8.3 [2019.11.06] * Use `base-compat-batteries-0.11.0` to define instances for `(:~:)` back to `base-4.5` and instances for `(:~~:)` back to `base-4.9`. ### 3.8.2 [2019.05.02] * Make the `TextShow` instances for `UArray` and `Fixed` use the correct precedence on `base-4.13` or later. * Support deriving `TextShow(1)(2)` instances for data types with fields of type `Int8#`, `Int16#`, `Word8#`, or `Word16#` on GHC 8.8 or later. ### 3.8.1 [2019.04.26] * Support `th-abstraction-0.3` or later. ## 3.8 [2019.03.19] * Remove the `TextShow I16` instance from `TextShow.Data.Text`. The usefulness of this instance was dubious at best, and moreover, it was actively causing issues when building `text-show` with `reflex-platform` (see [#40](https://github.com/RyanGlScott/text-show/issues/40)). ### 3.7.5 [2018.10.07] * _Actually_ make `showbEFloat`'s behavior match that of `showEFloat` in `base-4.12`. * Remove uses of `AutoDeriveTypeable`, since it is now deprecated. (As a result, some things which used to have `Typeable` instances on GHC 7.8 no longer do, but I'm choosing not to be bothered by this unless someone shouts.) ### 3.7.4 [2018.07.03] * Add `FromGeneric` and `FromGeneric1` newtype adapters to `TextShow.Generic`. These are suitable for use with `DerivingVia`, and provide a convenient way to obtain `Generic(1)`-based defaults for `TextShow(1)` instances. * Add `TextShow(1)` instances for `Data.Monoid.Ap` on `base-4.12` or later. * Make `showbEFloat`'s behavior match that of `showEFloat` in `base-4.12`. ### 3.7.3 [2018.04.07] * Use `base-compat-batteries`. * Add a `TextShow FixIOException` instance on `base-4.11` or later. ### 3.7.2 [2018.03.08] * Depend on `quickcheck-instances-0.3.18` or later. ### 3.7.1 [2017.12.29] * Don't define a `TextShow GCStats` instance on GHC 8.4 or later, as `GCStats` has been removed from `base`. This fixes the build on GHC 8.4. ## 3.7 [2017.12.07] * Use `EmptyCase` on GHC 7.8 or later for `TextShow(1)` instances for empty data types that are derived using `TextShow.Generic`. * Derived `TextShow(1)(2)` instances (using `TextShow.TH`) will now force their argument instead of simply `error`ing. * Add `emptyCaseBehavior` to `Options`, which configures whether derived instances (using `TextShow.TH`) for empty data types should use the `EmptyCase` extension (this is disabled by default). ### 3.6.2 [2017.06.18] * Drop support for GHC 7.0 and 7.2 * Require `QuickCheck-2.10`/`quickcheck-instances-0.13.6` or later ### 3.6 [2017.04.22] * Introduce some 'TextShow' instances for datatypes added in `base-4.10.0.0`: * `CBool` (from `Foreign.C.Types`) * `CBlkSize`, `CBlkCnt`, `CClockId`, `CFsBlkCnt`, `CId`, `CKey`, and `CTimer` (from `System.Posix.Types`) * `CompactionFailed` (from `Control.Exception`) * `(:~~:)` (from `Data.Type.Equality`) * `TypeRep` and `SomeTypeRep` (from `Type.Reflection`) * Remove most monomorphic `TextShow` functions, as their utility is questionable, and their maintenance burden is undeniable * Add `showbCommaSpace`, `showtCommaSpace`, and `showtlCommaSpace` to `TextShow`. This appears quite frequently in derived `TextShow` instances, so it is likely worthwhile to define it once. * Rename `showbVersionConcrete` to `showbVersion` in `TextShow.Data.Version` * Add `SPECIALIZE` pragmas for `showbEFloat`, `showbFFloat`, and `showbGFloat` in `TextShow.Data.Floating`, mirroring the ones in `Numeric` * Generalize the kind of the last type parameter for the `TextShow (Const a b)` instance, which previously had been defaulted to `*` * Refactor test suite #### 3.4.1.1 [2016.11.07] * Require `criterion-1.1.4` or later. This allows the benchmarks to be run on older versions of GHC. ### 3.4.1 [2016.10.20] * Require `QuickCheck-2.9` or later * Fix bug in which infix record selectors weren't shown with parentheses ## 3.4 * The default definitions of `showt` and `showtl` were changed to `showtPrec 0` and `showtlPrec 0`, respectively * `deriveTextShowOptions`, `deriveTextShow1Options`, and `deriveTextShow2Options` added to `TextShow.TH`, which allow further configuration of how `TextShow(1)(2)` instances should be derived using the new `Options` data type. `Options` itself contains `GenTextMethods`, which configures whether manual implementations of `TextShow` should implement the methods that return strict and lazy `Text`. * The `defaultOptions` uses `SometimesTextMethods`, which only implements the `Text`-returning methods if the datatype contains only nullary constructors (i.e., it is an enumeration type). For example, `deriveTextShow = deriveTextShowOptions defaultOptions`. One can also choose `AlwaysTextMethods` or `NeverTextMethods` instead. * The internals of `TextShow.Generic` were refactored so that is possible to generically derive `showbPrec`, `showtPrec`, and `showtlPrec` (which use `Builder`, strict `Text`, and lazy `Text`, respectively). Before, only generic derivation of `showbPrec` was possible, and all other generic functions were defined in terms of `showbPrec`. * The internal class `GTextShow` was split up into `GShowB`, `GShowT`, and `GShowTL`, depending on what type it returns. * As a result, functions like `genericShowtPrec` might be faster than before if they are showing something like an enumeration type, since they no longer construct an intermediate `Builder`. On the other hand, they might be slower if they are showing a constructor with many fields, since they will now be appending lots of `Text`s. If so, make sure to switch to `genericShowbPrec` and convert the final `Builder` to `Text` instead. * Added `showtParen`, `showtSpace`, `showtlParen`, `showtlSpace`, `liftShowtPrec`, `liftShowtPrec2`, `liftShowtlPrec`, and `liftShowtlPrec2` to `TextShow` * Added `showtPrecToShowbPrec`, `showtlPrecToShowbPrec`, `showtToShowb`, `showtlToShowb`, `showbPrecToShowtPrec`, `showbPrecToShowtlPrec`, `showbToShowt`, and `showbToShowtl` to `TextShow` * Added `showtListWith` and `showtlListWith` to `TextShow.Data.List` * Added `Data` instance for `ConType` in `TextShow.Generic` * Require `generic-deriving-1.11` or later ## 3.3 * Refactored the internals of `TextShow.Generic` to avoid the use of proxies. * Made benchmark suite more comprehensive, including benchmarks for showing an enumeration type * Microoptimization in derived `TextShow1/2` instances involving `TextShow.TH` * Allow building with `QuickCheck-2.9` * Fix GHC HEAD build ### 3.2.2 * Added benchmarks ### 3.2.1 * Fixed compilation on GHC 8.0 ## 3.2 * Rewrote `TextShow.Generic` to enable more code reuse. The `GTextShow1` and `GTextShow1Con` classes were eliminated, and `GTextShow` and `GTextShowCon` were redesigned to be able to generically implement both `showbPrec` and `liftShowbPrec`. The latter two classes now take an additional `arity` type parameter which is `Zero` if `TextShow` is being derived and `One` is `TextShow1` is being derived. ## 3.1 * Made the derived `TextShow` output of record datatypes match that of `Show` in GHC 8.0 (now that Trac #2530 has been reverted) * Fixed GHC 8.0 build (again) ### 3.0.1 * Added the `TextShow.GHC.Stack` module, which provides `TextShow` instances for `CallStack` and `SrcLoc` on `base-4.8.1` and up. * Fix Haddock rendering error # 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 * Added `Generic1` instances for `FromStringShow` and `FromTextShow` * Added `TextShow` instances for `UChar`, `UDouble`, `UFloat`, `UInt`, and `UWord` in `TextShow.GHC.Generics` # 2.1.1 * Restore support for `semigroups-0.16.1` # 2.1 * Require `semigroups` >= 0.17 * Added `showsToShowb` and `showbToShows` to `TextShow` * Added `TextShow1 FromStringShow` instance * Added `showbGiveGCStats`, `showbDoCostCentres`, `showbDoHeapProfile`, and `showbDoTrace` to `TextShow.GHC.RTS.Flags` if using `base-4.8.2` or later * Exported `showbDownPrecWith` on earlier versions of GHC * Fixed mistakes in TH error output * Make `Proxy`, `Coercion`, and `(:~:)` instances poly-kinded * Changed implementation of `showbByteStringStrict`, `showbByteStrictLazy(Prec)`, `showbShortByteString` (in `TextShow.Data.ByteString`), `showbThreadIdPrec` (in `TextShow.Control.Concurrent`), `showbEvent`, and `showbFdKeyPrec` (in `TextShow.GHC.Event`) to avoid using `String`s as an intermediary # 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` * 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` * Fixed a bug in the Template Haskell deriver which would cause `deriveTextShow` to fail on type parameters with sufficiently high kinds # 1 * The `Show1` class has been completely overhauled. `Show1` now uses the function `showbPrecWith`, which takes as an argument a function of type `Int -> a -> Builder` to show occurrences of the type parameter (instead of requiring the type parameter to be a `Show` instance). This matches the new implementation of `Show1` in the next version of `transformers`. A similar `Show2` class (with the function `showbPrecWith2`) was also added. * As a consequence, `Show1` instances should no longer be defined in terms of `showbPrec`; rather, `Show` instances should be defined in terms of `showbPrecWith` or `showbPrecWith2`, and `Show1` instances can be defined in terms of `showbPrecWith2`. * The `showbPrec1` function is no longer a class method of `Show1`, but is now a standalone function defined in terms of `showbPrecWith`. `showbPrec1` can be useful for defining `Show` instances. A similar `showbPrec2` function was also added. * The monomorphic functions in the many submodules of this package have been generalized (where possible) to use `Show1` and `Show2` instances. These functions have `-PrecWith` and `-PrecWith2` suffixes, respectively. * Because of the generality of the new `showPrecWith` function, `Show1` instances are now possible for `Ratio`, `Alt`, `Rec1`, `M1`, `(:+:)`, `(:*:)`, and `(:.:)`. * Removed many silly instances for `FromStringShow` and `FromTextShow`, since they'll never be used in the ways suggested by those instances to begin with. * The Template Haskell engine has been completely overhauled. Deriving `Show1` and `Show2` instances are now possible using the `deriveShow1` and `deriveShow2` functions. See the documentation in `Text.Show.Text.TH` for more details. In addition, the `mkShowbPrecWith`, `mkShowbPrec1`, `mkShowbPrecWith2`, and `mkShowbPrec2` functions were added. * Removed the ability to call `deriveShow` or `mkShowbPrec` (or other functions prefixed with `mk-`) using a data family name. This is considered a misfeature. If you want to derive `Show` for data family instances, use the corresponding `data instance` or `newtype instance` constructor name as an argument instead. * Removed `PragmaOptions`, `deriveShowPragmas`, `defaultInlineShowbPrec`, `defaultInlineShowb`, and `defaultInlineShowbList`, as it was impossible to make Template Haskell-generated pragmas work consistently across different versions of GHC. If you really want to use `INLINE` and `SPECIALIZE instance` pragmas with your Template Haskell-generated code, create manual instances with `mkShowbPrec` and family. * `Show1` instances can now be created generically using the `genericShowbPrecWith` function in `Text.Show.Text.Generics`. A `genericShowbPrec1` was also added. * Added `generic-deriving` as a dependency, which allows generics-related code to be exported on more versions of GHC * `ConType` (in `Text.Show.Text.Generics`) now has an `Inf String` constructor instead of `Inf Builder`. As a result, `ConType` now always an `Eq` and `Ord` instance, and a `Read ConType` instance was added. * `Typeable` instances for the promoted data constructors `'FromStringShow` and `'FromTextShow` * Added `showbFPFormat` to `Text.Show.Text.Data.Floating` * Revamped test suite ### 0.8.1.1 * Retroactive `CHANGELOG` update ## 0.8.1 * Fix test suite build with older versions of `QuickCheck` # 0.8 * Exported `formatRealFloatB` and `formatRealFloatAltB` from `Text.Show.Text.Data.Floating`. Reexported `FPFormat` (from `text`) in the same module, and added a `Text` `Show` instance for it. * The `Show` instance for `Ratio a` now only requires a `Show a` constraint if using `base-4.4.0.0` or later (if using `base-4.3.0.0`, it requires a `(Show a, Integral a)` constraint) * Added `showbSingPrec` to `Text.Show.Text.GHC.TypeLits` (if using `base-4.6`) * Modules which were previously exported only if using a recent-enough version of GHC/`base` (e.g., `Text.Show.Text.GHC.Generics`) are now always exposed. If the functionality that the module provides is not available on a given version of GHC/`base`, the module will not expose anything. * Bump lower version bounds of `text` to 0.11.1 due to reexporting `FPFormat` * Added `showbUnicodeException`, `showbI16Prec`, `showbDecodingPrec`, and `showbSizePrec` functions (and corresponding `Show` instances) to `Text.Show.Text.Data.Text` * Made `GShow` in `Text.Show.Text.Generics` poly-kinded * The Template Haskell deriver (and `GShow`) now handles "infix" data constructors that are applied as prefix correctly (e.g., `data Amp a = (:&) a a`) * The Template Haskell deriver now handles showable unlifted types (`Char#`, `Double#`, `Float#`, `Int#`, and `Word#`) correctly on GHC 7.11 and later * The Template Haskell derive now does not parenthesize record types regardless of precedence on GHC 7.11 and later * Fixed build on GHC 7.2 * Changed test-suite to use `hspec`, which allows for it to be built on GHC 7.0 and 7.2 ### 0.7.0.1 * Disabled `print`-related tests, as they sporadically break referential transparency for unknown reasons * Fixed build on Windows # 0.7 * Added `showbConstPrec` (and corresponding `Show` and `Show1` instances for `Const`) to `Text.Show.Text.Control.Applicative` * Added `showbUArrayPrec` (and corresponding `Show` instance for `UArray`s) and `showbIArrayPrec` to `Text.Data.Text.Data.Array`. * Renamed `showbListDefault` to `showbListWith` to match how `Text.Show` names it * Exposed `showbShortByteString` with all versions of `bytestring` by using the `bytestring-builder` package * Corrected the `Show` instance for `Lexeme` (in `Text.Show.Text.Text.Read.Lex`) * Fixed `TypeRep` output on GHC 7.10 and later * Removed `LitChar` and `LitString` from `Text.Show.Text.Data.Char`, as they were not as useful as I had imagined. * Removed the deprecated `replicateB` function * `Typable` instances for `Show`, `Show1`, and `GShow` (with GHC 7.8 and later) * `Typeable` instance for `ConType` * Only derive `Eq` and `Ord` for `ConType` if a recent-enough version of `text` is used * Changed the implementations of some functions in `Text.Show.Text.Debug.Trace` to use `ByteString`s instead of `String`s ### 0.6.0.1 * Forgot to include some header files in `text-show.cabal` # 0.6 * `deriveShow` can now construct instances for data families, using either the data family name or a data instance constructor as an argument. See the documentation in `Text.Show.Text.TH` for more details. * Fixed a bug in which infix backticked data constructors (e.g., ```data Add = Int `Plus` Int```) would not be shown correctly. * Fixed typo in `Text.Show.Text.GHC.RTS.Flags` * Removed the phantom-type detecting mechanism with `template-haskell-2.9.0.0` or higher. This method of finding phantom types is intrinsically flawed and is not usable on older GHCs. * Added generics support with the `Text.Show.Text.Generic` and `Text.Show.Text.Debug.Trace.Generic` modules * Deprecated `replicateB` in favor of `timesN` from the `semigroups` library * Added `FromTextShow` to `Text.Show.Text`, which admits a `String` `Show` instance for any data type with a `Text` `Show` instance (the counterpart of `FromStringShow`) * Added `Monoid` and `Semigroup` instances for `FromStringShow`, `Semigroup` instance for `LitString`, `IsChar` instance for `LitChar`, and `IsString` instance for `[LitChar]` * Changed the `String` `Show` instances of `FromStringShow`, `LitChar`, and `LitString` to more closely match the `Text` `Show` instances. As a result, the `Read` instances for these data types were also changed so that `read . show = read . show = id`. * Removed the `recent-text` flag. We'll allow users to build with older versions of `text`, but the latest version is recommended. Because of this, the `integer-simple` and `integer-gmp` flags are not needed. * Removed the `integer-gmp2` flag, as it supported a configuration that didn't actually compile on GHC * Removed the `transformers-four` flag, as it is not needed now that `transformers-compat` is a dependency # 0.5 * Fix build for GHC 7.10, old GHC versions, and Windows * Removed the `Text.Show.Text.Data.Containers` and `Text.Show.Text.Data.Time` modules. The modules for the data types in `containers` and `time` were migrated to a separate library, `text-show-instances`. * Removed the `-ftext-format` flag, as `text-show` no longer uses `text-format`. * A [serious bug](https://github.com/bos/text/issues/99) in the `text` package that caused segfaults when building large `Integer`s was fixed in `text-1.2.0.2`. A flag (`-frecent-text`) was added that allows you to take advantage of this. * Fixed a bug that would cause the output of functions in the `Text.Show.Text.Data.Floating` module to not match `base` depending on what version of `base` is used. * The type signatures of lambda expressions generated by `mkShow` and related functions were loosened to allow them to be used to "manually" derive `Show` instances for data types with higher-kinded type parameters or type arguments with restricted `Show` instances. This should not be a breaking change; you can simply do more with `mkShow` et al. than you could before. For more information, see the documentation in `Text.Show.Text.TH`. * Loosened the `Show` instance of `Complex a` to only depend on `Show a` (previously required `RealFloat a`) if using base-4.4.0.0 or later * Moved `showbRatioPrec` to `Text.Show.Text.Data.Ratio`, `showbComplexPrec` to `Text.Show.Text.Data.Complex`, `showbProxy` to `Text.Show.Text.Data.Proxy`, and `showbFingerprint` to `Text.Show.Text.GHC.Fingerprint` * Added `deriveShowPragmas` to `Text.Show.Text.TH` to allow users to specify `INLINE` or `SPECIALIZE instance` pragmas with `Show` instances. * Added `FromStringShow`, `showbSpace`, `showbUnary`, `showbUnary1`, and `showbBinary1` to `Text.Show.Text` * Added `mkShowList`, `mkShowListLazy`, and `mkShowbList` to `Text.Data.Text.TH` * For base-4.8.0.0 and above, added the `Text.Show.Text.Data.Functor.Identity`, `Text.Show.Text.Data.Void`, `Text.Show.Text.GHC.RTS.Flags`, `Text.Show.Text.GHC.StaticPtr`, and `Text.Show.Text.Numeric.Natural` modules. Also added `Show` instances for `AllocationLimitExceeded` in `Text.Show.Text.Control.Exception` and `Alt` in `Text.Show.Text.Data.Monoid`. Also fixed the `Show` instance for `Fixed` values. * Added the `Text.Show.Text.Data.GHC.Conc.Windows` module (Windows-only) * Added the `Text.Show.Text.Data.OldTypeable` module for base-4.7 * Added the `Text.Show.Text.GHC.TypeLits` module for base-4.6 and above * Added the `Text.Show.Text.Debug.Trace` and `Text.Show.Text.Debug.Trace.TH` modules as an analog to `Debug.Trace` * Added the `Show1` class and corresponding instances for unary type constructors. * Added `LitChar` and `LitString` to `Text.Show.Text.Data.Char` * Exported `asciiTabB` in `Text.Show.Text.Data.Char` * Renamed `showbTextStrict` to 'showbText' (to keep with naming conventions in the `text` library) and added `showbBuilder` to `Text.Show.Text.Data.Text`. ## 0.4.1 * Added the utility functions `toText` and `toString` for working with `Builder`s. # 0.4 * Due to [GHC bug #5289](http://ghc.haskell.org/trac/ghc/ticket/5289), projects that depend on the `double-conversion` library (such as `text-format`, a dependency of `text-show`) may break due to GHC incorrectly linking against libstdc++. Therefore, `text-show` was changed so that it does not depend on `text-format` by default. This behavior can be changed by using the `-ftext-format` flag when using `cabal`. * Added `showbZonedTime` to `Text.Show.Text.Data.Time` (and corresponding `Show` instance for `ZonedTime`) * Exposed `showbMaskingState` (is was already there, I just forgot to export it) * If using GHC 7.6 or earlier, depend on tagged so that `Data.Proxy` (and thus `showbProxy` from `Text.Show.Text.Data.Typeable`) can be used * Refactored code to use Template Haskell derivations when possible ## 0.3.1.0 * Added `showList` and `showListLazy` * Don't use `showbListDefault` to show `containers` data types * Added the ability to splice `show` functions for arbitrary data types (even if they aren't `Show` instances). These functions are `mkShow`, `mkShowLazy`, `mkShowPrec`, `mkShowPrecLazy`, `mkShowb`, `mkShowbPrec`, `mkPrint`, `mkPrintLazy`, `mkHPrint`, and `mkHPrintLazy`. # 0.3.0.0 * Lots of bugfixes * `Show` instances for many other data types in `base`, `containers` and `time` * Exposed internal modules with monomorphic functions * `Text.Show.Text` now exports `Data.Text.Lazy.Builder` for convenience * Add `showLazy`, `showPrec`, `showPrecLazy`, `printLazy`, `hPrint`, `hPrintLazy`, `lengthB`, and `replicateB` * Template Haskell derivation of `Show` instances (doesn't support data families yet) # 0.2.0.0 * Added `Show` instances for strict and lazy `Text` # 0.1.0.0 * Initial commit text-show-3.10.4/LICENSE0000644000000000000000000000276307346545000012747 0ustar0000000000000000Copyright (c) 2014-2017, Ryan Scott All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Ryan Scott nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. text-show-3.10.4/README.md0000644000000000000000000000430307346545000013211 0ustar0000000000000000# `text-show` [![Hackage](https://img.shields.io/hackage/v/text-show.svg)][Hackage: text-show] [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/text-show.svg)](http://packdeps.haskellers.com/reverse/text-show) [![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3] [![Linux build](https://github.com/RyanGlScott/text-show/workflows/Haskell-CI/badge.svg)](https://github.com/RyanGlScott/text-show/actions?query=workflow%3AHaskell-CI) [![Windows build](https://ci.appveyor.com/api/projects/status/fy1q86lbfttmnthy?svg=true)](https://ci.appveyor.com/project/RyanGlScott/text-show) [Hackage: text-show]: http://hackage.haskell.org/package/text-show "text-show package on Hackage" [Haskell.org]: http://www.haskell.org "The Haskell Programming Language" [tl;dr Legal: BSD3]: https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29 "BSD 3-Clause License (Revised)" `text-show` offers a replacement for the `Show` typeclass intended for use with `Text` instead of `String`s. This package was created in the spirit of [`bytestring-show`](http://hackage.haskell.org/package/bytestring-show). For most uses, simply importing `TextShow` will suffice: ```haskell module Main where import TextShow main :: IO () main = printT (Just "Hello, World!") ``` See also the [naming conventions](https://github.com/RyanGlScott/text-show/wiki/Naming-conventions) page. Support for automatically deriving `TextShow` instances can be found in the `TextShow.TH` and `TextShow.Generic` modules. ## Scope of the library `text-show` only provides instances for data types in the following packages: * [`array`](http://hackage.haskell.org/package/array) * [`base`](http://hackage.haskell.org/package/base) * [`bytestring`](http://hackage.haskell.org/package/bytestring) * [`text`](http://hackage.haskell.org/package/text) This policy is in place to keep `text-show`'s dependencies reasonably light. If you need a `TextShow` instance for a library that is not in this list, it may be covered by the [`text-show-instances`](https://github.com/RyanGlScott/text-show-instances) library. text-show-3.10.4/Setup.hs0000644000000000000000000000005607346545000013367 0ustar0000000000000000import Distribution.Simple main = defaultMain text-show-3.10.4/benchmarks/0000755000000000000000000000000007346545000014047 5ustar0000000000000000text-show-3.10.4/benchmarks/Bench.hs0000644000000000000000000001052307346545000015423 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-| Module: Bench Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Benchmarks for @text-show@. -} module Main (main) where import Control.DeepSeq (NFData) import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf) import Data.List (foldl') import qualified Data.Text as T import GHC.Generics (Generic) import TextShow (TextShow(..)) import TextShow.Generic (genericShowbPrec, genericShowtPrec, genericShowtlPrec) import TextShow.TH (deriveTextShow) ------------------------------------------------------------------------------- -- Tree-like ADTs ------------------------------------------------------------------------------- -- NB: constructors must be same length! data BinTree1 a = BTEmpty1 | BTLeaf1 a | BTBranch1 (BinTree1 a) (BinTree1 a) deriving Show data BinTree2 a = BTEmpty2 | BTLeaf2 a | BTBranch2 (BinTree2 a) (BinTree2 a) data BinTree3 a = BTEmpty3 | BTLeaf3 a | BTBranch3 (BinTree3 a) (BinTree3 a) deriving Generic instance TextShow a => TextShow (BinTree3 a) where showbPrec = genericShowbPrec ------------------------------------------------------------------------------- -- Simple enumeration types ------------------------------------------------------------------------------- data Color = Red | Green | Blue | Orange | Violet deriving (Generic, Show) newtype Color2 = Color2 Color instance TextShow Color2 where showbPrec p (Color2 c) = genericShowbPrec p c showtPrec p (Color2 c) = genericShowtPrec p c showtlPrec p (Color2 c) = genericShowtlPrec p c colorShowt :: Color -> T.Text colorShowt c = case c of Red -> T.pack "Red" Green -> T.pack "Green" Blue -> T.pack "Blue" Orange -> T.pack "Orange" Violet -> T.pack "Violet" ------------------------------------------------------------------------------- $(deriveTextShow ''BinTree2) $(deriveTextShow ''Color) ------------------------------------------------------------------------------- -- Benchmarks ------------------------------------------------------------------------------- main :: IO () main = defaultMain [ sampleGroup "String Show" BTLeaf1 BTBranch1 BTEmpty1 show , sampleGroup "String Show, then Text.pack" BTLeaf1 BTBranch1 BTEmpty1 (T.pack . show) , sampleGroup "TextShow (TH)" BTLeaf2 BTBranch2 BTEmpty2 showt , sampleGroup "TextShow (generics)" BTLeaf3 BTBranch3 BTEmpty3 showt , bgroup "Enumeration type" [ bench "String Show" $ nf show Violet , bench "String Show, then Text.pack" $ nf (T.pack . show) Violet , bench "TextShow (TH)" $ nf showt Violet , bench "TextShow (generics)" $ nf showt $ Color2 Violet , bench "Manually written showt" $ nf colorShowt Violet ] ] sampleGroup :: forall a b. NFData b => String -> (Int -> a) -> (a -> a -> a) -> a -> (a -> b) -> Benchmark sampleGroup title leaf branch empty showFun = bgroup title [ bench "Small sample" $ nf smallSample pile , bench "Medium sample" $ nf mediumSample pile , bench "Large sample" $ nf largeSample pile ] where pile :: (Int -> a, a -> a -> a, a, a -> b) pile = (leaf, branch, empty, showFun) type Sample = forall a b. ( Int -> a , a -> a -> a , a , a -> b ) -> b smallSample :: Sample smallSample (leaf, branch, _, showFun) = showFun $ sampleTree leaf branch {-# NOINLINE smallSample #-} mediumSample :: Sample mediumSample (leaf, branch, empty, showFun) = showFun . foldl' branch empty . replicate 1000 $ sampleTree leaf branch {-# NOINLINE mediumSample #-} largeSample :: Sample largeSample (leaf, branch, empty, showFun) = showFun . foldl' branch empty . replicate 100000 $ sampleTree leaf branch {-# NOINLINE largeSample #-} sampleTree :: (Int -> a) -> (a -> a -> a) -> a sampleTree leaf branch = (leaf 12345 `branch` leaf 1234) `branch` leaf 123456 `branch` (leaf 1234567 `branch` leaf 123456) text-show-3.10.4/include/0000755000000000000000000000000007346545000013355 5ustar0000000000000000text-show-3.10.4/include/generic.h0000644000000000000000000000047507346545000015150 0ustar0000000000000000#ifndef GENERIC_H #define GENERIC_H #if __GLASGOW_HASKELL__ >= 709 || \ (__GLASGOW_HASKELL__ == 708 && \ defined(__GLASGOW_HASKELL_PATCHLEVEL1__) && \ __GLASGOW_HASKELL_PATCHLEVEL1__ == 4) # define __LANGUAGE_DERIVE_GENERIC1__ // Workaround for https://ghc.haskell.org/trac/ghc/ticket/9563 #endif #endif text-show-3.10.4/include/overlap.h0000644000000000000000000000065007346545000015177 0ustar0000000000000000#ifndef OVERLAP_H #define OVERLAP_H #if __GLASGOW_HASKELL__ >= 710 # define __LANGUAGE_OVERLAPPING_INSTANCES__ # define __OVERLAPPABLE__ {-# OVERLAPPABLE #-} # define __OVERLAPPING__ {-# OVERLAPPING #-} # define __OVERLAPS__ {-# OVERLAPS #-} #else # define __LANGUAGE_OVERLAPPING_INSTANCES__ {-# LANGUAGE OverlappingInstances #-} # define __OVERLAPPABLE__ # define __OVERLAPPING__ # define __OVERLAPS__ #endif #endif text-show-3.10.4/shared/TextShow/TH/0000755000000000000000000000000007346545000015300 5ustar0000000000000000text-show-3.10.4/shared/TextShow/TH/Names.hs0000644000000000000000000000545507346545000016710 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Names Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Template Haskell names to eliminate some boilerplate. -} module TextShow.TH.Names ( evtCloseValName, eventIsValName, fdKeyTypeName, uniqueTypeName, asInt64ValName, #if MIN_VERSION_base(4,8,0) giveGCStatsTypeName, doCostCentresTypeName, doHeapProfileTypeName, doTraceTypeName, #endif ) where import Language.Haskell.TH.Syntax #if MIN_VERSION_base(4,8,2) import GHC.RTS.Flags (GiveGCStats, DoCostCentres, DoHeapProfile, DoTrace) #endif ------------------------------------------------------------------------------- -- | Creates a 'Name' for a value from the "GHC.Event.Internal" module. mkEventName_v :: String -> Name #if MIN_VERSION_base(4,15,0) mkEventName_v = mkNameG_v "base" "GHC.Event.Internal.Types" #else mkEventName_v = mkNameG_v "base" "GHC.Event.Internal" #endif -- | The 'Name' of 'evtClose'. evtCloseValName :: Name evtCloseValName = mkEventName_v "evtClose" -- | The 'Name' of 'eventIs'. eventIsValName :: Name eventIsValName = mkEventName_v "eventIs" -- | The 'Name' of 'FdKey'. fdKeyTypeName :: Name fdKeyTypeName = mkNameG_tc "base" "GHC.Event.Manager" "FdKey" -- | The 'Name' of 'Unique'. uniqueTypeName :: Name uniqueTypeName = mkNameG_tc "base" "GHC.Event.Unique" "Unique" -- | The 'Name' of 'asInt64' (or, 'asInt' on @base-4.10.0.0@ or later). asInt64ValName :: Name #if MIN_VERSION_base(4,19,0) asInt64ValName = mkNameG_fld "base" "GHC.Event.Unique" "Unique" "asInt" #elif MIN_VERSION_base(4,10,0) asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt" #else asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt64" #endif #if MIN_VERSION_base(4,8,0) -- | The 'Name' of 'GiveGCStats'. giveGCStatsTypeName :: Name # if MIN_VERSION_base(4,8,2) giveGCStatsTypeName = ''GiveGCStats # else giveGCStatsTypeName = mkFlagsName_tc "GiveGCStats" # endif -- | The 'Name' of 'DoCostCentres'. doCostCentresTypeName :: Name # if MIN_VERSION_base(4,8,2) doCostCentresTypeName = ''DoCostCentres # else doCostCentresTypeName = mkFlagsName_tc "DoCostCentres" # endif -- | The 'Name' of 'DoHeapProfile'. doHeapProfileTypeName :: Name # if MIN_VERSION_base(4,8,2) doHeapProfileTypeName = ''DoHeapProfile # else doHeapProfileTypeName = mkFlagsName_tc "DoHeapProfile" # endif -- | The 'Name' of 'DoTrace'. doTraceTypeName :: Name # if MIN_VERSION_base(4,8,2) doTraceTypeName = ''DoTrace # else doTraceTypeName = mkFlagsName_tc "DoTrace" # endif -- | Creates a 'Name' for a type from the "GHC.RTS.Flags" module. # if !(MIN_VERSION_base(4,8,2)) mkFlagsName_tc :: String -> Name mkFlagsName_tc = mkNameG_tc "base" "GHC.RTS.Flags" # endif #endif text-show-3.10.4/src/0000755000000000000000000000000007346545000012521 5ustar0000000000000000text-show-3.10.4/src/TextShow.hs0000644000000000000000000000416607346545000014651 0ustar0000000000000000{-| Module: TextShow Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Efficiently convert from values to 'Text' via 'Builder's. /Since: 2/ -} module TextShow ( -- * The @TextShow@ classes -- ** 'TextShow' TextShow(..) , showbParen , showtParen , showtlParen , showbCommaSpace , showtCommaSpace , showtlCommaSpace , showbSpace , showtSpace , showtlSpace -- ** 'TextShow1' , TextShow1(..) , showbPrec1 , showbUnaryWith , liftShowtPrec , liftShowtlPrec -- ** 'TextShow2' , TextShow2(..) , showbPrec2 , showbBinaryWith , liftShowtPrec2 , liftShowtlPrec2 -- * 'Builder's -- ** The 'Builder' type , Builder , toText , toLazyText , toLazyTextWith , toString -- ** Constructing 'Builder's , singleton , fromText , fromLazyText , fromString -- ** Flushing the buffer state , flush -- ** 'Builder' utility functions , lengthB , unlinesB , unwordsB -- * Printing values , printT , printTL , hPrintT , hPrintTL -- * Conversions -- ** Conversion between 'TextShow' and string 'Show' , FromStringShow(..) , FromTextShow(..) , FromStringShow1(..) , FromTextShow1(..) , FromStringShow2(..) , FromTextShow2(..) , showsPrecToShowbPrec , showsToShowb , showbPrecToShowsPrec , showbToShows -- ** Conversions between 'Builder', strict 'TS.Text', and lazy 'TL.Text' , showtPrecToShowbPrec , showtlPrecToShowbPrec , showtToShowb , showtlToShowb , showbPrecToShowtPrec , showbPrecToShowtlPrec , showbToShowt , showbToShowtl ) where import qualified Data.Text as TS () import qualified Data.Text.Lazy as TL () import Data.Text.Lazy.Builder import Prelude () import TextShow.Classes import TextShow.FromStringTextShow import TextShow.Instances () import TextShow.Utils (toString, toText, lengthB, unlinesB, unwordsB) text-show-3.10.4/src/TextShow/0000755000000000000000000000000007346545000014306 5ustar0000000000000000text-show-3.10.4/src/TextShow/Classes.hs0000644000000000000000000004644307346545000016252 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE QuantifiedConstraints #-} #endif {-| Module: TextShow.Classes Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC The 'TextShow', 'TextShow1', and 'TextShow2' typeclasses. -} module TextShow.Classes where import Data.Data (Typeable) import qualified Data.Text as TS (Text, singleton) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import qualified Data.Text.Lazy as TL (Text, singleton) import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder, fromLazyText, fromString, fromText, singleton, toLazyText) import GHC.Show (appPrec, appPrec1) import Prelude () import Prelude.Compat import System.IO (Handle) import TextShow.Utils (toString, toText) ------------------------------------------------------------------------------- -- | Conversion of values to @Text@. Because there are both strict and lazy @Text@ -- variants, the 'TextShow' class deliberately avoids using @Text@ in its functions. -- Instead, 'showbPrec', 'showb', and 'showbList' all return 'Builder', an -- efficient intermediate form that can be converted to either kind of @Text@. -- -- 'Builder' is a 'Monoid', so it is useful to use the 'mappend' (or '<>') function -- to combine 'Builder's when creating 'TextShow' instances. As an example: -- -- @ -- import Data.Semigroup -- import TextShow -- -- data Example = Example Int Int -- instance TextShow Example where -- showb (Example i1 i2) = showb i1 <> showbSpace <> showb i2 -- @ -- -- If you do not want to create 'TextShow' instances manually, you can alternatively -- use the "TextShow.TH" module to automatically generate default 'TextShow' -- instances using Template Haskell, or the "TextShow.Generic" module to -- quickly define 'TextShow' instances using "GHC.Generics". -- -- /Since: 2/ class TextShow a where -- | Convert a value to a 'Builder' with the given predence. -- -- /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 'Builder'. -> Builder showbPrec _ = showb -- | Converts a value to a strict 'TS.Text'. If you hand-define this, it should -- satisfy: -- -- @ -- 'showb' = 'showbPrec' 0 -- @ -- -- /Since: 2/ showb :: a -- ^ The value to be converted to a 'Builder'. -> Builder showb = showbPrec 0 -- | 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] -- ^ The list of values to be converted to a 'Builder'. -> Builder showbList = showbListWith 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 -- | Converts a value to a strict 'TS.Text'. This can be overridden for -- efficiency, but it should satisfy: -- -- @ -- 'showt' = 'showtPrec' 0 -- 'showt' = 'toStrict' . 'showtl' -- @ -- -- The first equation is the default definition of 'showt'. -- -- /Since: 3/ showt :: a -- ^ The value to be converted to a strict 'TS.Text'. -> TS.Text showt = showtPrec 0 -- | 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 -- | 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 -- | Converts a value to a lazy 'TL.Text'. This can be overridden for -- efficiency, but it should satisfy: -- -- @ -- 'showtl' = 'showtlPrec' 0 -- 'showtl' = 'toLazyText' . 'showb' -- @ -- -- The first equation is the default definition of 'showtl'. -- -- /Since: 3/ showtl :: a -- ^ The value to be converted to a lazy 'TL.Text'. -> TL.Text showtl = showtlPrec 0 -- | 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 {-# MINIMAL showbPrec | showb #-} deriving instance Typeable TextShow -- | Surrounds 'Builder' output with parentheses if the 'Bool' parameter is 'True'. -- -- /Since: 2/ showbParen :: Bool -> Builder -> Builder showbParen p builder | p = singleton '(' <> builder <> singleton ')' | otherwise = builder -- | Construct a 'Builder' containing a comma followed by a space. -- -- /Since: 3.6/ showbCommaSpace :: Builder showbCommaSpace = ", " -- | Construct a 'Builder' containing a single space character. -- -- /Since: 2/ showbSpace :: Builder showbSpace = singleton ' ' -- | Converts a list of values into a 'Builder' in which the values are surrounded -- by square brackets and each value is separated by a comma. The function argument -- controls how each element is shown. -- -- @'showbListWith' 'showb'@ is the default implementation of 'showbList' save for -- a few special cases (e.g., 'String'). -- -- /Since: 2/ showbListWith :: (a -> Builder) -> [a] -> Builder showbListWith _ [] = "[]" showbListWith showbx (x:xs) = singleton '[' <> showbx x <> go xs -- "[.. where go (y:ys) = singleton ',' <> showbx y <> go ys -- ..,.. go [] = singleton ']' -- ..]" -- | Surrounds strict 'TS.Text' output with parentheses if the 'Bool' parameter is 'True'. -- -- /Since: 3.4/ showtParen :: Bool -> TS.Text -> TS.Text showtParen p t | p = TS.singleton '(' <> t <> TS.singleton ')' | otherwise = t -- | Construct a strict 'TS.Text' containing a comma followed by a space. -- -- /Since: 3.6/ showtCommaSpace :: TS.Text showtCommaSpace = ", " -- | Construct a strict 'TS.Text' containing a single space character. -- -- /Since: 3.4/ showtSpace :: TS.Text showtSpace = TS.singleton ' ' -- | Converts a list of values into a strict 'TS.Text' in which the values are surrounded -- by square brackets and each value is separated by a comma. The function argument -- controls how each element is shown. -- -- /Since: 3.4/ showtListWith :: (a -> TS.Text) -> [a] -> TS.Text showtListWith _ [] = "[]" showtListWith showtx (x:xs) = TS.singleton '[' <> showtx x <> go xs -- "[.. where go (y:ys) = TS.singleton ',' <> showtx y <> go ys -- ..,.. go [] = TS.singleton ']' -- ..]" -- | Surrounds lazy 'TL.Text' output with parentheses if the 'Bool' parameter is 'True'. -- -- /Since: 3.4/ showtlParen :: Bool -> TL.Text -> TL.Text showtlParen p t | p = TL.singleton '(' <> t <> TL.singleton ')' | otherwise = t {-# INLINE showtlParen #-} -- | Construct a lazy 'TL.Text' containing a comma followed by a space. -- -- /Since: 3.6/ showtlCommaSpace :: TL.Text showtlCommaSpace = ", " -- | Construct a lazy 'TL.Text' containing a single space character. -- -- /Since: 3.4/ showtlSpace :: TL.Text showtlSpace = TL.singleton ' ' -- | Converts a list of values into a lazy 'TL.Text' in which the values are surrounded -- by square brackets and each value is separated by a comma. The function argument -- controls how each element is shown. -- -- /Since: 3.4/ showtlListWith :: (a -> TL.Text) -> [a] -> TL.Text showtlListWith _ [] = "[]" showtlListWith showtlx (x:xs) = TL.singleton '[' <> showtlx x <> go xs -- "[.. where go (y:ys) = TL.singleton ',' <> showtlx y <> go ys -- ..,.. go [] = TL.singleton ']' -- ..]" -- | Writes a value's strict 'TS.Text' representation to the standard output, followed -- by a newline. -- -- /Since: 2/ printT :: TextShow a => a -> IO () printT = TS.putStrLn . showt {-# INLINE printT #-} -- | Writes a value's lazy 'TL.Text' representation to the standard output, followed -- by a newline. -- -- /Since: 2/ printTL :: TextShow a => a -> IO () printTL = TL.putStrLn . showtl {-# INLINE printTL #-} -- | Writes a value's strict 'TS.Text' representation to a file handle, followed -- by a newline. -- -- /Since: 2/ hPrintT :: TextShow a => Handle -> a -> IO () hPrintT h = TS.hPutStrLn h . showt {-# INLINE hPrintT #-} -- | Writes a value's lazy 'TL.Text' representation to a file handle, followed -- by a newline. -- -- /Since: 2/ hPrintTL :: TextShow a => Handle -> a -> IO () 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 precedence-aware, strict 'TS.Text'-based show function to a 'Builder'-based one. -- -- /Since: 3.4/ showtPrecToShowbPrec :: (Int -> a -> TS.Text) -> Int -> a -> Builder showtPrecToShowbPrec sp p = fromText . sp p {-# INLINE showtPrecToShowbPrec #-} -- | Convert a precedence-aware, lazy 'TL.Text'-based show function to a 'Builder'-based one. -- -- /Since: 3.4/ showtlPrecToShowbPrec :: (Int -> a -> TL.Text) -> Int -> a -> Builder showtlPrecToShowbPrec sp p = fromLazyText . sp p {-# INLINE showtlPrecToShowbPrec #-} -- | Convert a 'ShowS'-based show function to a 'Builder'-based one. -- -- /Since: 3/ showsToShowb :: (a -> ShowS) -> a -> Builder showsToShowb sf x = fromString $ sf x "" {-# INLINE showsToShowb #-} -- | Convert a strict 'TS.Text'-based show function to a 'Builder'-based one. -- -- /Since: 3.4/ showtToShowb :: (a -> TS.Text) -> a -> Builder showtToShowb sf = fromText . sf {-# INLINE showtToShowb #-} -- | Convert a lazy 'TL.Text'-based show function to a 'Builder'-based one. -- -- /Since: 3.4/ showtlToShowb :: (a -> TL.Text) -> a -> Builder showtlToShowb sf = fromLazyText . sf {-# INLINE showtlToShowb #-} -- | 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 precedence-aware 'Builder'-based show function to a strict 'TS.Text'-based one. -- -- /Since: 3.4/ showbPrecToShowtPrec :: (Int -> a -> Builder) -> Int -> a -> TS.Text showbPrecToShowtPrec sp p = toText . sp p {-# INLINE showbPrecToShowtPrec #-} -- | Convert a precedence-aware 'Builder'-based show function to a lazy 'TL.Text'-based one. -- -- /Since: 3.4/ showbPrecToShowtlPrec :: (Int -> a -> Builder) -> Int -> a -> TL.Text showbPrecToShowtlPrec sp p = toLazyText . sp p {-# INLINE showbPrecToShowtlPrec #-} -- | Convert a 'Builder'-based show function to a 'ShowS'-based one. -- -- /Since: 3/ showbToShows :: (a -> Builder) -> a -> ShowS showbToShows sf = showString . toString . sf {-# INLINE showbToShows #-} -- | Convert a 'Builder'-based show function to a strict 'TS.Text'-based one. -- -- /Since: 3/ showbToShowt :: (a -> Builder) -> a -> TS.Text showbToShowt sf = toText . sf {-# INLINE showbToShowt #-} -- | Convert a 'Builder'-based show function to a lazy 'TL.Text'-based one. -- -- /Since: 3/ showbToShowtl :: (a -> Builder) -> a -> TL.Text showbToShowtl sf = toLazyText . sf {-# INLINE showbToShowtl #-} ------------------------------------------------------------------------------- -- | Lifting of the 'TextShow' class to unary type constructors. -- -- /Since: 2/ class #if __GLASGOW_HASKELL__ >= 806 (forall a. TextShow a => TextShow (f a)) => #endif TextShow1 f where -- | 'showbPrec' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument type. -- -- /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) {-# MINIMAL liftShowbPrec #-} deriving instance Typeable TextShow1 -- | Lift the standard 'showbPrec' and 'showbList' functions through the -- type constructor. -- -- /Since: 2/ showbPrec1 :: (TextShow1 f, TextShow a) => Int -> f a -> Builder showbPrec1 = liftShowbPrec showbPrec showbList {-# INLINE showbPrec1 #-} -- | @'showbUnaryWith' sp n p x@ produces the 'Builder' representation of a unary data -- constructor with name @n@ and argument @x@, in precedence context @p@, using the -- function @sp@ to show occurrences of the type argument. -- -- /Since: 2/ showbUnaryWith :: (Int -> a -> Builder) -> Builder -> Int -> a -> Builder showbUnaryWith sp nameB p x = showbParen (p > appPrec) $ nameB <> showbSpace <> sp appPrec1 x {-# INLINE showbUnaryWith #-} -- | 'showtPrec' function for an application of the type constructor -- based on 'showtPrec' and 'showtList' functions for the argument type. -- -- The current implementation is based on `liftShowbPrec` internally. -- -- /Since: 3.4/ liftShowtPrec :: TextShow1 f => (Int -> a -> TS.Text) -> ([a] -> TS.Text) -> Int -> f a -> TS.Text liftShowtPrec sp sl = showbPrecToShowtPrec $ liftShowbPrec (showtPrecToShowbPrec sp) (showtToShowb sl) -- | 'showtlPrec' function for an application of the type constructor -- based on 'showtlPrec' and 'showtlList' functions for the argument type. -- -- The current implementation is based on `liftShowbPrec` internally. -- -- /Since: 3.4/ liftShowtlPrec :: TextShow1 f => (Int -> a -> TL.Text) -> ([a] -> TL.Text) -> Int -> f a -> TL.Text liftShowtlPrec sp sl = showbPrecToShowtlPrec $ liftShowbPrec (showtlPrecToShowbPrec sp) (showtlToShowb sl) ------------------------------------------------------------------------------- -- | Lifting of the 'TextShow' class to binary type constructors. -- -- /Since: 2/ class #if __GLASGOW_HASKELL__ >= 806 ( forall a. TextShow a => TextShow1 (f a) # if __GLASGOW_HASKELL__ < 900 -- Sadly, pre-9.0 versions of GHC have difficulty inferring this -- superclass from the one above due to -- https://gitlab.haskell.org/ghc/ghc/-/issues/17202. -- As a workaround, we manually expand the superclass above to assist -- type inference. Without doing this, the text-show test suite would -- not compile on pre-9.0 versions of GHC. , forall a b. (TextShow a, TextShow b) => TextShow (f a b) # endif ) => #endif TextShow2 f where -- | 'showbPrec' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument types. -- -- /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) {-# MINIMAL liftShowbPrec2 #-} deriving instance Typeable TextShow2 -- | Lift two 'showbPrec' functions through the type constructor. -- -- /Since: 2/ showbPrec2 :: (TextShow2 f, TextShow a, TextShow b) => Int -> f a b -> Builder showbPrec2 = liftShowbPrec2 showbPrec showbList showbPrec showbList {-# INLINE showbPrec2 #-} -- | @'showbBinaryWith' sp n p x y@ produces the 'Builder' representation of a binary -- data constructor with name @n@ and arguments @x@ and @y@, in precedence context -- @p@, using the functions @sp1@ and @sp2@ to show occurrences of the type arguments. -- -- /Since: 2/ showbBinaryWith :: (Int -> a -> Builder) -> (Int -> b -> Builder) -> Builder -> Int -> a -> b -> Builder showbBinaryWith sp1 sp2 nameB p x y = showbParen (p > appPrec) $ nameB <> showbSpace <> sp1 appPrec1 x <> showbSpace <> sp2 appPrec1 y {-# INLINE showbBinaryWith #-} -- | 'showtPrec' function for an application of the type constructor -- based on 'showtPrec' and 'showtList' functions for the argument type. -- -- The current implementation is based on `liftShowbPrec2` internally. -- -- /Since: 3.4/ liftShowtPrec2 :: TextShow2 f => (Int -> a -> TS.Text) -> ([a] -> TS.Text) -> (Int -> b -> TS.Text) -> ([b] -> TS.Text) -> Int -> f a b -> TS.Text liftShowtPrec2 sp1 sl1 sp2 sl2 = showbPrecToShowtPrec $ liftShowbPrec2 (showtPrecToShowbPrec sp1) (showtToShowb sl1) (showtPrecToShowbPrec sp2) (showtToShowb sl2) -- | 'showtlPrec' function for an application of the type constructor -- based on 'showtlPrec' and 'showtlList' functions for the argument type. -- -- The current implementation is based on `liftShowbPrec2` internally. -- -- /Since: 3.4/ liftShowtlPrec2 :: TextShow2 f => (Int -> a -> TL.Text) -> ([a] -> TL.Text) -> (Int -> b -> TL.Text) -> ([b] -> TL.Text) -> Int -> f a b -> TL.Text liftShowtlPrec2 sp1 sl1 sp2 sl2 = showbPrecToShowtlPrec $ liftShowbPrec2 (showtlPrecToShowbPrec sp1) (showtlToShowb sl1) (showtlPrecToShowbPrec sp2) (showtlToShowb sl2) text-show-3.10.4/src/TextShow/Control/0000755000000000000000000000000007346545000015726 5ustar0000000000000000text-show-3.10.4/src/TextShow/Control/Applicative.hs0000644000000000000000000000253707346545000020532 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Applicative Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for 'Const' and 'ZipList'. /Since: 2/ -} module TextShow.Control.Applicative () where import Control.Applicative (Const(..), ZipList) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..), showbUnaryWith) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) -- | /Since: 2/ instance TextShow a => TextShow (Const a b) where showbPrec = liftShowbConstPrec showbPrec -- | /Since: 2/ instance TextShow a => TextShow1 (Const a) where liftShowbPrec _ _ = liftShowbConstPrec showbPrec -- | /Since: 2/ instance TextShow2 Const where liftShowbPrec2 sp _ _ _ = liftShowbConstPrec sp liftShowbConstPrec :: (Int -> a -> Builder) -> Int -> Const a b -> Builder liftShowbConstPrec sp p (Const x) = showbUnaryWith sp "Const" p x {-# INLINE liftShowbConstPrec #-} -- | /Since: 2/ $(deriveTextShow ''ZipList) -- | /Since: 2/ $(deriveTextShow1 ''ZipList) text-show-3.10.4/src/TextShow/Control/Concurrent.hs0000644000000000000000000000302507346545000020404 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnliftedFFITypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Concurrent Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for concurrency-related data types. /Since: 2/ -} module TextShow.Control.Concurrent () where import Data.Text.Lazy.Builder (fromString) import Foreign.C.Types import GHC.Conc (BlockReason, ThreadStatus) import GHC.Conc.Sync (ThreadId(..)) import GHC.Exts (Addr#, unsafeCoerce#) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Foreign.C.Types () import TextShow.TH.Internal (deriveTextShow) #if MIN_VERSION_base(4,14,0) import TextShow.Classes (showbParen) import GHC.Show (appPrec) #endif -- | /Since: 2/ instance TextShow ThreadId where showbPrec p t = #if MIN_VERSION_base(4,14,0) showbParen (p > appPrec) $ #endif fromString "ThreadId " <> showbPrec p (getThreadId t) {-# INLINE showbPrec #-} -- Temporary workaround until Trac #8281 is fixed foreign import ccall unsafe "rts_getThreadId" getThreadId# :: Addr# -> CInt getThreadId :: ThreadId -> CInt getThreadId (ThreadId tid) = getThreadId# (unsafeCoerce# tid) -- | /Since: 2/ $(deriveTextShow ''BlockReason) -- | /Since: 2/ $(deriveTextShow ''ThreadStatus) text-show-3.10.4/src/TextShow/Control/Exception.hs0000644000000000000000000001230207346545000020216 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE DerivingVia #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Exception Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for 'Exception' data types. /Since: 2/ -} module TextShow.Control.Exception () where import Control.Exception.Base import Data.Text.Lazy.Builder (fromString) #if MIN_VERSION_base(4,9,0) import Data.Text.Lazy.Builder (singleton) #endif import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.FromStringTextShow (FromStringShow(..)) import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ #if __GLASGOW_HASKELL__ >= 806 deriving via FromStringShow SomeException instance TextShow SomeException #else instance TextShow SomeException where showbPrec p (SomeException e) = showbPrec p $ FromStringShow e {-# INLINE showbPrec #-} #endif -- | /Since: 2/ #if __GLASGOW_HASKELL__ >= 806 deriving via FromStringShow IOException instance TextShow IOException #else instance TextShow IOException where showb = showb . FromStringShow {-# INLINE showb #-} #endif -- | /Since: 2/ instance TextShow ArithException where showb Overflow = "arithmetic overflow" showb Underflow = "arithmetic underflow" showb LossOfPrecision = "loss of precision" showb DivideByZero = "divide by zero" showb Denormal = "denormal" showb RatioZeroDenominator = "Ratio has zero denominator" -- | /Since: 2/ instance TextShow ArrayException where showb (IndexOutOfBounds s) = "array index out of range" <> (if not $ null s then ": " <> fromString s else mempty) showb (UndefinedElement s) = "undefined array element" <> (if not $ null s then ": " <> fromString s else mempty) {-# INLINE showb #-} -- | /Since: 2/ instance TextShow AssertionFailed where showb (AssertionFailed err) = fromString err {-# INLINE showb #-} -- | /Since: 2/ instance TextShow SomeAsyncException where showb (SomeAsyncException e) = showb $ FromStringShow e {-# INLINE showb #-} -- | /Since: 2/ instance TextShow AsyncException where showb StackOverflow = "stack overflow" showb HeapOverflow = "heap overflow" showb ThreadKilled = "thread killed" showb UserInterrupt = "user interrupt" {-# INLINE showb #-} -- | /Since: 2/ instance TextShow NonTermination where showb NonTermination = "<>" {-# INLINE showb #-} -- | /Since: 2/ instance TextShow NestedAtomically where showb NestedAtomically = "Control.Concurrent.STM.atomically was nested" {-# INLINE showb #-} -- | /Since: 2/ instance TextShow BlockedIndefinitelyOnMVar where showb BlockedIndefinitelyOnMVar = "thread blocked indefinitely in an MVar operation" {-# INLINE showb #-} -- | /Since: 2/ instance TextShow BlockedIndefinitelyOnSTM where showb BlockedIndefinitelyOnSTM = "thread blocked indefinitely in an STM transaction" {-# INLINE showb #-} #if MIN_VERSION_base(4,8,0) -- | Only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ instance TextShow AllocationLimitExceeded where showb AllocationLimitExceeded = "allocation limit exceeded" {-# INLINE showb #-} #endif #if MIN_VERSION_base(4,9,0) -- | Only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ instance TextShow TypeError where showb (TypeError err) = fromString err {-# INLINE showb #-} #endif #if MIN_VERSION_base(4,10,0) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ instance TextShow CompactionFailed where showb (CompactionFailed why) = fromString ("compaction failed: " <> why) #endif #if MIN_VERSION_base(4,11,0) -- | Only available with @base-4.11.0.0@ or later. -- -- /Since: 3.7.3/ instance TextShow FixIOException where showbPrec _ FixIOException = fromString "cyclic evaluation in fixIO" #endif -- | /Since: 2/ instance TextShow Deadlock where showb Deadlock = "<>" {-# INLINE showb #-} -- | /Since: 2/ instance TextShow NoMethodError where showb (NoMethodError err) = fromString err {-# INLINE showb #-} -- | /Since: 2/ instance TextShow PatternMatchFail where showb (PatternMatchFail err) = fromString err {-# INLINE showb #-} -- | /Since: 2/ instance TextShow RecConError where showb (RecConError err) = fromString err {-# INLINE showb #-} -- | /Since: 2/ instance TextShow RecSelError where showb (RecSelError err) = fromString err {-# INLINE showb #-} -- | /Since: 2/ instance TextShow RecUpdError where showb (RecUpdError err) = fromString err {-# INLINE showb #-} -- | /Since: 2/ instance TextShow ErrorCall where #if MIN_VERSION_base(4,9,0) showb (ErrorCallWithLocation err "") = fromString err showb (ErrorCallWithLocation err loc) = fromString err <> singleton '\n' <> fromString loc #else showb (ErrorCall err) = fromString err #endif -- | /Since: 2/ $(deriveTextShow ''MaskingState) text-show-3.10.4/src/TextShow/Control/Monad/0000755000000000000000000000000007346545000016764 5ustar0000000000000000text-show-3.10.4/src/TextShow/Control/Monad/ST.hs0000644000000000000000000000152007346545000017644 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Monad.ST Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for strict 'ST'. /Since: 2/ -} module TextShow.Control.Monad.ST () where import Control.Monad.ST (ST) import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..)) -- | /Since: 2/ instance TextShow (ST s a) where showb = liftShowbPrec undefined undefined 0 {-# INLINE showb #-} -- | /Since: 2/ instance TextShow1 (ST s) where liftShowbPrec = liftShowbPrec2 undefined undefined {-# INLINE liftShowbPrec #-} -- | /Since: 2/ instance TextShow2 ST where liftShowbPrec2 _ _ _ _ _ _ = "<>" {-# INLINE liftShowbPrec2 #-} text-show-3.10.4/src/TextShow/Data/0000755000000000000000000000000007346545000015157 5ustar0000000000000000text-show-3.10.4/src/TextShow/Data/Array.hs0000644000000000000000000000405007346545000016570 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Array Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Provides 'TextShow' instances for 'Array' types, as well as the 'showbIArrayPrec' function. /Since: 2/ -} module TextShow.Data.Array (showbIArrayPrec) where import qualified Data.Array as Array (assocs, bounds) import Data.Array (Array) import qualified Data.Array.Base as IArray (assocs, bounds) import Data.Array.Base (IArray) import Data.Array.Unboxed (UArray) import Data.Ix (Ix) import Data.Text.Lazy.Builder (Builder) import GHC.Show (appPrec) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.List () import TextShow.Data.Tuple () {-# SPECIALIZE showbIArrayPrec :: (IArray UArray e, Ix i, TextShow i, TextShow e) => Int -> UArray i e -> Builder #-} -- | Convert an 'IArray' instance to a 'Builder' with the given precedence. -- -- /Since: 2/ showbIArrayPrec :: (IArray a e, Ix i, TextShow i, TextShow e) => Int -> a i e -> Builder showbIArrayPrec p a = showbParen (p > arrayPrec) $ "array " <> showb (IArray.bounds a) <> showbSpace <> showb (IArray.assocs a) where arrayPrec :: Int #if MIN_VERSION_base(4,13,0) arrayPrec = appPrec #else arrayPrec = 9 #endif -- | /Since: 2/ instance (TextShow i, TextShow e, Ix i) => TextShow (Array i e) where showbPrec p a = showbParen (p > appPrec) $ "array " <> showb (Array.bounds a) <> showbSpace <> showb (Array.assocs a) {-# INLINE showbPrec #-} -- | /Since: 2/ instance (IArray UArray e, Ix i, TextShow i, TextShow e) => TextShow (UArray i e) where showbPrec = showbIArrayPrec {-# INLINE showbPrec #-} text-show-3.10.4/src/TextShow/Data/Array/0000755000000000000000000000000007346545000016235 5ustar0000000000000000text-show-3.10.4/src/TextShow/Data/Array/Byte.hs0000644000000000000000000000356507346545000017505 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Array.Byte Copyright: (C) 2022 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Provides a 'TextShow' instance for 'ByteArray' from the "Data.Array.Byte" module. Only provided if using @base-4.17.0.0@ or later. /Since: 3.10/ -} module TextShow.Data.Array.Byte () where #if MIN_VERSION_base(4,17,0) import Data.Array.Byte (ByteArray(..)) import Data.Bits (Bits(..)) import Data.Char (intToDigit) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import GHC.Exts (Int(..), indexWord8Array#, sizeofByteArray#) import GHC.Word (Word8(..)) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) -- | /Since: 3.10/ instance TextShow ByteArray where showbPrec _ ba = fromString "[" <> go 0 where showW8 :: Word8 -> Builder showW8 !w = singleton '0' <> singleton 'x' <> singleton (intToDigit (fromIntegral (unsafeShiftR w 4))) <> singleton (intToDigit (fromIntegral (w .&. 0x0F))) go i | i < sizeofByteArray ba = comma <> showW8 (indexByteArray ba i :: Word8) <> go (i+1) | otherwise = singleton ']' where comma | i == 0 = mempty | otherwise = fromString ", " -- | Read byte at specific index. indexByteArray :: ByteArray -> Int -> Word8 {-# INLINE indexByteArray #-} indexByteArray (ByteArray arr#) (I# i#) = W8# (indexWord8Array# arr# i#) -- | Size of the byte array in bytes. sizeofByteArray :: ByteArray -> Int {-# INLINE sizeofByteArray #-} sizeofByteArray (ByteArray arr#) = I# (sizeofByteArray# arr#) #endif text-show-3.10.4/src/TextShow/Data/Bool.hs0000644000000000000000000000065407346545000016413 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Bool Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Bool'. /Since: 2/ -} module TextShow.Data.Bool () where import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ $(deriveTextShow ''Bool) text-show-3.10.4/src/TextShow/Data/ByteString.hs0000644000000000000000000001055207346545000017610 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} #if !(MIN_VERSION_bytestring(0,10,0)) {-# LANGUAGE TemplateHaskell #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.ByteString Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for data types in the @bytestring@ library. /Since: 2/ -} module TextShow.Data.ByteString () where import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Lazy.Internal as BL import qualified Data.ByteString.Short as SBS import Data.ByteString.Short.Internal (ShortByteString(..)) import GHC.Exts (ByteArray#, Char(C#), Int(I#), indexCharArray#) import TextShow.Classes (TextShow(..)) import TextShow.Data.Char () import TextShow.Data.List () #if !(MIN_VERSION_bytestring(0,10,0)) import Data.Word (Word8) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (plusPtr) import Foreign.Storable (peek, peekByteOff) import TextShow.TH.Internal (deriveTextShow) #endif ------------------------------------------------------------------------ -- Primop wrappers data BA = BA# ByteArray# indexCharArray :: BA -> Int -> Char indexCharArray (BA# ba#) (I# i#) = C# (indexCharArray# ba# i#) ------------------------------------------------------------------------ -- Internal utils asBA :: ShortByteString -> BA asBA (SBS ba#) = BA# ba# ------------------------------------------------------------------------ -- | /Since: 2/ instance TextShow BS.ByteString where {-# INLINE showb #-} #if MIN_VERSION_bytestring(0,10,0) showb = showb . BS.unpackChars #else showb = showb . unpackWith BS.w2c -- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function. unpackWith :: (Word8 -> a) -> BS.ByteString -> [a] unpackWith _ (BS.PS _ _ 0) = [] unpackWith k (BS.PS ps s l) = BS.inlinePerformIO $ withForeignPtr ps $ \p -> go (p `plusPtr` s) (l - 1) [] where go !p !0 !acc = peek p >>= \e -> return (k e : acc) go !p !n !acc = peekByteOff p n >>= \e -> go p (n-1) (k e : acc) {-# INLINE unpackWith #-} #endif #if MIN_VERSION_bytestring(0,10,0) -- | /Since: 2/ instance TextShow BL.ByteString where showb = showb . BL.unpackChars {-# INLINE showb #-} #else -- | /Since: 2/ $(deriveTextShow ''BL.ByteString) #endif -- | /Since: 2/ instance TextShow ShortByteString where showb = showb . unpackChars {-# INLINE showb #-} -- Unpacking bytestrings into lists effeciently is a tradeoff: on the one hand -- we would like to write a tight loop that just blats the list into memory, on -- the other hand we want it to be unpacked lazily so we don't end up with a -- massive list data structure in memory. -- -- Our strategy is to combine both: we will unpack lazily in reasonable sized -- chunks, where each chunk is unpacked strictly. -- -- unpackChars does the lazy loop, while unpackAppendBytes and -- unpackAppendChars do the chunks strictly. unpackChars :: ShortByteString -> [Char] unpackChars bs = unpackAppendCharsLazy bs [] -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate -- takes just shy of 4k which seems like a reasonable amount. -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes) unpackAppendCharsLazy :: ShortByteString -> [Char] -> [Char] unpackAppendCharsLazy sbs cs0 = go 0 (SBS.length sbs) cs0 where sz = 100 go off len cs | len <= sz = unpackAppendCharsStrict sbs off len cs | otherwise = unpackAppendCharsStrict sbs off sz remainder where remainder = go (off+sz) (len-sz) cs -- For these unpack functions, since we're unpacking the whole list strictly we -- build up the result list in an accumulator. This means we have to build up -- the list starting at the end. So our traversal starts at the end of the -- buffer and loops down until we hit the sentinal: unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char] unpackAppendCharsStrict !sbs off len cs = go (off-1) (off-1 + len) cs where go !sentinal !i !acc | i == sentinal = acc | otherwise = let !c = indexCharArray (asBA sbs) i in go sentinal (i-1) (c:acc) text-show-3.10.4/src/TextShow/Data/Char.hs0000644000000000000000000000655607346545000016404 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Char Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances and monomorphic functions for 'Char' and 'String'. /Since: 2/ -} module TextShow.Data.Char ( showbChar , showbLitChar , showbString , showbLitString , showbGeneralCategory , asciiTabB ) where import Data.Array (Array, (!), listArray) import Data.Char (GeneralCategory, isDigit, ord) import Data.Text.Lazy.Builder (Builder, singleton) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral () import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ $(deriveTextShow ''GeneralCategory) -- | /Since: 2/ instance TextShow Char where showb = showbChar {-# INLINE showb #-} showbList = showbString {-# INLINE showbList #-} -- | A table of ASCII control characters that needs to be escaped with a backslash. -- -- /Since: 2/ asciiTabB :: Array Int Builder asciiTabB = listArray (0, 32) ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", "BS" , "HT" , "LF" , "VT" , "FF" , "CR" , "SO" , "SI" , "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", "CAN", "EM" , "SUB", "ESC", "FS" , "GS" , "RS" , "US" , "SP"] -- | Convert a 'Char' to a 'Builder' (surrounded by single quotes). -- -- /Since: 2/ showbChar :: Char -> Builder showbChar '\'' = "'\\''" showbChar c = singleton '\'' <> showbLitChar c <> singleton '\'' {-# INLINE showbChar #-} -- | Convert a 'Char' to a 'Builder' (without single quotes). -- -- /Since: 2/ showbLitChar :: Char -> Builder showbLitChar c | c > '\DEL' = singleton '\\' <> showb (ord c) showbLitChar '\DEL' = "\\DEL" showbLitChar '\\' = "\\\\" showbLitChar c | c >= ' ' = singleton c showbLitChar '\a' = "\\a" showbLitChar '\b' = "\\b" showbLitChar '\f' = "\\f" showbLitChar '\n' = "\\n" showbLitChar '\r' = "\\r" showbLitChar '\t' = "\\t" showbLitChar '\v' = "\\v" showbLitChar '\SO' = "\\SO" showbLitChar c = singleton '\\' <> (asciiTabB ! ord c) -- | Convert a 'String' to a 'Builder' (surrounded by double quotes). -- -- /Since: 2/ showbString :: String -> Builder showbString cs = singleton '"' <> showbLitString cs <> singleton '"' {-# INLINE showbString #-} -- | Convert a 'String' to a 'Builder' (without double quotes). -- -- /Since: 2/ showbLitString :: String -> Builder showbLitString [] = mempty showbLitString ('\SO':'H':cs) = "\\SO\\&H" <> showbLitString cs showbLitString ('"':cs) = "\\\"" <> showbLitString cs showbLitString (c:d:cs) | c > '\DEL' && isDigit d = singleton '\\' <> showb (ord c) <> "\\&" <> singleton d <> showbLitString cs showbLitString (c:cs) = showbLitChar c <> showbLitString cs -- | Convert a 'GeneralCategory' to a 'Builder'. -- -- /Since: 2/ showbGeneralCategory :: GeneralCategory -> Builder showbGeneralCategory = showb {-# INLINE showbGeneralCategory #-} text-show-3.10.4/src/TextShow/Data/Complex.hs0000644000000000000000000000330207346545000017120 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ == 800 -- See Note [Increased simpl-tick-factor on old GHCs] {-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} #endif {-| Module: TextShow.Data.Ratio Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for 'Ratio'. /Since: 2/ -} module TextShow.Data.Complex () where import Data.Complex (Complex) import TextShow.Classes (TextShow(..)) import TextShow.Data.Floating () import TextShow.TH.Internal (deriveTextShow1, makeShowbPrec) -- | /Since: 2/ instance TextShow a => TextShow (Complex a) where {-# SPECIALIZE instance TextShow (Complex Float) #-} {-# SPECIALIZE instance TextShow (Complex Double) #-} showbPrec = $(makeShowbPrec ''Complex) {-# INLINE showbPrec #-} -- | /Since: 2/ $(deriveTextShow1 ''Complex) {- Note [Increased simpl-tick-factor on old GHCs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Compiling certain text-show modules with optimizations on old versions of GHC (particularly 8.0 and 8.2) will trigger "Simplifier ticks exhausted" panics. To make things worse, this sometimes depends on whether a certain version of the text library is being used. There are two possible ways to work around this issue: 1. Figure out which uses of the INLINE pragma in text-show are responsible and remove them. 2. Just increase the tick limit. Since executing on (1) will require a lot of effort to fix an issue that only happens on old versions of GHC, I've opted for the simple solution of (2) for now. Issue #51 is a reminder to revisit this choice. -} text-show-3.10.4/src/TextShow/Data/Data.hs0000644000000000000000000000163307346545000016367 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Data Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for data types in the @Data.Data@ module. /Since: 2/ -} module TextShow.Data.Data () where import Data.Data (Constr, ConstrRep, DataRep, DataType, Fixity, showConstr) import Data.Text.Lazy.Builder (fromString) import TextShow.Classes (TextShow(..)) import TextShow.Data.List () import TextShow.Data.Ratio () import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ instance TextShow Constr where showb = fromString . showConstr {-# INLINE showb #-} -- | /Since: 2/ $(deriveTextShow ''DataRep) -- | /Since: 2/ $(deriveTextShow ''DataType) -- | /Since: 2/ $(deriveTextShow ''ConstrRep) -- | /Since: 2/ $(deriveTextShow ''Fixity) text-show-3.10.4/src/TextShow/Data/Dynamic.hs0000644000000000000000000000117507346545000017103 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Dynamic Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Dynamic'. /Since: 2/ -} module TextShow.Data.Dynamic () where import Data.Dynamic (Dynamic, dynTypeRep) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Typeable () -- | /Since: 2/ instance TextShow Dynamic where showb dyn = "<<" <> showb (dynTypeRep dyn) <> ">>" {-# INLINE showb #-} text-show-3.10.4/src/TextShow/Data/Either.hs0000644000000000000000000000105707346545000016736 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Either Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Either'. /Since: 2/ -} module TextShow.Data.Either () where import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) -- | /Since: 2/ $(deriveTextShow ''Either) -- | /Since: 2/ $(deriveTextShow1 ''Either) -- | /Since: 2/ $(deriveTextShow2 ''Either) text-show-3.10.4/src/TextShow/Data/Fixed.hs0000644000000000000000000000477707346545000016571 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Fixed Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Provides 'TextShow' instance for 'Fixed', as well as the 'showbFixed' function. /Since: 2/ -} module TextShow.Data.Fixed (showbFixed) where import Data.Fixed (Fixed(..), HasResolution(..)) import Data.Int (Int64) import Data.Semigroup.Compat (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral () import TextShow.Utils (lengthB) #if MIN_VERSION_base(4,13,0) import TextShow.Classes (showbParen) #endif -- | Convert a 'Fixed' value to a 'Builder', where the first argument indicates -- whether to chop off trailing zeroes. -- -- /Since: 2/ showbFixed :: HasResolution a => Bool -> Fixed a -> Builder showbFixed chopTrailingZeroes fa@(MkFixed a) | a < 0 = singleton '-' <> showbFixed chopTrailingZeroes (asTypeOf (MkFixed (negate a)) fa) showbFixed chopTrailingZeroes fa@(MkFixed a) = showb i <> withDotB (showbIntegerZeroes chopTrailingZeroes digits fracNum) where res = fromInteger $ resolution fa (i, d) = divMod (fromInteger a) res digits = ceiling (logBase 10 (fromInteger $ resolution fa) :: Double) maxnum = 10 ^ digits #if MIN_VERSION_base(4,8,0) fracNum = divCeil (d * maxnum) res divCeil x y = (x + y - 1) `div` y #else fracNum = div (d * maxnum) res #endif -- | Only works for positive 'Integer's. showbIntegerZeroes :: Bool -> Int64 -> Integer -> Builder showbIntegerZeroes True _ 0 = mempty showbIntegerZeroes chopTrailingZeroes digits a = mtimesDefault (max 0 $ digits - lengthB sh) (singleton '0') <> sh' where sh, sh' :: Builder sh = showb a sh' = if chopTrailingZeroes then chopZeroesB a else sh -- | Chops off the trailing zeroes of an 'Integer'. chopZeroesB :: Integer -> Builder chopZeroesB 0 = mempty chopZeroesB a | mod a 10 == 0 = chopZeroesB (div a 10) chopZeroesB a = showb a -- | Prepends a dot to a non-empty 'Builder'. withDotB :: Builder -> Builder withDotB b | b == mempty = mempty | otherwise = singleton '.' <> b {-# INLINE withDotB #-} -- | /Since: 2/ instance HasResolution a => TextShow (Fixed a) where #if MIN_VERSION_base(4,13,0) showbPrec p n = showbParen (p > 6 && n < 0) $ showbFixed False n #else showb = showbFixed False {-# INLINE showb #-} #endif text-show-3.10.4/src/TextShow/Data/Floating.hs0000644000000000000000000003427507346545000017271 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Floating Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances and monomorphic functions for floating-point types. /Since: 2/ -} module TextShow.Data.Floating ( showbRealFloatPrec , showbEFloat , showbFFloat , showbGFloat , showbFFloatAlt , showbGFloatAlt , showbFPFormat , FPFormat(..) , formatRealFloatB , formatRealFloatAltB ) where import Data.Array.Base (unsafeAt) import Data.Array.IArray (Array, array) import qualified Data.Text as T (replicate) import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton) import Data.Text.Lazy.Builder.Int (decimal) import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..), showbParen) import TextShow.TH.Internal (deriveTextShow) import TextShow.Utils (i2d) ------------------------------------------------------------------------------- -- TextShow instances ------------------------------------------------------------------------------- -- | /Since: 2/ $(deriveTextShow ''FPFormat) -- | /Since: 2/ instance TextShow Float where showbPrec = showbRealFloatPrec {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow Double where showbPrec = showbRealFloatPrec {-# INLINE showbPrec #-} ------------------------------------------------------------------------------- -- Standalone showb* functions ------------------------------------------------------------------------------- -- | Convert a 'RealFloat' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbRealFloatPrec :: RealFloat a => Int -> a -> Builder showbRealFloatPrec p x | x < 0 || isNegativeZero x = showbParen (p > 6) $ singleton '-' <> showbGFloat Nothing (-x) | otherwise = showbGFloat Nothing x {-# INLINE showbRealFloatPrec #-} {-# SPECIALIZE showbEFloat :: Maybe Int -> Float -> Builder, Maybe Int -> Double -> Builder #-} {-# SPECIALIZE showbFFloat :: Maybe Int -> Float -> Builder, Maybe Int -> Double -> Builder #-} {-# SPECIALIZE showbGFloat :: Maybe Int -> Float -> Builder, Maybe Int -> Double -> Builder #-} -- | Show a signed 'RealFloat' value -- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@). -- -- In the call @'showbEFloat' digs val@, if @digs@ is 'Nothing', -- the value is shown to full precision; if @digs@ is @'Just' d@, -- then at most @d@ digits after the decimal point are shown. -- -- /Since: 2/ showbEFloat :: RealFloat a => Maybe Int -> a -> Builder showbEFloat = formatRealFloatB Exponent -- | Show a signed 'RealFloat' value -- using standard decimal notation (e.g. @245000@, @0.0015@). -- -- In the call @'showbFFloat' digs val@, if @digs@ is 'Nothing', -- the value is shown to full precision; if @digs@ is @'Just' d@, -- then at most @d@ digits after the decimal point are shown. -- -- /Since: 2/ showbFFloat :: RealFloat a => Maybe Int -> a -> Builder showbFFloat = formatRealFloatB Fixed -- | Show a signed 'RealFloat' value -- using standard decimal notation for arguments whose absolute value lies -- between @0.1@ and @9,999,999@, and scientific notation otherwise. -- -- In the call @'showbGFloat' digs val@, if @digs@ is 'Nothing', -- the value is shown to full precision; if @digs@ is @'Just' d@, -- then at most @d@ digits after the decimal point are shown. -- -- /Since: 2/ showbGFloat :: RealFloat a => Maybe Int -> a -> Builder showbGFloat = formatRealFloatB Generic -- | Show a signed 'RealFloat' value -- using standard decimal notation (e.g. @245000@, @0.0015@). -- -- This behaves as 'showFFloat', except that a decimal point -- is always guaranteed, even if not needed. -- -- /Since: 2/ showbFFloatAlt :: RealFloat a => Maybe Int -> a -> Builder showbFFloatAlt d = formatRealFloatAltB Fixed d True {-# INLINE showbFFloatAlt #-} -- | Show a signed 'RealFloat' value -- using standard decimal notation for arguments whose absolute value lies -- between @0.1@ and @9,999,999@, and scientific notation otherwise. -- -- This behaves as 'showFFloat', except that a decimal point -- is always guaranteed, even if not needed. -- -- /Since: 2/ showbGFloatAlt :: RealFloat a => Maybe Int -> a -> Builder showbGFloatAlt d = formatRealFloatAltB Generic d True {-# INLINE showbGFloatAlt #-} -- | Convert an 'FPFormat' value to a 'Builder'. -- -- /Since: 2/ showbFPFormat :: FPFormat -> Builder showbFPFormat = showb {-# INLINE showbFPFormat #-} ------------------------------------------------------------------------------- -- GHC.Float internal functions, adapted for Builders ------------------------------------------------------------------------------- -- | Like 'formatRealFloatAltB', except that the decimal is only shown for arguments -- whose absolute value is between @0.1@ and @9,999,999@. -- -- /Since: 2/ formatRealFloatB :: RealFloat a => FPFormat -- ^ What notation to use. -> Maybe Int -- ^ Number of decimal places to render. -> a -> Builder formatRealFloatB fmt decs = formatRealFloatAltB fmt decs False {-# INLINE formatRealFloatB #-} -- | Converts a 'RealFloat' value to a Builder, specifying if a decimal point -- should always be shown. -- -- /Since: 2/ formatRealFloatAltB :: RealFloat a => FPFormat -- ^ What notation to use. -> Maybe Int -- ^ Number of decimal places to render. -> Bool -- ^ Should a decimal point always be shown? -> a -> Builder {-# SPECIALIZE formatRealFloatAltB :: FPFormat -> Maybe Int -> Bool -> Float -> Builder #-} {-# SPECIALIZE formatRealFloatAltB :: FPFormat -> Maybe Int -> Bool -> Double -> Builder #-} formatRealFloatAltB fmt decs alt x | isNaN x = "NaN" | isInfinite x = if x < 0 then "-Infinity" else "Infinity" | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x)) | otherwise = doFmt fmt (floatToDigits x) where doFmt format (is, e) = let ds = map i2d is in case format of Generic -> doFmt (if e < 0 || e > 7 then Exponent else Fixed) (is,e) Exponent -> case decs of Nothing -> let show_e' = decimal (e-1) in case ds of "0" -> "0.0e0" [d] -> singleton d <> ".0e" <> show_e' (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e' [] -> error "formatRealFloat/doFmt/Exponent: []" Just d | d <= 0 -> -- handle this case specifically since we need to omit the -- decimal point as well (#15115). -- Note that this handles negative precisions as well for consistency -- (see #15509). case is of [0] -> "0e0" _ -> let (ei,is') = roundTo 1 is n = case map i2d (if ei > 0 then init is' else is') of n':_ -> n' [] -> error "formatRealFloatAltB (Exponent, negative decs): Unexpected empty list" in singleton n <> singleton 'e' <> decimal (e-1+ei) Just dec -> let dec' = max dec 1 in case is of [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0" _ -> let (ei,is') = roundTo (dec'+1) is (d,ds') = case map i2d (if ei > 0 then init is' else is') of (d':ds'') -> (d',ds'') [] -> error "formatRealFloatAltB (Exponent, non-negative decs): Unexpected empty list" in singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei) Fixed -> let mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls} in case decs of Nothing | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds | otherwise -> let f 0 str rs = mk0 (reverse str) <> singleton '.' <> mk0 rs f n str "" = f (n-1) ('0':str) "" f n str (r:rs) = f (n-1) (r:str) rs in f e "" ds Just dec -> let dec' = max dec 0 in if e >= 0 then let (ei,is') = roundTo (dec' + e) is (ls,rs) = splitAt (e+ei) (map i2d is') in mk0 ls <> (if null rs && not alt then "" else singleton '.' <> fromString rs) else let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is) (d,ds') = case map i2d (if ei > 0 then is' else 0:is') of (d':ds'') -> (d',ds'') [] -> error "formatRealFloatAltB (Fixed): Unexpected empty list" in singleton d <> (if null ds' && not alt then "" else singleton '.' <> fromString ds') -- Based on "Printing Floating-Point Numbers Quickly and Accurately" -- by R.G. Burger and R.K. Dybvig in PLDI 96. -- This version uses a much slower logarithm estimator. It should be improved. -- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number, -- and returns a list of digits and an exponent. -- In particular, if @x>=0@, and -- -- > floatToDigits base x = ([d1,d2,...,dn], e) -- -- then -- -- (1) @n >= 1@ -- -- (2) @x = 0.d1d2...dn * (base**e)@ -- -- (3) @0 <= di <= base-1@ floatToDigits :: (RealFloat a) => a -> ([Int], Int) {-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-} {-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-} floatToDigits 0 = ([0], 0) floatToDigits x = let (f0, e0) = decodeFloat x (minExp0, _) = floatRange x p = floatDigits x b = floatRadix x minExp = minExp0 - p -- the real minimum exponent -- Haskell requires that f be adjusted so denormalized numbers -- will have an impossibly low exponent. Adjust for this. (f, e) = let n = minExp - e0 in if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0) (r, s', mUp, mDn) = if e >= 0 then let be = expt b e in if f == expt b (p-1) then (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig else (f*be*2, 2, be, be) else if e > minExp && f == expt b (p-1) then (f*b*2, expt b (-e+1)*2, b, 1) else (f*2, expt b (-e)*2, 1, 1) k :: Int k = let k0 :: Int k0 = if b == 2 then -- logBase 10 2 is very slightly larger than 8651/28738 -- (about 5.3558e-10), so if log x >= 0, the approximation -- k1 is too small, hence we add one and need one fixup step less. -- If log x < 0, the approximation errs rather on the high side. -- That is usually more than compensated for by ignoring the -- fractional part of logBase 2 x, but when x is a power of 1/2 -- or slightly larger and the exponent is a multiple of the -- denominator of the rational approximation to logBase 10 2, -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x, -- we get a leading zero-digit we don't want. -- With the approximation 3/10, this happened for -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above. -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x -- for IEEE-ish floating point types with exponent fields -- <= 17 bits and mantissae of several thousand bits, earlier -- convergents to logBase 10 2 would fail for long double. -- Using quot instead of div is a little faster and requires -- fewer fixup steps for negative lx. let lx = p - 1 + e0 k1 = (lx * 8651) `quot` 28738 in if lx >= 0 then k1 + 1 else k1 else -- f :: Integer, log :: Float -> Float, -- ceiling :: Float -> Int ceiling ((log (fromInteger (f+1) :: Float) + fromIntegral e * log (fromInteger b)) / log 10) --WAS: fromInt e * log (fromInteger b)) fixup n = if n >= 0 then if r + mUp <= expt 10 n * s' then n else fixup (n+1) else if expt 10 (-n) * (r + mUp) <= s' then n else fixup (n+1) in fixup k0 gen ds rn sN mUpN mDnN = let (dn, rn') = (rn * 10) `quotRem` sN mUpN' = mUpN * 10 mDnN' = mDnN * 10 in case (rn' < mDnN', rn' + mUpN' > sN) of (True, False) -> dn : ds (False, True) -> dn+1 : ds (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN' rds = if k >= 0 then gen [] r (s' * expt 10 k) mUp mDn else let bk = expt 10 (-k) in gen [] (r * bk) s' (mUp * bk) (mDn * bk) in (map fromIntegral (reverse rds), k) roundTo :: Int -> [Int] -> (Int,[Int]) roundTo d is = case f d True is of x@(0,_) -> x (1,xs) -> (1, 1:xs) _ -> error "roundTo: bad Value" where b2 = base `quot` 2 f n _ [] = (0, replicate n 0) f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base | otherwise = (if x >= b2 then 1 else 0, []) f n _ (i:xs) | i' == base = (1,0:ds) | otherwise = (0,i':ds) where (c,ds) = f (n-1) (even i) xs i' = c + i base = 10 -- Exponentiation with a cache for the most common numbers. -- | The minimum exponent in the cache. minExpt :: Int minExpt = 0 -- | The maximum exponent (of 2) in the cache. maxExpt :: Int maxExpt = 1100 -- | Exponentiate an 'Integer', using a cache if possible. expt :: Integer -> Int -> Integer expt base n | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n | otherwise = base^n -- | Cached powers of two. expts :: Array Int Integer expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]] -- | The maximum exponent (of 10) in the cache. maxExpt10 :: Int maxExpt10 = 324 -- | Cached powers of 10. expts10 :: Array Int Integer expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]] text-show-3.10.4/src/TextShow/Data/Functor/0000755000000000000000000000000007346545000016577 5ustar0000000000000000text-show-3.10.4/src/TextShow/Data/Functor/Compose.hs0000644000000000000000000000164407346545000020545 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Compose Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Compose'. /Since: 3/ -} module TextShow.Data.Functor.Compose () where import Data.Functor.Compose (Compose(..)) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1, showbUnaryWith) -- | /Since: 3/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Compose f g a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} -- | /Since: 3/ instance (TextShow1 f, TextShow1 g) => TextShow1 (Compose f g) where liftShowbPrec sp sl p (Compose x) = showbUnaryWith (liftShowbPrec (liftShowbPrec sp sl) (liftShowbList sp sl)) "Compose" p x text-show-3.10.4/src/TextShow/Data/Functor/Identity.hs0000644000000000000000000000164007346545000020725 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Identity Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Identity' values. /Since: 2/ -} module TextShow.Data.Functor.Identity () where import Data.Functor.Identity (Identity(..)) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1, showbUnaryWith) -- | /Since: 3/ instance TextShow a => TextShow (Identity a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} -- | /Since: 3/ instance TextShow1 Identity where -- This would be equivalent to the derived instance of 'Identity' if the -- 'runIdentity' field were removed. liftShowbPrec sp _ p (Identity x) = showbUnaryWith sp "Identity" p x {-# INLINE liftShowbPrec #-} text-show-3.10.4/src/TextShow/Data/Functor/Product.hs0000644000000000000000000000136607346545000020561 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Product Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Product'. /Since: 3/ -} module TextShow.Data.Functor.Product () where import Data.Functor.Product (Product(..)) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1) import TextShow.TH.Internal (deriveTextShow1) -- | /Since: 3/ $(deriveTextShow1 ''Product) -- | /Since: 3/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Product f g a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} text-show-3.10.4/src/TextShow/Data/Functor/Sum.hs0000644000000000000000000000132607346545000017701 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Sum Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Sum'. /Since: 3/ -} module TextShow.Data.Functor.Sum () where import Data.Functor.Sum (Sum) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1) import TextShow.TH.Internal (deriveTextShow1) -- | /Since: 3/ $(deriveTextShow1 ''Sum) -- | /Since: 3/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Sum f g a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} text-show-3.10.4/src/TextShow/Data/Integral.hs0000644000000000000000000001171507346545000017265 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Integral Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances and monomorphic functions for integral types. /Since: 2/ -} module TextShow.Data.Integral ( showbIntegralPrec , showbIntAtBase , showbBin , showbHex , showbOct ) where import Data.Char (intToDigit) import Data.Int (Int8, Int16, Int32, Int64) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Text.Lazy.Builder.Int (decimal) import Data.Word (Word8, Word16, Word32, Word64) import GHC.Exts (Int(I#), (<#), (>#), isTrue#) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Utils (toString) -- | Convert an 'Integral' type to a 'Builder' with the given precedence. -- -- /Since: 2/ showbIntegralPrec :: Integral a => Int -> a -> Builder showbIntegralPrec p = showbPrec p . toInteger {-# INLINE showbIntegralPrec #-} -- | Shows a /non-negative/ 'Integral' number using the base specified by the -- first argument, and the character representation specified by the second. -- -- /Since: 2/ showbIntAtBase :: (Integral a, TextShow a) => a -> (Int -> Char) -> a -> Builder {-# SPECIALIZE showbIntAtBase :: Int -> (Int -> Char) -> Int -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Int8 -> (Int -> Char) -> Int8 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Int16 -> (Int -> Char) -> Int16 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Int32 -> (Int -> Char) -> Int32 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Int64 -> (Int -> Char) -> Int64 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Integer -> (Int -> Char) -> Integer -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word -> (Int -> Char) -> Word -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word8 -> (Int -> Char) -> Word8 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word16 -> (Int -> Char) -> Word16 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word32 -> (Int -> Char) -> Word32 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word64 -> (Int -> Char) -> Word64 -> Builder #-} showbIntAtBase base toChr n0 | base <= 1 = error . toString $ "TextShow.Int.showbIntAtBase: applied to unsupported base" <> showb base | n0 < 0 = error . toString $ "TextShow.Int.showbIntAtBase: applied to negative number " <> showb n0 | otherwise = showbIt (quotRem n0 base) mempty where showbIt (n, d) b = seq c $ -- stricter than necessary case n of 0 -> b' _ -> showbIt (quotRem n base) b' where c :: Char c = toChr $ fromIntegral d b' :: Builder b' = singleton c <> b -- | Show /non-negative/ 'Integral' numbers in base 2. -- -- /Since: 2/ showbBin :: (Integral a, TextShow a) => a -> Builder showbBin = showbIntAtBase 2 intToDigit {-# INLINE showbBin #-} -- | Show /non-negative/ 'Integral' numbers in base 16. -- -- /Since: 2/ showbHex :: (Integral a, TextShow a) => a -> Builder showbHex = showbIntAtBase 16 intToDigit {-# INLINE showbHex #-} -- | Show /non-negative/ 'Integral' numbers in base 8. -- -- /Since: 2/ showbOct :: (Integral a, TextShow a) => a -> Builder showbOct = showbIntAtBase 8 intToDigit {-# INLINE showbOct #-} -- | /Since: 2/ instance TextShow Int where showbPrec (I# p) n'@(I# n) | isTrue# (n <# 0#) && isTrue# (p ># 6#) = singleton '(' <> decimal n' <> singleton ')' | otherwise = decimal n' -- | /Since: 2/ instance TextShow Int8 where showbPrec p x = showbPrec p (fromIntegral x :: Int) {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow Int16 where showbPrec p x = showbPrec p (fromIntegral x :: Int) {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow Int32 where showbPrec p x = showbPrec p (fromIntegral x :: Int) {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow Int64 where #if WORD_SIZE_IN_BITS < 64 showbPrec p = showbPrec p . toInteger #else showbPrec p x = showbPrec p (fromIntegral x :: Int) #endif {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow Integer where showbPrec p n | p > 6 && n < 0 = singleton '(' <> decimal n <> singleton ')' | otherwise = decimal n {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow Word where showb = decimal {-# INLINE showb #-} -- | /Since: 2/ instance TextShow Word8 where showb = decimal {-# INLINE showb #-} -- | /Since: 2/ instance TextShow Word16 where showb = decimal {-# INLINE showb #-} -- | /Since: 2/ instance TextShow Word32 where showb = decimal {-# INLINE showb #-} -- | /Since: 2/ instance TextShow Word64 where showb = decimal {-# INLINE showb #-} text-show-3.10.4/src/TextShow/Data/List.hs0000644000000000000000000000164607346545000016435 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.List Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Exports 'showbListWith', 'showtListWith', and 'showtlListWith', and 'TextShow' instances for lists. -} module TextShow.Data.List (showbListWith, showtListWith, showtlListWith) where import TextShow.Classes (TextShow(..), TextShow1(..), showbListWith, showtListWith, showtlListWith) import TextShow.Data.Char () import TextShow.Data.Integral () -- | /Since: 2/ instance TextShow a => TextShow [a] where {-# SPECIALIZE instance TextShow [String] #-} {-# SPECIALIZE instance TextShow String #-} {-# SPECIALIZE instance TextShow [Int] #-} showb = showbList {-# INLINE showb #-} -- | /Since: 2/ instance TextShow1 [] where liftShowbPrec _ sl _ = sl {-# INLINE liftShowbPrec #-} text-show-3.10.4/src/TextShow/Data/List/0000755000000000000000000000000007346545000016072 5ustar0000000000000000text-show-3.10.4/src/TextShow/Data/List/NonEmpty.hs0000644000000000000000000000112707346545000020200 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.List.NonEmpty Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'NonEmpty' lists. /Since: 3/ -} module TextShow.Data.List.NonEmpty () where import Data.List.NonEmpty.Compat (NonEmpty) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) -- | /Since: 3/ $(deriveTextShow ''NonEmpty) -- | /Since: 3/ $(deriveTextShow1 ''NonEmpty) text-show-3.10.4/src/TextShow/Data/Maybe.hs0000644000000000000000000000075507346545000016557 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Maybe Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Maybe'. /Since: 2/ -} module TextShow.Data.Maybe () where import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) -- | /Since: 2/ $(deriveTextShow ''Maybe) -- | /Since: 2/ $(deriveTextShow1 ''Maybe) text-show-3.10.4/src/TextShow/Data/Monoid.hs0000644000000000000000000000364507346545000016750 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE FlexibleContexts #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Monoid Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for 'Monoid'-related newtypes. /Since: 2/ -} module TextShow.Data.Monoid () where import Data.Monoid.Compat (All, Any, Dual, First, Last, Product, Sum) 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 (TextShow(..)) import TextShow.TH.Internal (makeShowbPrec) #endif #if MIN_VERSION_base(4,12,0) import Data.Monoid (Ap) #endif -- | /Since: 2/ $(deriveTextShow ''All) -- | /Since: 2/ $(deriveTextShow ''Any) -- | /Since: 2/ $(deriveTextShow ''Dual) -- | /Since: 2/ $(deriveTextShow1 ''Dual) -- | /Since: 2/ $(deriveTextShow ''First) -- | /Since: 2/ $(deriveTextShow1 ''First) -- | /Since: 2/ $(deriveTextShow ''Last) -- | /Since: 2/ $(deriveTextShow1 ''Last) -- | /Since: 2/ $(deriveTextShow ''Product) -- | /Since: 2/ $(deriveTextShow1 ''Product) -- | /Since: 2/ $(deriveTextShow ''Sum) -- | /Since: 2/ $(deriveTextShow1 ''Sum) #if MIN_VERSION_base(4,8,0) -- | Only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ instance TextShow (f a) => TextShow (Alt f a) where showbPrec = $(makeShowbPrec ''Alt) -- | Only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ $(deriveTextShow1 ''Alt) #endif #if MIN_VERSION_base(4,12,0) -- | Only available with @base-4.12.0.0@ or later. -- -- /Since: 3.7.4/ instance TextShow (f a) => TextShow (Ap f a) where showbPrec = $(makeShowbPrec ''Ap) -- | Only available with @base-4.12.0.0@ or later. -- -- /Since: 3.7.4/ $(deriveTextShow1 ''Ap) #endif text-show-3.10.4/src/TextShow/Data/OldTypeable.hs0000644000000000000000000000370007346545000017717 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_base(4,8,0)) {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} #endif {-| Module: TextShow.Data.OldTypeable Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for data types in the @OldTypeable@ module. This module only exports functions if using @base-4.7@. /Since: 2/ -} module TextShow.Data.OldTypeable () where #if !(MIN_VERSION_base(4,8,0)) import Data.OldTypeable.Internal (TyCon(TyCon, tyConName), TypeRep(..), funTc, listTc) import Data.Text.Lazy.Builder (fromString, singleton) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import TextShow.Utils (isTupleString) -- | Does the 'TyCon' represent a tuple type constructor? isTupleTyCon :: TyCon -> Bool isTupleTyCon (TyCon _ _ _ str) = isTupleString str {-# INLINE isTupleTyCon #-} -- | /Since: 2/ instance TextShow TyCon where showb = fromString . tyConName {-# INLINE showb #-} -- | /Since: 2/ instance TextShow TypeRep where showbPrec p (TypeRep _ tycon tys) = case tys of [] -> showb tycon [x] | tycon == listTc -> singleton '[' <> showb x <> singleton ']' [a,r] | tycon == funTc -> showbParen (p > 8) $ showbPrec 9 a <> " -> " <> showbPrec 8 r xs | isTupleTyCon tycon -> showbTuple xs | otherwise -> showbParen (p > 9) $ showbPrec p tycon <> showbSpace <> showbArgs showbSpace tys {-# INLINE showbPrec #-} #endif text-show-3.10.4/src/TextShow/Data/Ord.hs0000644000000000000000000000212607346545000016240 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ord Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for 'Ordering' and 'Down'. /Since: 2/ -} module TextShow.Data.Ord () where import GHC.Exts (Down(..)) import TextShow.Classes ( TextShow(..), TextShow1(..) , showbPrec1, showbUnaryWith ) import TextShow.TH.Internal (deriveTextShow) -- | This instance would be equivalent to a derived 'TextShow' instance -- if the 'getDown' field were removed. -- -- /Since: 2/ instance TextShow a => TextShow (Down a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} -- | This instance would be equivalent to a derived 'TextShow1' instance -- if the 'getDown' field were removed. -- -- /Since: 2/ instance TextShow1 Down where liftShowbPrec sp _ p (Down x) = showbUnaryWith sp "Down" p x {-# INLINE liftShowbPrec #-} -- | /Since: 2/ $(deriveTextShow ''Ordering) text-show-3.10.4/src/TextShow/Data/Proxy.hs0000644000000000000000000000167707346545000016647 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Proxy Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Proxy'. /Since: 2/ -} module TextShow.Data.Proxy () where import Data.Proxy.Compat (Proxy) import TextShow.Classes (TextShow(..)) import TextShow.TH.Internal (deriveTextShow1, makeShowbPrec, makeShowtPrec, makeShowtlPrec) -- | /Since: 2/ instance TextShow (Proxy s) where showbPrec = $(makeShowbPrec ''Proxy) showtPrec = $(makeShowtPrec ''Proxy) showtlPrec = $(makeShowtlPrec ''Proxy) {-# INLINE showbPrec #-} {-# INLINE showtPrec #-} {-# INLINE showtlPrec #-} -- | /Since: 2/ $(deriveTextShow1 ''Proxy) text-show-3.10.4/src/TextShow/Data/Ratio.hs0000644000000000000000000000206107346545000016570 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ratio Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Ratio'. /Since: 2/ -} module TextShow.Data.Ratio () where import GHC.Real (Ratio(..), ratioPrec, ratioPrec1) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..), TextShow1(..), showbParen) import TextShow.Data.Integral () -- | /Since: 2/ instance TextShow a => TextShow (Ratio a) where {-# SPECIALIZE instance TextShow Rational #-} showbPrec p (numer :% denom) = showbParen (p > ratioPrec) $ showbPrec ratioPrec1 numer <> " % " <> showbPrec ratioPrec1 denom {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow1 Ratio where liftShowbPrec sp _ p (numer :% denom) = showbParen (p > ratioPrec) $ sp ratioPrec1 numer <> " % " <> sp ratioPrec1 denom {-# INLINE liftShowbPrec #-} text-show-3.10.4/src/TextShow/Data/Semigroup.hs0000644000000000000000000000216007346545000017464 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Semigroup Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for data types in the "Data.Semigroup" module. /Since: 3/ -} module TextShow.Data.Semigroup () where import Data.Semigroup.Compat (Min, Max, First, Last, WrappedMonoid, Arg) import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) -- | /Since: 3/ $(deriveTextShow ''Min) -- | /Since: 3/ $(deriveTextShow1 ''Min) -- | /Since: 3/ $(deriveTextShow ''Max) -- | /Since: 3/ $(deriveTextShow1 ''Max) -- | /Since: 3/ $(deriveTextShow ''First) -- | /Since: 3/ $(deriveTextShow1 ''First) -- | /Since: 3/ $(deriveTextShow ''Last) -- | /Since: 3/ $(deriveTextShow1 ''Last) -- | /Since: 3/ $(deriveTextShow ''WrappedMonoid) -- | /Since: 3/ $(deriveTextShow1 ''WrappedMonoid) -- | /Since: 3/ $(deriveTextShow ''Arg) -- | /Since: 3/ $(deriveTextShow1 ''Arg) -- | /Since: 3/ $(deriveTextShow2 ''Arg) text-show-3.10.4/src/TextShow/Data/Text.hs0000644000000000000000000000564207346545000016446 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} #if MIN_VERSION_text(0,9,0) {-# LANGUAGE TemplateHaskell #-} #endif {-# OPTIONS_GHC -fno-warn-deprecations #-} -- TODO: Remove this later {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Text Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines 'TextShow' instances for 'Text' types, as well as other miscellaneous data types from the @text@ package. Note that this module deliberately does not define a 'TextShow' instance for the @I16@ data type from @Data.Text.Foreign@, as that module is not available on certain widely used variants of GHC (e.g., @reflex-platform@). See #40 for more details. If this is a problem for you, please file an issue. /Since: 2/ -} module TextShow.Data.Text () where import qualified Data.Text as TS import Data.Text.Encoding.Error (UnicodeException(..)) import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Char (showbString) import TextShow.Data.Integral (showbHex) import TextShow.TH.Internal (deriveTextShow) #if MIN_VERSION_text(1,0,0) import Data.Text.Encoding (Decoding(..)) import Data.Text.Lazy.Builder (singleton) import GHC.Show (appPrec) import TextShow.Classes (showbParen) import TextShow.Data.ByteString () #endif #if MIN_VERSION_text(1,1,0) import Data.Text.Internal.Fusion.Size (Size) #endif -- | /Since: 2/ instance TextShow TS.Text where showb = showbString . TS.unpack {-# INLINE showb #-} -- | /Since: 2/ instance TextShow TL.Text where showb = showbString . TL.unpack {-# INLINE showb #-} -- | /Since: 2/ instance TextShow Builder where showb = showb . toLazyText {-# INLINE showb #-} -- | /Since: 2/ instance TextShow UnicodeException where showb (DecodeError desc (Just w)) = "Cannot decode byte '\\x" <> showbHex w <> "': " <> fromString desc showb (DecodeError desc Nothing) = "Cannot decode input: " <> fromString desc showb (EncodeError desc (Just c)) = "Cannot encode character '\\x" <> showbHex (fromEnum c) <> "': " <> fromString desc showb (EncodeError desc Nothing) = "Cannot encode input: " <> fromString desc #if MIN_VERSION_text(1,0,0) -- | Only available with @text-1.0.0.0@ or later. -- -- /Since: 2/ instance TextShow Decoding where showbPrec p (Some t bs _) = showbParen (p > appPrec) $ "Some " <> showb t <> singleton ' ' <> showb bs <> " _" {-# INLINE showbPrec #-} #endif #if MIN_VERSION_text(1,1,0) -- | Only available with @text-1.1.0.0@ or later. -- -- /Since: 2/ $(deriveTextShow ''Size) #endif text-show-3.10.4/src/TextShow/Data/Tuple.hs0000644000000000000000000000614607346545000016613 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Tuple Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for tuple types. /Since: 2/ -} module TextShow.Data.Tuple () where #if MIN_VERSION_ghc_prim(0,7,0) import GHC.Tuple (Solo(..)) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1, showbUnaryWith) #endif import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) -- The Great Pyramids of Template Haskell -- | /Since: 2/ $(deriveTextShow ''()) -- | /Since: 2/ $(deriveTextShow ''(,)) -- | /Since: 2/ $(deriveTextShow ''(,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,,,,,)) #if MIN_VERSION_ghc_prim(0,7,0) -- | /Since: 3.9.3/ instance TextShow a => TextShow (Solo a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} -- | /Since: 3.9.3/ instance TextShow1 Solo where # if MIN_VERSION_ghc_prim(0,10,0) liftShowbPrec sp _ p (MkSolo x) = showbUnaryWith sp "MkSolo" p x # else liftShowbPrec sp _ p (Solo x) = showbUnaryWith sp "Solo" p x # endif {-# INLINE liftShowbPrec #-} #endif text-show-3.10.4/src/TextShow/Data/Type/0000755000000000000000000000000007346545000016100 5ustar0000000000000000text-show-3.10.4/src/TextShow/Data/Type/Coercion.hs0000644000000000000000000000144307346545000020177 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Type.Coercion Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for representational equality. /Since: 2/ -} module TextShow.Data.Type.Coercion () where import Data.Type.Coercion (Coercion) import TextShow.Classes (TextShow1(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow2, makeLiftShowbPrec) -- | /Since: 2/ $(deriveTextShow ''Coercion) -- | /Since: 2/ instance TextShow1 (Coercion a) where liftShowbPrec = $(makeLiftShowbPrec ''Coercion) -- | /Since: 2/ $(deriveTextShow2 ''Coercion) text-show-3.10.4/src/TextShow/Data/Type/Equality.hs0000644000000000000000000000207307346545000020233 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Type.Equality Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for propositional equality. /Since: 2/ -} module TextShow.Data.Type.Equality () where import Data.Type.Equality.Compat import TextShow.Classes (TextShow1(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow2, makeLiftShowbPrec) -- | /Since: 2/ $(deriveTextShow ''(:~:)) -- | /Since: 2/ instance TextShow1 ((:~:) a) where liftShowbPrec = $(makeLiftShowbPrec ''(:~:)) -- | /Since: 2/ $(deriveTextShow2 ''(:~:)) #if MIN_VERSION_base(4,9,0) -- | /Since: 3.6/ $(deriveTextShow ''(:~~:)) -- | /Since: 3.6/ instance TextShow1 ((:~~:) a) where liftShowbPrec = $(makeLiftShowbPrec ''(:~~:)) -- | /Since: 3.6/ $(deriveTextShow2 ''(:~~:)) #endif text-show-3.10.4/src/TextShow/Data/Typeable.hs0000644000000000000000000002137407346545000017267 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ >= 801 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeApplications #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Typeable Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for data types in the @Typeable@ module. /Since: 2/ -} module TextShow.Data.Typeable () where import Prelude () import Prelude.Compat #if MIN_VERSION_base(4,10,0) import Data.Kind (Type) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Type.Equality ((:~~:)(..)) import GHC.Exts (Addr#, Char(..), (+#), eqChar#, indexCharOffAddr#) import GHC.Types (Module(..), TrName(..), TyCon(..), isTrue#) import TextShow.Classes (TextShow(..), TextShow1(..), showbParen, showbSpace) import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import Type.Reflection (pattern App, pattern Con, pattern Con', pattern Fun, SomeTypeRep(..), TypeRep, eqTypeRep, tyConName, typeRep, typeRepTyCon) #else /* !(MIN_VERSION_base(4,10,0) */ import Data.Text.Lazy.Builder (fromString, singleton) import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) 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.Text.Lazy.Builder (Builder) import Data.Typeable.Internal (Proxy(..), Typeable, TypeRep(TypeRep), typeRep) import GHC.Exts (RuntimeRep(..), TYPE) # else import Data.Typeable.Internal (funTc, listTc) # endif # if MIN_VERSION_base(4,9,0) import GHC.Exts (Addr#, Char(..), (+#), eqChar#, indexCharOffAddr#) import GHC.Types (TyCon(..), TrName(..), Module(..), isTrue#) # else import Data.Typeable.Internal (TyCon) # endif import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.List () import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) #endif #if MIN_VERSION_base(4,13,0) import Type.Reflection (typeRepKind) #endif #if MIN_VERSION_base(4,19,0) import Data.Char (isDigit, ord) import Type.Reflection (tyConModule, tyConPackage) #else import TextShow.Utils (isTupleString) #endif #if !(MIN_VERSION_base(4,10,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 'PtrRepLifted) tc'Unlifted :: TyCon tc'Unlifted = tyConOf (Proxy :: Proxy 'PtrRepUnlifted) # else -- | The list 'TyCon'. tcList :: TyCon tcList = listTc -- | The function (@->@) 'TyCon'. tcFun :: TyCon tcFun = funTc # endif #endif -- | Does the 'TyCon' represent a tuple type constructor? #if MIN_VERSION_base(4,19,0) isTupleTyCon :: TyCon -> Maybe Int isTupleTyCon tc | tyConPackage tc == "ghc-prim" , tyConModule tc == "GHC.Tuple.Prim" = case tyConName tc of "Unit" -> Just 0 'T' : 'u' : 'p' : 'l' : 'e' : arity -> readTwoDigits arity _ -> Nothing | otherwise = Nothing readTwoDigits :: String -> Maybe Int readTwoDigits s = case s of [c] | isDigit c -> Just (digit_to_int c) [c1, c2] | isDigit c1, isDigit c2 -> Just (digit_to_int c1 * 10 + digit_to_int c2) _ -> Nothing where digit_to_int :: Char -> Int digit_to_int c = ord c - ord '0' #else isTupleTyCon :: TyCon -> Bool isTupleTyCon = isTupleString . tyConName {-# INLINE isTupleTyCon #-} #endif #if MIN_VERSION_base(4,10,0) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ instance TextShow SomeTypeRep where showbPrec p (SomeTypeRep ty) = showbPrec p ty -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ instance TextShow (TypeRep (a :: k)) where showbPrec = showbTypeable -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ instance TextShow1 TypeRep where liftShowbPrec _ _ = showbTypeable showbTypeable :: Int -> TypeRep (a :: k) -> Builder showbTypeable _ rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = singleton '*' | isListTyCon tc, [] <- tys = fromString "[]" | isListTyCon tc, [ty] <- tys = singleton '[' <> showb ty <> singleton ']' # if MIN_VERSION_base(4,19,0) | Just _ <- isTupleTyCon tc, Just _ <- typeRep @Type `eqTypeRep` typeRepKind rep = showbTuple tys -- Print (,,,) instead of Tuple4 | Just n <- isTupleTyCon tc, [] <- tys = singleton '(' <> fromString (replicate (n-1) ',') <> singleton ')' # else | isTupleTyCon tc # if MIN_VERSION_base(4,13,0) , Just _ <- typeRep @Type `eqTypeRep` typeRepKind rep # endif = showbTuple tys # endif where (tc, tys) = splitApps rep showbTypeable p (Con' tycon []) = showbPrec p tycon showbTypeable p (Con' tycon args) = showbParen (p > 9) $ showbPrec p tycon <> showbSpace <> showbArgs showbSpace args showbTypeable p (Fun x r) = showbParen (p > 8) $ showbPrec 9 x <> " -> " <> showbPrec 8 r showbTypeable p (App f x) = showbParen (p > 9) $ showbPrec 8 f <> showbSpace <> showbPrec 10 x splitApps :: TypeRep a -> (TyCon, [SomeTypeRep]) splitApps = go [] where go :: [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep]) go [] (Fun a b) = (funTyCon, [SomeTypeRep a, SomeTypeRep b]) go _ (Fun _ _) = errorWithoutStackTrace "Data.Typeable.Internal.splitApps: Impossible" go xs (Con tc) = (tc, xs) go xs (App f x) = go (SomeTypeRep x : xs) f funTyCon :: TyCon funTyCon = typeRepTyCon (typeRep @(->)) isListTyCon :: TyCon -> Bool isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) #else -- | Only available with @base-4.9@ or earlier. -- -- /Since: 2/ instance TextShow TypeRep where showbPrec p tyrep = case tys of [] -> showb tycon # 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 <> " -> " <> showbPrec 8 r xs | isTupleTyCon tycon -> showbTuple xs | otherwise -> showbParen (p > 9) $ showbPrec p tycon <> showbSpace <> showbArgs showbSpace # if MIN_VERSION_base(4,8,0) (kinds ++ tys) # else tys # endif where tycon = typeRepTyCon tyrep tys = typeRepArgs tyrep # if MIN_VERSION_base(4,8,0) kinds = typeRepKinds tyrep # endif #endif -- | /Since: 2/ instance TextShow TyCon where #if MIN_VERSION_base(4,10,0) showbPrec p (TyCon _ _ _ tc_name _ _) = showbPrec p tc_name #elif MIN_VERSION_base(4,9,0) showb (TyCon _ _ _ tc_name) = showb tc_name #else showb = fromString . tyConName #endif #if MIN_VERSION_base(4,9,0) -- | Only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ instance TextShow TrName where showb (TrNameS s) = unpackCStringToBuilder# s showb (TrNameD s) = fromString s {-# INLINE showb #-} 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# #-} -- | Only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ instance TextShow Module where showb (Module p m) = showb p <> singleton ':' <> showb m {-# INLINE showb #-} #endif text-show-3.10.4/src/TextShow/Data/Typeable/0000755000000000000000000000000007346545000016724 5ustar0000000000000000text-show-3.10.4/src/TextShow/Data/Typeable/Utils.hs0000644000000000000000000000174107346545000020363 0ustar0000000000000000{-| Module: TextShow.Data.Typeable.Utils Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Utility functions for showing data types in the @Typeable@ (or @OldTypeable@) module. -} module TextShow.Data.Typeable.Utils (showbArgs, showbTuple) where import Data.Text.Lazy.Builder (Builder, singleton) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) -- | Helper function for showing a list of arguments, each separated by the given -- 'Builder'. showbArgs :: TextShow a => Builder -> [a] -> Builder showbArgs _ [] = mempty showbArgs _ [a] = showbPrec 10 a showbArgs sep (a:as) = showbPrec 10 a <> sep <> showbArgs sep as -- | Helper function for showing a list of 'Show' instances in a tuple. showbTuple :: TextShow a => [a] -> Builder showbTuple args = singleton '(' <> showbArgs (singleton ',') args <> singleton ')' {-# INLINE showbTuple #-} text-show-3.10.4/src/TextShow/Data/Version.hs0000644000000000000000000000233107346545000017137 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Version Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Provides a 'TextShow' instance for 'Version' and the 'showbVersion' function. /Since: 2/ -} module TextShow.Data.Version (showbVersion) where import Data.List (intersperse) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Version (Version(..)) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow) -- | Provides one possible concrete representation for 'Version'. For -- a version with 'versionBranch' @= [1,2,3]@ and 'versionTags' -- @= [\"tag1\",\"tag2\"]@, the output will be @1.2.3-tag1-tag2@. -- -- /Since: 3.6/ showbVersion :: Version -> Builder showbVersion (Version branch tags) = mconcat (intersperse (singleton '.') $ map showb branch) <> mconcat (map ((singleton '-' <>) . fromString) tags) {-# INLINE showbVersion #-} -- | /Since: 2/ $(deriveTextShow ''Version) text-show-3.10.4/src/TextShow/Data/Void.hs0000644000000000000000000000072507346545000016420 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Void Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Void'. /Since: 2/ -} module TextShow.Data.Void () where import Data.Void.Compat (Void, absurd) import Prelude () import TextShow.Classes (TextShow(..)) -- | /Since: 2/ instance TextShow Void where showb = absurd text-show-3.10.4/src/TextShow/Debug/0000755000000000000000000000000007346545000015334 5ustar0000000000000000text-show-3.10.4/src/TextShow/Debug/Trace.hs0000644000000000000000000002617407346545000016740 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-| Module: TextShow.Debug.Trace Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions for tracing and monitoring execution. These can be useful for investigating bugs or performance problems. They should /not/ be used in production code. If you do not wish to require 'TextShow' instances for your @trace@ functions, the "TextShow.Debug.Trace.TH" and "Text.Show.Text.Debug.Trace.Generic" modules exist to convert the input to a debug message using Template Haskell or generics, respectively. /Since: 2/ -} module TextShow.Debug.Trace ( -- * Tracing -- $tracing tracet , tracetl , tracetId , tracetlId , traceTextShow , traceTextShowId , tracetStack , tracetlStack , tracetIO , tracetlIO , tracetM , tracetlM , traceTextShowM -- * Eventlog tracing -- $eventlog_tracing , tracetEvent , tracetlEvent , tracetEventIO , tracetlEventIO -- * Execution phase markers -- $markers , tracetMarker , tracetlMarker , tracetMarkerIO , tracetlMarkerIO ) where import Control.Monad (unless) import qualified Data.ByteString as BS (null, partition) import Data.ByteString (ByteString, useAsCString) import qualified Data.ByteString.Char8 as BS (pack) import Data.ByteString.Internal (c2w) import qualified Data.Text as TS (Text, unpack) import Data.Text.Encoding (encodeUtf8) import qualified Data.Text.Lazy as TL (Text, unpack) import Data.Text.Lazy (toStrict) import Debug.Trace import Foreign.C.String (CString) import GHC.Stack (currentCallStack, renderStack) import Prelude () import Prelude.Compat import System.IO.Unsafe (unsafePerformIO) import TextShow.Classes (TextShow(..)) import TextShow.Instances () -- $tracing -- -- The @tracet(l)@, @traceTextShow@ and @tracet(l)IO@ functions print messages to an -- output stream. They are intended for \"printf debugging\", that is: tracing the flow -- of execution and printing interesting values. -- -- All these functions evaluate the message completely before printing -- it; so if the message is not fully defined, none of it will be -- printed. -- -- The usual output stream is 'System.IO.stderr'. For Windows GUI applications -- (that have no stderr) the output is directed to the Windows debug console. -- Some implementations of these functions may decorate the @Text@ that\'s -- output to indicate that you\'re tracing. -- | The 'tracetIO' function outputs the trace message from the IO monad. -- This sequences the output with respect to other IO actions. -- -- /Since: 2/ tracetIO :: TS.Text -> IO () tracetIO = traceIOByteString . encodeUtf8 -- | Like 'tracetIO' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlIO :: TL.Text -> IO () tracetlIO = tracetIO . toStrict traceIOByteString :: ByteString -> IO () traceIOByteString msg = useAsCString "%s\n" $ \cfmt -> do -- NB: debugBelch can't deal with null bytes, so filter them -- out so we don't accidentally truncate the message. See Trac #9395 let (nulls, msg') = BS.partition (== c2w '\0') msg useAsCString msg' $ \cmsg -> debugBelch cfmt cmsg unless (BS.null nulls) $ useAsCString "WARNING: previous trace message had null bytes" $ \cmsg -> debugBelch cfmt cmsg -- don't use debugBelch() directly, because we cannot call varargs functions -- using the FFI. foreign import ccall unsafe "HsBase.h debugBelch2" debugBelch :: CString -> CString -> IO () {-| The 'tracet' function outputs the trace message given as its first argument, before returning the second argument as its result. For example, this returns the value of @f x@ but first outputs the message. > tracet ("calling f with x = " <> showt x) (f x) The 'tracet' function should /only/ be used for debugging, or for monitoring execution. The function is not referentially transparent: its type indicates that it is a pure function but it has the side effect of outputting the trace message. /Since: 2/ -} tracet :: TS.Text -> a -> a tracet = traceByteString . encodeUtf8 -- | Like 'tracet' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetl :: TL.Text -> a -> a tracetl = tracet . toStrict {-# NOINLINE traceByteString #-} traceByteString :: ByteString -> a -> a traceByteString bs expr = unsafePerformIO $ do traceIOByteString bs return expr -- | Like 'tracet' but returns the message instead of a third value. -- -- /Since: 2/ tracetId :: TS.Text -> TS.Text tracetId a = tracet a a -- | Like 'tracetId' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlId :: TL.Text -> TL.Text tracetlId a = tracetl a a {-| Like 'tracet', but uses 'showt' on the argument to convert it to a 'TS.Text'. This makes it convenient for printing the values of interesting variables or expressions inside a function. For example here we print the value of the variables @x@ and @z@: > f x y = > traceTextShow (x, z) $ result > where > z = ... > ... /Since: 2/ -} traceTextShow :: TextShow a => a -> b -> b traceTextShow = tracet . showt -- | Like 'traceTextShow' but returns the shown value instead of a third value. -- -- /Since: 2/ traceTextShowId :: TextShow a => a -> a traceTextShowId a = tracet (showt a) a {-| Like 'tracet' but returning unit in an arbitrary 'Applicative' context. Allows for convenient use in do-notation. Note that the application of 'tracet' is not an action in the 'Applicative' context, as 'tracetIO' is in the 'IO' type. > ... = do > x <- ... > tracetM $ "x: " <> showt x > y <- ... > tracetM $ "y: " <> showt y /Since: 2/ -} tracetM :: Applicative f => TS.Text -> f () tracetM text = tracet text $ pure () -- | Like 'tracetM' but accepts a lazy 'TL.Text' argument. tracetlM :: Applicative f => TL.Text -> f () tracetlM text = tracetl text $ pure () {-| Like 'tracetM', but uses 'showt' on the argument to convert it to a 'TS.Text'. > ... = do > x <- ... > traceTextShowM x > y <- ... > traceTextShowM $ x + y /Since: 2/ -} traceTextShowM :: (TextShow a, Applicative f) => a -> f () traceTextShowM = tracetM . showt -- | Like 'tracet' but additionally prints a call stack if one is -- available. -- -- In the current GHC implementation, the call stack is only -- availble if the program was compiled with @-prof@; otherwise -- 'tracetStack' behaves exactly like 'tracet'. Entries in the call -- stack correspond to @SCC@ annotations, so it is a good idea to use -- @-fprof-auto@ or @-fprof-auto-calls@ to add SCC annotations automatically. -- -- /Since: 2/ tracetStack :: TS.Text -> a -> a tracetStack = traceStackByteString . encodeUtf8 -- | Like 'tracetStack' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlStack :: TL.Text -> a -> a tracetlStack = tracetStack . toStrict traceStackByteString :: ByteString -> a -> a traceStackByteString bs expr = unsafePerformIO $ do traceIOByteString bs stack <- currentCallStack unless (null stack) . traceIOByteString . BS.pack $ renderStack stack return expr -- $eventlog_tracing -- -- Eventlog tracing is a performance profiling system. These functions emit -- extra events into the eventlog. In combination with eventlog profiling -- tools these functions can be used for monitoring execution and -- investigating performance problems. -- -- Currently only GHC provides eventlog profiling, see the GHC user guide for -- details on how to use it. These function exists for other Haskell -- implementations but no events are emitted. Note that the @Text@ message is -- always evaluated, whether or not profiling is available or enabled. -- | The 'tracetEvent' function behaves like 'tracet' with the difference that -- the message is emitted to the eventlog, if eventlog profiling is available -- and enabled at runtime. -- -- It is suitable for use in pure code. In an IO context use 'tracetEventIO' -- instead. -- -- Note that when using GHC's SMP runtime, it is possible (but rare) to get -- duplicate events emitted if two CPUs simultaneously evaluate the same thunk -- that uses 'traceEvent'. -- -- /Since: 2/ tracetEvent :: TS.Text -> a -> a tracetEvent = traceEvent . TS.unpack -- | Like 'tracetEvent' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlEvent :: TL.Text -> a -> a tracetlEvent = traceEvent . TL.unpack -- | The 'tracetEventIO' function emits a message to the eventlog, if eventlog -- profiling is available and enabled at runtime. -- -- Compared to 'tracetEvent', 'tracetEventIO' sequences the event with respect to -- other IO actions. -- -- /Since: 2/ tracetEventIO :: TS.Text -> IO () tracetEventIO = traceEventIO . TS.unpack -- | Like 'tracetEventIO' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlEventIO :: TL.Text -> IO () tracetlEventIO = traceEventIO . TL.unpack -- $markers -- -- When looking at a profile for the execution of a program we often want to -- be able to mark certain points or phases in the execution and see that -- visually in the profile. -- For example, a program might have several distinct phases with different -- performance or resource behaviour in each phase. To properly interpret the -- profile graph we really want to see when each phase starts and ends. -- -- Markers let us do this: we can annotate the program to emit a marker at -- an appropriate point during execution and then see that in a profile. -- -- Currently this feature is only supported in GHC by the eventlog tracing -- system, but in future it may also be supported by the heap profiling or -- other profiling tools. These function exists for other Haskell -- implementations but they have no effect. Note that the @Text@ message is -- always evaluated, whether or not profiling is available or enabled. -- | The 'tracetMarker' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime. The 'TS.Text' is the name of -- the marker. The name is just used in the profiling tools to help you keep -- clear which marker is which. -- -- This function is suitable for use in pure code. In an IO context use -- 'tracetMarkerIO' instead. -- -- Note that when using GHC's SMP runtime, it is possible (but rare) to get -- duplicate events emitted if two CPUs simultaneously evaluate the same thunk -- that uses 'traceMarker'. -- -- /Since: 2/ tracetMarker :: TS.Text -> a -> a tracetMarker msg = traceMarker $ TS.unpack msg -- | Like 'tracetMarker' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlMarker :: TL.Text -> a -> a tracetlMarker msg = traceMarker $ TL.unpack msg -- | The 'tracetMarkerIO' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime. -- -- Compared to 'tracetMarker', 'tracetMarkerIO' sequences the event with respect to -- other IO actions. -- -- /Since: 2/ tracetMarkerIO :: TS.Text -> IO () tracetMarkerIO = traceMarkerIO . TS.unpack -- | Like 'tracetMarkerIO' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlMarkerIO :: TL.Text -> IO () tracetlMarkerIO = traceMarkerIO . TL.unpack text-show-3.10.4/src/TextShow/Debug/Trace/0000755000000000000000000000000007346545000016372 5ustar0000000000000000text-show-3.10.4/src/TextShow/Debug/Trace/Generic.hs0000644000000000000000000000232607346545000020305 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-| Module: TextShow.Debug.Trace.Generic Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions that trace the values of 'Generic' instances (even if they are not instances of @TextShow@). /Since: 2/ -} module TextShow.Debug.Trace.Generic ( genericTraceTextShow , genericTraceTextShowId , genericTraceTextShowM ) where import Generics.Deriving.Base (Generic, Rep) import Prelude () import Prelude.Compat import TextShow.Debug.Trace import TextShow.Generic (GTextShowT, genericShowt) -- | A 'Generic' implementation of 'traceTextShow'. -- -- /Since: 2/ genericTraceTextShow :: (Generic a, GTextShowT (Rep a ())) => a -> b -> b genericTraceTextShow = tracet . genericShowt -- | A 'Generic' implementation of 'traceTextShowId'. -- -- /Since: 2/ genericTraceTextShowId :: (Generic a, GTextShowT (Rep a ())) => a -> a genericTraceTextShowId a = tracet (genericShowt a) a -- | A 'Generic' implementation of 'traceShowM'. -- -- /Since: 2/ genericTraceTextShowM :: (Generic a, GTextShowT (Rep a ()), Applicative f) => a -> f () genericTraceTextShowM = tracetM . genericShowt text-show-3.10.4/src/TextShow/Debug/Trace/TH.hs0000644000000000000000000000263307346545000017245 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.Debug.Trace.TH Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions that splice traces into source code which take an arbitrary data type or data family instance as an argument (even if it is not an instance of @TextShow@). You need to enable the @TemplateHaskell@ language extension in order to use this module. /Since: 2/ -} module TextShow.Debug.Trace.TH ( makeTraceTextShow , makeTraceTextShowId , makeTraceTextShowM ) where import Language.Haskell.TH.Syntax (Name, Q, Exp) import TextShow.Debug.Trace import TextShow.TH.Internal (makeShowt) -- | Generates a lambda expression which behaves like 'traceTextShow' (without -- requiring a @TextShow@ instance). -- -- /Since: 2/ makeTraceTextShow :: Name -> Q Exp makeTraceTextShow name = [| tracet . $(makeShowt name) |] -- | Generates a lambda expression which behaves like 'traceTextShowId' (without -- requiring a @TextShow@ instance). -- -- /Since: 2/ makeTraceTextShowId :: Name -> Q Exp makeTraceTextShowId name = [| \a -> tracet ($(makeShowt name) a) a |] -- | Generates a lambda expression which behaves like 'traceTextShowM' (without -- requiring a @TextShow@ instance). -- -- /Since: 2/ makeTraceTextShowM :: Name -> Q Exp makeTraceTextShowM name = [| tracetM . $(makeShowt name) |] text-show-3.10.4/src/TextShow/Foreign/C/0000755000000000000000000000000007346545000016061 5ustar0000000000000000text-show-3.10.4/src/TextShow/Foreign/C/Types.hs0000644000000000000000000000402007346545000017515 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Foreign.C.Types Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for Haskell newtypes corresponding to C types in the Foreign Function Interface (FFI). /Since: 2/ -} module TextShow.Foreign.C.Types () where import Foreign.C.Types import TextShow.Classes (TextShow(..)) import TextShow.Data.Floating () import TextShow.Data.Integral () -- | /Since: 2/ deriving instance TextShow CChar -- | /Since: 2/ deriving instance TextShow CSChar -- | /Since: 2/ deriving instance TextShow CUChar -- | /Since: 2/ deriving instance TextShow CShort -- | /Since: 2/ deriving instance TextShow CUShort -- | /Since: 2/ deriving instance TextShow CInt -- | /Since: 2/ deriving instance TextShow CUInt -- | /Since: 2/ deriving instance TextShow CLong -- | /Since: 2/ deriving instance TextShow CULong -- | /Since: 2/ deriving instance TextShow CPtrdiff -- | /Since: 2/ deriving instance TextShow CSize -- | /Since: 2/ deriving instance TextShow CWchar -- | /Since: 2/ deriving instance TextShow CSigAtomic -- | /Since: 2/ deriving instance TextShow CLLong -- | /Since: 2/ deriving instance TextShow CULLong -- | /Since: 2/ deriving instance TextShow CIntPtr -- | /Since: 2/ deriving instance TextShow CUIntPtr -- | /Since: 2/ deriving instance TextShow CIntMax -- | /Since: 2/ deriving instance TextShow CUIntMax -- | /Since: 2/ deriving instance TextShow CClock -- | /Since: 2/ deriving instance TextShow CTime -- | /Since: 2/ deriving instance TextShow CUSeconds -- | /Since: 2/ deriving instance TextShow CSUSeconds -- | /Since: 2/ deriving instance TextShow CFloat -- | /Since: 2/ deriving instance TextShow CDouble #if MIN_VERSION_base(4,10,0) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CBool #endif text-show-3.10.4/src/TextShow/Foreign/0000755000000000000000000000000007346545000015677 5ustar0000000000000000text-show-3.10.4/src/TextShow/Foreign/Ptr.hs0000644000000000000000000000436607346545000017011 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Foreign.Ptr Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for pointer types used in the Haskell Foreign Function Interface (FFI). /Since: 2/ -} module TextShow.Foreign.Ptr () where import Data.Semigroup.Compat (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Foreign.ForeignPtr (ForeignPtr) import Foreign.Ptr (FunPtr, IntPtr, WordPtr, castFunPtrToPtr) import GHC.Exts (addr2Int#, int2Word#) import GHC.ForeignPtr (unsafeForeignPtrToPtr) import GHC.Num import GHC.Ptr (Ptr(..)) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..), TextShow1(..)) import TextShow.Data.Integral (showbHex) import TextShow.Utils (lengthB) import Unsafe.Coerce (unsafeCoerce) #include "MachDeps.h" -- | /Since: 2/ instance TextShow (Ptr a) where showbPrec = liftShowbPrec undefined undefined {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow1 Ptr where liftShowbPrec _ _ _ (Ptr a) = padOut . showbHex $ integerFromWord# (int2Word# (addr2Int# a)) where padOut :: Builder -> Builder padOut ls = singleton '0' <> singleton 'x' <> mtimesDefault (max 0 $ 2*SIZEOF_HSPTR - lengthB ls) (singleton '0') <> ls #if !(MIN_VERSION_base(4,15,0)) integerFromWord# = wordToInteger #endif -- | /Since: 2/ instance TextShow (FunPtr a) where showbPrec = liftShowbPrec undefined undefined {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow1 FunPtr where liftShowbPrec _ _ _ = showb . castFunPtrToPtr {-# INLINE liftShowbPrec #-} -- | /Since: 2/ instance TextShow IntPtr where showbPrec p ip = showbPrec p (unsafeCoerce ip :: Integer) -- | /Since: 2/ instance TextShow WordPtr where showb wp = showb (unsafeCoerce wp :: Word) -- | /Since: 2/ instance TextShow (ForeignPtr a) where showbPrec = liftShowbPrec undefined undefined {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow1 ForeignPtr where liftShowbPrec _ _ _ = showb . unsafeForeignPtrToPtr {-# INLINE liftShowbPrec #-} text-show-3.10.4/src/TextShow/FromStringTextShow.hs0000644000000000000000000005325207346545000020451 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} #endif {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-| Module: TextShow.FromStringTextShow Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC The 'FromStringShow' and 'FromTextShow' data types. -} module TextShow.FromStringTextShow ( FromStringShow(..) , FromTextShow(..) , FromStringShow1(..) , FromTextShow1(..) , FromStringShow2(..) , FromTextShow2(..) ) where #include "generic.h" import Data.Bifunctor.TH (deriveBifunctor, deriveBifoldable, deriveBitraversable) import Data.Coerce (coerce) import Data.Data (Data, Typeable) import Data.Functor.Classes (Show1(..), showsPrec1) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif import GHC.Generics (Generic, Generic1) import Language.Haskell.TH.Lift import Prelude () import Prelude.Compat import Text.ParserCombinators.ReadPrec (ReadPrec) import Text.Read (Read(..)) import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..), showbPrec1, showbPrec2, showbPrecToShowsPrec, showsPrecToShowbPrec, showbToShows, showsToShowb) #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..), showsPrec2) #else import Text.Show (showListWith) #endif ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@. -- The 'TextShow' instance for 'FromStringShow' is based on its @String@ -- 'Show' instance. That is, -- -- @ -- showbPrec p ('FromStringShow' x) = 'showsToShowb' 'showsPrec' p x -- @ -- -- /Since: 2/ newtype FromStringShow a = FromStringShow { fromStringShow :: a } deriving ( Data , Eq , Foldable , Functor , Generic , Generic1 #if __GLASGOW_HASKELL__ >= 800 , Lift #endif , Ord , Traversable , Typeable ) instance Read a => Read (FromStringShow a) where 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 = showsPrecToShowbPrec showsPrec p . fromStringShow showb = showsToShowb shows . fromStringShow showbList l = showsToShowb showList (coerce l :: [a]) instance Show a => Show (FromStringShow a) where showsPrec = coerce (showsPrec :: Int -> a -> ShowS) show = coerce (show :: a -> String) showList = coerce (showList :: [a] -> ShowS) ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@. -- The @String@ 'Show' instance for 'FromTextShow' is based on its -- 'TextShow' instance. That is, -- -- @ -- showsPrec p ('FromTextShow' x) = 'showbToShows' 'showbPrec' p x -- @ -- -- /Since: 2/ newtype FromTextShow a = FromTextShow { fromTextShow :: a } deriving ( Data , Eq , Foldable , Functor , Generic , Generic1 #if __GLASGOW_HASKELL__ >= 800 , Lift #endif , Ord , TextShow , Traversable , Typeable ) instance Read a => Read (FromTextShow a) where 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 = showbPrecToShowsPrec showbPrec p . fromTextShow show (FromTextShow x) = showbToShows showb x "" showList l = showbToShows showbList (coerce l :: [a]) ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@. -- 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 , Ord , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif #if __GLASGOW_HASKELL__ >= 800 , Data , Foldable , Functor , Lift , Show1 -- TODO: Manually implement this when you -- can derive Show1 (someday) , Traversable #endif ) #if __GLASGOW_HASKELL__ < 800 -- TODO: Manually implement this when you can derive Show1 (someday) 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) 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 defined(NEW_FUNCTOR_CLASSES) -- | Not available if using @transformers-0.4@ -- -- This instance is somewhat strange, as its instance context mixes a -- 'Show1' constraint with a 'TextShow' constraint. This is done for -- consistency with the 'Show' instance for 'FromTextShow1', which mixes -- constraints in a similar way to satisfy superclass constraints. See the -- Haddocks on the 'Show' instance for 'FromTextShow1' for more details. instance (Show1 f, TextShow a) => TextShow (FromStringShow1 f a) where showbPrec = showbPrec1 -- | 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 ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@. -- 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 , Ord , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif #if __GLASGOW_HASKELL__ >= 800 , Data , Foldable , Functor , Lift , TextShow1 , Traversable #endif ) #if __GLASGOW_HASKELL__ < 800 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) 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 defined(NEW_FUNCTOR_CLASSES) -- | Not available if using @transformers-0.4@ -- -- This instance is somewhat strange, as its instance context mixes a -- 'TextShow1' constraint with a 'Show' constraint. The 'Show' constraint is -- necessary to satisfy the quantified 'Show' superclass in 'Show1'. Really, -- the 'Show' constraint ought to be a 'TextShow' constraint instead, but GHC -- has no way of knowing that the 'TextShow' constraint can be converted to a -- 'Show' constraint when checking superclasses. -- -- This is all to say: this instance is almost surely not what you want if you -- are looking to derive a 'Show' instance only via 'TextShow'-related -- classes. If you wish to do this, derive via 'FromTextShow' instead. instance (TextShow1 f, Show a) => Show (FromTextShow1 f a) where showsPrec = showsPrec1 #endif instance TextShow1 f => Show1 (FromTextShow1 f) where #if defined(NEW_FUNCTOR_CLASSES) 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 ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@. -- 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 , Ord , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif #if __GLASGOW_HASKELL__ >= 800 , Data , Foldable , Functor , Lift , Traversable #endif ) #if __GLASGOW_HASKELL__ < 800 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) 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 defined(NEW_FUNCTOR_CLASSES) -- TODO: Manually implement this when you can derive Show2 (someday) -- | Not available if using @transformers-0.4@ deriving instance Show2 f => Show2 (FromStringShow2 f) -- | Not available if using @transformers-0.4@ -- -- This instance is somewhat strange, as its instance context mixes a -- 'Show2' constraint with 'TextShow' constraints. This is done for consistency -- with the 'Show' instance for 'FromTextShow2', which mixes constraints in a -- similar way to satisfy superclass constraints. See the Haddocks on the -- 'Show' instance for 'FromTextShow2' for more details. instance (Show2 f, TextShow a, TextShow b) => TextShow (FromStringShow2 f a b) where showbPrec = showbPrec2 -- | Not available if using @transformers-0.4@ -- -- This instance is somewhat strange, as its instance context mixes a -- 'Show2' constraint with a 'TextShow' constraint. This is done for -- consistency with the 'Show1' instance for 'FromTextShow2', which mixes -- constraints in a similar way to satisfy superclass constraints. See the -- Haddocks on the 'Show1' instance for 'FromTextShow2' for more details. instance (Show2 f, TextShow a) => TextShow1 (FromStringShow2 f a) where liftShowbPrec = liftShowbPrec2 showbPrec showbList liftShowbList = liftShowbList2 showbPrec showbList -- | 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 ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@. -- 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 , Ord , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif #if __GLASGOW_HASKELL__ >= 800 , Data , Foldable , Functor , Lift , TextShow2 , Traversable #endif ) #if __GLASGOW_HASKELL__ < 800 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) 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 defined(NEW_FUNCTOR_CLASSES) -- | Not available if using @transformers-0.4@ -- -- This instance is somewhat strange, as its instance context mixes a -- 'TextShow2' constraint with 'Show' constraints. The 'Show' constraints are -- necessary to satisfy the quantified 'Show' superclass in 'Show2'. Really, -- the 'Show' constraints ought to be 'TextShow' constraints instead, but GHC -- has no way of knowing that the 'TextShow' constraints can be converted to -- 'Show' constraints when checking superclasses. -- -- This is all to say: this instance is almost surely not what you want if you -- are looking to derive a 'Show' instance only via 'TextShow'-related -- classes. If you wish to do this, derive via 'FromTextShow' instead. instance (TextShow2 f, Show a, Show b) => Show (FromTextShow2 f a b) where showsPrec = showsPrec2 -- | Not available if using @transformers-0.4@ -- -- This instance is somewhat strange, as its instance context mixes a -- 'TextShow2' constraint with a 'Show' constraint. The 'Show' constraint is -- necessary to satisfy the quantified 'Show' superclass in 'Show2'. Really, -- the 'Show' constraint ought to be a 'TextShow' constraint instead, but GHC -- has no way of knowing that the 'TextShow' constraint can be converted to a -- 'Show' constraint when checking superclasses. -- -- This is all to say: this instance is almost surely not what you want if you -- are looking to derive a 'Show1' instance only via 'TextShow'-related -- classes. If you wish to do this, derive via 'FromTextShow1' instead. instance (TextShow2 f, Show a) => Show1 (FromTextShow2 f a) where liftShowsPrec = liftShowsPrec2 showsPrec showList liftShowList = liftShowList2 showsPrec showList -- | 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 !defined(NEW_FUNCTOR_CLASSES) 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 text-show-3.10.4/src/TextShow/Functions.hs0000644000000000000000000000153107346545000016612 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Functions Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Optional orphan 'TextShow', 'TextShow1', and 'TextShow2' instances for functions. /Since: 2/ -} module TextShow.Functions () where import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..)) -- | /Since: 2/ instance TextShow (a -> b) where showbPrec = liftShowbPrec undefined undefined {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow1 ((->) a) where liftShowbPrec = liftShowbPrec2 undefined undefined {-# INLINE liftShowbPrec #-} -- | /Since: 2/ instance TextShow2 (->) where liftShowbPrec2 _ _ _ _ _ _ = "" {-# INLINE liftShowbPrec2 #-} text-show-3.10.4/src/TextShow/GHC/Conc/0000755000000000000000000000000007346545000015571 5ustar0000000000000000text-show-3.10.4/src/TextShow/GHC/Conc/Windows.hs0000644000000000000000000000127607346545000017565 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !defined(__GHCJS__) && defined(mingw32_HOST_OS) {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.Conc.Windows Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'ConsoleEvent'. Only provided if using Windows, and not using GHCJS. /Since: 2/ -} module TextShow.GHC.Conc.Windows () where #if !defined(__GHCJS__) && defined(mingw32_HOST_OS) import GHC.Conc.Windows (ConsoleEvent) import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ $(deriveTextShow ''ConsoleEvent) #endif text-show-3.10.4/src/TextShow/GHC/0000755000000000000000000000000007346545000014707 5ustar0000000000000000text-show-3.10.4/src/TextShow/GHC/Event.hs0000644000000000000000000000371707346545000016334 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.Event Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for data types in the @Event@ module. Only provided if using a platform other than Windows or GHCJS. /Since: 2/ -} module TextShow.GHC.Event () where #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) import Data.List (intersperse) import Data.Maybe (catMaybes) import Data.Text.Lazy.Builder (Builder, singleton) import GHC.Event (Event, evtRead, evtWrite) import Language.Haskell.TH.Lib (conT, varE) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral () import TextShow.System.Posix.Types () import TextShow.TH.Internal (deriveTextShow) import TextShow.TH.Names (evtCloseValName, eventIsValName, fdKeyTypeName, uniqueTypeName, asInt64ValName) # if MIN_VERSION_base(4,8,1) import GHC.Event (Lifetime) # endif -- | /Since: 2/ instance TextShow Event where showb e = singleton '[' <> mconcat (intersperse "," $ catMaybes [ evtRead `so` "evtRead" , evtWrite `so` "evtWrite" , $(varE evtCloseValName) `so` "evtClose" ]) <> singleton ']' where so :: Event -> Builder -> Maybe Builder ev `so` disp | $(varE eventIsValName) e ev = Just disp | otherwise = Nothing -- | /Since: 2/ $(deriveTextShow fdKeyTypeName) instance TextShow $(conT uniqueTypeName) where showb = showb . $(varE asInt64ValName) {-# INLINE showb #-} # if MIN_VERSION_base(4,8,1) -- | Only available with @base-4.8.1.0@ or later. -- -- /Since: 2/ $(deriveTextShow ''Lifetime) # endif #endif text-show-3.10.4/src/TextShow/GHC/Fingerprint.hs0000644000000000000000000000166407346545000017541 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.GHC.Fingerprint Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Fingerprint'. /Since: 2/ -} module TextShow.GHC.Fingerprint () where import Data.Semigroup.Compat (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Word (Word64) import GHC.Fingerprint.Type (Fingerprint(..)) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral (showbHex) import TextShow.Utils (lengthB) -- | /Since: 2/ instance TextShow Fingerprint where showb (Fingerprint w1 w2) = hex16 w1 <> hex16 w2 where hex16 :: Word64 -> Builder hex16 i = let hex = showbHex i in mtimesDefault (max 0 $ 16 - lengthB hex) (singleton '0') <> hex text-show-3.10.4/src/TextShow/GHC/Generics.hs0000644000000000000000000000720307346545000017004 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.GHC.Generics Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for generics-related data types. /Since: 2/ -} module TextShow.GHC.Generics () where import Generics.Deriving.Base 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, makeLiftShowbPrec, makeLiftShowbPrec2) -- | /Since: 2/ $(deriveTextShow1 ''U1) -- | /Since: 2/ instance TextShow (U1 p) where showbPrec = liftShowbPrec undefined undefined -- | /Since: 2/ $(deriveTextShow ''Par1) -- | /Since: 2/ $(deriveTextShow1 ''Par1) -- | /Since: 2/ instance TextShow (f p) => TextShow (Rec1 f p) where showbPrec = $(makeShowbPrec ''Rec1) -- | /Since: 2/ $(deriveTextShow1 ''Rec1) -- | /Since: 2/ instance TextShow c => TextShow (K1 i c p) where showbPrec = liftShowbPrec undefined undefined -- | /Since: 2/ instance TextShow c => TextShow1 (K1 i c) where liftShowbPrec = liftShowbPrec2 showbPrec showbList -- | /Since: 2/ instance TextShow2 (K1 i) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''K1) -- | /Since: 2/ instance TextShow (f p) => TextShow (M1 i c f p) where showbPrec = $(makeShowbPrec ''M1) -- | /Since: 2/ instance TextShow1 f => TextShow1 (M1 i c f) where liftShowbPrec = $(makeLiftShowbPrec ''M1) -- | /Since: 2/ instance (TextShow (f p), TextShow (g p)) => TextShow ((f :+: g) p) where showbPrec = $(makeShowbPrec ''(:+:)) -- | /Since: 2/ $(deriveTextShow1 ''(:+:)) -- | /Since: 2/ instance (TextShow (f p), TextShow (g p)) => TextShow ((f :*: g) p) where showbPrec = $(makeShowbPrec ''(:*:)) -- | /Since: 2/ $(deriveTextShow1 ''(:*:)) -- | /Since: 2/ instance TextShow (f (g p)) => TextShow ((f :.: g) p) where showbPrec = $(makeShowbPrec ''(:.:)) -- | /Since: 2/ $(deriveTextShow1 ''(:.:)) -- | /Since: 2.1.2/ instance TextShow (UChar p) where showbPrec = $(makeShowbPrec 'UChar) -- | /Since: 2.1.2/ $(deriveTextShow1 'UChar) -- | /Since: 2.1.2/ instance TextShow (UDouble p) where showbPrec = $(makeShowbPrec 'UDouble) -- | /Since: 2.1.2/ $(deriveTextShow1 'UDouble) -- | /Since: 2.1.2/ instance TextShow (UFloat p) where showbPrec = $(makeShowbPrec 'UFloat) -- | /Since: 2.1.2/ $(deriveTextShow1 'UFloat) -- | /Since: 2.1.2/ instance TextShow (UInt p) where showbPrec = $(makeShowbPrec 'UInt) -- | /Since: 2.1.2/ $(deriveTextShow1 'UInt) -- | /Since: 2.1.2/ instance TextShow (UWord p) where showbPrec = $(makeShowbPrec 'UWord) -- | /Since: 2.1.2/ $(deriveTextShow1 'UWord) -- | /Since: 2/ $(deriveTextShow ''Associativity) -- | /Since: 2/ $(deriveTextShow ''Fixity) #if MIN_VERSION_base(4,9,0) -- | Only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ $(deriveTextShow ''SourceUnpackedness) -- | Only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ $(deriveTextShow ''SourceStrictness) -- | Only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ $(deriveTextShow ''DecidedStrictness) #else -- | Only available with @base-4.8@ or earlier. -- -- /Since: 2/ $(deriveTextShow ''Arity) #endif text-show-3.10.4/src/TextShow/GHC/RTS/0000755000000000000000000000000007346545000015357 5ustar0000000000000000text-show-3.10.4/src/TextShow/GHC/RTS/Flags.hs0000644000000000000000000000341407346545000016751 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.RTS.Flags Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for data types in the 'GHC.RTS.Flags' module. Only provided if using @base-4.8.0.0@ or later. /Since: 2/ -} module TextShow.GHC.RTS.Flags () where #if MIN_VERSION_base(4,8,0) import GHC.RTS.Flags import TextShow.Data.Bool () import TextShow.Data.Char () import TextShow.Data.Floating () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow) import TextShow.TH.Names (giveGCStatsTypeName, doCostCentresTypeName, doHeapProfileTypeName, doTraceTypeName) -- | /Since: 2.1/ $(deriveTextShow giveGCStatsTypeName) -- | /Since: 2.1/ $(deriveTextShow doCostCentresTypeName) -- | /Since: 2.1/ $(deriveTextShow doHeapProfileTypeName) -- | /Since: 2.1/ $(deriveTextShow doTraceTypeName) -- | /Since: 2/ $(deriveTextShow ''GCFlags) -- | /Since: 2/ $(deriveTextShow ''ConcFlags) # if MIN_VERSION_base(4,15,0) -- | /Since: 3.9/ $(deriveTextShow ''IoSubSystem) # endif -- | /Since: 2/ $(deriveTextShow ''MiscFlags) -- | /Since: 2/ $(deriveTextShow ''DebugFlags) -- | /Since: 2/ $(deriveTextShow ''CCFlags) -- | /Since: 2/ $(deriveTextShow ''ProfFlags) -- | /Since: 2/ $(deriveTextShow ''TraceFlags) -- | /Since: 2/ $(deriveTextShow ''TickyFlags) # if MIN_VERSION_base(4,10,0) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.3/ $(deriveTextShow ''ParFlags) # endif -- | /Since: 2/ $(deriveTextShow ''RTSFlags) #endif text-show-3.10.4/src/TextShow/GHC/Stack.hs0000644000000000000000000000215707346545000016315 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,1) {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.Stack Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for 'CallStack' and 'SrcLoc' values. Only provided if using @base-4.8.1.0@ or later. /Since: 3.0.1/ -} module TextShow.GHC.Stack () where #if MIN_VERSION_base(4,8,1) import GHC.Stack (CallStack) # if MIN_VERSION_base(4,9,0) import GHC.Stack (SrcLoc, getCallStack) import TextShow.Classes (TextShow(..)) # else import GHC.SrcLoc (SrcLoc) # endif import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.Data.Tuple () import TextShow.TH.Internal (deriveTextShow) -- | /Since: 3.0.1/ $(deriveTextShow ''SrcLoc) # if MIN_VERSION_base(4,9,0) -- | /Since: 3.0.1/ instance TextShow CallStack where showb = showb . getCallStack {-# INLINE showb #-} # else -- | /Since: 3.0.1/ $(deriveTextShow ''CallStack) # endif #endif text-show-3.10.4/src/TextShow/GHC/StaticPtr.hs0000644000000000000000000000141007346545000017154 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.StaticPtr Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'StaticPtrInfo'. Only provided if using @base-4.8.0.0@ or later. /Since: 2/ -} module TextShow.GHC.StaticPtr () where #if MIN_VERSION_base(4,8,0) import GHC.StaticPtr (StaticPtrInfo) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.Data.Tuple () import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ $(deriveTextShow ''StaticPtrInfo) #endif text-show-3.10.4/src/TextShow/GHC/Stats.hs0000644000000000000000000000152207346545000016341 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_base(4,11,0)) {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans #-} # if __GLASGOW_HASKELL__ == 800 -- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex {-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} # endif #endif {-| Module: TextShow.GHC.Stats Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'GCStats'. /Since: 2/ -} module TextShow.GHC.Stats () where #if !(MIN_VERSION_base(4,11,0)) import GHC.Stats (GCStats) import TextShow.Data.Integral () import TextShow.Data.Floating () import TextShow.TH.Internal (deriveTextShow) -- /Since: 2/ $(deriveTextShow ''GCStats) #endif text-show-3.10.4/src/TextShow/GHC/TypeLits.hs0000644000000000000000000000363307346545000017025 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.GHC.TypeLits Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for data types in the @GHC.TypeLits@ module. /Since: 2/ -} module TextShow.GHC.TypeLits () where import GHC.TypeLits (SomeNat(..), SomeSymbol(..), natVal, symbolVal) #if MIN_VERSION_base(4,16,0) import GHC.TypeLits (SomeChar(..), charVal) #endif import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Char () import TextShow.Data.Integral () #if MIN_VERSION_base(4,18,0) import Data.Text.Lazy.Builder (fromString) import GHC.Show (appPrec, appPrec1) import GHC.TypeLits ( SNat, SSymbol, SChar , fromSNat, fromSSymbol, fromSChar ) import TextShow.Classes (showbParen) #endif -- | /Since: 2/ instance TextShow SomeNat where showbPrec p (SomeNat x) = showbPrec p $ natVal x {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow SomeSymbol where showb (SomeSymbol x) = showbList $ symbolVal x {-# INLINE showb #-} #if MIN_VERSION_base(4,16,0) -- | /Since: 3.10.1/ instance TextShow SomeChar where showbPrec p (SomeChar x) = showbPrec p $ charVal x {-# INLINE showbPrec #-} #endif #if MIN_VERSION_base(4,18,0) -- | /Since: 3.10.1/ instance TextShow (SNat n) where showbPrec p sn = showbParen (p > appPrec) ( fromString "SNat @" <> showbPrec appPrec1 (fromSNat sn) ) -- | /Since: 3.10.1/ instance TextShow (SSymbol s) where showbPrec p ss = showbParen (p > appPrec) ( fromString "SSymbol @" <> showbList (fromSSymbol ss) ) -- | /Since: 3.10.1/ instance TextShow (SChar c) where showbPrec p sc = showbParen (p > appPrec) ( fromString "SChar @" <> showbPrec appPrec1 (fromSChar sc) ) #endif text-show-3.10.4/src/TextShow/Generic.hs0000644000000000000000000012324107346545000016221 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} #endif #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE QuantifiedConstraints #-} #endif {-| Module: TextShow.Generic Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Generic versions of 'TextShow' and 'TextShow1' class functions, as an alternative to "TextShow.TH", which uses Template Haskell. Because there is no 'Generic2' class, 'TextShow2' cannot be implemented generically. This implementation is loosely based off of the @Generics.Deriving.Show@ module from the @generic-deriving@ library. /Since: 2/ -} module TextShow.Generic ( -- * Generic adapter newtypes FromGeneric(..) , FromGeneric1(..) -- * Generic @show@ functions -- $generics , genericShowt , genericShowtl , genericShowtPrec , genericShowtlPrec , genericShowtList , genericShowtlList , genericShowb , genericShowbPrec , genericShowbList , genericPrintT , genericPrintTL , genericHPrintT , genericHPrintTL , genericLiftShowbPrec , genericShowbPrec1 -- * Internals -- ** 'Builder' , GTextShowB(..) , GTextShowConB(..) , GTextShowB1(..) , GTextShowConB1(..) -- ** Strict 'TS.Text' , GTextShowT(..) , GTextShowConT(..) , GTextShowT1(..) , GTextShowConT1(..) -- ** Lazy 'TL.Text' , GTextShowTL(..) , GTextShowConTL(..) , GTextShowTL1(..) , GTextShowConTL1(..) -- ** Other internals , IsNullary(..) , ConType(..) ) where import Data.Data (Data, Typeable) import qualified Data.Text as TS (Text, pack, singleton) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import qualified Data.Text.Lazy as TL (Text, pack, singleton) import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) import qualified Data.Text.Lazy.Builder as TB (fromString, singleton) import Data.Text.Lazy.Builder (Builder) import Generics.Deriving.Base #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif 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(..), TextShow1(..), showbListWith, showbParen, showbSpace, showtListWith, showtParen, showtSpace, showtlListWith, showtlParen, showtlSpace, liftShowtPrec, liftShowtlPrec) import TextShow.Instances () import TextShow.TH.Internal (deriveTextShow) import TextShow.Utils (isInfixDataCon, isSymVar, isTupleString) {- $generics 'TextShow' instances can be easily defined for data types that are 'Generic' instances. If you are using GHC 8.6 or later, the easiest way to do this is to use the @DerivingVia@ extension. @ {-# LANGUAGE DeriveGeneric, DerivingVia #-} import GHC.Generics import TextShow import TextShow.Generic data D a = D a deriving ('Generic', 'Generic1') deriving 'TextShow' via 'FromGeneric' (D a) deriving 'TextShow1' via 'FromGeneric1' D @ Or, if you are using a version of GHC older than 8.6, one can alternatively define these instances like so: @ instance 'TextShow' a => 'TextShow' (D a) where 'showbPrec' = 'genericShowbPrec' instance 'TextShow1' D where 'liftShowbPrec' = 'genericLiftShowbPrec' @ -} -- | An adapter newtype, suitable for @DerivingVia@. -- The 'TextShow' instance for 'FromGeneric' leverages a 'Generic'-based -- default. That is, -- -- @ -- 'showbPrec' p ('FromGeneric' x) = 'genericShowbPrec' p x -- @ -- -- /Since: 3.7.4/ newtype FromGeneric a = FromGeneric { fromGeneric :: a } deriving ( Data , Eq , Foldable , Functor , Generic , Generic1 , Ord , Read , Show , Traversable , Typeable #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) -- | /Since: 3.7.4/ instance (Generic a, GTextShowB (Rep a ())) => TextShow (FromGeneric a) where showbPrec p = genericShowbPrec p . fromGeneric -- | An adapter newtype, suitable for @DerivingVia@. -- The 'TextShow1' instance for 'FromGeneric1' leverages a 'Generic1'-based -- default. That is, -- -- @ -- 'liftShowbPrec' sp sl p ('FromGeneric1' x) = 'genericLiftShowbPrec' sp sl p x -- @ -- -- /Since: 3.7.4/ newtype FromGeneric1 f a = FromGeneric1 { fromGeneric1 :: f a } deriving ( Eq , Ord , Read , Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) deriving instance Foldable f => Foldable (FromGeneric1 f) deriving instance Functor f => Functor (FromGeneric1 f) deriving instance Traversable f => Traversable (FromGeneric1 f) deriving instance Typeable FromGeneric1 deriving instance ( Data (f a), Typeable f, Typeable a ) => Data (FromGeneric1 f (a :: *)) -- | /Since: 3.10/ instance (Generic1 f, GTextShowB (Rep1 f a)) => TextShow (FromGeneric1 f a) where showbPrec p = gShowbPrec p . from1 . fromGeneric1 -- | /Since: 3.7.4/ instance ( Generic1 f #if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ < 902 -- Unfortunately, the quantified superclass for GTextShowB1 doesn't -- work on pre-9.2 versions of GHC when using a GTextShowB1 (Rep1 f) -- constraint directly, perhaps due to -- https://gitlab.haskell.org/ghc/ghc/-/issues/14860#note_454218. -- Fortunately, we can make GHC come to its senses by using an -- equality constraint. , g ~ Rep1 f, GTextShowB1 g #else , GTextShowB1 (Rep1 f) #endif ) => TextShow1 (FromGeneric1 f) where liftShowbPrec sp sl p = genericLiftShowbPrec sp sl p . fromGeneric1 -- | A 'Generic' implementation of 'showt'. -- -- /Since: 2/ genericShowt :: (Generic a, GTextShowT (Rep a ())) => a -> TS.Text genericShowt = genericShowtPrec 0 -- | A 'Generic' implementation of 'showtl'. -- -- /Since: 2/ genericShowtl :: (Generic a, GTextShowTL (Rep a ())) => a -> TL.Text genericShowtl = genericShowtlPrec 0 -- | A 'Generic' implementation of 'showPrect'. -- -- /Since: 2/ genericShowtPrec :: (Generic a, GTextShowT (Rep a ())) => Int -> a -> TS.Text genericShowtPrec p = gShowtPrec p . fromRepUnit -- | A 'Generic' implementation of 'showtlPrec'. -- -- /Since: 2/ genericShowtlPrec :: (Generic a, GTextShowTL (Rep a ())) => Int -> a -> TL.Text genericShowtlPrec p = gShowtlPrec p . fromRepUnit -- | A 'Generic' implementation of 'showtList'. -- -- /Since: 2/ genericShowtList :: (Generic a, GTextShowT (Rep a ())) => [a] -> TS.Text genericShowtList = showtListWith genericShowt -- | A 'Generic' implementation of 'showtlList'. -- -- /Since: 2/ genericShowtlList :: (Generic a, GTextShowTL (Rep a ())) => [a] -> TL.Text genericShowtlList = showtlListWith genericShowtl -- | A 'Generic' implementation of 'showb'. -- -- /Since: 2/ genericShowb :: (Generic a, GTextShowB (Rep a ())) => a -> Builder genericShowb = genericShowbPrec 0 -- | A 'Generic' implementation of 'showbPrec'. -- -- /Since: 2/ genericShowbPrec :: (Generic a, GTextShowB (Rep a ())) => Int -> a -> Builder genericShowbPrec p = gShowbPrec p . fromRepUnit -- | A 'Generic' implementation of 'showbList'. -- -- /Since: 2/ genericShowbList :: (Generic a, GTextShowB (Rep a ())) => [a] -> Builder genericShowbList = showbListWith genericShowb -- | A 'Generic' implementation of 'printT'. -- -- /Since: 2/ genericPrintT :: (Generic a, GTextShowT (Rep a ())) => a -> IO () genericPrintT = TS.putStrLn . genericShowt -- | A 'Generic' implementation of 'printTL'. -- -- /Since: 2/ genericPrintTL :: (Generic a, GTextShowTL (Rep a ())) => a -> IO () genericPrintTL = TL.putStrLn . genericShowtl -- | A 'Generic' implementation of 'hPrintT'. -- -- /Since: 2/ genericHPrintT :: (Generic a, GTextShowT (Rep a ())) => Handle -> a -> IO () genericHPrintT h = TS.hPutStrLn h . genericShowt -- | A 'Generic' implementation of 'hPrintTL'. -- -- /Since: 2/ genericHPrintTL :: (Generic a, GTextShowTL (Rep a ())) => Handle -> a -> IO () genericHPrintTL h = TL.hPutStrLn h . genericShowtl -- | A 'Generic1' implementation of 'genericLiftShowbPrec'. -- -- /Since: 2/ genericLiftShowbPrec :: (Generic1 f, GTextShowB1 (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 , GTextShowB (Rep a ()) , GTextShowB1 (Rep1 f) ) => Int -> f a -> Builder genericShowbPrec1 = genericLiftShowbPrec genericShowbPrec genericShowbList -- | A type-specialized version of 'from' used to assist type inference. fromRepUnit :: Generic a => a -> Rep a () fromRepUnit = from ------------------------------------------------------------------------------- -- | Whether a constructor is a record ('Rec'), a tuple ('Tup'), is prefix ('Pref'), -- or infix ('Inf'). -- -- /Since: 2/ data ConType = Rec | Tup | Pref | Inf String deriving ( Data , Eq , Generic , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) {- I'm not particularly proud of the code below. The issue is that we need to be able to generically work over Builders, strict Text, and lazy Text. We could just work generically over Builders only and then convert to Text after the fact, but that results in a drastic slowdown for certain datatypes (see GH-21 for an example). For the most part, the shared functionality could be abstracted with a subclass of Monoid that supports fromString, fromChar, etc. But there's a very small chance that the code below is ever going to inline properly, and the runtime cost of all those dictinary lookups is likely to be as bad as converting to Text at the end, if not worse. Therefore, I perform some ugly CPP hackery to copy-paste the generic functionality three times, once for each Text/Builder variant. At some point, I should replace this with TH. See #33. -} hashPrec :: Int -> Int #if __GLASGOW_HASKELL__ >= 711 hashPrec = const 0 #else hashPrec = id #endif #if __GLASGOW_HASKELL__ >= 711 #define HASH_FUNS(text_type,one_hash,two_hash,from_char,from_string) \ one_hash, two_hash :: text_type; \ one_hash = from_char '#'; \ two_hash = from_string "##"; #else #define HASH_FUNS(text_type,one_hash,two_hash,from_char,from_string) \ one_hash, two_hash :: text_type; \ one_hash = mempty; \ two_hash = mempty; #endif -- For some mysterious reason, attaching INLINE pragmas to things in this -- module causes GHC 8.10's simplifier to absolutely explode in terms of -- compile times. This also affects 9.0, 8.8, and older versions of GHC to -- varying degrees, usually adding a couple of minutes or more to the overall -- compile times. -- -- We'd still like to include the INLINE pragmas on 9.2 or later, however, as -- it delivers a modest but measurable performance boost in the benchmark suite. -- As a compromise, we use CPP to only attach INLINE annotations on 9.2 or -- later. #if __GLASGOW_HASKELL__ >= 902 #define INLINE_GE_902(f) {-# INLINE f #-}; #else #define INLINE_GE_902(f) #endif #if __GLASGOW_HASKELL__ >= 806 #define QUANTIFIED_SUPERCLASS(class_name,f) (forall a. TextShow a => class_name (f a)) => #else #define QUANTIFIED_SUPERCLASS(class_name,f) #endif #define GTEXT_SHOW(text_type,show_funs,one_hash,two_hash,gtext_show,gtext_show1,gshow_prec,glift_show_prec,gtext_show_con,gtext_show_con1,gshow_prec_con,glift_show_prec_con,show_prec,lift_show_prec,show_space,show_paren,show_list,show_list_with,from_char,from_string,c1_show_prec,s1_show_prec,product_show_prec,u_char_show_prec,u_double_show_prec,u_float_show_prec,u_int_show_prec,u_word_show_prec) \ {- | Class of generic representation types that can be converted to a \ 'text_type'. \ \ /Since: 3.10/ \ -}; \ class gtext_show a where { \ ; gshow_prec :: Int -> a -> text_type \ }; \ deriving instance Typeable gtext_show; \ \ instance gtext_show (f p) => gtext_show (D1 d f p) where { \ ; gshow_prec p (M1 x) = gshow_prec p x \ }; \ \ instance gtext_show (V1 p) where { \ ; gshow_prec _ x = case x of {} \ }; \ \ instance (gtext_show (f p), gtext_show (g p)) \ => gtext_show ((f :+: g) p) where { \ ; gshow_prec p (L1 x) = gshow_prec p x \ ; gshow_prec p (R1 x) = gshow_prec p x \ }; \ \ instance (Constructor c, gtext_show_con (f p), IsNullary f) \ => gtext_show (C1 c f p) where { \ gshow_prec = c1_show_prec gshow_prec_con \ }; \ \ {- | Class of generic representation types for which the 'ConType' has been \ determined. \ \ /Since: 3.10/ \ -}; \ class gtext_show_con a where { \ ; gshow_prec_con :: ConType -> Int -> a -> text_type \ }; \ deriving instance Typeable gtext_show_con; \ \ instance gtext_show_con (U1 p) where { \ ; gshow_prec_con _ _ U1 = mempty \ }; \ \ instance TextShow p => gtext_show_con (Par1 p) where { \ ; gshow_prec_con _ p (Par1 x) = show_prec p x \ }; \ \ instance TextShow c => gtext_show_con (K1 i c p) where { \ ; gshow_prec_con _ p (K1 x) = show_prec p x \ }; \ \ instance (TextShow1 f, TextShow p) => gtext_show_con (Rec1 f p) where { \ ; gshow_prec_con _ p (Rec1 x) = lift_show_prec show_prec show_list p x \ }; \ \ instance (Selector s, gtext_show_con (f p)) => gtext_show_con (S1 s f p) where { \ ; gshow_prec_con t = s1_show_prec $ gshow_prec_con t \ }; \ \ instance (gtext_show_con (f p), gtext_show_con (g p)) \ => gtext_show_con ((f :*: g) p) where { \ ; gshow_prec_con t = product_show_prec (gshow_prec_con t) (gshow_prec_con t) t \ }; \ \ instance (TextShow1 f, gtext_show_con (g p)) => gtext_show_con ((f :.: g) p) where { \ ; gshow_prec_con t p (Comp1 x) = \ let gspc = gshow_prec_con t \ in lift_show_prec gspc (show_list_with (gspc 0)) p x \ }; \ \ instance gtext_show_con (UChar p) where { \ ; gshow_prec_con _ = u_char_show_prec show_prec \ }; \ \ instance gtext_show_con (UDouble p) where { \ ; gshow_prec_con _ = u_double_show_prec show_prec \ }; \ \ instance gtext_show_con (UFloat p) where { \ ; gshow_prec_con _ = u_float_show_prec show_prec \ }; \ \ instance gtext_show_con (UInt p) where { \ ; gshow_prec_con _ = u_int_show_prec show_prec \ }; \ \ instance gtext_show_con (UWord p) where { \ ; gshow_prec_con _ = u_word_show_prec show_prec \ }; \ \ {- | Class of generic representation types for unary type constructors that can \ be converted to a 'text_type'. \ \ /Since: 3.10/ \ -}; \ class QUANTIFIED_SUPERCLASS(gtext_show,f) \ gtext_show1 f where { \ ; glift_show_prec :: (Int -> a -> text_type) -> ([a] -> text_type) \ -> Int -> f a -> text_type \ }; \ deriving instance Typeable gtext_show1; \ \ instance gtext_show1 f => gtext_show1 (D1 d f) where { \ ; glift_show_prec sp sl p (M1 x) = glift_show_prec sp sl p x \ }; \ \ instance gtext_show1 V1 where { \ ; glift_show_prec _ _ _ x = case x of {} \ }; \ \ instance (gtext_show1 f, gtext_show1 g) => gtext_show1 (f :+: g) where { \ ; glift_show_prec sp sl p (L1 x) = glift_show_prec sp sl p x \ ; glift_show_prec sp sl p (R1 x) = glift_show_prec sp sl p x \ }; \ \ instance (Constructor c, gtext_show_con1 f, IsNullary f) \ => gtext_show1 (C1 c f) where { \ ; glift_show_prec sp sl = c1_show_prec $ glift_show_prec_con sp sl \ }; \ \ {- | Class of generic representation types for unary type constructors for which \ the 'ConType' has been determined. \ \ /Since: 3.10/ \ -}; \ class QUANTIFIED_SUPERCLASS(gtext_show_con,f) \ gtext_show_con1 f where { \ ; glift_show_prec_con :: (Int -> a -> text_type) -> ([a] -> text_type) \ -> ConType -> Int -> f a -> text_type \ }; \ deriving instance Typeable gtext_show_con1; \ \ instance gtext_show_con1 U1 where { \ ; glift_show_prec_con _ _ _ _ U1 = mempty \ }; \ \ instance gtext_show_con1 Par1 where { \ ; glift_show_prec_con sp _ _ p (Par1 x) = sp p x \ }; \ \ instance TextShow c => gtext_show_con1 (K1 i c) where { \ ; glift_show_prec_con _ _ _ p (K1 x) = show_prec p x \ }; \ \ instance TextShow1 f => gtext_show_con1 (Rec1 f) where { \ ; glift_show_prec_con sp sl _ p (Rec1 x) = lift_show_prec sp sl p x \ }; \ \ instance (Selector s, gtext_show_con1 f) => gtext_show_con1 (S1 s f) where { \ ; glift_show_prec_con sp sl t = s1_show_prec $ glift_show_prec_con sp sl t \ }; \ \ instance (gtext_show_con1 f, gtext_show_con1 g) \ => gtext_show_con1 (f :*: g) where { \ ; glift_show_prec_con sp sl t = \ product_show_prec (glift_show_prec_con sp sl t) (glift_show_prec_con sp sl t) t \ }; \ \ instance (TextShow1 f, gtext_show_con1 g) => gtext_show_con1 (f :.: g) where { \ ; glift_show_prec_con sp sl t p (Comp1 x) = \ let gspc = glift_show_prec_con sp sl t \ in lift_show_prec gspc (show_list_with (gspc 0)) p x \ }; \ \ instance gtext_show_con1 UChar where { \ ; glift_show_prec_con _ _ _ = u_char_show_prec show_prec \ }; \ \ instance gtext_show_con1 UDouble where { \ ; glift_show_prec_con _ _ _ = u_double_show_prec show_prec \ }; \ \ instance gtext_show_con1 UFloat where { \ ; glift_show_prec_con _ _ _ = u_float_show_prec show_prec \ }; \ \ instance gtext_show_con1 UInt where { \ ; glift_show_prec_con _ _ _ = u_int_show_prec show_prec \ }; \ \ instance gtext_show_con1 UWord where { \ ; glift_show_prec_con _ _ _ = u_word_show_prec show_prec \ }; \ \ c1_show_prec :: forall c f p. \ (Constructor c, IsNullary f) \ => (ConType -> Int -> f p -> text_type) \ -> Int -> C1 c f p -> text_type; \ c1_show_prec sp p c@(M1 x) = case fixity of { \ ; Prefix -> show_paren ( p > appPrec \ && not (isNullary x || conIsTuple c) \ ) $ \ (if conIsTuple c \ then mempty \ else let cn = conName c \ in show_paren (isInfixDataCon cn) $ from_string cn) \ <> (if isNullary x || conIsTuple c \ then mempty \ else from_char ' ') \ <> showBraces t (sp t appPrec1 x) \ ; Infix _ m -> show_paren (p > m) $ sp t (m+1) x \ } where { \ ; fixity :: Fixity \ ; fixity = conFixity c \ \ ; t :: ConType \ ; t = if conIsRecord c \ then Rec \ else case conIsTuple c of { \ ; True -> Tup \ ; False -> case fixity of { \ ; Prefix -> Pref \ ; Infix _ _ -> Inf $ conName c \ }; \ }; \ \ ; showBraces :: ConType -> text_type -> text_type \ ; showBraces Rec b = from_char '{' <> b <> from_char '}' \ ; showBraces Tup b = from_char '(' <> b <> from_char ')' \ ; showBraces Pref b = b \ ; showBraces (Inf _) b = b \ \ ; conIsTuple :: C1 c f p -> Bool \ ; conIsTuple = isTupleString . conName \ }; \ INLINE_GE_902(c1_show_prec) \ \ s1_show_prec :: Selector s \ => (Int -> f p -> text_type) \ -> Int -> S1 s f p -> text_type; \ s1_show_prec sp p sel@(M1 x) \ | selName sel == "" = sp p x \ | otherwise = infixRec \ <> " = " \ <> sp 0 x \ where { \ ; infixRec :: text_type \ ; infixRec | isSymVar selectorName \ = from_char '(' <> from_string selectorName <> from_char ')' \ | otherwise \ = from_string selectorName \ \ ; selectorName :: String \ ; selectorName = selName sel \ }; \ INLINE_GE_902(s1_show_prec) \ \ product_show_prec :: (Int -> f p -> text_type) -> (Int -> g p -> text_type) \ -> ConType -> Int -> (f :*: g) p -> text_type; \ product_show_prec spf spg t p (a :*: b) = \ case t of { \ ; Rec -> \ spf 0 a \ <> ", " \ <> spg 0 b \ ; Inf o -> \ spf p a \ <> show_space \ <> infixOp o \ <> show_space \ <> spg p b \ ; Tup -> \ spf 0 a \ <> from_char ',' \ <> spg 0 b \ ; Pref -> \ spf p a \ <> show_space \ <> spg p b \ } where { \ ; infixOp :: String -> text_type \ ; infixOp o = if isInfixDataCon o \ then from_string o \ else from_char '`' <> from_string o <> from_char '`' \ }; \ INLINE_GE_902(product_show_prec) \ \ u_char_show_prec :: (Int -> Char -> text_type) -> Int -> UChar p -> text_type; \ u_char_show_prec sp p (UChar c) = sp (hashPrec p) (C# c) <> one_hash; \ INLINE_GE_902(u_char_show_prec) \ \ u_double_show_prec :: (Int -> Double -> text_type) -> Int -> UDouble p -> text_type; \ u_double_show_prec sp p (UDouble d) = sp (hashPrec p) (D# d) <> two_hash; \ INLINE_GE_902(u_double_show_prec) \ \ u_float_show_prec :: (Int -> Float -> text_type) -> Int -> UFloat p -> text_type; \ u_float_show_prec sp p (UFloat f) = sp (hashPrec p) (F# f) <> one_hash; \ INLINE_GE_902(u_float_show_prec) \ \ u_int_show_prec :: (Int -> Int -> text_type) -> Int -> UInt p -> text_type; \ u_int_show_prec sp p (UInt i) = sp (hashPrec p) (I# i) <> one_hash; \ INLINE_GE_902(u_int_show_prec) \ \ u_word_show_prec :: (Int -> Word -> text_type) -> Int -> UWord p -> text_type; \ u_word_show_prec sp p (UWord w) = sp (hashPrec p) (W# w) <> two_hash; \ INLINE_GE_902(u_word_show_prec) \ \ HASH_FUNS(text_type,one_hash,two_hash,from_char,from_string); GTEXT_SHOW(Builder,ShowFunsB,oneHashB,twoHashB,GTextShowB,GTextShowB1,gShowbPrec,gLiftShowbPrec,GTextShowConB,GTextShowConB1,gShowbPrecCon,gLiftShowbPrecCon,showbPrec,liftShowbPrec,showbSpace,showbParen,showbList,showbListWith,TB.singleton,TB.fromString,c1ShowbPrec,s1ShowbPrec,productShowbPrec,uCharShowbPrec,uDoubleShowbPrec,uFloatShowbPrec,uIntShowbPrec,uWordShowbPrec) GTEXT_SHOW(TS.Text,ShowFunsT,oneHashT,twoHashT,GTextShowT,GTextShowT1,gShowtPrec,gLiftShowtPrec,GTextShowConT,GTextShowConT1,gShowtPrecCon,gLiftShowtPrecCon,showtPrec,liftShowtPrec,showtSpace,showtParen,showtList,showtListWith,TS.singleton,TS.pack,c1ShowtPrec,s1ShowtPrec,productShowtPrec,uCharShowtPrec,uDoubleShowtPrec,uFloatShowtPrec,uIntShowtPrec,uWordShowtPrec) GTEXT_SHOW(TL.Text,ShowFunsTL,oneHashTL,twoHashTL,GTextShowTL,GTextShowTL1,gShowtlPrec,gLiftShowtlPrec,GTextShowConTL,GTextShowConTL1,gShowtlPrecCon,gLiftShowtlPrecCon,showtlPrec,liftShowtlPrec,showtlSpace,showtlParen,showtlList,showtlListWith,TL.singleton,TL.pack,c1ShowtlPrec,s1ShowtlPrec,productShowtlPrec,uCharShowtlPrec,uDoubleShowtlPrec,uFloatShowtlPrec,uIntShowtlPrec,uWordShowtlPrec) -- | 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 ------------------------------------------------------------------------------- $(deriveTextShow ''ConType) #if __GLASGOW_HASKELL__ < 800 $(deriveLift ''ConType) $(deriveLift ''FromGeneric) instance Lift (f a) => Lift (FromGeneric1 f a) where lift = $(makeLift ''FromGeneric1) #endif #if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta ''FromGeneric1) $(Generics.deriveRepresentable1 ''FromGeneric1) #endif text-show-3.10.4/src/TextShow/Instances.hs0000644000000000000000000000476007346545000016600 0ustar0000000000000000{-| Module: TextShow.Instances Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Imports all orphan 'TextShow', 'TextShow1', and 'TextShow2' instances covered by @text-show@ (except for the instances in `TextShow.Functions`, which are not imported by default). -} module TextShow.Instances () where import TextShow.Control.Applicative () import TextShow.Control.Concurrent () import TextShow.Control.Exception () import TextShow.Control.Monad.ST () import TextShow.Data.Array () import TextShow.Data.Array.Byte () import TextShow.Data.Bool () import TextShow.Data.ByteString () import TextShow.Data.Char () import TextShow.Data.Complex () import TextShow.Data.Data () import TextShow.Data.Dynamic () 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 () import TextShow.Data.Type.Equality () import TextShow.Data.Typeable () import TextShow.Data.Version () import TextShow.Data.Void () import TextShow.Foreign.C.Types () import TextShow.Foreign.Ptr () import TextShow.GHC.Conc.Windows () import TextShow.GHC.Event () import TextShow.GHC.Fingerprint () import TextShow.GHC.Generics () import TextShow.GHC.RTS.Flags () import TextShow.GHC.Stack () import TextShow.GHC.StaticPtr () import TextShow.GHC.Stats () import TextShow.GHC.TypeLits () import TextShow.Numeric.Natural () import TextShow.System.Exit () import TextShow.System.IO () import TextShow.System.Posix.Types () import TextShow.Text.Read () text-show-3.10.4/src/TextShow/Numeric/0000755000000000000000000000000007346545000015710 5ustar0000000000000000text-show-3.10.4/src/TextShow/Numeric/Natural.hs0000644000000000000000000000237707346545000017663 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE MagicHash #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Numeric.Natural Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Natural'. /Since: 2/ -} module TextShow.Numeric.Natural () where #if MIN_VERSION_base(4,15,0) import GHC.Exts (Word(..)) import GHC.Num (integerFromNatural) import GHC.Num.Natural (Natural(..)) #elif MIN_VERSION_base(4,8,0) && defined(MIN_VERSION_integer_gmp) import GHC.Exts (Word(..)) import GHC.Integer.GMP.Internals (Integer(..)) import GHC.Natural (Natural(..)) #else import Numeric.Natural.Compat (Natural) #endif import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral () -- | /Since: 2/ instance TextShow Natural where #if MIN_VERSION_base(4,15,0) showbPrec p (NS w) = showbPrec p (W# w) showbPrec p n = showbPrec p (integerFromNatural n) #elif MIN_VERSION_base(4,8,0) && defined(MIN_VERSION_integer_gmp) showbPrec _ (NatS# w#) = showb $ W# w# showbPrec p (NatJ# bn) = showbPrec p $ Jp# bn #else showbPrec p = showbPrec p . toInteger {-# INLINE showbPrec #-} #endif text-show-3.10.4/src/TextShow/Options.hs0000644000000000000000000000465307346545000016305 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} #endif {-| Module: TextShow.Options Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Options' and related datatypes. /Since: 3.4/ -} module TextShow.Options (Options(..), GenTextMethods(..), defaultOptions) where import Data.Data (Data, Typeable) import Data.Ix (Ix) import GHC.Generics (Generic) import Language.Haskell.TH.Lift -- | Options that specify how to derive 'TextShow' instances using Template Haskell. -- -- /Since: 3.4/ data Options = Options { genTextMethods :: GenTextMethods -- ^ When Template Haskell should generate definitions for methods which -- return @Text@? -- -- /Since: 3.4/ , emptyCaseBehavior :: Bool -- ^ If 'True', derived instances for empty data types (i.e., ones with -- no data constructors) will use the @EmptyCase@ language extension. -- If 'False', derived instances will simply use 'seq' instead. -- -- /Since: 3.7/ } deriving ( Data , Eq , Generic , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) -- | When should Template Haskell generate implementations for the methods of -- 'TextShow' which return @Text@? -- -- /Since: 3.4/ data GenTextMethods = AlwaysTextMethods -- ^ Always generate them. | SometimesTextMethods -- ^ Only generate when @text-show@ feels it's appropriate. | NeverTextMethods -- ^ Never generate them under any circumstances. deriving ( Bounded , Data , Enum , Eq , Generic , Ix , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) -- | Sensible default 'Options'. -- -- /Since: 3.4/ defaultOptions :: Options defaultOptions = Options { genTextMethods = SometimesTextMethods , emptyCaseBehavior = False } ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ < 800 $(deriveLift ''Options) $(deriveLift ''GenTextMethods) #endif text-show-3.10.4/src/TextShow/System/0000755000000000000000000000000007346545000015572 5ustar0000000000000000text-show-3.10.4/src/TextShow/System/Exit.hs0000644000000000000000000000077007346545000017043 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.Exit Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'ExitCode'. /Since: 2/ -} module TextShow.System.Exit () where import System.Exit (ExitCode) import TextShow.Data.Integral () import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ $(deriveTextShow ''ExitCode) text-show-3.10.4/src/TextShow/System/IO.hs0000644000000000000000000000362307346545000016441 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.IO Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for 'IO'-related data types. /Since: 2/ -} module TextShow.System.IO () where import Data.Text.Lazy.Builder (Builder, fromString, singleton) import GHC.IO.Encoding.Failure (CodingFailureMode) import GHC.IO.Encoding.Types (CodingProgress, TextEncoding(textEncodingName)) import GHC.IO.Handle (HandlePosn(..)) import GHC.IO.Handle.Types (Handle(..)) import Prelude () import Prelude.Compat import System.IO (BufferMode, IOMode, Newline, NewlineMode, SeekMode) import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral () import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ instance TextShow Handle where showb (FileHandle file _) = showbHandleFilePath file showb (DuplexHandle file _ _) = showbHandleFilePath file {-# INLINE showb #-} -- | Convert a 'Handle`'s 'FilePath' to a 'Builder'. showbHandleFilePath :: FilePath -> Builder showbHandleFilePath file = "{handle: " <> fromString file <> singleton '}' {-# INLINE showbHandleFilePath #-} -- | /Since: 2/ $(deriveTextShow ''IOMode) -- | /Since: 2/ $(deriveTextShow ''BufferMode) -- | /Since: 2/ instance TextShow HandlePosn where showb (HandlePosn h pos) = showb h <> " at position " <> showbPrec 0 pos {-# INLINE showb #-} -- | /Since: 2/ $(deriveTextShow ''SeekMode) -- | /Since: 2/ instance TextShow TextEncoding where showb = fromString . textEncodingName {-# INLINE showb #-} -- | /Since: 2/ $(deriveTextShow ''CodingProgress) -- | /Since: 2/ $(deriveTextShow ''CodingFailureMode) -- | /Since: 2/ $(deriveTextShow ''Newline) -- | /Since: 2/ $(deriveTextShow ''NewlineMode) text-show-3.10.4/src/TextShow/System/Posix/0000755000000000000000000000000007346545000016674 5ustar0000000000000000text-show-3.10.4/src/TextShow/System/Posix/Types.hs0000644000000000000000000000611707346545000020341 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.Posix.Types Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instances for Haskell equivalents of POSIX data types. Note that these are only available if the operating system supports them, so some OSes (e.g., Windows) will not be able to use all of the instances in this module. /Since: 2/ -} module TextShow.System.Posix.Types () where import System.Posix.Types import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral () import TextShow.Foreign.C.Types () import TextShow.Foreign.Ptr () #include "HsBaseConfig.h" #if defined(HTYPE_DEV_T) -- | /Since: 2/ deriving instance TextShow CDev #endif #if defined(HTYPE_INO_T) -- | /Since: 2/ deriving instance TextShow CIno #endif #if defined(HTYPE_MODE_T) -- | /Since: 2/ deriving instance TextShow CMode #endif #if defined(HTYPE_OFF_T) -- | /Since: 2/ deriving instance TextShow COff #endif #if defined(HTYPE_PID_T) -- | /Since: 2/ deriving instance TextShow CPid #endif #if defined(HTYPE_SSIZE_T) -- | /Since: 2/ deriving instance TextShow CSsize #endif #if defined(HTYPE_GID_T) -- | /Since: 2/ deriving instance TextShow CGid #endif #if defined(HTYPE_NLINK_T) -- | /Since: 2/ deriving instance TextShow CNlink #endif #if defined(HTYPE_UID_T) -- | /Since: 2/ deriving instance TextShow CUid #endif #if defined(HTYPE_CC_T) -- | /Since: 2/ deriving instance TextShow CCc #endif #if defined(HTYPE_SPEED_T) -- | /Since: 2/ deriving instance TextShow CSpeed #endif #if defined(HTYPE_TCFLAG_T) -- | /Since: 2/ deriving instance TextShow CTcflag #endif #if defined(HTYPE_RLIM_T) -- | /Since: 2/ deriving instance TextShow CRLim #endif #if MIN_VERSION_base(4,10,0) # if defined(HTYPE_BLKSIZE_T) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CBlkSize # endif # if defined(HTYPE_BLKCNT_T) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CBlkCnt # endif # if defined(HTYPE_CLOCKID_T) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CClockId # endif # if defined(HTYPE_FSBLKCNT_T) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CFsBlkCnt # endif # if defined(HTYPE_FSFILCNT_T) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CFsFilCnt # endif # if defined(HTYPE_ID_T) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CId # endif # if defined(HTYPE_KEY_T) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CKey # endif # if defined(HTYPE_TIMER_T) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CTimer # endif #endif -- | /Since: 2/ deriving instance TextShow Fd text-show-3.10.4/src/TextShow/TH.hs0000644000000000000000000000137407346545000015162 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.TH Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions to mechanically derive 'TextShow', 'TextShow1', or 'TextShow2' instances, or to splice @show@-related expressions into Haskell source code. You need to enable the @TemplateHaskell@ language extension in order to use this module. /Since: 2/ -} module TextShow.TH (module TextShow.TH.Internal) where import TextShow.Instances () import TextShow.TH.Internal ------------------------------------------------------------------------------- $(deriveTextShow ''GenTextMethods) $(deriveTextShow ''Options) text-show-3.10.4/src/TextShow/TH/0000755000000000000000000000000007346545000014621 5ustar0000000000000000text-show-3.10.4/src/TextShow/TH/Internal.hs0000644000000000000000000020070107346545000016731 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Internal Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions to mechanically derive 'TextShow', 'TextShow1', or 'TextShow2' instances, or to splice their functions directly into Haskell source code. You need to enable the @TemplateHaskell@ language extension in order to use this module. This implementation is loosely based off of the @Data.Aeson.TH@ module from the @aeson@ library. -} module TextShow.TH.Internal ( -- * 'deriveTextShow' -- $deriveTextShow deriveTextShow -- * 'deriveTextShow1' -- $deriveTextShow1 , deriveTextShow1 -- * 'deriveTextShow2' -- $deriveTextShow2 , deriveTextShow2 -- * @make-@ functions -- $make , makeShowt , makeShowtl , makeShowtPrec , makeShowtlPrec , makeShowtList , makeShowtlList , makeShowb , makeShowbPrec , makeShowbList , makePrintT , makePrintTL , makeHPrintT , makeHPrintTL , makeLiftShowbPrec , makeShowbPrec1 , makeLiftShowbPrec2 , makeShowbPrec2 -- * 'Options' , Options(..) , defaultOptions , GenTextMethods(..) , deriveTextShowOptions , deriveTextShow1Options , deriveTextShow2Options ) where import Control.Monad (unless, when) import qualified Control.Monad as Monad (fail) import Data.Foldable.Compat import qualified Data.List.Compat as List import Data.List.NonEmpty.Compat (NonEmpty(..), (<|)) import qualified Data.Map as Map (fromList, keys, lookup, singleton) import Data.Map (Map) import Data.Maybe 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 qualified Data.Text.Lazy.Builder as TB import Data.Text.Lazy.Builder (Builder, 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(..) , Char#, Double#, Float#, Int#, Word# #if MIN_VERSION_base(4,13,0) , Int8#, Int16#, Word8#, Word16# # if MIN_VERSION_base(4,16,0) , Int32#, Word32# # if MIN_VERSION_base(4,19,0) , Int64#, Word64# # else , int8ToInt#, int16ToInt#, int32ToInt# , intToInt8#, intToInt16#, intToInt32# , word8ToWord#, word16ToWord#, word32ToWord# , wordToWord8#, wordToWord16#, wordToWord32# # endif # else , extendInt8#, extendInt16#, extendWord8#, extendWord16# , narrowInt8#, narrowInt16#, narrowWord8#, narrowWord16# # endif #endif ) import GHC.Show (appPrec, appPrec1) #if MIN_VERSION_base(4,19,0) import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..)) import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) #endif import Language.Haskell.TH.Datatype as Datatype 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, showbCommaSpace, showbSpace, showtParen, showtCommaSpace, showtSpace, showtlParen, showtlCommaSpace, showtlSpace) import TextShow.Options (Options(..), GenTextMethods(..), defaultOptions) import TextShow.Utils (isInfixDataCon, isSymVar, 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: @ {-# LANGUAGE TemplateHaskell #-} 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 ... @ '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: @ {-# LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies #-} 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 = deriveTextShowOptions defaultOptions -- | Like 'deriveTextShow', but takes an 'Options' argument. -- -- /Since: 3.4/ deriveTextShowOptions :: Options -> Name -> Q [Dec] deriveTextShowOptions = 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: @ {-# LANGUAGE TemplateHaskell #-} 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 = deriveTextShow1Options defaultOptions -- | Like 'deriveTextShow1', but takes an 'Options' argument. -- -- /Since: 3.4/ deriveTextShow1Options :: Options -> Name -> Q [Dec] deriveTextShow1Options = 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: @ {-# LANGUAGE TemplateHaskell #-} 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 = deriveTextShow2Options defaultOptions -- | Like 'deriveTextShow2', but takes an 'Options' argument. -- -- /Since: 3.4/ deriveTextShow2Options :: Options -> Name -> Q [Dec] deriveTextShow2Options = 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': @ {-# LANGUAGE FlexibleContexts, TemplateHaskell #-} 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 = makeShowtPrec name `appE` integerE 0 -- | Generates a lambda expression which behaves like 'showtl' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowtl :: Name -> Q Exp makeShowtl name = makeShowtlPrec name `appE` integerE 0 -- | Generates a lambda expression which behaves like 'showtPrec' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowtPrec :: Name -> Q Exp makeShowtPrec = makeShowbPrecClass TextShow ShowtPrec defaultOptions -- | Generates a lambda expression which behaves like 'showtlPrec' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeShowtlPrec :: Name -> Q Exp makeShowtlPrec = makeShowbPrecClass TextShow ShowtlPrec defaultOptions -- | 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` integerE 0 -- | Generates a lambda expression which behaves like 'showbPrec' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowbPrec :: Name -> Q Exp makeShowbPrec = makeShowbPrecClass TextShow ShowbPrec defaultOptions -- | Generates a lambda expression which behaves like 'liftShowbPrec' (without -- requiring a 'TextShow1' instance). -- -- /Since: 3/ makeLiftShowbPrec :: Name -> Q Exp makeLiftShowbPrec = makeShowbPrecClass TextShow1 ShowbPrec defaultOptions -- | 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 ShowbPrec defaultOptions -- | 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 -> Options -> Name -> Q [Dec] deriveTextShowClass tsClass opts name = do info <- reifyDatatype name case info of DatatypeInfo { datatypeContext = ctxt , datatypeName = parentName , datatypeInstTypes = instTys , datatypeVariant = variant , datatypeCons = cons } -> do (instanceCxt, instanceType) <- buildTypeInstance tsClass parentName ctxt instTys variant (:[]) <$> instanceD (return instanceCxt) (return instanceType) (showbPrecDecs tsClass opts instTys 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 -> Options -> [Type] -> [ConstructorInfo] -> [Q Dec] showbPrecDecs tsClass opts instTys cons = [genMethod ShowbPrec (showbPrecName tsClass)] ++ if tsClass == TextShow && shouldGenTextMethods then [genMethod ShowtPrec 'showtPrec, genMethod ShowtlPrec 'showtlPrec] else [] where shouldGenTextMethods :: Bool shouldGenTextMethods = case genTextMethods opts of AlwaysTextMethods -> True SometimesTextMethods -> all isNullaryCon cons NeverTextMethods -> False genMethod :: TextShowFun -> Name -> Q Dec genMethod method methodName = funD methodName [ clause [] (normalB $ makeTextShowForCons tsClass method opts instTys cons) [] ] -- | Generates a lambda expression which behaves like showbPrec (for TextShow), -- liftShowbPrec (for TextShow1), or liftShowbPrec2 (for TextShow2). makeShowbPrecClass :: TextShowClass -> TextShowFun -> Options -> Name -> Q Exp makeShowbPrecClass tsClass tsFun opts name = do info <- reifyDatatype name case info of DatatypeInfo { datatypeContext = ctxt , datatypeName = parentName , datatypeInstTypes = instTys , datatypeVariant = variant , datatypeCons = cons } -> -- 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 parentName ctxt instTys variant >> makeTextShowForCons tsClass tsFun opts instTys cons -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for the -- given constructors. All constructors must be from the same type. makeTextShowForCons :: TextShowClass -> TextShowFun -> Options -> [Type] -> [ConstructorInfo] -> Q Exp makeTextShowForCons tsClass tsFun opts instTys 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 lastTyVars = map varTToName $ drop (length instTys - fromEnum tsClass) instTys splMap = Map.fromList $ zip lastTyVars spls makeFun | null cons && emptyCaseBehavior opts = caseE (varE value) [] | null cons = appE (varE 'seq) (varE value) `appE` appE (varE 'error) (stringE $ "Void " ++ nameBase (showPrecName tsClass tsFun)) | otherwise = caseE (varE value) (map (makeTextShowForCon p tsClass tsFun splMap) cons) lamE (map varP $ spsAndSls ++ [p, value]) . appsE $ [ varE $ showPrecConstName tsClass tsFun , makeFun ] ++ map varE spsAndSls ++ [varE p, varE value] -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for a -- single constructor. makeTextShowForCon :: Name -> TextShowClass -> TextShowFun -> TyVarMap -> ConstructorInfo -> Q Match makeTextShowForCon _ _ tsFun _ (ConstructorInfo { constructorName = conName, constructorFields = [] }) = match (conP conName []) (normalB $ varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName "")) [] makeTextShowForCon p tsClass tsFun tvMap (ConstructorInfo { constructorName = conName , constructorVariant = NormalConstructor , constructorFields = [argTy] }) = do argTy' <- resolveTypeSynonyms argTy arg <- newName "arg" let showArg = makeTextShowForArg appPrec1 tsClass tsFun conName tvMap argTy' arg namedArg = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) [| (<>) |] showArg match (conP conName [varP arg]) (normalB $ varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE appPrec) `appE` namedArg) [] makeTextShowForCon p tsClass tsFun tvMap (ConstructorInfo { constructorName = conName , constructorVariant = NormalConstructor , constructorFields = argTys }) = do argTys' <- mapM resolveTypeSynonyms argTys args <- newNameList "arg" $ length argTys' if isNonUnitTuple conName then do let showArgs = zipWith (makeTextShowForArg 0 tsClass tsFun conName tvMap) argTys' args parenCommaArgs = (varE (singletonName tsFun) `appE` charE '(') : List.intersperse (varE (singletonName tsFun) `appE` charE ',') showArgs mappendArgs = foldr' (`infixApp` [| (<>) |]) (varE (singletonName tsFun) `appE` charE ')') parenCommaArgs match (conP conName $ map varP args) (normalB mappendArgs) [] else do let showArgs = zipWith (makeTextShowForArg appPrec1 tsClass tsFun conName tvMap) argTys' args mappendArgs = foldr1 (\v q -> infixApp v [| (<>) |] (infixApp (varE $ showSpaceName tsFun) [| (<>) |] q)) showArgs namedArgs = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) [| (<>) |] mappendArgs match (conP conName $ map varP args) (normalB $ varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE appPrec) `appE` namedArgs) [] makeTextShowForCon p tsClass tsFun tvMap (ConstructorInfo { constructorName = conName , constructorVariant = RecordConstructor argNames , constructorFields = argTys }) = do argTys' <- mapM resolveTypeSynonyms argTys args <- newNameList "arg" $ length argTys' let showArgs = concatMap (\(argName, argTy, arg) -> let argNameBase = nameBase argName infixRec = showParen (isSymVar argNameBase) (showString argNameBase) "" in [ varE (fromStringName tsFun) `appE` stringE (infixRec ++ " = ") , makeTextShowForArg 0 tsClass tsFun conName tvMap argTy arg , varE (showCommaSpaceName tsFun) ] ) (zip3 argNames argTys' args) braceCommaArgs = (varE (singletonName tsFun) `appE` charE '{') : take (length showArgs - 1) showArgs mappendArgs = foldr' (`infixApp` [| (<>) |]) (varE (singletonName tsFun) `appE` charE '}') braceCommaArgs namedArgs = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) [| (<>) |] mappendArgs match (conP conName $ map varP args) (normalB $ varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE appPrec) `appE` namedArgs) [] makeTextShowForCon p tsClass tsFun tvMap (ConstructorInfo { constructorName = conName , constructorVariant = InfixConstructor , constructorFields = argTys }) = do [alTy, arTy] <- mapM resolveTypeSynonyms argTys al <- newName "argL" ar <- newName "argR" fi <- fromMaybe defaultFixity <$> reifyFixityCompat conName let conPrec = case fi of Fixity prec _ -> prec opName = nameBase conName infixOpE = appE (varE $ fromStringName tsFun) . stringE $ if isInfixDataCon opName then " " ++ opName ++ " " else " `" ++ opName ++ "` " match (infixP (varP al) conName (varP ar)) (normalB $ (varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE conPrec)) `appE` (infixApp (makeTextShowForArg (conPrec + 1) tsClass tsFun conName tvMap alTy al) [| (<>) |] (infixApp infixOpE [| (<>) |] (makeTextShowForArg (conPrec + 1) tsClass tsFun conName tvMap arTy ar))) ) [] -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for an -- argument of a constructor. makeTextShowForArg :: Int -> TextShowClass -> TextShowFun -> Name -> TyVarMap -> Type -> Name -> Q Exp makeTextShowForArg p _ tsFun _ _ (ConT tyName) tyExpName = showE where tyVarE, showPrecE :: Q Exp tyVarE = varE tyExpName showPrecE = varE (showPrecName TextShow tsFun) showE :: Q Exp showE = case Map.lookup tyName primShowTbl of Just ps -> showPrimE ps Nothing -> showPrecE `appE` integerE p `appE` tyVarE showPrimE :: PrimShow -> Q Exp showPrimE PrimShow{ primShowBoxer #if __GLASGOW_HASKELL__ >= 800 , primShowPostfixMod, primShowConv #endif } #if __GLASGOW_HASKELL__ >= 800 -- Starting with GHC 8.0, data types containing unlifted types with -- derived Show instances show hashed literals with actual hash signs, -- and negative hashed literals are not surrounded with parentheses. = primShowConv tsFun $ infixApp (primE 0) [| (<>) |] (primShowPostfixMod tsFun) #else = primE p #endif where primE :: Int -> Q Exp primE prec = showPrecE `appE` integerE prec `appE` primShowBoxer tyVarE makeTextShowForArg p tsClass tsFun conName tvMap ty tyExpName = [| $(makeTextShowForType tsClass tsFun conName tvMap False ty) p $(varE tyExpName) |] -- | Generates a lambda expression for showbPrec/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 -> TextShowFun -> 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 _ tsFun _ tvMap sl (VarT tyName) = varE $ case Map.lookup tyName tvMap of Just (spExp, slExp) -> if sl then slExp else spExp Nothing -> if sl then showListName TextShow tsFun else showPrecName TextShow tsFun makeTextShowForType tsClass tsFun conName tvMap sl (SigT ty _) = makeTextShowForType tsClass tsFun conName tvMap sl ty makeTextShowForType tsClass tsFun conName tvMap sl (ForallT _ _ ty) = makeTextShowForType tsClass tsFun conName tvMap sl ty makeTextShowForType tsClass tsFun 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 <- isInTypeFamilyApp tyVarNames tyCon tyArgs if any (`mentionsName` tyVarNames) lhsArgs || itf then outOfPlaceTyVarError tsClass conName else if any (`mentionsName` tyVarNames) rhsArgs then appsE $ [ varE $ showPrecOrListName sl (toEnum numLastArgs) tsFun] ++ zipWith (makeTextShowForType tsClass tsFun conName tvMap) (cycle [False,True]) (interleave rhsArgs rhsArgs) else varE $ if sl then showListName TextShow tsFun else showPrecName TextShow tsFun ------------------------------------------------------------------------------- -- Template Haskell reifying and AST manipulation ------------------------------------------------------------------------------- -- 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] buildTypeInstance :: 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 -> DatatypeVariant -- ^ Are we dealing with a data family instance or not -> Q (Cxt, Type) buildTypeInstance tsClass tyConName dataCxt varTysOrig variant = 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 resolveTypeSynonyms 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 = freeVariables droppedTysExpSubst -- If any of the dropped types were polykinded, ensure that they 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 (List.union droppedKindVarNames kvNames')) $ take remainingLength varTysOrig isDataFamily <- case variant of Datatype -> return False Newtype -> return False DataInstance -> return True NewtypeInstance -> return True #if MIN_VERSION_th_abstraction(0,5,0) Datatype.TypeData -> typeDataError tyConName #endif let 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 [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 -> Q a derivingKindError tsClass tyConName = Monad.fail . 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 -> Q a etaReductionError instanceType = Monad.fail $ "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 -> Q a datatypeContextError dataName instanceType = Monad.fail . 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 -> Q a outOfPlaceTyVarError tsClass conName = Monad.fail . 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_th_abstraction(0,5,0) -- | We cannot implement class methods at the term level for @type data@ -- declarations, which only exist at the type level. typeDataError :: Name -> Q a typeDataError dataName = Monad.fail . showString "Cannot derive instance for ‘" . showString (nameBase dataName) . showString "‘, which is a ‘type data‘ declaration" $ "" #endif ------------------------------------------------------------------------------- -- Expanding type synonyms ------------------------------------------------------------------------------- substNameWithKind :: Name -> Kind -> Type -> Type substNameWithKind n k = applySubstitution (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) -- | A representation of which TextShow method is being used to -- implement something. data TextShowFun = ShowbPrec | ShowtPrec | ShowtlPrec fromStringName :: TextShowFun -> Name fromStringName ShowbPrec = 'TB.fromString fromStringName ShowtPrec = 'TS.pack fromStringName ShowtlPrec = 'TL.pack singletonName :: TextShowFun -> Name singletonName ShowbPrec = 'TB.singleton singletonName ShowtPrec = 'TS.singleton singletonName ShowtlPrec = 'TL.singleton showParenName :: TextShowFun -> Name showParenName ShowbPrec = 'showbParen showParenName ShowtPrec = 'showtParen showParenName ShowtlPrec = 'showtlParen showCommaSpaceName :: TextShowFun -> Name showCommaSpaceName ShowbPrec = 'showbCommaSpace showCommaSpaceName ShowtPrec = 'showtCommaSpace showCommaSpaceName ShowtlPrec = 'showtlCommaSpace showSpaceName :: TextShowFun -> Name showSpaceName ShowbPrec = 'showbSpace showSpaceName ShowtPrec = 'showtSpace showSpaceName ShowtlPrec = 'showtlSpace showPrecConstName :: TextShowClass -> TextShowFun -> Name showPrecConstName tsClass ShowbPrec = showbPrecConstName tsClass showPrecConstName TextShow ShowtPrec = 'showtPrecConst showPrecConstName TextShow ShowtlPrec = 'showtlPrecConst showPrecConstName _ _ = error "showPrecConstName" showbPrecConstName :: TextShowClass -> Name showbPrecConstName TextShow = 'showbPrecConst showbPrecConstName TextShow1 = 'liftShowbPrecConst showbPrecConstName TextShow2 = 'liftShowbPrec2Const textShowClassName :: TextShowClass -> Name textShowClassName TextShow = ''TextShow textShowClassName TextShow1 = ''TextShow1 textShowClassName TextShow2 = ''TextShow2 showPrecName :: TextShowClass -> TextShowFun -> Name showPrecName tsClass ShowbPrec = showbPrecName tsClass showPrecName TextShow ShowtPrec = 'showtPrec showPrecName TextShow ShowtlPrec = 'showtlPrec showPrecName _ _ = error "showPrecName" showbPrecName :: TextShowClass -> Name showbPrecName TextShow = 'showbPrec showbPrecName TextShow1 = 'liftShowbPrec showbPrecName TextShow2 = 'liftShowbPrec2 showListName :: TextShowClass -> TextShowFun -> Name showListName tsClass ShowbPrec = showbListName tsClass showListName TextShow ShowtPrec = 'showtPrec showListName TextShow ShowtlPrec = 'showtlPrec showListName _ _ = error "showListName" showbListName :: TextShowClass -> Name showbListName TextShow = 'showbList showbListName TextShow1 = 'liftShowbList showbListName TextShow2 = 'liftShowbList2 showPrecOrListName :: Bool -- ^ showbListName if True, showbPrecName if False -> TextShowClass -> TextShowFun -> Name showPrecOrListName False = showPrecName showPrecOrListName True = showListName -- | 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 showtPrecConst :: TS.Text -> Int -> a -> TS.Text showtPrecConst t _ _ = t showtlPrecConst :: TL.Text -> Int -> a -> TL.Text showtlPrecConst tl _ _ = tl 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 SigT _ (VarT k) -> IsKindVar k _ -> 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 ------------------------------------------------------------------------------- -- PrimShow ------------------------------------------------------------------------------- data PrimShow = PrimShow { primShowBoxer :: Q Exp -> Q Exp , primShowPostfixMod :: TextShowFun -> Q Exp , primShowConv :: TextShowFun -> Q Exp -> Q Exp } primShowTbl :: Map Name PrimShow primShowTbl = Map.fromList [ (''Char#, PrimShow { primShowBoxer = appE (conE 'C#) , primShowPostfixMod = oneHashE , primShowConv = \_ x -> x }) , (''Double#, PrimShow { primShowBoxer = appE (conE 'D#) , primShowPostfixMod = twoHashE , primShowConv = \_ x -> x }) , (''Float#, PrimShow { primShowBoxer = appE (conE 'F#) , primShowPostfixMod = oneHashE , primShowConv = \_ x -> x }) , (''Int#, PrimShow { primShowBoxer = appE (conE 'I#) , primShowPostfixMod = oneHashE , primShowConv = \_ x -> x }) , (''Word#, PrimShow { primShowBoxer = appE (conE 'W#) , primShowPostfixMod = twoHashE , primShowConv = \_ x -> x }) #if MIN_VERSION_base(4,19,0) , (''Int8#, PrimShow { primShowBoxer = appE (conE 'I8#) , primShowPostfixMod = extendedLitE "Int8" , primShowConv = \_ x -> x }) , (''Int16#, PrimShow { primShowBoxer = appE (conE 'I16#) , primShowPostfixMod = extendedLitE "Int16" , primShowConv = \_ x -> x }) , (''Int32#, PrimShow { primShowBoxer = appE (conE 'I32#) , primShowPostfixMod = extendedLitE "Int32" , primShowConv = \_ x -> x }) , (''Int64#, PrimShow { primShowBoxer = appE (conE 'I64#) , primShowPostfixMod = extendedLitE "Int64" , primShowConv = \_ x -> x }) , (''Word8#, PrimShow { primShowBoxer = appE (conE 'W8#) , primShowPostfixMod = extendedLitE "Word8" , primShowConv = \_ x -> x }) , (''Word16#, PrimShow { primShowBoxer = appE (conE 'W16#) , primShowPostfixMod = extendedLitE "Word16" , primShowConv = \_ x -> x }) , (''Word32#, PrimShow { primShowBoxer = appE (conE 'W32#) , primShowPostfixMod = extendedLitE "Word32" , primShowConv = \_ x -> x }) , (''Word64#, PrimShow { primShowBoxer = appE (conE 'W64#) , primShowPostfixMod = extendedLitE "Word64" , primShowConv = \_ x -> x }) #else # if MIN_VERSION_base(4,13,0) , (''Int8#, PrimShow { primShowBoxer = appE (conE 'I#) . appE (varE int8ToIntHashValName) , primShowPostfixMod = oneHashE , primShowConv = mkNarrowE intToInt8HashValName }) , (''Int16#, PrimShow { primShowBoxer = appE (conE 'I#) . appE (varE int16ToIntHashValName) , primShowPostfixMod = oneHashE , primShowConv = mkNarrowE intToInt16HashValName }) , (''Word8#, PrimShow { primShowBoxer = appE (conE 'W#) . appE (varE word8ToWordHashValName) , primShowPostfixMod = twoHashE , primShowConv = mkNarrowE wordToWord8HashValName }) , (''Word16#, PrimShow { primShowBoxer = appE (conE 'W#) . appE (varE word16ToWordHashValName) , primShowPostfixMod = twoHashE , primShowConv = mkNarrowE wordToWord16HashValName }) # endif # if MIN_VERSION_base(4,16,0) , (''Int32#, PrimShow { primShowBoxer = appE (conE 'I#) . appE (varE 'int32ToInt#) , primShowPostfixMod = oneHashE , primShowConv = mkNarrowE 'intToInt32# }) , (''Word32#, PrimShow { primShowBoxer = appE (conE 'W#) . appE (varE 'word32ToWord#) , primShowPostfixMod = twoHashE , primShowConv = mkNarrowE 'wordToWord32# }) # endif #endif ] #if MIN_VERSION_base(4,13,0) && !(MIN_VERSION_base(4,19,0)) mkNarrowE :: Name -> TextShowFun -> Q Exp -> Q Exp mkNarrowE narrowName tsFun e = foldr (`infixApp` [| (<>) |]) (varE (singletonName tsFun) `appE` charE ')') [ varE (fromStringName tsFun) `appE` stringE ('(':nameBase narrowName ++ " ") , e ] int8ToIntHashValName :: Name int8ToIntHashValName = # if MIN_VERSION_base(4,16,0) 'int8ToInt# # else 'extendInt8# # endif int16ToIntHashValName :: Name int16ToIntHashValName = # if MIN_VERSION_base(4,16,0) 'int16ToInt# # else 'extendInt16# # endif intToInt8HashValName :: Name intToInt8HashValName = # if MIN_VERSION_base(4,16,0) 'intToInt8# # else 'narrowInt8# # endif intToInt16HashValName :: Name intToInt16HashValName = # if MIN_VERSION_base(4,16,0) 'intToInt16# # else 'narrowInt16# # endif word8ToWordHashValName :: Name word8ToWordHashValName = # if MIN_VERSION_base(4,16,0) 'word8ToWord# # else 'extendWord8# # endif word16ToWordHashValName :: Name word16ToWordHashValName = # if MIN_VERSION_base(4,16,0) 'word16ToWord# # else 'extendWord16# # endif wordToWord8HashValName :: Name wordToWord8HashValName = # if MIN_VERSION_base(4,16,0) 'wordToWord8# # else 'narrowWord8# # endif wordToWord16HashValName :: Name wordToWord16HashValName = # if MIN_VERSION_base(4,16,0) 'wordToWord16# # else 'narrowWord16# # endif #endif oneHashE, twoHashE :: TextShowFun -> Q Exp oneHashE tsFun = varE (singletonName tsFun) `appE` charE '#' twoHashE tsFun = varE (fromStringName tsFun) `appE` stringE "##" #if MIN_VERSION_base(4,19,0) extendedLitE :: String -> TextShowFun -> Q Exp extendedLitE suffix tsFun = varE (fromStringName tsFun) `appE` stringE ("#" ++ suffix) #endif ------------------------------------------------------------------------------- -- Assorted utilities ------------------------------------------------------------------------------- integerE :: Int -> Q Exp integerE = litE . integerL . fromIntegral charE :: Char -> Q Exp charE = litE . charL -- | Returns True if a Type has kind *. hasKindStar :: Type -> Bool hasKindStar VarT{} = True hasKindStar (SigT _ StarT) = True hasKindStar _ = False -- Returns True is a kind is equal to *, or if it is a kind variable. isStarOrVar :: Kind -> Bool isStarOrVar StarT = True isStarOrVar VarT{} = True 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] -- | @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 = uncurryTy (tyKind t) in if (length uk - 1 == kindArrows) && all isStarOrVar uk then Just (concatMap freeVariables uk) else Nothing -- | If a Type is a SigT, returns its kind signature. Otherwise, return *. tyKind :: Type -> Kind tyKind (SigT _ k) = k tyKind _ = starK -- | 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 (isInfixDataCon conNameBase) $ showString conNameBase -- | 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 -- | Detect if a Name in a list of provided Names occurs as an argument to some -- type family. This makes an effort to exclude /oversaturated/ arguments to -- type families. For instance, if one declared the following type family: -- -- @ -- type family F a :: Type -> Type -- @ -- -- Then in the type @F a b@, we would consider @a@ to be an argument to @F@, -- but not @b@. isInTypeFamilyApp :: [Name] -> Type -> [Type] -> Q Bool isInTypeFamilyApp names tyFun tyArgs = case tyFun of ConT tcName -> go tcName _ -> return False where go :: Name -> Q Bool go tcName = do info <- reify tcName case info of #if MIN_VERSION_template_haskell(2,11,0) FamilyI (OpenTypeFamilyD (TypeFamilyHead _ bndrs _ _)) _ -> withinFirstArgs bndrs #else FamilyI (FamilyD TypeFam _ bndrs _) _ -> withinFirstArgs bndrs #endif #if MIN_VERSION_template_haskell(2,11,0) FamilyI (ClosedTypeFamilyD (TypeFamilyHead _ bndrs _ _) _) _ -> withinFirstArgs bndrs #else FamilyI (ClosedTypeFamilyD _ bndrs _ _) _ -> withinFirstArgs bndrs #endif _ -> return False where withinFirstArgs :: [a] -> Q Bool withinFirstArgs bndrs = let firstArgs = take (length bndrs) tyArgs argFVs = freeVariables firstArgs in return $ any (`elem` argFVs) names -- | 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 || go k names 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 ty = go ty ty [] where go :: Type -> Type -> [Type] -> NonEmpty Type go _ (AppT ty1 ty2) args = go ty1 ty1 (ty2:args) go origTy (SigT ty' _) args = go origTy ty' args #if MIN_VERSION_template_haskell(2,11,0) go origTy (InfixT ty1 n ty2) args = go origTy (ConT n `AppT` ty1 `AppT` ty2) args go origTy (ParensT ty') args = go origTy ty' args #endif go origTy _ args = origTy :| args -- | 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 :| [] createKindChain :: Int -> Kind createKindChain = go starK where go :: Kind -> Int -> Kind go k !0 = k go k !n = go (arrowKCompat starK k) (n - 1) isNullaryCon :: ConstructorInfo -> Bool isNullaryCon (ConstructorInfo { constructorFields = [] }) = True isNullaryCon _ = False interleave :: [a] -> [a] -> [a] interleave (a1:a1s) (a2:a2s) = a1:a2:interleave a1s a2s interleave _ _ = [] {- 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. -} text-show-3.10.4/src/TextShow/Text/0000755000000000000000000000000007346545000015232 5ustar0000000000000000text-show-3.10.4/src/TextShow/Text/Read.hs0000644000000000000000000000134307346545000016442 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Text.Read Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'TextShow' instance for 'Lexeme' (and 'Number', if using a recent-enough version of @base@). /Since: 2/ -} module TextShow.Text.Read () where import Text.Read.Lex (Lexeme, Number) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.Data.Maybe () import TextShow.Data.Ratio () import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ $(deriveTextShow ''Number) -- | /Since: 2/ $(deriveTextShow ''Lexeme) text-show-3.10.4/src/TextShow/Utils.hs0000644000000000000000000000535607346545000015753 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-| Module: TextShow.Utils Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Miscellaneous utility functions. -} module TextShow.Utils ( i2d , isInfixDataCon , isSymVar , isTupleString , lengthB , toString , toText , unlinesB , unwordsB ) where import Data.Int (Int64) import Data.Text (Text) import Data.Text.Lazy (length, toStrict, unpack) import Data.Text.Lazy.Builder (Builder, singleton, toLazyText) import GHC.Exts (Char(C#), Int(I#), (+#), chr#, ord#) import Prelude () import Prelude.Compat hiding (length) #if defined(MIN_VERSION_ghc_boot_th) import GHC.Lexeme (startsVarSym) #else import Data.Char (isSymbol, ord) #endif -- | Unsafe conversion for decimal digits. i2d :: Int -> Char i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) {-# INLINE i2d #-} -- | Checks if a 'String' names a valid Haskell infix data constructor (i.e., does -- it begin with a colon?). isInfixDataCon :: String -> Bool isInfixDataCon (':':_) = True isInfixDataCon _ = False {-# INLINE isInfixDataCon #-} -- | Checks if a 'String' names a valid Haskell infix, non-constructor function. isSymVar :: String -> Bool isSymVar "" = False isSymVar (c : _) = startsVarSym c #if !defined(MIN_VERSION_ghc_boot_th) startsVarSym :: Char -> Bool startsVarSym c = startsVarSymASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids startsVarSymASCII :: Char -> Bool startsVarSymASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-" #endif -- | Checks if a 'String' represents a tuple (other than '()') isTupleString :: String -> Bool isTupleString ('(':',':_) = True isTupleString _ = False {-# INLINE isTupleString #-} -- | Computes the length of a 'Builder'. -- -- /Since: 2/ lengthB :: Builder -> Int64 lengthB = length . toLazyText {-# INLINE lengthB #-} -- | Convert a 'Builder' to a 'String' (without surrounding it with double quotes, -- as 'show' would). -- -- /Since: 2/ toString :: Builder -> String toString = unpack . toLazyText {-# INLINE toString #-} -- | Convert a 'Builder' to a strict 'Text'. -- -- /Since: 2/ toText :: Builder -> Text toText = toStrict . toLazyText {-# INLINE toText #-} -- | Merges several 'Builder's, separating them by newlines. -- -- /Since: 2/ unlinesB :: [Builder] -> Builder unlinesB (b:bs) = b <> singleton '\n' <> unlinesB bs unlinesB [] = mempty -- | Merges several 'Builder's, separating them by spaces. -- -- /Since: 2/ unwordsB :: [Builder] -> Builder unwordsB (b:bs@(_:_)) = b <> singleton ' ' <> unwordsB bs unwordsB [b] = b unwordsB [] = mempty text-show-3.10.4/tests/Derived/0000755000000000000000000000000007346545000014456 5ustar0000000000000000text-show-3.10.4/tests/Derived/DataFamilies.hs0000644000000000000000000001034707346545000017342 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ < 710 -- Starting with GHC 7.10, NullaryTypeClasses was deprecated in favor of -- MultiParamTypeClasses, which is already enabled {-# LANGUAGE NullaryTypeClasses #-} #endif {-| Module: Derived.DataFamilies Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines corner case-provoking data families. -} module Derived.DataFamilies ( NotAllShow(..) , KindDistinguished(..) , NullaryClass(..) , NullaryData(..) ) where #include "generic.h" #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif import GHC.Generics (Generic) #if defined(__LANGUAGE_DERIVE_GENERIC1__) import GHC.Generics (Generic1) #endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- data family NotAllShow (w :: *) (x :: *) (y :: *) (z :: *) :: * data instance NotAllShow () () () d = NASNoShow data instance NotAllShow Int b c d = NASShow1 c b | NASShow2 d deriving ( Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) instance (Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (NotAllShow Int b c d) where arbitrary = genericArbitrary #if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'NASShow1) #else $(deriveShow1 'NASShow1) $(deriveShow2 'NASShow2) #endif $(deriveTextShow 'NASShow1) $(deriveTextShow1 'NASShow2) $(deriveTextShow2 'NASShow1) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'NASShow1) $(Generics.deriveRepresentable1 'NASShow2) #endif ------------------------------------------------------------------------------- data family KindDistinguished (x :: k) (y :: *) (z :: *) :: * data instance KindDistinguished (a :: ()) b c = KindDistinguishedUnit b c deriving ( Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) data instance KindDistinguished (a :: Bool) b c = KindDistinguishedBool b c deriving ( Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) instance (Arbitrary b, Arbitrary c) => Arbitrary (KindDistinguished (a :: ()) b c) where arbitrary = genericArbitrary instance (Arbitrary b, Arbitrary c) => Arbitrary (KindDistinguished (a :: Bool) b c) where arbitrary = genericArbitrary #if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'KindDistinguishedUnit) $(deriveShow1 'KindDistinguishedBool) #else $(deriveShow1 'KindDistinguishedUnit) $(deriveShow2 'KindDistinguishedUnit) $(deriveShow1 'KindDistinguishedBool) $(deriveShow2 'KindDistinguishedBool) #endif $(deriveTextShow 'KindDistinguishedUnit) $(deriveTextShow1 'KindDistinguishedUnit) $(deriveTextShow2 'KindDistinguishedUnit) $(deriveTextShow 'KindDistinguishedBool) $(deriveTextShow1 'KindDistinguishedBool) $(deriveTextShow2 'KindDistinguishedBool) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveAll1 'KindDistinguishedUnit) $(Generics.deriveAll1 'KindDistinguishedBool) #endif ------------------------------------------------------------------------------- class NullaryClass where data NullaryData :: * instance NullaryClass where newtype NullaryData = NullaryCon Int deriving (Arbitrary, Show, Generic) $(deriveTextShow 'NullaryCon) text-show-3.10.4/tests/Derived/DatatypeContexts.hs0000644000000000000000000000633207346545000020321 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DatatypeContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- I don't know how to silence the -XDatatypeContexts warnings otherwise... {-# OPTIONS_GHC -w #-} {-| Module: Derived.DatatypeContexts Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with DatatypeContexts (which are gross, but still possible). -} module Derived.DatatypeContexts (TyCon(..), TyFamily(..)) where import Data.Functor.Classes (Show1(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..)) import Text.Show.Deriving (makeLiftShowsPrec, makeLiftShowsPrec2) #else import Text.Show.Deriving (makeShowsPrec1) #endif ------------------------------------------------------------------------------- data Ord a => TyCon a b c = TyCon a b c deriving Show ------------------------------------------------------------------------------- data family TyFamily x y z :: * data instance Ord a => TyFamily a b c = TyFamily a b c deriving Show ------------------------------------------------------------------------------- instance (Ord a, Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (TyCon a b c) where arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary instance (Ord a, Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (TyFamily a b c) where arbitrary = TyFamily <$> arbitrary <*> arbitrary <*> arbitrary ------------------------------------------------------------------------------- $(return []) instance (Ord a, Show a, Show b) => Show1 (TyCon a b) where #if defined(NEW_FUNCTOR_CLASSES) liftShowsPrec = $(makeLiftShowsPrec ''TyCon) #else showsPrec1 = $(makeShowsPrec1 ''TyCon) #endif #if defined(NEW_FUNCTOR_CLASSES) instance (Ord a, Show a) => Show2 (TyCon a) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyCon) #endif 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 liftShowbPrec = $(makeLiftShowbPrec ''TyCon) instance (Ord a, TextShow a) => TextShow2 (TyCon a) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyCon) #if !defined(NEW_FUNCTOR_CLASSES) instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where showsPrec1 = $(makeShowsPrec1 'TyFamily) #else instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamily) instance (Ord a, Show a) => Show2 (TyFamily a) where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamily) #endif 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 liftShowbPrec = $(makeLiftShowbPrec 'TyFamily) instance (Ord a, TextShow a) => TextShow2 (TyFamily a) where liftShowbPrec2 = $(makeLiftShowbPrec2 'TyFamily) text-show-3.10.4/tests/Derived/ExistentialQuantification.hs0000644000000000000000000001132307346545000022202 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-| Module: Derived.ExistentialQuantification Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with existentially quantified type variables. -} module Derived.ExistentialQuantification (TyCon(..), TyFamily(..)) where import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), Gen, oneof) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow (TextShow) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- data TyCon a b c d where TyConClassConstraints :: (Ord m, Ord n, Ord o, Ord p) => m -> n -> o -> p -> TyCon m n o p TyConEqualityConstraints :: (e ~ g, f ~ h, e ~ f) => e -> f -> g -> h -> TyCon e f g h TyConTypeRefinement1, TyConTypeRefinement2 :: Int -> z -> TyCon Int Int z z TyConForalls :: forall p q r s t u. (Arbitrary p, Show p, TextShow p, Arbitrary q, Show q, TextShow q) => p -> q -> u -> t -> TyCon r s t u deriving instance (Show a, Show b, Show c, Show d) => Show (TyCon a b c d) ------------------------------------------------------------------------------- data family TyFamily w x y z :: * data instance TyFamily a b c d where TyFamilyClassConstraints :: (Ord m, Ord n, Ord o, Ord p) => m -> n -> o -> p -> TyFamily m n o p TyFamilyEqualityConstraints :: (e ~ g, f ~ h, e ~ f) => e -> f -> g -> h -> TyFamily e f g h TyFamilyTypeRefinement1, TyFamilyTypeRefinement2 :: Int -> z -> TyFamily Int Int z z TyFamilyForalls :: forall p q r s t u. (Arbitrary p, Show p, TextShow p, Arbitrary q, Show q, TextShow q) => p -> q -> u -> t -> TyFamily r s t u deriving instance (Show a, Show b, Show c, Show d) => Show (TyFamily a b c d) ------------------------------------------------------------------------------- instance (a ~ Int, b ~ Int, c ~ Int, d ~ Int) => Arbitrary (TyCon a b c d) where arbitrary = oneof [ TyConClassConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary , TyConEqualityConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary , TyConTypeRefinement1 <$> arbitrary <*> arbitrary , TyConTypeRefinement2 <$> arbitrary <*> arbitrary , TyConForalls <$> (arbitrary :: Gen Int) <*> (arbitrary :: Gen Int) <*> arbitrary <*> arbitrary ] 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 , TyFamilyTypeRefinement1 <$> arbitrary <*> arbitrary , TyFamilyTypeRefinement2 <$> arbitrary <*> arbitrary , TyFamilyForalls <$> (arbitrary :: Gen Int) <*> (arbitrary :: Gen Int) <*> arbitrary <*> arbitrary ] ------------------------------------------------------------------------------- $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamilyClassConstraints) #else $(deriveShow1 'TyFamilyTypeRefinement1) $(deriveShow2 'TyFamilyTypeRefinement1) #endif $(deriveTextShow 'TyFamilyClassConstraints) $(deriveTextShow1 'TyFamilyTypeRefinement1) $(deriveTextShow2 'TyFamilyTypeRefinement2) text-show-3.10.4/tests/Derived/Infix.hs0000644000000000000000000001073307346545000016073 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| Module: Derived.Infix Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with infix constructors. -} module Derived.Infix ( TyConPlain(..) , TyConGADT(..) , TyFamilyPlain(..) , TyFamilyGADT(..) ) where #include "generic.h" #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif import GHC.Generics (Generic, Generic1) import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- 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 , Generic , Generic1 ) ------------------------------------------------------------------------------- infixr 1 :., :..., :.... data TyConGADT a b where (:.) :: c -> d -> TyConGADT c d (:..) :: e -> f -> TyConGADT e f (:...) :: g -> h -> Int -> TyConGADT g h (:....) :: { tcg1 :: i, tcg2 :: j } -> TyConGADT i j deriving ( Show , Generic , Generic1 ) ------------------------------------------------------------------------------- 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 , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) ------------------------------------------------------------------------------- data family TyFamilyGADT y z :: * infixr 1 :*, :***, :**** data instance TyFamilyGADT a b where (:*) :: c -> d -> TyFamilyGADT c d (:**) :: e -> f -> TyFamilyGADT e f (:***) :: g -> h -> Int -> TyFamilyGADT g h (:****) :: { tfg1 :: i, tfg2 :: j } -> TyFamilyGADT i j deriving ( Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyConPlain a b) where arbitrary = genericArbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyConGADT a b) where arbitrary = genericArbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyPlain a b) where arbitrary = genericArbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyGADT a b) where arbitrary = genericArbitrary ------------------------------------------------------------------------------- $(deriveShow1 ''TyConPlain) $(deriveShow1 ''TyConGADT) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyConPlain) $(deriveShow2 ''TyConGADT) #endif $(deriveTextShow ''TyConPlain) $(deriveTextShow1 ''TyConPlain) $(deriveTextShow2 ''TyConPlain) $(deriveTextShow ''TyConGADT) $(deriveTextShow1 ''TyConGADT) $(deriveTextShow2 ''TyConGADT) #if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 '(:#:)) $(deriveShow1 '(:*)) #else $(deriveShow1 '(:#:)) $(deriveShow2 '(:$:)) $(deriveShow1 '(:*)) $(deriveShow2 '(:***)) #endif $(deriveTextShow '(:#:)) $(deriveTextShow1 '(:$:)) $(deriveTextShow2 'TyFamilyPlain) $(deriveTextShow '(:*)) $(deriveTextShow1 '(:***)) $(deriveTextShow2 '(:****)) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta '(:#:)) $(Generics.deriveRepresentable1 '(:$:)) $(Generics.deriveMeta '(:*)) $(Generics.deriveRepresentable1 '(:**)) #endif text-show-3.10.4/tests/Derived/MagicHash.hs0000644000000000000000000001347407346545000016647 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| Module: Derived.MagicHash Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with fields that have unlifted types. -} module Derived.MagicHash ( TyCon#(..), TyFamily#(..) #if MIN_VERSION_base(4,13,0) , TyCon'#(..), TyFamily'#(..) #endif ) where #if __GLASGOW_HASKELL__ < 711 import qualified Generics.Deriving.TH as Generics #endif import GHC.Exts #if __GLASGOW_HASKELL__ >= 711 import GHC.Generics (Generic, Generic1) #endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1Options, legacyShowOptions) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2Options) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- data TyCon# a b = TyCon# { tcA :: a , tcB :: b , tcInt# :: Int# , tcFloat# :: Float# , tcDouble# :: Double# , tcChar# :: Char# , tcWord# :: Word# } deriving ( Show #if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1 #endif ) #if MIN_VERSION_base(4,13,0) data TyCon'# a b = TyCon'# { tcA' :: a , tcB' :: b , tcInt8# :: Int8# , tcInt16# :: Int16# , tcWord8# :: Word8# , tcWord16# :: Word16# # if MIN_VERSION_base(4,16,0) , tcInt32# :: Int32# , tcWord32# :: Word32# # endif } deriving Show #endif ------------------------------------------------------------------------------- data family TyFamily# y z :: * data instance TyFamily# a b = TyFamily# { tfA :: a , tfB :: b , tfInt# :: Int# , tfFloat# :: Float# , tfDouble# :: Double# , tfChar# :: Char# , tfWord# :: Word# } deriving ( Show #if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1 #endif ) #if MIN_VERSION_base(4,13,0) data family TyFamily'# y z :: * data instance TyFamily'# a b = TyFamily'# { tfA' :: a , tfB' :: b , tfInt8# :: Int8# , tfInt16# :: Int16# , tfWord8# :: Word8# , tfWord16# :: Word16# # if MIN_VERSION_base(4,16,0) , tfInt32# :: Int32# , tfWord32# :: Word32# # endif } deriving Show #endif ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon# a b) where arbitrary = genericArbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily# a b) where arbitrary = genericArbitrary #if MIN_VERSION_base(4,13,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon'# a b) where arbitrary = do a <- arbitrary b <- arbitrary I# i1 <- arbitrary I# i2 <- arbitrary W# w1 <- arbitrary W# w2 <- arbitrary # if MIN_VERSION_base(4,16,0) I# i3 <- arbitrary W# w3 <- arbitrary # endif pure $ TyCon'# a b (intToInt8Compat# i1) (intToInt16Compat# i2) (wordToWord8Compat# w1) (wordToWord16Compat# w2) # if MIN_VERSION_base(4,16,0) (intToInt32# i3) (wordToWord32# w3) # endif instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily'# a b) where arbitrary = do a <- arbitrary b <- arbitrary I# i1 <- arbitrary I# i2 <- arbitrary W# w1 <- arbitrary W# w2 <- arbitrary # if MIN_VERSION_base(4,16,0) I# i3 <- arbitrary W# w3 <- arbitrary # endif pure $ TyFamily'# a b (intToInt8Compat# i1) (intToInt16Compat# i2) (wordToWord8Compat# w1) (wordToWord16Compat# w2) # if MIN_VERSION_base(4,16,0) (intToInt32# i3) (wordToWord32# w3) # endif # if MIN_VERSION_base(4,16,0) intToInt8Compat# :: Int# -> Int8# intToInt8Compat# = intToInt8# intToInt16Compat# :: Int# -> Int16# intToInt16Compat# = intToInt16# wordToWord8Compat# :: Word# -> Word8# wordToWord8Compat# = wordToWord8# wordToWord16Compat# :: Word# -> Word16# wordToWord16Compat# = wordToWord16# # else intToInt8Compat# :: Int# -> Int8# intToInt8Compat# = narrowInt8# intToInt16Compat# :: Int# -> Int16# intToInt16Compat# = narrowInt16# wordToWord8Compat# :: Word# -> Word8# wordToWord8Compat# = narrowWord8# wordToWord16Compat# :: Word# -> Word16# wordToWord16Compat# = narrowWord16# # endif #endif ------------------------------------------------------------------------------- $(deriveShow1Options legacyShowOptions ''TyCon#) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2Options legacyShowOptions ''TyCon#) #endif $(deriveTextShow ''TyCon#) $(deriveTextShow1 ''TyCon#) $(deriveTextShow2 ''TyCon#) #if __GLASGOW_HASKELL__ < 711 $(Generics.deriveAll0And1 ''TyCon#) #endif #if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1Options legacyShowOptions 'TyFamily#) #else $(deriveShow1Options legacyShowOptions 'TyFamily#) $(deriveShow2Options legacyShowOptions 'TyFamily#) #endif $(deriveTextShow 'TyFamily#) $(deriveTextShow1 'TyFamily#) $(deriveTextShow2 'TyFamily#) #if __GLASGOW_HASKELL__ < 711 $(Generics.deriveAll0And1 'TyFamily#) #endif #if MIN_VERSION_base(4,13,0) $(deriveShow1Options legacyShowOptions ''TyCon'#) $(deriveShow2Options legacyShowOptions ''TyCon'#) $(deriveTextShow ''TyCon'#) $(deriveTextShow1 ''TyCon'#) $(deriveTextShow2 ''TyCon'#) $(deriveShow1Options legacyShowOptions 'TyFamily'#) $(deriveShow2Options legacyShowOptions 'TyFamily'#) $(deriveTextShow 'TyFamily'#) $(deriveTextShow1 'TyFamily'#) $(deriveTextShow2 'TyFamily'#) #endif text-show-3.10.4/tests/Derived/PolyKinds.hs0000644000000000000000000002530507346545000016733 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Derived.PolyKinds Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with poly-kinded type variables. -} module Derived.PolyKinds ( TyConCompose(..) , TyConProxy(..) , TyConReallyHighKinds , TyFamilyCompose(..) , TyFamilyProxy(..) , TyFamilyReallyHighKinds(..) ) where #include "generic.h" import Data.Functor.Classes (Show1(..)) import Data.Orphans () import Generics.Deriving.Base #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif import Test.QuickCheck (Arbitrary) import Text.Show.Deriving (deriveShow1) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (deriveTextShow2, makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..)) import Text.Show.Deriving (deriveShow2, makeLiftShowsPrec, makeLiftShowsPrec2) #else import Text.Show.Deriving (makeShowsPrec1) #endif ------------------------------------------------------------------------------- -- NB: Don't use k as a type variable here! It'll trigger GHC Trac #12503. newtype TyConCompose f g h j p a b = TyConCompose (f (g (j a) (p a)) (h (j a) (p b))) deriving Generic deriving instance Arbitrary (f (g (j a) (k a)) (h (j a) (k b))) => Arbitrary (TyConCompose 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 (TyConCompose f g h j k a) #endif deriving instance Show (f (g (j a) (k a)) (h (j a) (k b))) => Show (TyConCompose f g h j k a b) ------------------------------------------------------------------------------- newtype TyConProxy a b where TyConProxy :: () -> TyConProxy a b deriving ( Arbitrary , Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) ------------------------------------------------------------------------------- newtype TyConReallyHighKinds f a b c d e = TyConReallyHighKinds (f a b c d e) deriving ( Arbitrary , Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) ------------------------------------------------------------------------------- data family TyFamilyCompose (t :: k1 -> k2 -> *) (u :: k3 -> k4 -> k1) (v :: k3 -> k4 -> k2) (w :: k5 -> k3) (x :: k5 -> k4) (y :: k5) (z :: k5) :: * newtype instance TyFamilyCompose f g h j k a b = TyFamilyCompose (f (g (j a) (k a)) (h (j a) (k b))) deriving Generic 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 (x :: k1) (y :: k2) :: * newtype instance TyFamilyProxy a b where TyFamilyProxy :: () -> TyFamilyProxy a b deriving ( Arbitrary , Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) ------------------------------------------------------------------------------- data family TyFamilyReallyHighKinds (g :: k1 -> k2 -> k3 -> k4 -> k5 -> *) (v :: k1) (w :: k2) (x :: k3) (y :: k4) (z :: k5) :: * newtype instance TyFamilyReallyHighKinds f a b c d e = TyFamilyReallyHighKinds (f a b c d e) deriving ( Arbitrary , Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) ------------------------------------------------------------------------------- $(return []) -- TODO: Replace these with non-orphan instances $(deriveShow1 ''(,,,,)) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''(,,,,)) #endif #if defined(NEW_FUNCTOR_CLASSES) instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyConCompose f g h j k a) where liftShowsPrec = $(makeLiftShowsPrec ''TyConCompose) instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) => Show2 (TyConCompose f g h j k) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyConCompose) instance Show1 (TyConProxy (a :: *)) where liftShowsPrec = $(makeLiftShowsPrec ''TyConProxy) instance Show2 TyConProxy where liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyConProxy) instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where liftShowsPrec = $(makeLiftShowsPrec ''TyConReallyHighKinds) instance Show2 (f a b c) => Show2 (TyConReallyHighKinds f a b c) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyConReallyHighKinds) #else instance (Functor (f (g (j a) (k a))), Functor (h (j a)), Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyConCompose f g h j k a) where showsPrec1 = $(makeShowsPrec1 ''TyConCompose) instance Show1 (TyConProxy (a :: *)) where showsPrec1 = $(makeShowsPrec1 ''TyConProxy) instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where showsPrec1 = $(makeShowsPrec1 ''TyConReallyHighKinds) #endif instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) => TextShow (TyConCompose f g h j k a b) where showbPrec = $(makeShowbPrec ''TyConCompose) instance (TextShow1 (f (g (j a) (k a))), TextShow1 (h (j a)), TextShow1 k) => TextShow1 (TyConCompose f g h j k a) where liftShowbPrec = $(makeLiftShowbPrec ''TyConCompose) $(deriveTextShow2 ''TyConCompose) instance TextShow (TyConProxy a b) where showbPrec = $(makeShowbPrec ''TyConProxy) instance TextShow1 (TyConProxy a) where liftShowbPrec = $(makeLiftShowbPrec ''TyConProxy) $(deriveTextShow2 ''TyConProxy) instance TextShow (f a b c d e) => TextShow (TyConReallyHighKinds f a b c d e) where showbPrec = $(makeShowbPrec ''TyConReallyHighKinds) instance TextShow1 (f a b c d) => TextShow1 (TyConReallyHighKinds f a b c d) where liftShowbPrec = $(makeLiftShowbPrec ''TyConReallyHighKinds) instance TextShow2 (f a b c) => TextShow2 (TyConReallyHighKinds f a b c) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyConReallyHighKinds) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta ''TyConCompose) $(Generics.deriveRep1Options False ''TyConCompose) instance ( Functor (f (g (j a) (k a))) , Functor (h (j a)) ) => Generic1 (TyConCompose f g h j k a) where type Rep1 (TyConCompose f g h j k a) = $(Generics.makeRep1 ''TyConCompose) f g h j k a from1 = $(Generics.makeFrom1 ''TyConCompose) to1 = $(Generics.makeTo1 ''TyConCompose) $(Generics.deriveMeta ''TyConProxy) $(Generics.deriveRepresentable1 ''TyConProxy) $(Generics.deriveMeta ''TyConReallyHighKinds) $(Generics.deriveRepresentable1 ''TyConReallyHighKinds) #endif #if !defined(NEW_FUNCTOR_CLASSES) instance (Functor (f (g (j a) (k a))), Functor (h (j a)), Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyFamilyCompose f g h j k a) where showsPrec1 = $(makeShowsPrec1 'TyFamilyCompose) instance Show1 (TyFamilyProxy (a :: *)) where showsPrec1 = $(makeShowsPrec1 'TyFamilyProxy) instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where showsPrec1 = $(makeShowsPrec1 'TyFamilyReallyHighKinds) #else instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyFamilyCompose f g h j k a) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyCompose) instance Show1 (TyFamilyProxy (a :: *)) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyProxy) instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyReallyHighKinds) instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) => Show2 (TyFamilyCompose f g h j k) where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyCompose) instance Show2 TyFamilyProxy where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyProxy) instance Show2 (f a b c) => Show2 (TyFamilyReallyHighKinds f a b c) where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyReallyHighKinds) #endif instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) => TextShow (TyFamilyCompose f g h j k a b) where 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 liftShowbPrec = $(makeLiftShowbPrec 'TyFamilyCompose) $(deriveTextShow2 'TyFamilyCompose) instance TextShow (TyFamilyProxy a b) where showbPrec = $(makeShowbPrec 'TyFamilyProxy) instance TextShow1 (TyFamilyProxy a) where 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 liftShowbPrec = $(makeLiftShowbPrec 'TyFamilyReallyHighKinds) instance TextShow2 (f a b c) => TextShow2 (TyFamilyReallyHighKinds f a b c) where liftShowbPrec2 = $(makeLiftShowbPrec2 'TyFamilyReallyHighKinds) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamilyCompose) $(Generics.deriveRep1Options False 'TyFamilyCompose) instance ( Functor (f (g (j a) (k a))) , Functor (h (j a)) ) => Generic1 (TyFamilyCompose f g h j k a) where type Rep1 (TyFamilyCompose f g h j k a) = $(Generics.makeRep1 'TyFamilyCompose) f g h j k a from1 = $(Generics.makeFrom1 'TyFamilyCompose) to1 = $(Generics.makeTo1 'TyFamilyCompose) $(Generics.deriveMeta 'TyFamilyProxy) $(Generics.deriveRepresentable1 'TyFamilyProxy) $(Generics.deriveMeta 'TyFamilyReallyHighKinds) $(Generics.deriveRepresentable1 'TyFamilyReallyHighKinds) #endif text-show-3.10.4/tests/Derived/RankNTypes.hs0000644000000000000000000000660607346545000017060 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-| Module: Derived.RankNTypes Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with rank-n voodoo. -} module Derived.RankNTypes (TyCon(..), TyFamily(..)) where import Data.Functor.Classes (Show1(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2, makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..)) import Text.Show.Deriving (deriveShow2, makeLiftShowsPrec, makeLiftShowsPrec2) #else import Text.Show.Deriving (makeShowsPrec1) #endif ------------------------------------------------------------------------------- data TyCon a b = TyCon (forall a. Tagged2 a Int b) (forall b. Tagged2 b a a) deriving instance (Show a, Show b) => Show (TyCon a b) ------------------------------------------------------------------------------- data family TyFamily x y :: * data instance TyFamily a b = TyFamily (forall a. Tagged2 a Int b) (forall b. Tagged2 b a a) deriving instance (Show a, Show b) => Show (TyFamily a b) ------------------------------------------------------------------------------- newtype Tagged2 s t c = Tagged2 c deriving Show ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon a b) where arbitrary = (\i1 i2 -> TyCon (Tagged2 i1) (Tagged2 i2)) <$> arbitrary <*> arbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily a b) where arbitrary = (\i1 i2 -> TyFamily (Tagged2 i1) (Tagged2 i2)) <$> arbitrary <*> arbitrary ------------------------------------------------------------------------------- $(return []) instance TextShow c => TextShow (Tagged2 s t c) where showbPrec = $(makeShowbPrec ''Tagged2) instance TextShow1 (Tagged2 s t) where liftShowbPrec = $(makeLiftShowbPrec ''Tagged2) instance TextShow2 (Tagged2 s) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''Tagged2) ------------------------------------------------------------------------------- instance Show1 (Tagged2 s t) where #if defined(NEW_FUNCTOR_CLASSES) liftShowsPrec = $(makeLiftShowsPrec ''Tagged2) #else showsPrec1 = $(makeShowsPrec1 ''Tagged2) #endif #if defined(NEW_FUNCTOR_CLASSES) instance Show2 (Tagged2 s) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''Tagged2) #endif $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) #else $(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) #endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) text-show-3.10.4/tests/Derived/Records.hs0000644000000000000000000000503707346545000016420 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| Module: Derived.Records Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with record syntax. -} module Derived.Records (TyCon(..), TyFamily(..)) where #include "generic.h" #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif import GHC.Generics (Generic, Generic1) import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- infixl 4 :@: data TyCon a b = TyConPrefix { tc1 :: a, tc2 :: b } | (:@:) { tc3 :: b, (##) :: a } deriving ( Show , Generic , Generic1 ) ------------------------------------------------------------------------------- data family TyFamily y z :: * infixl 4 :!: data instance TyFamily a b = TyFamilyPrefix { tf1 :: a, tf2 :: b } | (:!:) { tf3 :: b, (###) :: a } deriving ( Show , Generic #if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 #endif ) ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon a b) where arbitrary = genericArbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily a b) where arbitrary = genericArbitrary ------------------------------------------------------------------------------- $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamilyPrefix) #else $(deriveShow1 'TyFamilyPrefix) $(deriveShow2 '(:!:)) #endif $(deriveTextShow 'TyFamilyPrefix) $(deriveTextShow1 '(:!:)) $(deriveTextShow2 'TyFamilyPrefix) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamilyPrefix) $(Generics.deriveRepresentable1 '(:!:)) #endif text-show-3.10.4/tests/Derived/TypeFamilies.hs0000644000000000000000000000300307346545000017401 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| Module: Derived.TypeFamilies Copyright: (C) 2020 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines corner case-provoking type families. -} module Derived.TypeFamilies ( TyConOverSat(..) , TyFamilyOverSat(..) ) where import Test.QuickCheck (Arbitrary) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- type family F :: * -> * -> * type instance F = Either newtype TyConOverSat a b = TyConOverSat (F a b) deriving (Arbitrary, Show) data family TyFamilyOverSat (x :: *) (y :: *) newtype instance TyFamilyOverSat a b = TyFamilyOverSat (F a b) deriving (Arbitrary, Show) ------------------------------------------------------------------------------- $(deriveShow1 ''TyConOverSat) $(deriveShow1 'TyFamilyOverSat) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyConOverSat) $(deriveShow2 'TyFamilyOverSat) #endif $(deriveTextShow ''TyConOverSat) $(deriveTextShow1 ''TyConOverSat) $(deriveTextShow2 ''TyConOverSat) $(deriveTextShow 'TyFamilyOverSat) $(deriveTextShow1 'TyFamilyOverSat) $(deriveTextShow2 'TyFamilyOverSat) text-show-3.10.4/tests/Derived/TypeSynonyms.hs0000644000000000000000000000535107346545000017517 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Derived.TypeSynonyms Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types that use type synonyms. -} module Derived.TypeSynonyms (TyCon(..), TyFamily(..)) where import Control.Monad.Trans.Instances () import Data.Orphans () import qualified Generics.Deriving.TH as Generics import GHC.Generics (Generic) import Prelude import Test.QuickCheck (Arbitrary) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- type FakeOut a = Int type Id a = a type Flip f a b = f b a ------------------------------------------------------------------------------- newtype TyCon a b = TyCon ( Id (FakeOut (Id a)) , Id (FakeOut (Id b)) , Id (Flip Either (Id a) (Id Int)) , Id (Flip Either (Id b) (Id a)) ) deriving ( Arbitrary , Show , Generic ) ------------------------------------------------------------------------------- data family TyFamily y z :: * newtype instance TyFamily a b = TyFamily ( Id (FakeOut (Id a)) , Id (FakeOut (Id b)) , Id (Flip Either (Id a) (Id Int)) , Id (Flip Either (Id b) (Id a)) ) deriving ( Arbitrary , Show , Generic ) ------------------------------------------------------------------------------- #if !(MIN_VERSION_base(4,9,0)) -- TODO: Delete this code once we depend on transformers-compat-0.7.1 as the -- minimum # if !(MIN_VERSION_transformers_compat(0,7,1)) $(deriveShow1 ''(,,,)) # if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''(,,,)) # endif # endif #endif $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) $(Generics.deriveMeta ''TyCon) $(Generics.deriveRepresentable1 ''TyCon) #if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) #else $(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) #endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) $(Generics.deriveMeta 'TyFamily) $(Generics.deriveRepresentable1 'TyFamily) text-show-3.10.4/tests/Instances/Control/0000755000000000000000000000000007346545000016443 5ustar0000000000000000text-show-3.10.4/tests/Instances/Control/Concurrent.hs0000644000000000000000000000157607346545000021132 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Concurrent Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Control.Concurrent" module. -} module Instances.Control.Concurrent () where import GHC.Conc (BlockReason(..), ThreadStatus(..)) import GHC.Generics (Generic) import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) deriving instance Bounded BlockReason deriving instance Enum BlockReason instance Arbitrary BlockReason where arbitrary = arbitraryBoundedEnum instance Arbitrary ThreadStatus where arbitrary = genericArbitrary deriving instance Generic ThreadStatus text-show-3.10.4/tests/Instances/Control/Exception.hs0000644000000000000000000001025307346545000020736 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Exception Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Control.Exception" module. -} module Instances.Control.Exception () where import Control.Exception hiding (IOException) import GHC.Generics (Generic) import GHC.IO.Exception (IOException(..), IOErrorType(..)) #if MIN_VERSION_base(4,11,0) import GHC.IO.Exception (FixIOException(..)) #endif import Instances.Foreign.C.Types () import Instances.System.IO () import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), Gen, arbitraryBoundedEnum) instance Arbitrary SomeException where arbitrary = SomeException <$> (arbitrary :: Gen AssertionFailed) instance Arbitrary IOException where arbitrary = genericArbitrary deriving instance Bounded IOErrorType deriving instance Enum IOErrorType instance Arbitrary IOErrorType where arbitrary = arbitraryBoundedEnum deriving instance Bounded ArithException deriving instance Enum ArithException instance Arbitrary ArithException where arbitrary = arbitraryBoundedEnum instance Arbitrary ArrayException where arbitrary = genericArbitrary instance Arbitrary AssertionFailed where arbitrary = genericArbitrary instance Arbitrary SomeAsyncException where arbitrary = SomeAsyncException <$> (arbitrary :: Gen AsyncException) deriving instance Bounded AsyncException deriving instance Enum AsyncException instance Arbitrary AsyncException where arbitrary = arbitraryBoundedEnum deriving instance Bounded NonTermination deriving instance Enum NonTermination instance Arbitrary NonTermination where arbitrary = arbitraryBoundedEnum deriving instance Bounded NestedAtomically deriving instance Enum NestedAtomically instance Arbitrary NestedAtomically where arbitrary = arbitraryBoundedEnum deriving instance Bounded BlockedIndefinitelyOnMVar deriving instance Enum BlockedIndefinitelyOnMVar instance Arbitrary BlockedIndefinitelyOnMVar where arbitrary = arbitraryBoundedEnum deriving instance Bounded BlockedIndefinitelyOnSTM deriving instance Enum BlockedIndefinitelyOnSTM instance Arbitrary BlockedIndefinitelyOnSTM where arbitrary = arbitraryBoundedEnum #if MIN_VERSION_base(4,8,0) deriving instance Bounded AllocationLimitExceeded deriving instance Enum AllocationLimitExceeded instance Arbitrary AllocationLimitExceeded where arbitrary = arbitraryBoundedEnum #endif #if MIN_VERSION_base(4,9,0) deriving instance Arbitrary TypeError #endif #if MIN_VERSION_base(4,10,0) deriving instance Arbitrary CompactionFailed #endif #if MIN_VERSION_base(4,11,0) deriving instance Bounded FixIOException deriving instance Enum FixIOException instance Arbitrary FixIOException where arbitrary = arbitraryBoundedEnum #endif deriving instance Bounded Deadlock deriving instance Enum Deadlock instance Arbitrary Deadlock where arbitrary = arbitraryBoundedEnum instance Arbitrary NoMethodError where arbitrary = genericArbitrary instance Arbitrary PatternMatchFail where arbitrary = genericArbitrary instance Arbitrary RecConError where arbitrary = genericArbitrary instance Arbitrary RecSelError where arbitrary = genericArbitrary instance Arbitrary RecUpdError where arbitrary = genericArbitrary instance Arbitrary ErrorCall where arbitrary = genericArbitrary deriving instance Bounded MaskingState deriving instance Enum MaskingState instance Arbitrary MaskingState where arbitrary = arbitraryBoundedEnum deriving instance Generic ArrayException deriving instance Generic AssertionFailed deriving instance Generic IOException deriving instance Generic Deadlock deriving instance Generic NoMethodError deriving instance Generic PatternMatchFail deriving instance Generic RecConError deriving instance Generic RecSelError deriving instance Generic RecUpdError deriving instance Generic ErrorCall text-show-3.10.4/tests/Instances/Control/Monad/0000755000000000000000000000000007346545000017501 5ustar0000000000000000text-show-3.10.4/tests/Instances/Control/Monad/ST.hs0000644000000000000000000000076707346545000020375 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Monad.ST Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'ST'. -} module Instances.Control.Monad.ST () where import Control.Monad.ST (ST, fixST) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary (ST s a) where arbitrary = pure $ fixST undefined text-show-3.10.4/tests/Instances/Data/0000755000000000000000000000000007346545000015674 5ustar0000000000000000text-show-3.10.4/tests/Instances/Data/Char.hs0000644000000000000000000000074607346545000017114 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Char Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'GeneralCategory'. -} module Instances.Data.Char () where import Data.Char (GeneralCategory) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Arbitrary GeneralCategory where arbitrary = arbitraryBoundedEnum text-show-3.10.4/tests/Instances/Data/Data.hs0000644000000000000000000000235107346545000017102 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Data Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Data.Data" module. -} module Instances.Data.Data () where import Data.Data (Constr, ConstrRep(..), DataRep(..), DataType, Fixity(..), mkConstr, mkDataType) import GHC.Generics (Generic) import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Arbitrary Constr where arbitrary = mkConstr <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary ConstrRep where arbitrary = genericArbitrary instance Arbitrary DataRep where arbitrary = genericArbitrary instance Arbitrary DataType where arbitrary = mkDataType <$> arbitrary <*> arbitrary deriving instance Bounded Fixity deriving instance Enum Fixity instance Arbitrary Fixity where arbitrary = arbitraryBoundedEnum deriving instance Generic ConstrRep deriving instance Generic DataRep text-show-3.10.4/tests/Instances/Data/Dynamic.hs0000644000000000000000000000100307346545000017606 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Dynamic Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Dynamic'. -} module Instances.Data.Dynamic () where import Data.Dynamic (Dynamic, toDyn) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), Gen) instance Arbitrary Dynamic where arbitrary = toDyn <$> (arbitrary :: Gen Int) text-show-3.10.4/tests/Instances/Data/Floating.hs0000644000000000000000000000120507346545000017771 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Floating Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'FPFormat'. -} module Instances.Data.Floating () where import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) #if !(MIN_VERSION_text(2,0,0)) deriving instance Bounded FPFormat #endif instance Arbitrary FPFormat where arbitrary = arbitraryBoundedEnum text-show-3.10.4/tests/Instances/Data/Monoid.hs0000644000000000000000000000112207346545000017451 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,12,0) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: Instances.Data.Monoid Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Ap'. -} module Instances.Data.Monoid () where #if MIN_VERSION_base(4,12,0) import Data.Monoid (Ap(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary (f a) => Arbitrary (Ap f a) #endif text-show-3.10.4/tests/Instances/Data/OldTypeable.hs0000644000000000000000000000220707346545000020435 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_base(4,8,0)) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} #endif {-| Module: Instances.Data.OldTypeable Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Data.OldTypeable" module. -} module Instances.Data.OldTypeable () where #if !(MIN_VERSION_base(4,8,0)) import Data.OldTypeable.Internal (TyCon(..), TypeRep(..)) import GHC.Generics (Generic) import Instances.GHC.Fingerprint () import Instances.Utils ((<@>)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary TypeRep where arbitrary = TypeRep <$> arbitrary <*> arbitrary <@> [] -- arbitrary = TypeRep <$> arbitrary <*> arbitrary <*> arbitrary deriving instance Generic TyCon instance Arbitrary TyCon where arbitrary = genericArbitrary #endif text-show-3.10.4/tests/Instances/Data/Ord.hs0000644000000000000000000000076507346545000016764 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Ord Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Down'. -} module Instances.Data.Ord () where import GHC.Exts (Down(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary a => Arbitrary (Down a) text-show-3.10.4/tests/Instances/Data/Semigroup.hs0000644000000000000000000000105607346545000020204 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Semigroup Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for the 'Arg' datatype. -} module Instances.Data.Semigroup () where import Data.Semigroup.Compat (Arg(..)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) instance (Arbitrary a, Arbitrary b) => Arbitrary (Arg a b) where arbitrary = genericArbitrary text-show-3.10.4/tests/Instances/Data/Text.hs0000644000000000000000000000272107346545000017156 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Text Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the @text@ library. -} module Instances.Data.Text () where import Data.Text.Encoding.Error (UnicodeException(..)) import Data.Text.Lazy.Builder (Builder, fromString) #if MIN_VERSION_text(1,0,0) import Data.Text.Encoding (Decoding(..)) import Instances.Utils ((<@>)) #endif #if MIN_VERSION_text(1,1,0) import Data.Text.Internal.Fusion.Size (Size, exactSize) import Test.QuickCheck (getNonNegative) #endif import GHC.Generics (Generic) import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import Test.QuickCheck.Instances () instance Arbitrary Builder where arbitrary = fromString <$> arbitrary instance Arbitrary UnicodeException where arbitrary = genericArbitrary #if MIN_VERSION_text(1,0,0) instance Arbitrary Decoding where arbitrary = Some <$> arbitrary <*> arbitrary <@> undefined #endif #if MIN_VERSION_text(1,1,0) instance Arbitrary Size where arbitrary = exactSize . getNonNegative <$> arbitrary #endif deriving instance Generic UnicodeException text-show-3.10.4/tests/Instances/Data/Tuple.hs0000644000000000000000000000463307346545000017327 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Tuple Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for tuple types. -} module Instances.Data.Tuple () where import Generics.Deriving.Instances () import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f , Arbitrary g , Arbitrary h , Arbitrary i , Arbitrary j , Arbitrary k ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k) where arbitrary = genericArbitrary instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f , Arbitrary g , Arbitrary h , Arbitrary i , Arbitrary j , Arbitrary k , Arbitrary l ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l) where arbitrary = genericArbitrary instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f , Arbitrary g , Arbitrary h , Arbitrary i , Arbitrary j , Arbitrary k , Arbitrary l , Arbitrary m ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m) where arbitrary = genericArbitrary instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f , Arbitrary g , Arbitrary h , Arbitrary i , Arbitrary j , Arbitrary k , Arbitrary l , Arbitrary m , Arbitrary n ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where arbitrary = genericArbitrary instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f , Arbitrary g , Arbitrary h , Arbitrary i , Arbitrary j , Arbitrary k , Arbitrary l , Arbitrary m , Arbitrary n , Arbitrary o ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where arbitrary = genericArbitrary text-show-3.10.4/tests/Instances/Data/Type/0000755000000000000000000000000007346545000016615 5ustar0000000000000000text-show-3.10.4/tests/Instances/Data/Type/Coercion.hs0000644000000000000000000000112707346545000020713 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Type.Coercion Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Coercion'. -} module Instances.Data.Type.Coercion () where import Data.Coerce (Coercible) import Data.Type.Coercion (Coercion(..)) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Coercible a b => Arbitrary (Coercion a b) where arbitrary = arbitraryBoundedEnum text-show-3.10.4/tests/Instances/Data/Type/Equality.hs0000644000000000000000000000134307346545000020747 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Type.Equality Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for '(:~:)'. -} module Instances.Data.Type.Equality () where import Data.Type.Equality.Compat import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance a ~ b => Arbitrary (a :~: b) where arbitrary = arbitraryBoundedEnum #if MIN_VERSION_base(4,9,0) instance a ~~ b => Arbitrary (a :~~: b) where arbitrary = arbitraryBoundedEnum #endif text-show-3.10.4/tests/Instances/Data/Typeable.hs0000644000000000000000000001006307346545000017775 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Typeable Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Data.Typeable" module. -} module Instances.Data.Typeable () where #include "MachDeps.h" #if MIN_VERSION_base(4,9,0) import GHC.Types (TyCon(..), TrName(..), Module(..)) # if MIN_VERSION_base(4,17,0) || WORD_SIZE_IN_BITS < 64 import GHC.Word (Word64(..)) # else import GHC.Word (Word(..)) # endif #else import Data.Typeable.Internal (TyCon(..)) #endif #if MIN_VERSION_base(4,10,0) import GHC.Exts (Int(..), Ptr(..)) import GHC.Types ( KindRep(..), RuntimeRep(..), TypeLitSort(..) , VecCount(..), VecElem(..) # if MIN_VERSION_base(4,16,0) , Levity(..) # endif ) import Type.Reflection (SomeTypeRep(..), Typeable, TypeRep, typeRep) #else import Data.Typeable.Internal (TypeRep(..)) #endif import Instances.Foreign.Ptr () import Instances.GHC.Fingerprint () import Instances.Utils ((<@>)) import Prelude () import Prelude.Compat import Test.QuickCheck #if MIN_VERSION_base(4,10,0) instance Typeable a => Arbitrary (TypeRep (a :: k)) where arbitrary = pure (typeRep :: TypeRep (a :: k)) instance Arbitrary SomeTypeRep where arbitrary = SomeTypeRep <$> (arbitrary :: Gen (TypeRep Int)) deriving instance Bounded TypeLitSort deriving instance Enum TypeLitSort instance Arbitrary TypeLitSort where arbitrary = arbitraryBoundedEnum instance Arbitrary KindRep where arbitrary = oneof [ KindRepTyConApp <$> arbitrary <@> [] , KindRepVar <$> arbitrary , KindRepApp <$> krt <*> krt , krt , do Ptr a# <- arbitrary (\a -> KindRepTypeLitS a a#) <$> arbitrary , KindRepTypeLitD <$> arbitrary <*> arbitrary ] where krt = KindRepTYPE <$> arbitrary instance Arbitrary RuntimeRep where arbitrary = oneof [ VecRep <$> arbitrary <*> arbitrary , pure $ TupleRep [] , pure $ SumRep [] # if MIN_VERSION_base(4,16,0) , pure $ BoxedRep Lifted , pure $ BoxedRep Unlifted # else , pure LiftedRep , pure UnliftedRep # endif , pure IntRep , pure WordRep , pure Int64Rep , pure Word64Rep , pure AddrRep , pure FloatRep , pure DoubleRep ] instance Arbitrary VecCount where arbitrary = arbitraryBoundedEnum instance Arbitrary VecElem where arbitrary = arbitraryBoundedEnum #else /* !(MIN_VERSION_base(4,10,0) */ instance Arbitrary TypeRep where arbitrary = TypeRep <$> arbitrary <*> arbitrary # if MIN_VERSION_base(4,8,0) <@> [] <@> [] # else <@> [] # endif #endif instance Arbitrary TyCon where #if MIN_VERSION_base(4,9,0) arbitrary = do # if MIN_VERSION_base(4,17,0) || WORD_SIZE_IN_BITS < 64 W64# w1# <- arbitrary W64# w2# <- arbitrary # else W# w1# <- arbitrary W# w2# <- arbitrary # endif # if MIN_VERSION_base(4,10,0) I# i# <- arbitrary (\a1 a2 a3 -> TyCon w1# w2# a1 a2 i# a3) <$> arbitrary <*> arbitrary <*> arbitrary # else TyCon w1# w2# <$> arbitrary <*> arbitrary # endif #else arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> 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 text-show-3.10.4/tests/Instances/Foreign/C/0000755000000000000000000000000007346545000016576 5ustar0000000000000000text-show-3.10.4/tests/Instances/Foreign/C/Types.hs0000644000000000000000000000114607346545000020240 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Foreign.C.Types Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Foreign.C.Types" module. -} module Instances.Foreign.C.Types () where #if MIN_VERSION_base(4,10,0) import Foreign.C.Types import Test.QuickCheck (Arbitrary(..)) deriving instance Arbitrary CBool #endif text-show-3.10.4/tests/Instances/Foreign/0000755000000000000000000000000007346545000016414 5ustar0000000000000000text-show-3.10.4/tests/Instances/Foreign/Ptr.hs0000644000000000000000000000154107346545000017516 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Foreign.Ptr Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for pointer data types. -} module Instances.Foreign.Ptr () where import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr, castPtrToFunPtr, nullPtr, plusPtr, ptrToIntPtr, ptrToWordPtr) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary (Ptr a) where arbitrary = plusPtr nullPtr <$> arbitrary instance Arbitrary (FunPtr a) where arbitrary = castPtrToFunPtr <$> arbitrary instance Arbitrary IntPtr where arbitrary = ptrToIntPtr <$> arbitrary instance Arbitrary WordPtr where arbitrary = ptrToWordPtr <$> arbitrary text-show-3.10.4/tests/Instances/0000755000000000000000000000000007346545000015023 5ustar0000000000000000text-show-3.10.4/tests/Instances/FromStringTextShow.hs0000644000000000000000000000211207346545000021153 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.FromStringTextShow Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances 'FromStringShow' and 'FromTextShow' -} module Instances.FromStringTextShow () where import Test.QuickCheck (Arbitrary) import TextShow (FromStringShow(..), FromTextShow(..), FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..)) deriving instance Arbitrary a => Arbitrary (FromStringShow a) deriving instance Arbitrary (f a) => Arbitrary (FromStringShow1 f a) deriving instance Arbitrary (f a b) => Arbitrary (FromStringShow2 f a b) deriving instance Arbitrary a => Arbitrary (FromTextShow a) deriving instance Arbitrary (f a) => Arbitrary (FromTextShow1 f a) deriving instance Arbitrary (f a b) => Arbitrary (FromTextShow2 f a b) text-show-3.10.4/tests/Instances/GHC/Conc/0000755000000000000000000000000007346545000016306 5ustar0000000000000000text-show-3.10.4/tests/Instances/GHC/Conc/Windows.hs0000644000000000000000000000124007346545000020271 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Conc.Windows Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'ConsoleEvent'. -} module Instances.GHC.Conc.Windows () where #if !defined(__GHCJS__) && defined(mingw32_HOST_OS) import GHC.Conc.Windows (ConsoleEvent(..)) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) deriving instance Bounded ConsoleEvent instance Arbitrary ConsoleEvent where arbitrary = arbitraryBoundedEnum #endif text-show-3.10.4/tests/Instances/GHC/0000755000000000000000000000000007346545000015424 5ustar0000000000000000text-show-3.10.4/tests/Instances/GHC/Event.hs0000644000000000000000000000175707346545000017053 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Event Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "GHC.Event" module. -} module Instances.GHC.Event () where #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) import GHC.Event (Event, evtRead, evtWrite) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) # if MIN_VERSION_base(4,8,1) import GHC.Event (Lifetime(..)) import Test.QuickCheck (arbitraryBoundedEnum) # endif instance Arbitrary Event where arbitrary = oneof $ map pure [evtRead, evtWrite] -- TODO: instance Arbitrary FdKey # if MIN_VERSION_base(4,8,1) deriving instance Bounded Lifetime deriving instance Enum Lifetime instance Arbitrary Lifetime where arbitrary = arbitraryBoundedEnum # endif #endif text-show-3.10.4/tests/Instances/GHC/Fingerprint.hs0000644000000000000000000000142707346545000020253 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Fingerprint Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Fingerprint'. -} module Instances.GHC.Fingerprint () where import GHC.Fingerprint.Type (Fingerprint(..)) #if !(MIN_VERSION_base(4,15,0)) import GHC.Generics (Generic) #endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) instance Arbitrary Fingerprint where arbitrary = genericArbitrary #if !(MIN_VERSION_base(4,15,0)) deriving instance Generic Fingerprint #endif text-show-3.10.4/tests/Instances/GHC/Generics.hs0000644000000000000000000000432507346545000017523 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Generics Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "GHC.Generics" module. -} module Instances.GHC.Generics () where import Data.Orphans () import Generics.Deriving.Base import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Arbitrary (U1 p) where arbitrary = genericArbitrary deriving instance Arbitrary p => Arbitrary (Par1 p) deriving instance Arbitrary (f p) => Arbitrary (Rec1 f p) deriving instance Arbitrary c => Arbitrary (K1 i c p) deriving instance Arbitrary (f p) => Arbitrary (M1 i c f p) deriving instance Arbitrary (f (g p)) => Arbitrary ((f :.: g) p) instance (Arbitrary (f p), Arbitrary (g p)) => Arbitrary ((f :+: g) p) where arbitrary = genericArbitrary instance (Arbitrary (f p), Arbitrary (g p)) => Arbitrary ((f :*: g) p) where arbitrary = genericArbitrary instance Arbitrary Fixity where arbitrary = genericArbitrary instance Arbitrary Associativity where arbitrary = arbitraryBoundedEnum #if MIN_VERSION_base(4,9,0) instance Arbitrary SourceUnpackedness where arbitrary = arbitraryBoundedEnum instance Arbitrary SourceStrictness where arbitrary = arbitraryBoundedEnum instance Arbitrary DecidedStrictness where arbitrary = arbitraryBoundedEnum #else instance Arbitrary Arity where arbitrary = genericArbitrary #endif instance Arbitrary (UChar p) where arbitrary = genericArbitrary instance Arbitrary (UDouble p) where arbitrary = genericArbitrary instance Arbitrary (UFloat p) where arbitrary = genericArbitrary instance Arbitrary (UInt p) where arbitrary = genericArbitrary instance Arbitrary (UWord p) where arbitrary = genericArbitrary text-show-3.10.4/tests/Instances/GHC/RTS/0000755000000000000000000000000007346545000016074 5ustar0000000000000000text-show-3.10.4/tests/Instances/GHC/RTS/Flags.hs0000644000000000000000000000617307346545000017473 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} # if __GLASGOW_HASKELL__ == 802 -- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex {-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} # endif #endif {-| Module: Instances.GHC.RTS.Flags Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "GHC.RTS.Flags" module. -} module Instances.GHC.RTS.Flags ( #if !(MIN_VERSION_base(4,8,0)) ) where #else GiveGCStats' , DoCostCentres' , DoHeapProfile' , DoTrace' ) where import qualified Generics.Deriving.TH as Generics (deriveAll0) import GHC.RTS.Flags import Instances.Utils.GenericArbitrary (genericArbitrary) import Language.Haskell.TH.Lib (conT) import Test.QuickCheck (Arbitrary(..)) import TextShow.TH.Names #if !(MIN_VERSION_base(4,15,0)) $(Generics.deriveAll0 ''RTSFlags) $(Generics.deriveAll0 ''GCFlags) $(Generics.deriveAll0 ''ConcFlags) $(Generics.deriveAll0 ''MiscFlags) $(Generics.deriveAll0 ''DebugFlags) $(Generics.deriveAll0 ''CCFlags) $(Generics.deriveAll0 ''ProfFlags) $(Generics.deriveAll0 ''TraceFlags) $(Generics.deriveAll0 ''TickyFlags) # if MIN_VERSION_base(4,10,0) $(Generics.deriveAll0 ''ParFlags) # endif $(Generics.deriveAll0 giveGCStatsTypeName) $(Generics.deriveAll0 doCostCentresTypeName) $(Generics.deriveAll0 doHeapProfileTypeName) $(Generics.deriveAll0 doTraceTypeName) #endif #if MIN_VERSION_base(4,15,0) $(Generics.deriveAll0 ''IoSubSystem) #endif instance Arbitrary RTSFlags where arbitrary = genericArbitrary instance Arbitrary GCFlags where arbitrary = genericArbitrary instance Arbitrary ConcFlags where arbitrary = genericArbitrary #if MIN_VERSION_base(4,15,0) instance Arbitrary IoSubSystem where arbitrary = genericArbitrary #endif instance Arbitrary MiscFlags where arbitrary = genericArbitrary instance Arbitrary DebugFlags where arbitrary = genericArbitrary instance Arbitrary CCFlags where arbitrary = genericArbitrary instance Arbitrary ProfFlags where arbitrary = genericArbitrary instance Arbitrary TraceFlags where arbitrary = genericArbitrary instance Arbitrary TickyFlags where arbitrary = genericArbitrary # if MIN_VERSION_base(4,10,0) instance Arbitrary ParFlags where arbitrary = genericArbitrary # endif type GiveGCStats' = $(conT giveGCStatsTypeName) type DoCostCentres' = $(conT doCostCentresTypeName) type DoHeapProfile' = $(conT doHeapProfileTypeName) type DoTrace' = $(conT doTraceTypeName) instance Arbitrary GiveGCStats' where arbitrary = genericArbitrary instance Arbitrary DoCostCentres' where arbitrary = genericArbitrary instance Arbitrary DoHeapProfile' where arbitrary = genericArbitrary instance Arbitrary DoTrace' where arbitrary = genericArbitrary #endif text-show-3.10.4/tests/Instances/GHC/Stack.hs0000644000000000000000000000302107346545000017021 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,1) {-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: Instances.GHC.Stack Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for 'CallStack' and 'SrcLoc'. -} module Instances.GHC.Stack () where #if MIN_VERSION_base(4,8,1) # if MIN_VERSION_base(4,9,0) import GHC.Stack.Types (CallStack(..), SrcLoc(..)) import Instances.Utils ((<@>)) import Test.QuickCheck (oneof) # else import GHC.SrcLoc (SrcLoc) import GHC.Stack (CallStack) # endif # if !(MIN_VERSION_base(4,15,0)) import qualified Generics.Deriving.TH as Generics (deriveAll0) # endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) # if !(MIN_VERSION_base(4,9,0)) $(Generics.deriveAll0 ''CallStack) # endif # if !(MIN_VERSION_base(4,15,0)) $(Generics.deriveAll0 ''SrcLoc) # endif instance Arbitrary CallStack where # if MIN_VERSION_base(4,9,0) arbitrary = oneof [ pure EmptyCallStack , PushCallStack <$> arbitrary <*> arbitrary <@> EmptyCallStack , pure $ FreezeCallStack EmptyCallStack ] # else arbitrary = genericArbitrary # endif instance Arbitrary SrcLoc where arbitrary = genericArbitrary #endif text-show-3.10.4/tests/Instances/GHC/StaticPtr.hs0000644000000000000000000000141407346545000017675 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: Instances.GHC.StaticPtr Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'StaticPtrInfo'. -} module Instances.GHC.StaticPtr () where #if MIN_VERSION_base(4,8,0) import GHC.Generics (Generic) import GHC.StaticPtr (StaticPtrInfo(..)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) deriving instance Generic StaticPtrInfo instance Arbitrary StaticPtrInfo where arbitrary = genericArbitrary #endif text-show-3.10.4/tests/Instances/GHC/Stats.hs0000644000000000000000000000144007346545000017055 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_base(4,11,0)) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: Instances.GHC.Stats Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'GCStats'. -} module Instances.GHC.Stats () where #if !(MIN_VERSION_base(4,11,0)) import GHC.Generics (Generic) import GHC.Stats (GCStats(..)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) deriving instance Generic GCStats instance Arbitrary GCStats where arbitrary = genericArbitrary #endif text-show-3.10.4/tests/Instances/GHC/TypeLits.hs0000644000000000000000000000264507346545000017544 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.TypeLits Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "GHC.TypeLits" module. -} module Instances.GHC.TypeLits () where import GHC.TypeLits import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), getNonNegative) import Test.QuickCheck.Instances () #if MIN_VERSION_base(4,18,0) import qualified GHC.TypeNats as TN import Spec.Utils (GArbitrary(..), Some(..)) #endif instance Arbitrary SomeNat where arbitrary = do nat <- getNonNegative <$> arbitrary case someNatVal nat of Just sn -> pure sn Nothing -> error "Negative natural number" -- Should never happen instance Arbitrary SomeSymbol where arbitrary = someSymbolVal <$> arbitrary #if MIN_VERSION_base(4,16,0) instance Arbitrary SomeChar where arbitrary = someCharVal <$> arbitrary #endif #if MIN_VERSION_base(4,18,0) instance GArbitrary SNat where garbitrary = do n <- arbitrary TN.withSomeSNat n (pure . Some) instance GArbitrary SSymbol where garbitrary = do s <- arbitrary withSomeSSymbol s (pure . Some) instance GArbitrary SChar where garbitrary = do c <- arbitrary withSomeSChar c (pure . Some) #endif text-show-3.10.4/tests/Instances/Generic.hs0000644000000000000000000000347507346545000016744 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE DerivingVia #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Generic Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Provides instances for 'GenericExample', and an 'Arbitrary' instance for 'ConType'. -} module Instances.Generic () where import GHC.Generics (Generic, Generic1) import Instances.Data.Text () import Instances.Utils (GenericExample(..)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1) import TextShow (TextShow(..), TextShow1(..)) import TextShow.Generic ( ConType(..) #if __GLASGOW_HASKELL__ >= 806 , FromGeneric(..), FromGeneric1(..) #else , genericShowbPrec, genericLiftShowbPrec #endif ) deriving instance Show a => Show (GenericExample a) $(deriveShow1 ''GenericExample) instance Arbitrary a => Arbitrary (GenericExample a) where arbitrary = genericArbitrary deriving instance Generic (GenericExample a) deriving instance Generic1 GenericExample #if __GLASGOW_HASKELL__ >= 806 deriving via FromGeneric (GenericExample a) instance TextShow a => TextShow (GenericExample a) deriving via FromGeneric1 GenericExample instance TextShow1 GenericExample #else instance TextShow a => TextShow (GenericExample a) where showbPrec = genericShowbPrec instance TextShow1 GenericExample where liftShowbPrec = genericLiftShowbPrec #endif instance Arbitrary ConType where arbitrary = genericArbitrary text-show-3.10.4/tests/Instances/Options.hs0000644000000000000000000000117307346545000017014 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Options Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Options' and related datatypes. -} module Instances.Options () where import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) import TextShow.TH (Options(..), GenTextMethods) instance Arbitrary Options where arbitrary = genericArbitrary instance Arbitrary GenTextMethods where arbitrary = arbitraryBoundedEnum text-show-3.10.4/tests/Instances/System/0000755000000000000000000000000007346545000016307 5ustar0000000000000000text-show-3.10.4/tests/Instances/System/IO.hs0000644000000000000000000000323607346545000017156 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.IO Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "System.IO" module. -} module Instances.System.IO () where import GHC.Generics (Generic) import GHC.IO.Encoding.Failure (CodingFailureMode(..)) import GHC.IO.Encoding.Types (CodingProgress(..)) import GHC.IO.Handle (HandlePosn(..)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import System.IO (BufferMode(..), IOMode(..), SeekMode(..), Handle, stdin, stdout, stderr) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) instance Arbitrary Handle where arbitrary = oneof $ map pure [stdin, stdout, stderr] instance Arbitrary HandlePosn where arbitrary = genericArbitrary deriving instance Bounded IOMode instance Arbitrary IOMode where arbitrary = arbitraryBoundedEnum instance Arbitrary BufferMode where arbitrary = genericArbitrary deriving instance Bounded SeekMode instance Arbitrary SeekMode where arbitrary = arbitraryBoundedEnum deriving instance Bounded CodingProgress deriving instance Enum CodingProgress instance Arbitrary CodingProgress where arbitrary = arbitraryBoundedEnum deriving instance Bounded CodingFailureMode deriving instance Enum CodingFailureMode instance Arbitrary CodingFailureMode where arbitrary = arbitraryBoundedEnum deriving instance Generic HandlePosn deriving instance Generic BufferMode text-show-3.10.4/tests/Instances/System/Posix/0000755000000000000000000000000007346545000017411 5ustar0000000000000000text-show-3.10.4/tests/Instances/System/Posix/Types.hs0000644000000000000000000000421207346545000021050 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.Posix.Types Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "System.Posix.Types" module. -} module Instances.System.Posix.Types () where import Instances.Foreign.C.Types () import Instances.Foreign.Ptr () import System.Posix.Types import Test.QuickCheck (Arbitrary(..)) #include "HsBaseConfig.h" #if defined(HTYPE_DEV_T) deriving instance Arbitrary CDev #endif #if defined(HTYPE_INO_T) deriving instance Arbitrary CIno #endif #if defined(HTYPE_MODE_T) deriving instance Arbitrary CMode #endif #if defined(HTYPE_OFF_T) deriving instance Arbitrary COff #endif #if defined(HTYPE_PID_T) deriving instance Arbitrary CPid #endif #if defined(HTYPE_SSIZE_T) deriving instance Arbitrary CSsize #endif #if defined(HTYPE_GID_T) deriving instance Arbitrary CGid #endif #if defined(HTYPE_NLINK_T) deriving instance Arbitrary CNlink #endif #if defined(HTYPE_UID_T) deriving instance Arbitrary CUid #endif #if defined(HTYPE_CC_T) deriving instance Arbitrary CCc #endif #if defined(HTYPE_SPEED_T) deriving instance Arbitrary CSpeed #endif #if defined(HTYPE_TCFLAG_T) deriving instance Arbitrary CTcflag #endif #if defined(HTYPE_RLIM_T) deriving instance Arbitrary CRLim #endif #if MIN_VERSION_base(4,10,0) # if defined(HTYPE_BLKSIZE_T) deriving instance Arbitrary CBlkSize # endif # if defined(HTYPE_BLKCNT_T) deriving instance Arbitrary CBlkCnt # endif # if defined(HTYPE_CLOCKID_T) deriving instance Arbitrary CClockId # endif # if defined(HTYPE_FSBLKCNT_T) deriving instance Arbitrary CFsBlkCnt # endif # if defined(HTYPE_FSFILCNT_T) deriving instance Arbitrary CFsFilCnt # endif # if defined(HTYPE_ID_T) deriving instance Arbitrary CId # endif # if defined(HTYPE_KEY_T) deriving instance Arbitrary CKey # endif # if defined(HTYPE_TIMER_T) deriving instance Arbitrary CTimer # endif #endif deriving instance Arbitrary Fd text-show-3.10.4/tests/Instances/Text/0000755000000000000000000000000007346545000015747 5ustar0000000000000000text-show-3.10.4/tests/Instances/Text/Read.hs0000644000000000000000000000172307346545000017161 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Text.Read Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Text.Read" module. -} module Instances.Text.Read () where import qualified Generics.Deriving.TH as Generics (deriveAll0) import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) import Text.Read (Lexeme(..)) import Text.Read.Lex (Number) $(Generics.deriveAll0 ''Lexeme) $(Generics.deriveAll0 ''Number) instance Arbitrary Lexeme where arbitrary = genericArbitrary instance Arbitrary Number where arbitrary = genericArbitrary text-show-3.10.4/tests/Instances/Utils.hs0000644000000000000000000000122207346545000016454 0ustar0000000000000000{-| Module: Instances.Utils Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC A collection of utilities. -} module Instances.Utils (GenericExample(..), (<@>)) where -- | A simple data type for testing if 'FromGeneric' and -- 'FromGeneric1' work as intended. data GenericExample a = GE1 a (Maybe a) (Maybe (Maybe a)) | GE2 | GE3 { ge3 :: a } | a :!@#$: a infixl 4 <@> -- | A useful way to escape a 'Functor' context. (<@>) :: Functor f => f (a -> b) -> a -> f b f <@> x = fmap ($ x) f text-show-3.10.4/tests/Instances/Utils/0000755000000000000000000000000007346545000016123 5ustar0000000000000000text-show-3.10.4/tests/Instances/Utils/GenericArbitrary.hs0000644000000000000000000001133407346545000021715 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-| Module: Instances.Utils.GenericArbitrary Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC A generic default implemention of 'arbitrary'. Ideally, this should be a part of @QuickCheck@ itself (see https://github.com/nick8325/quickcheck/pull/40), but alas, it hasn't been merged yet. Until then, we'll have to define it ourselves. -} module Instances.Utils.GenericArbitrary (genericArbitrary) where import Generics.Deriving.Base import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), Gen, choose) -- | `Gen` for generic instances in which each constructor has equal probability -- of being chosen. genericArbitrary :: (Generic a, GArbitrary (Rep a)) => Gen a genericArbitrary = to <$> gArbitrary class GArbitrary f where gArbitrary :: Gen (f a) instance GArbitrary V1 where -- Following the `Encode' V1` example in GHC.Generics. gArbitrary = undefined instance GArbitrary U1 where gArbitrary = return U1 instance (GArbitrary a, GArbitrary b) => GArbitrary (a :*: b) where gArbitrary = (:*:) <$> gArbitrary <*> gArbitrary instance ( SumSize a, SumSize b , ChooseSum a, ChooseSum b ) => GArbitrary (a :+: b) where gArbitrary = do -- We cannot simply choose with equal probability between the left and -- right part of the `a :+: b` (e.g. with `choose (False, True)`), -- because GHC.Generics does not guarantee :+: to be balanced; even if it -- did, it could only do so for sum types with 2^n alternatives. -- If we did that and got a data structure of form `(a :+: (b :+: c))`, -- then a would be chosen just as often as b and c together. -- So we first have to compute the number of alternatives using `sumSize`, -- and then uniformly sample a number in the corresponding range. let size = unTagged2 (sumSize :: Tagged2 (a :+: b) Int) x <- choose (1, size) -- Optimisation: -- We could just recursively call `gArbitrary` on the left orright branch -- here, as in -- if x <= sizeL -- then L1 <$> gArbitrary -- else R1 <$> gArbitrary -- but this would unnecessarily sample again in the same sum type, and that -- even though `x` completely determines which alternative to choose, -- and sampling is slow because it needs IO and random numbers. -- So instead we use `chooseSum x` to pick the x'th alternative from the -- current sum type. -- This made it around 50% faster for a sum type with 26 alternatives -- on my computer. chooseSum x instance GArbitrary a => GArbitrary (M1 i c a) where gArbitrary = M1 <$> gArbitrary instance Arbitrary a => GArbitrary (K1 i a) where gArbitrary = K1 <$> arbitrary instance GArbitrary UChar where gArbitrary = do C# c <- arbitrary return (UChar c) instance GArbitrary UDouble where gArbitrary = do D# d <- arbitrary return (UDouble d) instance GArbitrary UFloat where gArbitrary = do F# f <- arbitrary return (UFloat f) instance GArbitrary UInt where gArbitrary = do I# i <- arbitrary return (UInt i) instance GArbitrary UWord where gArbitrary = do W# w <- arbitrary return (UWord w) newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b} -- | Calculates the size of a sum type (numbers of alternatives). -- -- Example: `data X = A | B | C` has `sumSize` 3. class SumSize f where sumSize :: Tagged2 f Int -- Recursive case: Sum split `(:+:)`.. instance (SumSize a, SumSize b) => SumSize (a :+: b) where sumSize = Tagged2 $ unTagged2 (sumSize :: Tagged2 a Int) + unTagged2 (sumSize :: Tagged2 b Int) {-# INLINE sumSize #-} -- Constructor base case. instance SumSize (C1 s a) where sumSize = Tagged2 1 {-# INLINE sumSize #-} -- | This class takes an integer `x` and returns a `gArbitrary` value -- for the `x`'th alternative in a sum type. class ChooseSum f where chooseSum :: Int -> Gen (f a) -- Recursive case: Check whether `x` lies in the left or the right side -- of the (:+:) split. instance (SumSize a, ChooseSum a, ChooseSum b) => ChooseSum (a :+: b) where chooseSum x = do let sizeL = unTagged2 (sumSize :: Tagged2 a Int) if x <= sizeL then L1 <$> chooseSum x else R1 <$> chooseSum (x - sizeL) -- Constructor base case. instance (GArbitrary a) => ChooseSum (C1 s a) where chooseSum 1 = gArbitrary chooseSum _ = error "chooseSum: BUG" text-show-3.10.4/tests/0000755000000000000000000000000007346545000013074 5ustar0000000000000000text-show-3.10.4/tests/Spec.hs0000644000000000000000000000005407346545000014321 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} text-show-3.10.4/tests/Spec/0000755000000000000000000000000007346545000013766 5ustar0000000000000000text-show-3.10.4/tests/Spec/BuilderSpec.hs0000644000000000000000000000352307346545000016526 0ustar0000000000000000{-| Module: Spec.BuilderSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for functions that manipulate 'Builder's. -} module Spec.BuilderSpec (main, spec) where import Instances.Data.Text () import Test.Hspec (Expectation, Spec, describe, hspec, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import TextShow (Builder, fromString, fromText, lengthB, toString, toText, unlinesB, unwordsB) main :: IO () main = hspec spec -- | Verifies 'lengthB' and 'length' produce the same output. prop_lengthB :: String -> Expectation prop_lengthB s = fromIntegral (lengthB $ fromString s) `shouldBe` length s -- | Verifies @fromText . toText = id@. prop_toText :: Builder -> Expectation prop_toText b = fromText (toText b) `shouldBe` b -- | Verifies @fromString . toString = id@. prop_toString :: Builder -> Expectation prop_toString b = fromString (toString b) `shouldBe` b -- | Verifies 'unlinesB' and 'unlines' produce the same output. prop_unlinesB :: [String] -> Expectation prop_unlinesB strs = unlinesB (map fromString strs) `shouldBe` fromString (unlines strs) -- | Verifies 'unwordsB' and 'unwords' produce the same output. prop_unwordsB :: [String] -> Expectation prop_unwordsB strs = unwordsB (map fromString strs) `shouldBe` fromString (unwords strs) spec :: Spec spec = parallel $ do describe "lengthB" $ prop "has the same output as length" prop_lengthB describe "toString" $ prop "fromString . toString = id" prop_toString describe "toText" $ prop "fromText . toText = id" prop_toText describe "unlinesB" $ prop "has the same output as unlines" prop_unlinesB describe "unwordsB" $ prop "has the same output as unwords" prop_unwordsB text-show-3.10.4/tests/Spec/Control/0000755000000000000000000000000007346545000015406 5ustar0000000000000000text-show-3.10.4/tests/Spec/Control/ApplicativeSpec.hs0000644000000000000000000000200507346545000021013 0ustar0000000000000000{-| Module: Spec.Control.ApplicativeSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Control.Applicative" module. -} module Spec.Control.ApplicativeSpec (main, spec) where import Control.Applicative (Const, ZipList) import Control.Monad.Trans.Instances () import Data.Orphans () import Data.Proxy.Compat (Proxy(..)) import Generics.Deriving.Instances () import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Const Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (Const Int Int)) describe "ZipList Int" $ do let p :: Proxy (ZipList Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p text-show-3.10.4/tests/Spec/Control/ConcurrentSpec.hs0000644000000000000000000000232507346545000020701 0ustar0000000000000000{-| Module: Spec.Control.ConcurrentSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Control.Concurrent" module. -} module Spec.Control.ConcurrentSpec (main, spec) where import Control.Concurrent (myThreadId) import Data.Proxy.Compat (Proxy(..)) import GHC.Conc (BlockReason, ThreadStatus) import Instances.Control.Concurrent () import Prelude () import Prelude.Compat import Spec.Utils (matchesTextShowSpec, prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Property, ioProperty) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "BlockReason" $ matchesTextShowSpec (Proxy :: Proxy BlockReason) describe "ThreadId" $ prop "TextShow instance" prop_showThreadId describe "ThreadStatus" $ matchesTextShowSpec (Proxy :: Proxy ThreadStatus) -- | Verifies the 'Show' instance for 'ThreadId' is accurate. prop_showThreadId :: Int -> Property prop_showThreadId p = ioProperty $ do tid <- myThreadId pure $ prop_matchesTextShow p tid text-show-3.10.4/tests/Spec/Control/ExceptionSpec.hs0000644000000000000000000000566507346545000020527 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Control.ExceptionSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Control.Exception" module. -} module Spec.Control.ExceptionSpec (main, spec) where import Control.Exception #if MIN_VERSION_base(4,11,0) import Control.Exception.Base (FixIOException) #endif import Data.Proxy.Compat (Proxy(..)) import Instances.Control.Exception () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "TextShow.Control.Exception" $ do describe "SomeException" $ matchesTextShowSpec (Proxy :: Proxy SomeException) describe "IOException" $ matchesTextShowSpec (Proxy :: Proxy IOException) describe "ArithException" $ matchesTextShowSpec (Proxy :: Proxy ArithException) describe "ArrayException" $ matchesTextShowSpec (Proxy :: Proxy ArrayException) describe "AssertionFailed" $ matchesTextShowSpec (Proxy :: Proxy AssertionFailed) describe "SomeAsyncException" $ matchesTextShowSpec (Proxy :: Proxy SomeAsyncException) describe "AsyncException" $ matchesTextShowSpec (Proxy :: Proxy AsyncException) describe "NonTermination" $ matchesTextShowSpec (Proxy :: Proxy NonTermination) describe "NestedAtomically" $ matchesTextShowSpec (Proxy :: Proxy NestedAtomically) describe "BlockedIndefinitelyOnMVar" $ matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnMVar) describe "BlockedIndefinitelyOnSTM" $ matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnSTM) #if MIN_VERSION_base(4,8,0) describe "AllocationLimitExceeded" $ matchesTextShowSpec (Proxy :: Proxy AllocationLimitExceeded) #endif #if MIN_VERSION_base(4,9,0) describe "TypeError" $ matchesTextShowSpec (Proxy :: Proxy TypeError) #endif #if MIN_VERSION_base(4,10,0) describe "CompactionFailed" $ matchesTextShowSpec (Proxy :: Proxy CompactionFailed) #endif #if MIN_VERSION_base(4,11,0) describe "FixIOException" $ matchesTextShowSpec (Proxy :: Proxy FixIOException) #endif describe "Deadlock" $ matchesTextShowSpec (Proxy :: Proxy Deadlock) describe "NoMethodError" $ matchesTextShowSpec (Proxy :: Proxy NoMethodError) describe "PatternMatchFail" $ matchesTextShowSpec (Proxy :: Proxy PatternMatchFail) describe "RecConError" $ matchesTextShowSpec (Proxy :: Proxy RecConError) describe "RecSelError" $ matchesTextShowSpec (Proxy :: Proxy RecSelError) describe "RecUpdError" $ matchesTextShowSpec (Proxy :: Proxy RecUpdError) describe "ErrorCall" $ matchesTextShowSpec (Proxy :: Proxy ErrorCall) describe "MaskingState" $ matchesTextShowSpec (Proxy :: Proxy MaskingState) text-show-3.10.4/tests/Spec/Control/Monad/0000755000000000000000000000000007346545000016444 5ustar0000000000000000text-show-3.10.4/tests/Spec/Control/Monad/STSpec.hs0000644000000000000000000000060207346545000020137 0ustar0000000000000000module Spec.Control.Monad.STSpec (main, spec) where import Control.Monad.ST import Data.Proxy.Compat (Proxy(..)) import Instances.Control.Monad.ST () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "ST Int Int" $ matchesTextShowSpec (Proxy :: Proxy (ST Int Int)) text-show-3.10.4/tests/Spec/Data/Array/0000755000000000000000000000000007346545000015715 5ustar0000000000000000text-show-3.10.4/tests/Spec/Data/Array/ByteSpec.hs0000644000000000000000000000150107346545000017764 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.Array.ByteSpec Copyright: (C) 2022 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'ByteArray' from the "Data.Array.Byte" module. -} module Spec.Data.Array.ByteSpec (main, spec) where import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) import Test.QuickCheck.Instances () #if MIN_VERSION_base(4,17,0) import Data.Array.Byte (ByteArray) import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if MIN_VERSION_base(4,17,0) describe "ByteArray" $ matchesTextShowSpec (Proxy :: Proxy ByteArray) #else pure () #endif text-show-3.10.4/tests/Spec/Data/0000755000000000000000000000000007346545000014637 5ustar0000000000000000text-show-3.10.4/tests/Spec/Data/ArraySpec.hs0000644000000000000000000000202007346545000017056 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.ArraySpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for array data types. -} module Spec.Data.ArraySpec (main, spec) where import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) import Test.QuickCheck.Instances () #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) import Data.Array (Array) import Data.Array.Unboxed (UArray) import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) -- TODO: Figure out why these tests diverge on Windows describe "Array Int Int" $ matchesTextShowSpec (Proxy :: Proxy (Array Int Int)) describe "UArray Int Int" $ matchesTextShowSpec (Proxy :: Proxy (UArray Int Int)) #else pure () #endif text-show-3.10.4/tests/Spec/Data/BoolSpec.hs0000644000000000000000000000114607346545000016703 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.BoolSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'Bool'. -} module Spec.Data.BoolSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Bool" $ do let p :: Proxy Bool p = Proxy matchesTextShowSpec p genericTextShowSpec p text-show-3.10.4/tests/Spec/Data/ByteStringSpec.hs0000644000000000000000000000201007346545000020071 0ustar0000000000000000{-| Module: Spec.Data.ByteStringSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the @bytestring@ library. -} module Spec.Data.ByteStringSpec (main, spec) where import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString) import Data.ByteString.Short (ShortByteString) import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "strict ByteString" $ matchesTextShowSpec (Proxy :: Proxy BS.ByteString) describe "lazy ByteString" $ matchesTextShowSpec (Proxy :: Proxy BL.ByteString) describe "ShortByteString" $ matchesTextShowSpec (Proxy :: Proxy ShortByteString) text-show-3.10.4/tests/Spec/Data/CharSpec.hs0000644000000000000000000000171007346545000016662 0ustar0000000000000000{-| Module: Spec.Data.CharSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Char" module. -} module Spec.Data.CharSpec (main, spec) where import Data.Array (elems) import Data.Char (GeneralCategory) import Data.Proxy.Compat (Proxy(..)) import GHC.Show (asciiTab) import Instances.Data.Char () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, it, parallel, shouldBe) import TextShow (fromString) import TextShow.Data.Char (asciiTabB) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Char" $ matchesTextShowSpec (Proxy :: Proxy Char) describe "GeneralCategory" $ matchesTextShowSpec (Proxy :: Proxy GeneralCategory) describe "asciiTabB" $ it "equals asciiTab" $ map fromString asciiTab `shouldBe` elems asciiTabB text-show-3.10.4/tests/Spec/Data/ComplexSpec.hs0000644000000000000000000000110607346545000017413 0ustar0000000000000000{-| Module: Spec.Data.ComplexSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Complex'. -} module Spec.Data.ComplexSpec (main, spec) where import Data.Complex (Complex) import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Complex Double" $ matchesTextShowSpec (Proxy :: Proxy (Complex Double)) text-show-3.10.4/tests/Spec/Data/DataSpec.hs0000644000000000000000000000172207346545000016661 0ustar0000000000000000{-| Module: Spec.Data.DataSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Data" module. -} module Spec.Data.DataSpec (main, spec) where import Data.Data (Constr, ConstrRep, DataRep, DataType, Fixity) import Data.Proxy.Compat (Proxy(..)) import Instances.Data.Data () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Constr" $ matchesTextShowSpec (Proxy :: Proxy Constr) describe "ConstrRep" $ matchesTextShowSpec (Proxy :: Proxy ConstrRep) describe "DataRep" $ matchesTextShowSpec (Proxy :: Proxy DataRep) describe "DataType" $ matchesTextShowSpec (Proxy :: Proxy DataType) describe "Fixity" $ matchesTextShowSpec (Proxy :: Proxy Fixity) text-show-3.10.4/tests/Spec/Data/DynamicSpec.hs0000644000000000000000000000113007346545000017365 0ustar0000000000000000{-| Module: Spec.Data.DynamicSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Dynamic'. -} module Spec.Data.DynamicSpec (main, spec) where import Data.Dynamic (Dynamic) import Data.Proxy.Compat (Proxy(..)) import Instances.Data.Dynamic () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Dynamic" $ matchesTextShowSpec (Proxy :: Proxy Dynamic) text-show-3.10.4/tests/Spec/Data/EitherSpec.hs0000644000000000000000000000130607346545000017226 0ustar0000000000000000{-| Module: Spec.Data.EitherSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'Either'. -} module Spec.Data.EitherSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Generics.Deriving.Instances () import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Either Int Int" $ do let p :: Proxy (Either Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p text-show-3.10.4/tests/Spec/Data/FixedSpec.hs0000644000000000000000000000276707346545000017061 0ustar0000000000000000{-| Module: Spec.Data.FixedSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Fixed' values. -} module Spec.Data.FixedSpec (main, spec) where import Data.Fixed (Fixed, E0, E1, E2, E3, E6, E9, E12, showFixed) import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Expectation, Spec, describe, hspec, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import TextShow (fromString) import TextShow.Data.Fixed (showbFixed) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Fixed E0" $ matchesTextShowSpec (Proxy :: Proxy (Fixed E0)) describe "Fixed E1" $ matchesTextShowSpec (Proxy :: Proxy (Fixed E1)) describe "Fixed E2" $ matchesTextShowSpec (Proxy :: Proxy (Fixed E2)) describe "Fixed E3" $ matchesTextShowSpec (Proxy :: Proxy (Fixed E3)) describe "Fixed E6" $ matchesTextShowSpec (Proxy :: Proxy (Fixed E6)) describe "Fixed E9" $ matchesTextShowSpec (Proxy :: Proxy (Fixed E9)) describe "Fixed E12" $ matchesTextShowSpec (Proxy :: Proxy (Fixed E12)) describe "showbFixed" $ prop "has the same output as showFixed" prop_showFixed -- | Verifies 'showFixed' and 'showbFixed' generate the same output. prop_showFixed :: Bool -> Fixed E12 -> Expectation prop_showFixed b f = fromString (showFixed b f) `shouldBe` showbFixed b f text-show-3.10.4/tests/Spec/Data/FloatingSpec.hs0000644000000000000000000000464007346545000017555 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.FloatingSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for floating-point data types. -} module Spec.Data.FloatingSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Data.Text.Lazy.Builder.RealFloat (FPFormat) import Instances.Data.Floating () import Numeric.Compat (showEFloat, showFFloat, showGFloat, showFFloatAlt, showGFloatAlt) import Prelude () import Prelude.Compat import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Property, arbitrary, property, suchThat) import TextShow (Builder, fromString) import TextShow.Data.Floating (showbEFloat, showbFFloat, showbGFloat, showbFFloatAlt, showbGFloatAlt) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Float" $ matchesTextShowSpec (Proxy :: Proxy Float) describe "Double" $ matchesTextShowSpec (Proxy :: Proxy Double) describe "showbEFloat" $ prop "has the same output as showEFloat" $ prop_showXFloat showEFloat showbEFloat describe "showbFFloat" $ prop "has the same output as showFFloat" $ prop_showXFloat showFFloat showbFFloat describe "showbGFloat" $ prop "has the same output as showGFloat" $ prop_showXFloat showGFloat showbGFloat describe "showbFFloatAlt" $ prop "has the same output as showFFloatAlt" $ prop_showXFloat showFFloatAlt showbFFloatAlt describe "showbGFloatAlt" $ prop "has the same output as showFFloatAlt" $ prop_showXFloat showGFloatAlt showbGFloatAlt describe "FPFormat" $ matchesTextShowSpec (Proxy :: Proxy FPFormat) -- | Verifies @showXFloat@ and @showbXFloat@ generate the same output (where @X@ -- is one of E, F, or G). prop_showXFloat :: (Maybe Int -> Double -> ShowS) -> (Maybe Int -> Double -> Builder) -> Double -> Property prop_showXFloat f1 f2 val = property $ do mb_digs <- arbitrary `suchThat` cond pure $ fromString (f1 mb_digs val "") == f2 mb_digs val where cond :: Maybe Int -> Bool cond mb_digs = mb_digs /= Nothing && mb_digs <= Just 10 #if !(MIN_VERSION_base(4,12,0)) && mb_digs > Just 0 -- Work around Trac #15115 #endif text-show-3.10.4/tests/Spec/Data/Functor/0000755000000000000000000000000007346545000016257 5ustar0000000000000000text-show-3.10.4/tests/Spec/Data/Functor/ComposeSpec.hs0000644000000000000000000000127707346545000021042 0ustar0000000000000000{-| Module: Spec.Data.Functor.ComposeSpec Copyright: (C) 2014-2017 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 Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Compose Maybe Maybe Int" $ matchesTextShow1Spec (Proxy :: Proxy (Compose Maybe Maybe Int)) text-show-3.10.4/tests/Spec/Data/Functor/IdentitySpec.hs0000644000000000000000000000121207346545000021213 0ustar0000000000000000{-| Module: Spec.Data.Functor.IdentitySpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Identity'. -} module Spec.Data.Functor.IdentitySpec (main, spec) where import Control.Monad.Trans.Instances () import Data.Functor.Identity (Identity) import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Identity Int" $ matchesTextShow1Spec (Proxy :: Proxy (Identity Int)) text-show-3.10.4/tests/Spec/Data/Functor/ProductSpec.hs0000644000000000000000000000127707346545000021055 0ustar0000000000000000{-| Module: Spec.Data.Functor.ProductSpec Copyright: (C) 2014-2017 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 Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Product Maybe Maybe Int" $ matchesTextShow1Spec (Proxy :: Proxy (Product Maybe Maybe Int)) text-show-3.10.4/tests/Spec/Data/Functor/SumSpec.hs0000644000000000000000000000124307346545000020172 0ustar0000000000000000{-| Module: Spec.Data.Functor.SumSpec Copyright: (C) 2014-2017 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 Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Sum Maybe Maybe Int" $ matchesTextShow1Spec (Proxy :: Proxy (Sum Maybe Maybe Int)) text-show-3.10.4/tests/Spec/Data/IntegralSpec.hs0000644000000000000000000000460207346545000017555 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.IntegralSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for integral data types. -} module Spec.Data.IntegralSpec (main, spec) where import Data.Int (Int8, Int16, Int32, Int64) import Data.Proxy.Compat (Proxy(..)) import Data.Word (Word8, Word16, Word32, Word64) import Prelude () import Prelude.Compat import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) import Data.Char (intToDigit) import Numeric (showIntAtBase) import Test.QuickCheck (Gen, arbitrary, getNonNegative, suchThat) import Test.Hspec (Expectation, shouldBe) import Test.Hspec.QuickCheck (prop) import TextShow (fromString) import TextShow.Data.Integral (showbIntAtBase) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Int" $ matchesTextShowSpec (Proxy :: Proxy Int) describe "Int8" $ matchesTextShowSpec (Proxy :: Proxy Int8) describe "Int16" $ matchesTextShowSpec (Proxy :: Proxy Int16) describe "Int32" $ matchesTextShowSpec (Proxy :: Proxy Int32) describe "Int64" $ matchesTextShowSpec (Proxy :: Proxy Int64) describe "Integer" $ matchesTextShowSpec (Proxy :: Proxy Integer) describe "Word" $ matchesTextShowSpec (Proxy :: Proxy Word) describe "Word8" $ matchesTextShowSpec (Proxy :: Proxy Word8) describe "Word16" $ matchesTextShowSpec (Proxy :: Proxy Word16) describe "Word32" $ matchesTextShowSpec (Proxy :: Proxy Word32) describe "Word64" $ matchesTextShowSpec (Proxy :: Proxy Word64) #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) -- TODO: Figure out why this diverges on Windows describe "showbIntAtBase" $ prop "has the same output as showIntAtBase" prop_showIntAtBase #endif -- | Verifies 'showIntAtBase' and 'showbIntAtBase' generate the same output. #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) prop_showIntAtBase :: Gen Expectation prop_showIntAtBase = do base <- arbitrary `suchThat` \b -> 1 < b && b <= 16 i <- getNonNegative <$> arbitrary :: Gen Int pure $ fromString (showIntAtBase base intToDigit i "") `shouldBe` showbIntAtBase base intToDigit i #endif text-show-3.10.4/tests/Spec/Data/List/0000755000000000000000000000000007346545000015552 5ustar0000000000000000text-show-3.10.4/tests/Spec/Data/List/NonEmptySpec.hs0000644000000000000000000000123007346545000020466 0ustar0000000000000000{-| Module: Spec.Data.List.NonEmptySpec Copyright: (C) 2014-2017 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.Proxy.Compat (Proxy(..)) import Data.List.NonEmpty.Compat (NonEmpty) import Data.Orphans () import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "NonEmpty Int" $ matchesTextShow1Spec (Proxy :: Proxy (NonEmpty Int)) text-show-3.10.4/tests/Spec/Data/ListSpec.hs0000644000000000000000000000223107346545000016717 0ustar0000000000000000{-| Module: Spec.Data.ListSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for lists. -} module Spec.Data.ListSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Expectation, Spec, describe, hspec, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import Text.Show (showListWith) import TextShow (fromString, showb) import TextShow.Data.List (showbListWith) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "String" $ matchesTextShowSpec (Proxy :: Proxy String) describe "[String]" $ matchesTextShowSpec (Proxy :: Proxy [String]) describe "[Int]" $ matchesTextShowSpec (Proxy :: Proxy [Int]) describe "showbListWith" $ prop "has the same output as showListWith" prop_showListWith -- | Verifies 'showListWith' and 'showbListWith' generate the same output. prop_showListWith :: String -> Expectation prop_showListWith str = fromString (showListWith shows str "") `shouldBe` showbListWith showb str text-show-3.10.4/tests/Spec/Data/MaybeSpec.hs0000644000000000000000000000125407346545000017045 0ustar0000000000000000{-| Module: Spec.Data.MaybeSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'Maybe'. -} module Spec.Data.MaybeSpec (main, spec) where import Data.Orphans () import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Maybe Int" $ do let p :: Proxy (Maybe Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p text-show-3.10.4/tests/Spec/Data/MonoidSpec.hs0000644000000000000000000000433007346545000017233 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.MonoidSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Monoid" module. -} module Spec.Data.MonoidSpec (main, spec) where import Data.Monoid import Data.Proxy.Compat (Proxy(..)) import Generics.Deriving.Instances () import Instances.Data.Monoid () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "All" $ do let p :: Proxy All p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "Any" $ do let p :: Proxy Any p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "Dual Int" $ do let p :: Proxy (Dual Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "First Int" $ do let p :: Proxy (First Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "Last Int" $ do let p :: Proxy (Last Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "Product Int" $ do let p :: Proxy (Product Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "Sum Int" $ do let p :: Proxy (Sum Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p #if MIN_VERSION_base(4,8,0) describe "Alt Maybe Int" $ do let p :: Proxy (Alt Maybe Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p #endif #if MIN_VERSION_base(4,12,0) describe "Ap Maybe Int" $ do let p :: Proxy (Ap Maybe Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p #endif text-show-3.10.4/tests/Spec/Data/OldTypeableSpec.hs0000644000000000000000000000176307346545000020221 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_base(4,8,0)) {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} #endif {-| Module: Spec.Data.OldTypeableSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.OldTypeable" module. -} module Spec.Data.OldTypeableSpec (main, spec) where import Instances.Data.OldTypeable () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if !(MIN_VERSION_base(4,8,0)) import Data.OldTypeable (TyCon, TypeRep) import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if !(MIN_VERSION_base(4,8,0)) describe "TypeRep" $ matchesTextShowSpec (Proxy :: Proxy TypeRep) describe "TyCon" $ matchesTextShowSpec (Proxy :: Proxy TyCon) #else pure () #endif text-show-3.10.4/tests/Spec/Data/OrdSpec.hs0000644000000000000000000000152207346545000016532 0ustar0000000000000000{-| Module: Spec.Data.OrdSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Ord" module. -} module Spec.Data.OrdSpec (main, spec) where import Data.Orphans () import Data.Proxy.Compat (Proxy(..)) import Generics.Deriving.Instances () import GHC.Exts (Down) import Instances.Data.Ord () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Ordering" $ do let p :: Proxy Ordering p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "Down Int" $ matchesTextShowSpec (Proxy :: Proxy (Down Int)) text-show-3.10.4/tests/Spec/Data/ProxySpec.hs0000644000000000000000000000124707346545000017133 0ustar0000000000000000{-| Module: Spec.Data.ProxySpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'Proxy'. -} module Spec.Data.ProxySpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Generics.Deriving.Base () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Proxy Int" $ do let p :: Proxy (Proxy Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p text-show-3.10.4/tests/Spec/Data/RatioSpec.hs0000644000000000000000000000106507346545000017066 0ustar0000000000000000{-| Module: Spec.Data.RatioSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Ratio'. -} module Spec.Data.RatioSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Data.Ratio (Ratio) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Ratio Int" $ do matchesTextShowSpec (Proxy :: Proxy (Ratio Int)) text-show-3.10.4/tests/Spec/Data/SemigroupSpec.hs0000644000000000000000000000222307346545000017757 0ustar0000000000000000{-| Module: Spec.Data.SemigroupSpec Copyright: (C) 2014-2017 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.Proxy.Compat (Proxy(..)) import Data.Semigroup.Compat (Min, Max, First, Last, WrappedMonoid, Arg) import Instances.Data.Semigroup () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Min Int" $ matchesTextShowSpec (Proxy :: Proxy (Min Int)) describe "Max Int" $ matchesTextShowSpec (Proxy :: Proxy (Max Int)) describe "First Int" $ matchesTextShowSpec (Proxy :: Proxy (First Int)) describe "Last Int" $ matchesTextShowSpec (Proxy :: Proxy (Last Int)) describe "WrappedMonoid ()" $ matchesTextShowSpec (Proxy :: Proxy (WrappedMonoid ())) describe "Arg Int Char" $ matchesTextShowSpec (Proxy :: Proxy (Arg Int Char)) text-show-3.10.4/tests/Spec/Data/TextSpec.hs0000644000000000000000000000272007346545000016733 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.TextSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the @text@ library. -} module Spec.Data.TextSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Instances.Data.Text () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import qualified Data.Text as TS import qualified Data.Text as TL #if MIN_VERSION_text(1,0,0) import Data.Text.Encoding (Decoding) #endif import Data.Text.Encoding.Error (UnicodeException) #if MIN_VERSION_text(1,1,0) import Data.Text.Internal.Fusion.Size (Size) #endif import Data.Text.Lazy.Builder (Builder) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Builder" $ matchesTextShowSpec (Proxy :: Proxy Builder) describe "strict Text" $ matchesTextShowSpec (Proxy :: Proxy TS.Text) describe "lazy Text" $ matchesTextShowSpec (Proxy :: Proxy TL.Text) describe "UnicodeException" $ matchesTextShowSpec (Proxy :: Proxy UnicodeException) #if MIN_VERSION_text(1,0,0) describe "Decoding" $ matchesTextShowSpec (Proxy :: Proxy Decoding) #endif #if MIN_VERSION_text(1,1,0) describe "Size" $ matchesTextShowSpec (Proxy :: Proxy Size) #endif text-show-3.10.4/tests/Spec/Data/TupleSpec.hs0000644000000000000000000000724107346545000017103 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.TupleSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for tuple types. -} module Spec.Data.TupleSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Generics.Deriving.Instances () #if MIN_VERSION_ghc_prim(0,7,0) import GHC.Tuple (Solo) #endif import Instances.Data.Tuple () import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "()" $ do let p :: Proxy () p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "(Int, Int)" $ do let p :: Proxy (Int, Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "(Int, Int, Int)" $ do let p :: Proxy (Int, Int, Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "(Int, Int, Int, Int)" $ do let p :: Proxy (Int, Int, Int, Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "(Int, Int, Int, Int, Int)" $ do let p :: Proxy (Int, Int, Int, Int, Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "(Int, Int, Int, Int, Int, Int)" $ do let p :: Proxy (Int, Int, Int, Int, Int, Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "(Int, Int, Int, Int, Int, Int, Int)" $ do let p :: Proxy (Int, Int, Int, Int, Int, Int, Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "(Int, Int, Int, Int, Int, Int, Int, Int)" $ do matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) #if MIN_VERSION_ghc_prim(0,7,0) describe "Solo Int" $ do let p :: Proxy (Solo Int) p = Proxy matchesTextShowSpec p matchesTextShow1Spec p #endif text-show-3.10.4/tests/Spec/Data/Type/0000755000000000000000000000000007346545000015560 5ustar0000000000000000text-show-3.10.4/tests/Spec/Data/Type/CoercionSpec.hs0000644000000000000000000000135407346545000020473 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.Type.CoercionSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Coercion'. -} module Spec.Data.Type.CoercionSpec (main, spec) where import Data.Monoid (All(..)) import Data.Proxy.Compat (Proxy(..)) import Data.Type.Coercion (Coercion) import Instances.Data.Type.Coercion () import Prelude () import Prelude.Compat import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ describe "Coercion All Bool" $ matchesTextShowSpec (Proxy :: Proxy (Coercion All Bool)) text-show-3.10.4/tests/Spec/Data/Type/EqualitySpec.hs0000644000000000000000000000157207346545000020531 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-| Module: Spec.Data.Type.EqualitySpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for '(:~:)'. -} module Spec.Data.Type.EqualitySpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Data.Type.Equality.Compat import Instances.Data.Type.Equality () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Int :~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~: Int)) # if MIN_VERSION_base(4,9,0) describe "Int :~~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~~: Int)) # endif text-show-3.10.4/tests/Spec/Data/TypeableSpec.hs0000644000000000000000000000453107346545000017556 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-| Module: Spec.Data.TypeableSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Typeable" module. -} module Spec.Data.TypeableSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Data.Typeable (TyCon) #if MIN_VERSION_base(4,9,0) import GHC.Types (TrName, Module) #endif #if MIN_VERSION_base(4,10,0) import Data.Kind (Type) import Type.Reflection (SomeTypeRep, TypeRep) #else import Data.Typeable (TypeRep) #endif import Instances.Data.Typeable () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon" $ matchesTextShowSpec (Proxy :: Proxy TyCon) #if MIN_VERSION_base(4,9,0) describe "TrName" $ matchesTextShowSpec (Proxy :: Proxy TrName) describe "Module" $ matchesTextShowSpec (Proxy :: Proxy Module) #endif #if MIN_VERSION_base(4,10,0) describe "SomeTypeRep" $ matchesTextShowSpec (Proxy :: Proxy SomeTypeRep) describe "TypeRep" $ do describe "TypeRep Type" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep Type)) describe "TypeRep []" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep [])) describe "TypeRep [Int]" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep [Int])) describe "TypeRep '[Int]" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep '[Int])) describe "TypeRep (Int, Int)" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep (Int, Int))) describe "TypeRep '(Int, Int)" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep '(Int, Int))) describe "TypeRep (Int -> Int)" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep (Int -> Int))) describe "TypeRep ((,) Int)" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep ((,) Int))) describe "TypeRep ('(,) Int)" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep ('(,) Int))) describe "TypeRep (Either Int)" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep (Either Int))) #else describe "TypeRep" $ matchesTextShowSpec (Proxy :: Proxy TypeRep) #endif text-show-3.10.4/tests/Spec/Data/VersionSpec.hs0000644000000000000000000000142607346545000017436 0ustar0000000000000000module Spec.Data.VersionSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Data.Version (Version, showVersion) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Expectation, Spec, describe, hspec, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import TextShow (fromString) import TextShow.Data.Version (showbVersion) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Version" $ matchesTextShowSpec (Proxy :: Proxy Version) describe "showbVersion" $ prop "has the same output as showVersion" prop_showVersion -- | Verifies 'showVersion' and 'showbVersion' generate the same output. prop_showVersion :: Version -> Expectation prop_showVersion v = fromString (showVersion v) `shouldBe` showbVersion v text-show-3.10.4/tests/Spec/Derived/0000755000000000000000000000000007346545000015350 5ustar0000000000000000text-show-3.10.4/tests/Spec/Derived/DataFamiliesSpec.hs0000644000000000000000000000301407346545000021040 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-| Module: Spec.Derived.DataFamiliesSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for corner case-provoking data families. -} module Spec.Derived.DataFamiliesSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.DataFamilies (NotAllShow, KindDistinguished, NullaryData) import Prelude () import Prelude.Compat import Spec.Utils ( matchesTextShowSpec, matchesTextShow1Spec , genericTextShowSpec, genericTextShow1Spec ) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "NotAllShow Int Int Int Int" $ do let p :: Proxy (NotAllShow Int Int Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "KindDistinguished '() Int Int" $ do let p :: Proxy (KindDistinguished '() Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "KindDistinguished 'True Int Int" $ do let p :: Proxy (KindDistinguished 'True Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "NullaryData" $ do let p :: Proxy NullaryData p = Proxy matchesTextShowSpec p genericTextShowSpec p text-show-3.10.4/tests/Spec/Derived/DatatypeContextsSpec.hs0000644000000000000000000000137207346545000022025 0ustar0000000000000000{-| Module: Spec.Derived.DatatypeContextsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with DatatypeContexts (eww). -} module Spec.Derived.DatatypeContextsSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.DatatypeContexts import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyCon Int Int Int)) describe "TyFamily Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamily Int Int Int)) text-show-3.10.4/tests/Spec/Derived/ExistentialQuantificationSpec.hs0000644000000000000000000000144207346545000023710 0ustar0000000000000000{-| Module: Spec.Derived.ExistentialQuantificationSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for existentially quantified data types. -} module Spec.Derived.ExistentialQuantificationSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.ExistentialQuantification import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyCon Int Int Int Int)) describe "TyFamily Int Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamily Int Int Int Int)) text-show-3.10.4/tests/Spec/Derived/InfixSpec.hs0000644000000000000000000000251707346545000017601 0ustar0000000000000000{-| Module: Spec.Derived.InfixSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with infix constructors. -} module Spec.Derived.InfixSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.Infix import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyConPlain Int Int" $ do let p :: Proxy (TyConPlain Int Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "TyConGADT Int Int" $ do let p :: Proxy (TyConGADT Int Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "TyFamilyPlain Int Int" $ do let p :: Proxy (TyFamilyPlain Int Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "TyFamilyGADT Int Int" $ do let p :: Proxy (TyFamilyGADT Int Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p text-show-3.10.4/tests/Spec/Derived/MagicHashSpec.hs0000644000000000000000000000271507346545000020350 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} #if __GLASGOW_HASKELL__ == 800 -- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex {-# OPTIONS_GHC -fsimpl-tick-factor=250 #-} #endif {-| Module: Spec.Derived.MagicHashSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with fields that have unlifted types. -} module Spec.Derived.MagicHashSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.MagicHash import Spec.Utils import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon# Int Int" $ do let p :: Proxy (TyCon# Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "TyFamily# Int Int" $ do let p :: Proxy (TyFamily# Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p #if MIN_VERSION_base(4,13,0) describe "TyCon'# Int Int" $ do let p :: Proxy (TyCon'# Int Int) p = Proxy matchesTextShowSpec p matchesTextShow2Spec p describe "TyFamily'# Int Int" $ do let p :: Proxy (TyFamily'# Int Int) p = Proxy matchesTextShowSpec p matchesTextShow2Spec p #endif text-show-3.10.4/tests/Spec/Derived/PolyKindsSpec.hs0000644000000000000000000000377207346545000020444 0ustar0000000000000000{-| Module: Spec.Derived.PolyKindsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with poly-kinded type variables. -} module Spec.Derived.PolyKindsSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.PolyKinds import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyConCompose Either Either Either Maybe Maybe Int Int" $ do let p :: Proxy (TyConCompose Either Either Either Maybe Maybe Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "TyConProxy Int Int" $ do let p :: Proxy (TyConProxy Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "TyConReallyHighKinds (,,,,) Int Int Int Int Int" $ do let p :: Proxy (TyConReallyHighKinds (,,,,) Int Int Int Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "TyFamilyCompose Either Either Either Maybe Maybe Int Int" $ do let p :: Proxy (TyFamilyCompose Either Either Either Maybe Maybe Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "TyFamilyProxy Int Int" $ do let p :: Proxy (TyFamilyProxy Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int" $ do let p :: Proxy (TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p text-show-3.10.4/tests/Spec/Derived/RankNTypesSpec.hs0000644000000000000000000000131707346545000020557 0ustar0000000000000000{-| Module: Spec.Derived.RankNTypesSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with rank-n voodoo. -} module Spec.Derived.RankNTypesSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.RankNTypes import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyCon Int Int)) describe "TyFamily Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamily Int Int)) text-show-3.10.4/tests/Spec/Derived/RecordsSpec.hs0000644000000000000000000000214607346545000020123 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ == 800 -- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex {-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} #endif {-| Module: Spec.Derived.RecordsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with record syntax. -} module Spec.Derived.RecordsSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.Records import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int" $ do let p :: Proxy (TyCon Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p describe "TyFamily Int Int" $ do let p :: Proxy (TyFamily Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p text-show-3.10.4/tests/Spec/Derived/TypeFamiliesSpec.hs0000644000000000000000000000144407346545000021115 0ustar0000000000000000{-| Module: Spec.Derived.TypeFamiliesSpec Copyright: (C) 2020 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests involving corner case-provoking type families. -} module Spec.Derived.TypeFamiliesSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.TypeFamilies import Prelude () import Prelude.Compat import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyConOverSat Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyConOverSat Int Int)) describe "TyFamilyOverSat Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamilyOverSat Int Int)) text-show-3.10.4/tests/Spec/Derived/TypeSynonymsSpec.hs0000644000000000000000000000170107346545000021217 0ustar0000000000000000{-| Module: Spec.Derived.TypeSynonymsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types that use type synonyms. -} module Spec.Derived.TypeSynonymsSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Derived.TypeSynonyms import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int" $ do let p :: Proxy (TyCon Int Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p describe "TyFamily Int Int" $ do let p :: Proxy (TyFamily Int Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p text-show-3.10.4/tests/Spec/Foreign/C/0000755000000000000000000000000007346545000015541 5ustar0000000000000000text-show-3.10.4/tests/Spec/Foreign/C/TypesSpec.hs0000644000000000000000000000515007346545000020015 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Foreign.C.TypesSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Foreign.C.Types" module. -} module Spec.Foreign.C.TypesSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Foreign.C.Types import Instances.Foreign.C.Types () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "CChar" $ matchesTextShowSpec (Proxy :: Proxy CChar) describe "CSChar" $ matchesTextShowSpec (Proxy :: Proxy CSChar) describe "CUChar" $ matchesTextShowSpec (Proxy :: Proxy CUChar) describe "CShort" $ matchesTextShowSpec (Proxy :: Proxy CShort) describe "CUShort" $ matchesTextShowSpec (Proxy :: Proxy CUShort) describe "CInt" $ matchesTextShowSpec (Proxy :: Proxy CInt) describe "CUInt" $ matchesTextShowSpec (Proxy :: Proxy CUInt) describe "CLong" $ matchesTextShowSpec (Proxy :: Proxy CLong) describe "CULong" $ matchesTextShowSpec (Proxy :: Proxy CULong) describe "CPtrdiff" $ matchesTextShowSpec (Proxy :: Proxy CPtrdiff) describe "CSize" $ matchesTextShowSpec (Proxy :: Proxy CSize) describe "CWchar" $ matchesTextShowSpec (Proxy :: Proxy CWchar) describe "CSigAtomic" $ matchesTextShowSpec (Proxy :: Proxy CSigAtomic) describe "CLLong" $ matchesTextShowSpec (Proxy :: Proxy CLLong) describe "CULLong" $ matchesTextShowSpec (Proxy :: Proxy CULLong) describe "CIntPtr" $ matchesTextShowSpec (Proxy :: Proxy CIntPtr) describe "CUIntPtr" $ matchesTextShowSpec (Proxy :: Proxy CUIntPtr) describe "CIntMax" $ matchesTextShowSpec (Proxy :: Proxy CIntMax) describe "CUIntMax" $ matchesTextShowSpec (Proxy :: Proxy CUIntMax) describe "CClock" $ matchesTextShowSpec (Proxy :: Proxy CClock) describe "CTime" $ matchesTextShowSpec (Proxy :: Proxy CTime) describe "CUSeconds" $ matchesTextShowSpec (Proxy :: Proxy CUSeconds) describe "CSUSeconds" $ matchesTextShowSpec (Proxy :: Proxy CSUSeconds) describe "CFloat" $ matchesTextShowSpec (Proxy :: Proxy CFloat) describe "CDouble" $ matchesTextShowSpec (Proxy :: Proxy CDouble) #if MIN_VERSION_base(4,10,0) describe "CBool" $ matchesTextShowSpec (Proxy :: Proxy CBool) #endif text-show-3.10.4/tests/Spec/Foreign/0000755000000000000000000000000007346545000015357 5ustar0000000000000000text-show-3.10.4/tests/Spec/Foreign/PtrSpec.hs0000644000000000000000000000254307346545000017277 0ustar0000000000000000{-| Module: Spec.Foreign.PtrSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for pointer data types. -} module Spec.Foreign.PtrSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Foreign.ForeignPtr (newForeignPtr_) import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr) import Instances.Foreign.Ptr () import Prelude () import Prelude.Compat import Spec.Utils (matchesTextShowSpec, prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Property, ioProperty) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Ptr Int" $ matchesTextShowSpec (Proxy :: Proxy (Ptr Int)) describe "FunPtr Int" $ matchesTextShowSpec (Proxy :: Proxy (FunPtr Int)) describe "IntPtr" $ matchesTextShowSpec (Proxy :: Proxy IntPtr) describe "WordPtr" $ matchesTextShowSpec (Proxy :: Proxy WordPtr) describe "ForeignPtr" $ prop "TextShow instance" prop_showForeignPtr -- | Verifies the 'Show' instance for 'ForeignPtr' is accurate. prop_showForeignPtr :: Int -> Ptr Int -> Property prop_showForeignPtr p ptr = ioProperty $ do fptr <- newForeignPtr_ ptr pure $ prop_matchesTextShow p fptr text-show-3.10.4/tests/Spec/FromStringTextShowSpec.hs0000644000000000000000000000377407346545000020750 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.FromStringTextShowSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'FromStringShow' and 'FromTextShow'. -} module Spec.FromStringTextShowSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Instances.FromStringTextShow () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import TextShow (FromStringShow(..), FromTextShow(..)) #if defined(NEW_FUNCTOR_CLASSES) import Spec.Utils (matchesTextShow1Spec, matchesTextShow2Spec) import TextShow (FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..)) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "FromStringShow Int" $ do let p :: Proxy (FromStringShow Int) p = Proxy matchesTextShowSpec p describe "FromStringShow String" $ do let p :: Proxy (FromStringShow String) p = Proxy matchesTextShowSpec p describe "FromTextShow Int" $ do let p :: Proxy (FromTextShow Int) p = Proxy matchesTextShowSpec p describe "FromTextShow String" $ do let p :: Proxy (FromTextShow String) p = Proxy matchesTextShowSpec p #if defined(NEW_FUNCTOR_CLASSES) describe "FromStringShow1 Maybe Int" $ do let p :: Proxy (FromStringShow1 Maybe Int) p = Proxy matchesTextShow1Spec p describe "FromTextShow1 Maybe Int" $ do let p :: Proxy (FromTextShow1 Maybe Int) p = Proxy matchesTextShow1Spec p describe "FromStringShow2 Either Char Int" $ do let p :: Proxy (FromStringShow2 Either Char Int) p = Proxy matchesTextShow2Spec p describe "FromTextShow2 Either Char Int" $ do let p :: Proxy (FromTextShow2 Either Char Int) p = Proxy matchesTextShow2Spec p #endif text-show-3.10.4/tests/Spec/FunctionsSpec.hs0000644000000000000000000000116607346545000017111 0ustar0000000000000000{-| Module: Spec.FunctionsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for the orphan 'TextShow' instance for functions. -} module Spec.FunctionsSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Text.Show.Functions () import TextShow.Functions () main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Int -> Int" $ matchesTextShowSpec (Proxy :: Proxy (Int -> Int)) text-show-3.10.4/tests/Spec/GHC/Conc/0000755000000000000000000000000007346545000015251 5ustar0000000000000000text-show-3.10.4/tests/Spec/GHC/Conc/WindowsSpec.hs0000644000000000000000000000153507346545000020056 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.Conc.WindowsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'ConsoleEvent'. -} module Spec.GHC.Conc.WindowsSpec (main, spec) where import Instances.GHC.Conc.Windows () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if !defined(__GHCJS__) && defined(mingw32_HOST_OS) import Data.Proxy.Compat (Proxy(..)) import GHC.Conc.Windows (ConsoleEvent) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if !defined(__GHCJS__) && defined(mingw32_HOST_OS) describe "ConsoleEvent" $ matchesTextShowSpec (Proxy :: Proxy ConsoleEvent) #else pure () #endif text-show-3.10.4/tests/Spec/GHC/0000755000000000000000000000000007346545000014367 5ustar0000000000000000text-show-3.10.4/tests/Spec/GHC/EventSpec.hs0000644000000000000000000000212107346545000016613 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.EventSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "GHC.Event" module. -} module Spec.GHC.EventSpec (main, spec) where import Instances.GHC.Event () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) import Data.Proxy.Compat (Proxy(..)) import GHC.Event (Event) # if MIN_VERSION_base(4,8,1) import GHC.Event (Lifetime) #endif import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) describe "Event" $ matchesTextShowSpec (Proxy :: Proxy Event) -- describe "FdKey" $ -- matchesTextShowSpec (Proxy :: Proxy FdKey) # if MIN_VERSION_base(4,8,1) describe "Lifetime" $ matchesTextShowSpec (Proxy :: Proxy Lifetime) # endif #else pure () #endif text-show-3.10.4/tests/Spec/GHC/FingerprintSpec.hs0000644000000000000000000000130307346545000020022 0ustar0000000000000000{-| Module: Spec.GHC.FingerprintSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'Fingerprint'. -} module Spec.GHC.FingerprintSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Data.Orphans () import GHC.Fingerprint.Type (Fingerprint) import Instances.GHC.Fingerprint () import Prelude () import Prelude.Compat import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ describe "Fingerprint" $ matchesTextShowSpec (Proxy :: Proxy Fingerprint) text-show-3.10.4/tests/Spec/GHC/GenericsSpec.hs0000644000000000000000000001041207346545000017273 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} {-| Module: Spec.GHC.GenericsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "GHC.Generics" module. -} module Spec.GHC.GenericsSpec (main, spec) where import Data.Orphans () import Data.Proxy.Compat (Proxy(..)) 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 Instances.GHC.Generics () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) 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 let p :: Proxy Fixity p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "Associativity" $ do let p :: Proxy Associativity p = Proxy matchesTextShowSpec p genericTextShowSpec p #if MIN_VERSION_base(4,9,0) describe "SourceUnpackedness" $ do let p :: Proxy SourceUnpackedness p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "SourceStrictness" $ do let p :: Proxy SourceStrictness p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "DecidedStrictness" $ do let p :: Proxy DecidedStrictness p = Proxy matchesTextShowSpec p genericTextShowSpec p #else describe "Arity" $ do let p :: Proxy Arity p = Proxy matchesTextShowSpec p genericTextShowSpec p #endif describe "U1 Int" $ do let p :: Proxy (U1 Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "Par1 Int" $ do let p :: Proxy (Par1 Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "Rec1 Maybe Int" $ do let p :: Proxy (Rec1 Maybe Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "K1 () Int ()" $ do let p :: Proxy (K1 () Int ()) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe m1Description $ do let p :: Proxy (M1 () MD Maybe Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "(Maybe :+: Maybe) Int" $ do let p :: Proxy ((Maybe :+: Maybe) Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "(Maybe :*: Maybe) Int" $ do let p :: Proxy ((Maybe :*: Maybe) Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "(Maybe :.: Maybe) Int" $ do let p :: Proxy ((Maybe :.: Maybe) Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "UChar Int" $ do let p :: Proxy (UChar Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "UDouble Int" $ do let p :: Proxy (UDouble Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "UFloat Int" $ do let p :: Proxy (UFloat Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "UInt Int" $ do let p :: Proxy (UInt Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "UWord Int" $ do let p :: Proxy (UWord Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p text-show-3.10.4/tests/Spec/GHC/RTS/0000755000000000000000000000000007346545000015037 5ustar0000000000000000text-show-3.10.4/tests/Spec/GHC/RTS/FlagsSpec.hs0000644000000000000000000000373507346545000017252 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.RTS.Flags Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'ConType'. -} module Spec.GHC.RTS.FlagsSpec (main, spec) where import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,8,0) import Data.Proxy.Compat (Proxy(..)) import GHC.RTS.Flags import Instances.GHC.RTS.Flags import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if MIN_VERSION_base(4,8,0) describe "RTSFlags" $ matchesTextShowSpec (Proxy :: Proxy RTSFlags) describe "GCFlags" $ matchesTextShowSpec (Proxy :: Proxy GCFlags) describe "ConcFlags" $ matchesTextShowSpec (Proxy :: Proxy ConcFlags) # if MIN_VERSION_base(4,15,0) describe "IoSubSystem" $ matchesTextShowSpec (Proxy :: Proxy IoSubSystem) # endif describe "MiscFlags" $ matchesTextShowSpec (Proxy :: Proxy MiscFlags) describe "DebugFlags" $ matchesTextShowSpec (Proxy :: Proxy DebugFlags) describe "CCFlags" $ matchesTextShowSpec (Proxy :: Proxy CCFlags) describe "ProfFlags" $ matchesTextShowSpec (Proxy :: Proxy ProfFlags) describe "TraceFlags" $ matchesTextShowSpec (Proxy :: Proxy TraceFlags) describe "TickyFlags" $ matchesTextShowSpec (Proxy :: Proxy TickyFlags) describe "GiveGCStats" $ matchesTextShowSpec (Proxy :: Proxy GiveGCStats') describe "DoCostCentres" $ matchesTextShowSpec (Proxy :: Proxy DoCostCentres') describe "DoHeapProfile" $ matchesTextShowSpec (Proxy :: Proxy DoHeapProfile') describe "DoTrace" $ matchesTextShowSpec (Proxy :: Proxy DoTrace') # if MIN_VERSION_base(4,10,0) describe "ParFlags" $ matchesTextShowSpec (Proxy :: Proxy ParFlags) # endif #else pure () #endif text-show-3.10.4/tests/Spec/GHC/StackSpec.hs0000644000000000000000000000170507346545000016606 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.StackSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'CallStack' and 'SrcLoc'. -} module Spec.GHC.StackSpec (main, spec) where import Instances.GHC.Stack () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,8,1) import Data.Proxy.Compat (Proxy(..)) import GHC.Stack (CallStack) # if MIN_VERSION_base(4,9,0) import GHC.Stack (SrcLoc) # else import GHC.SrcLoc (SrcLoc) # endif import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if MIN_VERSION_base(4,8,1) describe "CallStack" $ matchesTextShowSpec (Proxy :: Proxy CallStack) describe "SrcLoc" $ matchesTextShowSpec (Proxy :: Proxy SrcLoc) #else pure () #endif text-show-3.10.4/tests/Spec/GHC/StaticPtrSpec.hs0000644000000000000000000000144107346545000017453 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.StaticPtrSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'StaticPtr'. -} module Spec.GHC.StaticPtrSpec (main, spec) where import Instances.GHC.StaticPtr () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,8,0) import Data.Proxy.Compat (Proxy(..)) import GHC.StaticPtr (StaticPtrInfo) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if MIN_VERSION_base(4,8,0) describe "StaticPtrInfo" $ matchesTextShowSpec (Proxy :: Proxy StaticPtrInfo) #else pure () #endif text-show-3.10.4/tests/Spec/GHC/StatsSpec.hs0000644000000000000000000000146007346545000016635 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-| Module: Spec.GHC.StatsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'GCStats'. -} module Spec.GHC.StatsSpec (main, spec) where import Instances.GHC.Stats () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if !(MIN_VERSION_base(4,11,0)) import Data.Proxy.Compat (Proxy(..)) import GHC.Stats (GCStats) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if !(MIN_VERSION_base(4,11,0)) describe "GCStats" $ matchesTextShowSpec (Proxy :: Proxy GCStats) #else pure () #endif text-show-3.10.4/tests/Spec/GHC/TypeLitsSpec.hs0000644000000000000000000000240007346545000017307 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-| Module: Spec.GHC.TypeLitsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "GHC.TypeLits" module. -} module Spec.GHC.TypeLitsSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import GHC.TypeLits import Instances.GHC.TypeLits () import Prelude () import Prelude.Compat import Spec.Utils (matchesTextShowSpec) #if MIN_VERSION_base(4,18,0) import Spec.Utils (Some) #endif import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "SomeNat" $ matchesTextShowSpec (Proxy :: Proxy SomeNat) describe "SomeSymbol" $ matchesTextShowSpec (Proxy :: Proxy SomeSymbol) #if MIN_VERSION_base(4,16,0) describe "SomeChar" $ matchesTextShowSpec (Proxy :: Proxy SomeChar) #endif #if MIN_VERSION_base(4,18,0) describe "Some SNat" $ matchesTextShowSpec (Proxy :: Proxy (Some SNat)) describe "Some SSymbol" $ matchesTextShowSpec (Proxy :: Proxy (Some SSymbol)) describe "Some SChar" $ matchesTextShowSpec (Proxy :: Proxy (Some SChar)) #endif text-show-3.10.4/tests/Spec/GenericSpec.hs0000644000000000000000000000161707346545000016516 0ustar0000000000000000{-| Module: Spec.GenericSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'ConType'. -} module Spec.GenericSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Instances.Generic () import Instances.Utils (GenericExample) import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import TextShow.Generic (ConType) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "ConType" $ do let p :: Proxy ConType p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "GenericExample Int" $ do let p :: Proxy (GenericExample Int) p = Proxy matchesTextShowSpec p matchesTextShow1Spec p text-show-3.10.4/tests/Spec/Numeric/0000755000000000000000000000000007346545000015370 5ustar0000000000000000text-show-3.10.4/tests/Spec/Numeric/NaturalSpec.hs0000644000000000000000000000115107346545000020143 0ustar0000000000000000{-| Module: Spec.Numeric.NaturalSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'Natural'. -} module Spec.Numeric.NaturalSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Numeric.Natural.Compat (Natural) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Natural" $ matchesTextShowSpec (Proxy :: Proxy Natural) text-show-3.10.4/tests/Spec/OptionsSpec.hs0000644000000000000000000000154607346545000016576 0ustar0000000000000000{-| Module: Spec.OptionsSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'Options' and related datatypes. -} module Spec.OptionsSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Instances.Options () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import TextShow.TH (Options, GenTextMethods) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Options" $ do let p :: Proxy Options p = Proxy matchesTextShowSpec p genericTextShowSpec p describe "GenTextMethods" $ do let p :: Proxy GenTextMethods p = Proxy matchesTextShowSpec p genericTextShowSpec p text-show-3.10.4/tests/Spec/System/0000755000000000000000000000000007346545000015252 5ustar0000000000000000text-show-3.10.4/tests/Spec/System/ExitSpec.hs0000644000000000000000000000111707346545000017332 0ustar0000000000000000{-| Module: Spec.System.ExitSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'ExitCode'. -} module Spec.System.ExitSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import System.Exit (ExitCode) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck () main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "ExitCode" $ matchesTextShowSpec (Proxy :: Proxy ExitCode) text-show-3.10.4/tests/Spec/System/IOSpec.hs0000644000000000000000000000443607346545000016737 0ustar0000000000000000{-| Module: Spec.System.IOSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "System.IO" module. -} module Spec.System.IOSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import GHC.IO.Encoding.Failure (CodingFailureMode) import GHC.IO.Encoding.Types (CodingProgress) import Instances.System.IO () import Prelude () import Prelude.Compat import Spec.Utils (matchesTextShowSpec, prop_matchesTextShow) import System.IO (BufferMode, IOMode, HandlePosn, Newline, NewlineMode, SeekMode, Handle, mkTextEncoding) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Property, generate, ioProperty, oneof) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Handle" $ matchesTextShowSpec (Proxy :: Proxy Handle) describe "IOMode" $ matchesTextShowSpec (Proxy :: Proxy IOMode) describe "BufferMode" $ matchesTextShowSpec (Proxy :: Proxy BufferMode) describe "HandlePosn" $ matchesTextShowSpec (Proxy :: Proxy HandlePosn) describe "SeekMode" $ matchesTextShowSpec (Proxy :: Proxy SeekMode) describe "TextEncoding" $ prop "TextShow instance" prop_showTextEncoding describe "CodingProgress" $ matchesTextShowSpec (Proxy :: Proxy CodingProgress) describe "CodingFailureMode" $ matchesTextShowSpec (Proxy :: Proxy CodingFailureMode) describe "Newline" $ matchesTextShowSpec (Proxy :: Proxy Newline) describe "NewlineMode" $ matchesTextShowSpec (Proxy :: Proxy NewlineMode) -- | Verifies the 'TextShow' instance for 'TextEncoding' is accurate. prop_showTextEncoding :: Int -> Property prop_showTextEncoding p = ioProperty $ do -- Based on this description: -- http://hackage.haskell.org/package/base-4.7.0.2/docs/System-IO.html#v:mkTextEncoding utf <- generate . oneof $ map pure [ "UTF-8" , "UTF-16", "UTF-16BE", "UTF-16LE" , "UTF-32", "UTF-32BE", "UTF-32LE" ] tenc <- mkTextEncoding utf pure $ prop_matchesTextShow p tenc text-show-3.10.4/tests/Spec/System/Posix/0000755000000000000000000000000007346545000016354 5ustar0000000000000000text-show-3.10.4/tests/Spec/System/Posix/TypesSpec.hs0000644000000000000000000000572707346545000020642 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.System.Posix.TypesSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "System.Posix.Types" module. -} module Spec.System.Posix.TypesSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Instances.System.Posix.Types () import Spec.Utils (matchesTextShowSpec) import System.Posix.Types import Test.Hspec (Spec, describe, hspec, parallel) #include "HsBaseConfig.h" main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Fd" $ matchesTextShowSpec (Proxy :: Proxy Fd) #if defined(HTYPE_DEV_T) describe "CDev" $ matchesTextShowSpec (Proxy :: Proxy CDev) #endif #if defined(HTYPE_INO_T) describe "CIno" $ matchesTextShowSpec (Proxy :: Proxy CIno) #endif #if defined(HTYPE_MODE_T) describe "CMode" $ matchesTextShowSpec (Proxy :: Proxy CMode) #endif #if defined(HTYPE_OFF_T) describe "COff" $ matchesTextShowSpec (Proxy :: Proxy COff) #endif #if defined(HTYPE_PID_T) describe "CPid" $ matchesTextShowSpec (Proxy :: Proxy CPid) #endif #if defined(HTYPE_SSIZE_T) describe "CSsize" $ matchesTextShowSpec (Proxy :: Proxy CSsize) #endif #if defined(HTYPE_GID_T) describe "CGid" $ matchesTextShowSpec (Proxy :: Proxy CGid) #endif #if defined(HTYPE_NLINK_T) describe "CNlink" $ matchesTextShowSpec (Proxy :: Proxy CNlink) #endif #if defined(HTYPE_UID_T) describe "CUid" $ matchesTextShowSpec (Proxy :: Proxy CUid) #endif #if defined(HTYPE_CC_T) describe "CCc" $ matchesTextShowSpec (Proxy :: Proxy CCc) #endif #if defined(HTYPE_SPEED_T) describe "CSpeed" $ matchesTextShowSpec (Proxy :: Proxy CSpeed) #endif #if defined(HTYPE_TCFLAG_T) describe "CTcflag" $ matchesTextShowSpec (Proxy :: Proxy CTcflag) #endif #if defined(HTYPE_RLIM_T) describe "CRLim" $ matchesTextShowSpec (Proxy :: Proxy CRLim) #endif #if MIN_VERSION_base(4,10,0) # if defined(HTYPE_BLKSIZE_T) describe "CBlkSize" $ matchesTextShowSpec (Proxy :: Proxy CBlkSize) # endif # if defined(HTYPE_BLKCNT_T) describe "CBlkCnt" $ matchesTextShowSpec (Proxy :: Proxy CBlkCnt) # endif # if defined(HTYPE_CLOCKID_T) describe "CClockId" $ matchesTextShowSpec (Proxy :: Proxy CClockId) # endif # if defined(HTYPE_FSBLKCNT_T) describe "CFsBlkCnt" $ matchesTextShowSpec (Proxy :: Proxy CFsBlkCnt) # endif # if defined(HTYPE_FSFILCNT_T) describe "CFsFilCnt" $ matchesTextShowSpec (Proxy :: Proxy CFsFilCnt) # endif # if defined(HTYPE_ID_T) describe "CId" $ matchesTextShowSpec (Proxy :: Proxy CId) # endif # if defined(HTYPE_KEY_T) describe "CKey" $ matchesTextShowSpec (Proxy :: Proxy CKey) # endif # if defined(HTYPE_TIMER_T) describe "CTimer" $ matchesTextShowSpec (Proxy :: Proxy CTimer) # endif #endif text-show-3.10.4/tests/Spec/Text/0000755000000000000000000000000007346545000014712 5ustar0000000000000000text-show-3.10.4/tests/Spec/Text/ReadSpec.hs0000644000000000000000000000132707346545000016737 0ustar0000000000000000{-| Module: Spec.Text.ReadSpec Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Text.Read" module. -} module Spec.Text.ReadSpec (main, spec) where import Data.Proxy.Compat (Proxy(..)) import Instances.Text.Read () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Text.Read (Lexeme) import Text.Read.Lex (Number) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Lexeme" $ matchesTextShowSpec (Proxy :: Proxy Lexeme) describe "Number" $ matchesTextShowSpec (Proxy :: Proxy Number) text-show-3.10.4/tests/Spec/Utils.hs0000644000000000000000000001300507346545000015421 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE QuantifiedConstraints #-} #endif {-| Module: Spec.Utils Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Testing-related utility functions. -} module Spec.Utils ( matchesTextShowSpec , prop_matchesTextShow , matchesTextShow1Spec #if defined(NEW_FUNCTOR_CLASSES) , matchesTextShow2Spec #endif , genericTextShowSpec , genericTextShow1Spec , Some(..) , GArbitrary(..) ) where import Data.Functor.Classes (Show1, showsPrec1) import Data.Proxy.Compat (Proxy(..)) import Generics.Deriving.Base import Test.Hspec (Expectation, Spec, shouldBe) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Arbitrary(..), Gen) import TextShow (TextShow(..), TextShow1(..), showbPrec1, fromString) import TextShow.Generic #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2, showsPrec2) import TextShow (TextShow2(..), showbPrec2) #endif #if __GLASGOW_HASKELL__ >= 806 import GHC.Show (appPrec, appPrec1) import TextShow (showbParen, showbSpace) #endif -- | Expect a type's 'Show' instances to coincide for both 'String's and 'Text', -- irrespective of precedence. matchesTextShowSpec :: forall a. (Arbitrary a, Show a, TextShow a) => Proxy a -> Spec matchesTextShowSpec _ = prop "TextShow instance" (prop_matchesTextShow :: Int -> a -> Expectation) -- | 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 -> Expectation prop_matchesTextShow p x = showbPrec p x `shouldBe` fromString (showsPrec p x "") -- | Expect a type's 'Show1' instances to coincide for both 'String's and 'Text', -- irrespective of precedence. matchesTextShow1Spec :: forall f a. (Arbitrary (f a), Show1 f, Show a, Show (f a), TextShow1 f, TextShow a) => Proxy (f a) -> Spec matchesTextShow1Spec _ = prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> f a -> Expectation) -- | Verifies that a type's 'Show1' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow1 :: (Show1 f, Show a, TextShow1 f, TextShow a) => Int -> f a -> Expectation prop_matchesTextShow1 p x = showbPrec1 p x `shouldBe` fromString (showsPrec1 p x "") #if defined(NEW_FUNCTOR_CLASSES) -- | Expect a type's 'Show2' instances to coincide for both 'String's and 'Text', -- irrespective of precedence. matchesTextShow2Spec :: forall f a b. (Arbitrary (f a b), Show2 f, Show a, Show b, Show (f a b), TextShow2 f, TextShow a, TextShow b) => Proxy (f a b) -> Spec matchesTextShow2Spec _ = prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> f a b -> Expectation) -- | Verifies that a type's 'Show2' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow2 :: (Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b) => Int -> f a b -> Expectation prop_matchesTextShow2 p x = showbPrec2 p x `shouldBe` fromString (showsPrec2 p x "") #endif -- | Expect a type's 'TextShow' instance to coincide with the output produced -- by the equivalent 'Generic' functions. genericTextShowSpec :: forall a. (Arbitrary a, Show a, TextShow a, Generic a, GTextShowB (Rep a ())) => Proxy a -> Spec genericTextShowSpec _ = prop "generic TextShow" (prop_genericTextShow :: Int -> a -> Expectation) -- | Verifies that a type's 'TextShow' instance coincides with the output produced -- by the equivalent 'Generic' functions. prop_genericTextShow :: (TextShow a, Generic a, GTextShowB (Rep a ())) => Int -> a -> Expectation prop_genericTextShow p x = showbPrec p x `shouldBe` genericShowbPrec p x -- | Expect a type's 'TextShow1' instance to coincide with the output produced -- by the equivalent 'Generic1' functions. genericTextShow1Spec :: forall f a. (Arbitrary (f a), Show (f a), TextShow1 f, Generic1 f, GTextShowB1 (Rep1 f), TextShow a) => Proxy (f a) -> Spec genericTextShow1Spec _ = prop "generic TextShow1" (prop_genericTextShow1 :: Int -> f a -> Expectation) -- | Verifies that a type's 'TextShow1' instance coincides with the output produced -- by the equivalent 'Generic1' functions. prop_genericTextShow1 :: ( TextShow1 f, Generic1 f , GTextShowB1 (Rep1 f), TextShow a ) => Int -> f a -> Expectation prop_genericTextShow1 p x = showbPrec1 p x `shouldBe` genericLiftShowbPrec showbPrec showbList p x -- | A data type that existentially closes over something. data Some t where Some :: t a -> Some t #if __GLASGOW_HASKELL__ >= 806 deriving instance (forall a. Show (t a)) => Show (Some t) instance (forall a. TextShow (t a)) => TextShow (Some t) where showbPrec p (Some x) = showbParen (p > appPrec) $ fromString "Some" <> showbSpace <> showbPrec appPrec1 x #endif instance GArbitrary t => Arbitrary (Some t) where arbitrary = garbitrary -- | An 'Arbitrary'-like class for 1-type-parameter GADTs. class GArbitrary t where garbitrary :: Gen (Some t) text-show-3.10.4/text-show.cabal0000644000000000000000000004310507346545000014663 0ustar0000000000000000name: text-show version: 3.10.4 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 in the spirit of @@. . For most uses, simply importing "TextShow" will suffice: . @ module Main where . import TextShow . main :: IO () main = printT (Just \"Hello, World!\") @ . See also the page. . Support for automatically deriving @TextShow@ instances can be found in the "TextShow.TH" and "TextShow.Generic" modules. . @text-show@ only provides instances for data types in the following packages: . * @@ . * @@ . * @@ . * @@ . This policy is in place to keep @text-show@'s dependencies reasonably light. If you need a @TextShow@ instance for a library that is not in this list, it may be covered by the @@ library. homepage: https://github.com/RyanGlScott/text-show bug-reports: https://github.com/RyanGlScott/text-show/issues license: BSD3 license-file: LICENSE author: Ryan Scott maintainer: Ryan Scott stability: Provisional copyright: (C) 2014-2017 Ryan Scott category: Text build-type: Simple tested-with: GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8 , GHC == 9.4.5 , GHC == 9.6.2 extra-source-files: CHANGELOG.md, README.md, include/*.h cabal-version: >=1.10 source-repository head type: git location: https://github.com/RyanGlScott/text-show flag base-4-9 description: Use base-4.9 or later. default: True flag template-haskell-2-11 description: Use template-haskell-2.11.0.0 or later. default: True flag new-functor-classes description: Use a version of transformers or transformers-compat with a modern-style Data.Functor.Classes module. This flag cannot be used when building with transformers-0.4, since it comes with a different version of Data.Functor.Classes. default: True flag integer-gmp description: When building with a version of GHC older than 9.0, depend on the @integer-gmp@ library. You can disable this if you do not wish to link against GMP, but at the expense of having a slower @TextShow Natural@ instance. default: True library exposed-modules: TextShow TextShow.Control.Applicative TextShow.Control.Concurrent TextShow.Control.Exception TextShow.Control.Monad.ST TextShow.Data.Array TextShow.Data.Array.Byte TextShow.Data.Bool TextShow.Data.ByteString TextShow.Data.Char TextShow.Data.Complex TextShow.Data.Data TextShow.Data.Dynamic 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 TextShow.Data.Version TextShow.Data.Void TextShow.Foreign.C.Types TextShow.Foreign.Ptr TextShow.Functions TextShow.GHC.Fingerprint TextShow.GHC.Generics TextShow.GHC.Stats TextShow.Numeric.Natural TextShow.System.Exit TextShow.System.IO TextShow.System.Posix.Types TextShow.Text.Read TextShow.TH -- Only exports functions if using Windows TextShow.GHC.Conc.Windows -- Only exports functions if not using Windows TextShow.GHC.Event -- Only exports functions if base >= 4.6 TextShow.GHC.TypeLits -- Only exports functions if base >= 4.7 TextShow.Data.Type.Coercion TextShow.Data.Type.Equality -- Only exports functions if base >= 4.7 && < 4.8 TextShow.Data.OldTypeable -- Only exports functions if base >= 4.8 TextShow.GHC.RTS.Flags TextShow.GHC.StaticPtr -- Only exports functions if base >= 4.8.1 TextShow.GHC.Stack other-modules: TextShow.Classes TextShow.Data.Typeable.Utils TextShow.FromStringTextShow TextShow.Instances TextShow.Options TextShow.TH.Internal TextShow.TH.Names TextShow.Utils build-depends: array >= 0.3 && < 0.6 , base-compat-batteries >= 0.11 && < 0.14 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.13 , bytestring-builder , containers >= 0.1 && < 0.7 , generic-deriving >= 1.14.1 && < 2 , ghc-prim , text >= 0.11.1 && < 2.1 , th-abstraction >= 0.4 && < 0.7 , th-lift >= 0.7.6 && < 1 if flag(base-4-9) build-depends: base >= 4.9 && < 4.20 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.7 && < 4.9 if flag(template-haskell-2-11) build-depends: template-haskell >= 2.11 && < 2.22 , ghc-boot-th >= 8.0 && < 9.9 else build-depends: template-haskell >= 2.9 && < 2.11 if flag(new-functor-classes) build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.7) , transformers-compat >= 0.5 && < 1 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: transformers == 0.4.* -- integer-gmp is only needed on pre-9.0 versions of GHC, as GHC 9.0+ add -- enough functionality to base to avoid the use of integer-gmp entirely. if !impl(ghc >= 9.0) && flag(integer-gmp) build-depends: integer-gmp hs-source-dirs: src, shared default-language: Haskell2010 ghc-options: -Wall if impl(ghc >= 8.6) ghc-options: -Wno-star-is-type if impl(ghc >= 9.0) ghc-options: -fenable-th-splice-warnings include-dirs: include includes: generic.h test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Derived.DataFamilies Derived.DatatypeContexts Derived.ExistentialQuantification Derived.Infix Derived.MagicHash Derived.PolyKinds Derived.RankNTypes Derived.Records Derived.TypeFamilies Derived.TypeSynonyms Instances.Control.Concurrent Instances.Control.Exception Instances.Control.Monad.ST Instances.Data.Char Instances.Data.Data Instances.Data.Dynamic Instances.Data.Floating Instances.Data.Ord Instances.Data.Semigroup Instances.Data.Text Instances.Data.Tuple Instances.Data.Typeable Instances.Foreign.C.Types Instances.Foreign.Ptr Instances.FromStringTextShow Instances.Generic Instances.GHC.Fingerprint Instances.GHC.Generics Instances.GHC.Stats Instances.Options Instances.System.IO Instances.System.Posix.Types Instances.Text.Read Instances.Utils Instances.Utils.GenericArbitrary -- Only exports instances if using Windows Instances.GHC.Conc.Windows -- Only exports instances if not using Windows Instances.GHC.Event -- Only exports instances if base >= 4.6 Instances.GHC.TypeLits -- Only exports instances if base >= 4.7 Instances.Data.Type.Coercion Instances.Data.Type.Equality -- Only exports instances if base >= 4.7 && < 4.8 Instances.Data.OldTypeable -- Only exports instances if base >= 4.8 Instances.GHC.RTS.Flags Instances.GHC.StaticPtr -- Only exports instances if base >= 4.9 Instances.GHC.Stack -- Only exports instances if base >= 4.12 Instances.Data.Monoid Spec.BuilderSpec Spec.Control.ApplicativeSpec Spec.Control.ConcurrentSpec Spec.Control.ExceptionSpec Spec.Control.Monad.STSpec Spec.Data.ArraySpec Spec.Data.Array.ByteSpec Spec.Data.BoolSpec Spec.Data.ByteStringSpec Spec.Data.CharSpec Spec.Data.ComplexSpec Spec.Data.DataSpec Spec.Data.DynamicSpec 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 Spec.Data.VersionSpec Spec.Derived.DataFamiliesSpec Spec.Derived.DatatypeContextsSpec Spec.Derived.ExistentialQuantificationSpec Spec.Derived.InfixSpec Spec.Derived.MagicHashSpec Spec.Derived.PolyKindsSpec Spec.Derived.RankNTypesSpec Spec.Derived.RecordsSpec Spec.Derived.TypeFamiliesSpec Spec.Derived.TypeSynonymsSpec Spec.Foreign.C.TypesSpec Spec.Foreign.PtrSpec Spec.FromStringTextShowSpec Spec.FunctionsSpec Spec.GenericSpec Spec.GHC.FingerprintSpec Spec.GHC.GenericsSpec Spec.GHC.StatsSpec Spec.Numeric.NaturalSpec Spec.OptionsSpec Spec.System.ExitSpec Spec.System.IOSpec Spec.System.Posix.TypesSpec Spec.Text.ReadSpec Spec.Utils -- Only exports tests if using Windows Spec.GHC.Conc.WindowsSpec -- Only exports tests if not using Windows Spec.GHC.EventSpec -- Only exports tests if base >= 4.6 Spec.GHC.TypeLitsSpec -- Only exports tests if base >= 4.7 Spec.Data.Type.CoercionSpec Spec.Data.Type.EqualitySpec -- Only exports tests if base >= 4.7 && < 4.8 Spec.Data.OldTypeableSpec -- Only exports tests if base >= 4.8 Spec.GHC.RTS.FlagsSpec Spec.GHC.StaticPtrSpec -- Only exports tests if base >= 4.9 Spec.GHC.StackSpec TextShow.TH.Names build-depends: array >= 0.3 && < 0.6 , base-compat-batteries >= 0.11 && < 0.14 , base-orphans >= 0.8.5 && < 0.10 , bytestring >= 0.9 && < 0.13 , bytestring-builder , deriving-compat >= 0.6.5 && < 1 , generic-deriving >= 1.14.1 && < 2 , ghc-prim , hspec >= 2 && < 3 , QuickCheck >= 2.14.3 && < 2.15 , quickcheck-instances >= 0.3.28 && < 0.4 , template-haskell >= 2.9 && < 2.22 , text >= 0.11.1 && < 2.1 , text-show , transformers-compat >= 0.5 && < 1 build-tool-depends: hspec-discover:hspec-discover if flag(base-4-9) build-depends: base >= 4.9 && < 4.20 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.7 && < 4.9 if flag(new-functor-classes) build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.7) cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: transformers == 0.4.* hs-source-dirs: tests, shared default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts if impl(ghc >= 8.6) ghc-options: -Wno-star-is-type if impl(ghc >= 9.0) ghc-options: -fenable-th-splice-warnings include-dirs: include includes: generic.h , overlap.h benchmark bench type: exitcode-stdio-1.0 main-is: Bench.hs build-depends: base >= 4.5 && < 4.20 , criterion >= 1.1.4 && < 2 , deepseq >= 1.3 && < 2 , ghc-prim , text-show , text >= 0.11.1 && < 2.1 hs-source-dirs: benchmarks default-language: Haskell2010 ghc-options: -Wall